diff --git a/SQLite.xs b/SQLite.xs
index 1aca6d1..fda00aa 100644
--- a/SQLite.xs
+++ b/SQLite.xs
@@ -1,109 +1,109 @@
-#define PERL_NO_GET_CONTEXT
-
-#include "SQLiteXS.h"
-
-DBISTATE_DECLARE;
-
-MODULE = DBD::SQLite PACKAGE = DBD::SQLite::db
-
-PROTOTYPES: DISABLE
-
-BOOT:
- sv_setpv(get_sv("DBD::SQLite::sqlite_version", TRUE|GV_ADDMULTI), SQLITE_VERSION);
-
-AV *
-list_tables(dbh)
- SV *dbh
- CODE:
- {
- RETVAL = newAV();
- }
- OUTPUT:
- RETVAL
-
-IV
-last_insert_rowid(dbh)
- SV *dbh
- CODE:
- {
- D_imp_dbh(dbh);
- RETVAL = sqlite3_last_insert_rowid(imp_dbh->db);
- }
- OUTPUT:
- RETVAL
-
-void
-create_function(dbh, name, argc, func)
- SV *dbh
- char *name
- int argc
- SV *func
- CODE:
- {
- sqlite3_db_create_function(aTHX_ dbh, name, argc, func );
- }
-
-void
-enable_load_extension(dbh, onoff)
- SV *dbh
- int onoff
- CODE:
- {
- sqlite3_db_enable_load_extension(aTHX_ dbh, onoff );
- }
-
-void
-create_aggregate(dbh, name, argc, aggr)
- SV *dbh
- char *name
- int argc
- SV *aggr
- CODE:
- {
- sqlite3_db_create_aggregate(aTHX_ dbh, name, argc, aggr );
- }
-
-void
-create_collation(dbh, name, func)
- SV *dbh
- char *name
- SV *func
- CODE:
- {
- sqlite3_db_create_collation(aTHX_ dbh, name, func );
- }
-
-void
-progress_handler(dbh, n_opcodes, handler)
- SV *dbh
- int n_opcodes
- SV *handler
- CODE:
- {
- sqlite3_db_progress_handler(aTHX_ dbh, n_opcodes, handler );
- }
-
-int
-busy_timeout(dbh, timeout=0)
- SV *dbh
- int timeout
- CODE:
- RETVAL = dbd_set_sqlite3_busy_timeout(aTHX_ dbh, timeout );
- OUTPUT:
- RETVAL
-
-MODULE = DBD::SQLite PACKAGE = DBD::SQLite::st
-
-PROTOTYPES: DISABLE
-
-void
-reset(sth)
- SV *sth
- CODE:
- {
- sqlite_st_reset(aTHX_ sth);
- }
-
-MODULE = DBD::SQLite PACKAGE = DBD::SQLite
-
-INCLUDE: SQLite.xsi
+#define PERL_NO_GET_CONTEXT
+
+#include "SQLiteXS.h"
+
+DBISTATE_DECLARE;
+
+MODULE = DBD::SQLite PACKAGE = DBD::SQLite::db
+
+PROTOTYPES: DISABLE
+
+BOOT:
+ sv_setpv(get_sv("DBD::SQLite::sqlite_version", TRUE|GV_ADDMULTI), SQLITE_VERSION);
+
+AV *
+list_tables(dbh)
+ SV *dbh
+ CODE:
+ {
+ RETVAL = newAV();
+ }
+ OUTPUT:
+ RETVAL
+
+IV
+last_insert_rowid(dbh)
+ SV *dbh
+ CODE:
+ {
+ D_imp_dbh(dbh);
+ RETVAL = sqlite3_last_insert_rowid(imp_dbh->db);
+ }
+ OUTPUT:
+ RETVAL
+
+void
+create_function(dbh, name, argc, func)
+ SV *dbh
+ char *name
+ int argc
+ SV *func
+ CODE:
+ {
+ sqlite3_db_create_function(aTHX_ dbh, name, argc, func );
+ }
+
+void
+enable_load_extension(dbh, onoff)
+ SV *dbh
+ int onoff
+ CODE:
+ {
+ sqlite3_db_enable_load_extension(aTHX_ dbh, onoff );
+ }
+
+void
+create_aggregate(dbh, name, argc, aggr)
+ SV *dbh
+ char *name
+ int argc
+ SV *aggr
+ CODE:
+ {
+ sqlite3_db_create_aggregate(aTHX_ dbh, name, argc, aggr );
+ }
+
+void
+create_collation(dbh, name, func)
+ SV *dbh
+ char *name
+ SV *func
+ CODE:
+ {
+ sqlite3_db_create_collation(aTHX_ dbh, name, func );
+ }
+
+void
+progress_handler(dbh, n_opcodes, handler)
+ SV *dbh
+ int n_opcodes
+ SV *handler
+ CODE:
+ {
+ sqlite3_db_progress_handler(aTHX_ dbh, n_opcodes, handler );
+ }
+
+int
+busy_timeout(dbh, timeout=0)
+ SV *dbh
+ int timeout
+ CODE:
+ RETVAL = dbd_set_sqlite3_busy_timeout(aTHX_ dbh, timeout );
+ OUTPUT:
+ RETVAL
+
+MODULE = DBD::SQLite PACKAGE = DBD::SQLite::st
+
+PROTOTYPES: DISABLE
+
+void
+reset(sth)
+ SV *sth
+ CODE:
+ {
+ sqlite_st_reset(aTHX_ sth);
+ }
+
+MODULE = DBD::SQLite PACKAGE = DBD::SQLite
+
+INCLUDE: SQLite.xsi
diff --git a/dbdimp.c b/dbdimp.c
index f7416ae..8c69e2f 100644
--- a/dbdimp.c
+++ b/dbdimp.c
@@ -1,1383 +1,1383 @@
-#define PERL_NO_GET_CONTEXT
-
-#include "SQLiteXS.h"
-
-DBISTATE_DECLARE;
-
-#ifndef SvPV_nolen
-#define SvPV_nolen(x) SvPV(x,PL_na)
-#endif
-
-#define SvPV_nolen_undef_ok(x) (SvOK(x) ? SvPV_nolen(x) : "undef")
-
-#ifndef call_method
-#define call_method(x,y) perl_call_method(x,y)
-#endif
-
-#ifndef call_sv
-#define call_sv(x,y) perl_call_sv(x,y)
-#endif
-
-#define sqlite_error(h,xxh,rc,what) _sqlite_error(aTHX_ __FILE__, __LINE__, h, xxh, rc, what)
-
-/* XXX: is there any good way to use pTHX_/aTHX_ here like above? */
-#if defined(__GNUC__) && (__GNUC__ > 2)
-# define sqlite_trace(h,xxh,level,fmt...) _sqlite_tracef(__FILE__, __LINE__, h, xxh, level, fmt)
-#else
-# define sqlite_trace _sqlite_tracef_noline
-#endif
-
-void
-sqlite_init(dbistate_t *dbistate)
-{
- dTHX;
- DBISTATE_INIT; /* Initialize the DBI macros */
-}
-
-static void
-_sqlite_error(pTHX_ char *file, int line, SV *h, imp_xxh_t *imp_xxh, int rc, char *what)
-{
- DBIh_SET_ERR_CHAR(h, imp_xxh, Nullch, rc, what, Nullch, Nullch);
-
- /* #7753: DBD::SQLite error shouldn't include extraneous info */
- /* sv_catpvf(errstr, "(%d) at %s line %d", rc, file, line); */
- if ( DBIc_TRACE_LEVEL(imp_xxh) >= 3 ) {
- PerlIO_printf(
- DBIc_LOGPIO(imp_xxh),
- "sqlite error %d recorded: %s at %s line %d\n",
- rc, what, file, line
- );
- }
-}
-
-static void
-_sqlite_tracef(char *file, int line, SV *h, imp_xxh_t *imp_xxh, int level, const char *fmt, ...)
-{
- dTHX;
-
- va_list ap;
- if ( DBIc_TRACE_LEVEL(imp_xxh) >= level ) {
- char format[8192];
- sqlite3_snprintf(8191, format, "sqlite trace: %s at %s line %d\n", fmt, file, line);
- va_start(ap, fmt);
- PerlIO_vprintf(DBIc_LOGPIO(imp_xxh), format, ap);
- va_end(ap);
- }
-}
-
-static void
-_sqlite_tracef_noline(SV *h, imp_xxh_t *imp_xxh, int level, const char *fmt, ...)
-{
- dTHX;
-
- va_list ap;
- if ( DBIc_TRACE_LEVEL(imp_xxh) >= level ) {
- char format[8192];
- sqlite3_snprintf(8191, format, "sqlite trace: %s\n", fmt);
- va_start(ap, fmt);
- PerlIO_vprintf(DBIc_LOGPIO(imp_xxh), format, ap);
- va_end(ap);
- }
-}
-
-int
-sqlite_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pass)
-{
- dTHX;
- int retval;
- char *errmsg = NULL;
-
- if ( DBIc_TRACE_LEVEL(imp_dbh) >= 3 ) {
- PerlIO_printf(DBILOGFP, " login '%s' (version %s)\n",
- dbname, sqlite3_version);
- }
-
- if ((retval = sqlite3_open(dbname, &(imp_dbh->db))) != SQLITE_OK ) {
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
- DBIc_IMPSET_on(imp_dbh);
-
- imp_dbh->in_tran = FALSE;
- imp_dbh->unicode = FALSE;
- imp_dbh->functions = newAV();
- imp_dbh->aggregates = newAV();
- imp_dbh->timeout = SQL_TIMEOUT;
- imp_dbh->handle_binary_nulls = FALSE;
-
- sqlite3_busy_timeout(imp_dbh->db, SQL_TIMEOUT);
-
- if ((retval = sqlite3_exec(imp_dbh->db, "PRAGMA empty_result_callbacks = ON",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- /* warn("failed to set pragma: %s\n", errmsg); */
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
-
- if ((retval = sqlite3_exec(imp_dbh->db, "PRAGMA show_datatypes = ON",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- /* warn("failed to set pragma: %s\n", errmsg); */
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
-
- DBIc_ACTIVE_on(imp_dbh);
-
-/*
- if ( DBIc_WARN(imp_dbh) ) {
- warn("DBIc_WARN is on");
- }
- else {
- warn("DBIc_WARN if off");
- }
- if ( DBIc_is(imp_dbh, DBIcf_PrintWarn) ) {
- warn("DBIcf_PrintWarn is on");
- }
-*/
-
- return TRUE;
-}
-
-int
-dbd_set_sqlite3_busy_timeout (pTHX_ SV *dbh, int timeout )
-{
- D_imp_dbh(dbh);
- if (timeout) {
- imp_dbh->timeout = timeout;
- sqlite3_busy_timeout(imp_dbh->db, timeout);
- }
- return imp_dbh->timeout;
-}
-
-int
-sqlite_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHX;
- sqlite3_stmt *pStmt;
- DBIc_ACTIVE_off(imp_dbh);
-
- if (DBIc_is(imp_dbh, DBIcf_AutoCommit) == FALSE) {
- sqlite_db_rollback(dbh, imp_dbh);
- }
-
- while ( (pStmt = sqlite3_next_stmt(imp_dbh->db, 0))!=0 ) {
- sqlite3_finalize(pStmt);
- }
-
- if (sqlite3_close(imp_dbh->db) == SQLITE_BUSY) {
- /* active statements! */
- warn("closing dbh with active statement handles");
- }
- imp_dbh->db = NULL;
-
- av_undef(imp_dbh->functions);
- SvREFCNT_dec(imp_dbh->functions);
- imp_dbh->functions = (AV *)NULL;
-
- av_undef(imp_dbh->aggregates);
- SvREFCNT_dec(imp_dbh->aggregates);
- imp_dbh->aggregates = (AV *)NULL;
-
- return TRUE;
-}
-
-void
-sqlite_db_destroy (SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHX;
- if (DBIc_ACTIVE(imp_dbh)) {
- /* warn("DBIc_ACTIVE is on"); */
- sqlite_db_disconnect(dbh, imp_dbh);
-/*
- } else {
- warn("DBIc_ACTIVE is off");
-*/
- }
- DBIc_IMPSET_off(imp_dbh);
-}
-
-int
-sqlite_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHX;
- int retval;
- char *errmsg;
-
- if (imp_dbh->in_tran) {
- sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "ROLLBACK TRAN");
- if ((retval = sqlite3_exec(imp_dbh->db, "ROLLBACK TRANSACTION",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- return FALSE; /* -> &sv_no in SQLite.xsi */
- }
- imp_dbh->in_tran = FALSE;
- }
-
- return TRUE;
-}
-
-int
-sqlite_db_commit(SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHX;
- int retval;
- char *errmsg;
-
- if (DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
- /* We don't need to warn, because the DBI layer will do it for us */
- return TRUE;
- }
-
- if (imp_dbh->in_tran) {
- sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "COMMIT TRAN");
- if ((retval = sqlite3_exec(imp_dbh->db, "COMMIT TRANSACTION",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- return FALSE; /* -> &sv_no in SQLite.xsi */
- }
- imp_dbh->in_tran = FALSE;
- }
- return TRUE;
-}
-
-int
-sqlite_discon_all(SV *drh, imp_drh_t *imp_drh)
-{
- dTHX;
- return FALSE; /* no way to do this */
-}
-
-SV *
-sqlite_db_last_insert_id(SV *dbh, imp_dbh_t *imp_dbh, SV *catalog, SV *schema, SV *table, SV *field, SV *attr)
-{
- dTHX;
- return newSViv(sqlite3_last_insert_rowid(imp_dbh->db));
-}
-
-int
-sqlite_st_prepare (SV *sth, imp_sth_t *imp_sth,
- char *statement, SV *attribs)
-{
- dTHX;
- D_imp_dbh_from_sth;
- const char *extra;
- int retval = 0;
-
- if (!DBIc_ACTIVE(imp_dbh)) {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to prepare on inactive database handle");
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
-
- if (strlen(statement) < 1) {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to prepare empty statement");
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
-
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 2, "prepare statement: %s", statement);
- imp_sth->nrow = -1;
- imp_sth->retval = SQLITE_OK;
- imp_sth->params = newAV();
- imp_sth->col_types = newAV();
- Newz(0, imp_sth->statement, strlen(statement)+1, char);
-
- if ((retval = sqlite3_prepare_v2(imp_dbh->db, statement, -1, &(imp_sth->stmt), &extra))
- != SQLITE_OK)
- {
- if (imp_sth->stmt) {
- sqlite3_finalize(imp_sth->stmt);
- }
- sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return FALSE; /* -> undef in lib/DBD/SQLite.pm */
- }
-
- /* store the query for later re-use if required */
- Copy(statement, imp_sth->statement, strlen(statement)+1, char);
-
- DBIc_NUM_PARAMS(imp_sth) = sqlite3_bind_parameter_count(imp_sth->stmt);
- DBIc_NUM_FIELDS(imp_sth) = sqlite3_column_count(imp_sth->stmt);
- DBIc_IMPSET_on(imp_sth);
-
- return TRUE;
-}
-
-char *
-sqlite_quote(imp_dbh_t *imp_dbh, SV *val)
-{
- dTHX;
- STRLEN len;
- char *cval = SvPV(val, len);
- SV *ret = sv_2mortal(NEWSV(0, SvCUR(val) + 2));
- sv_setpvn(ret, "", 0);
-
- while (len) {
- switch (*cval) {
- case '\'':
- sv_catpvn(ret, "''", 2);
- break;
- default:
- sv_catpvn(ret, cval, 1);
- }
- *cval++; len--;
- }
- return SvPV_nolen(ret);
-}
-
-void
-sqlite_st_reset (pTHX_ SV *sth)
-{
- D_imp_sth(sth);
- if (DBIc_IMPSET(imp_sth))
- sqlite3_reset(imp_sth->stmt);
-}
-
-int
-sqlite_st_execute (SV *sth, imp_sth_t *imp_sth)
-{
- dTHX;
- D_imp_dbh_from_sth;
- char *errmsg;
- int num_params = DBIc_NUM_PARAMS(imp_sth);
- int i;
- int retval = 0;
-
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "execute");
-
- /* warn("execute\n"); */
-
- if (!DBIc_ACTIVE(imp_dbh)) {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to execute on inactive database handle");
- return -2; /* -> undef in SQLite.xsi */
- }
-
- if (DBIc_ACTIVE(imp_sth)) {
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "execute still active, reset");
- if ((imp_sth->retval = sqlite3_reset(imp_sth->stmt)) != SQLITE_OK) {
- char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
- sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
- return -2; /* -> undef in SQLite.xsi */
- }
- }
-
- for (i = 0; i < num_params; i++) {
- SV *value = av_shift(imp_sth->params);
- SV *sql_type_sv = av_shift(imp_sth->params);
- int sql_type = SvIV(sql_type_sv);
-
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 4, "params left in 0x%p: %d", imp_sth->params, 1+av_len(imp_sth->params));
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 4, "bind %d type %d as %s", i, sql_type, SvPV_nolen_undef_ok(value));
-
- if (!SvOK(value)) {
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 5, "binding null");
- retval = sqlite3_bind_null(imp_sth->stmt, i+1);
- }
- else if (sql_type >= SQL_NUMERIC && sql_type <= SQL_SMALLINT) {
-#if defined(USE_64_BIT_INT)
- retval = sqlite3_bind_int64(imp_sth->stmt, i+1, SvIV(value));
-#else
- retval = sqlite3_bind_int(imp_sth->stmt, i+1, SvIV(value));
-#endif
- }
- else if (sql_type >= SQL_FLOAT && sql_type <= SQL_DOUBLE) {
- retval = sqlite3_bind_double(imp_sth->stmt, i+1, SvNV(value));
- }
- else if (sql_type == SQL_BLOB) {
- STRLEN len;
- char * data = SvPV(value, len);
- retval = sqlite3_bind_blob(imp_sth->stmt, i+1, data, len, SQLITE_TRANSIENT);
- }
- else {
-#if 0
- /* stop guessing until we figure out better way to do this */
- const int numtype = looks_like_number(value);
- if ((numtype & (IS_NUMBER_IN_UV|IS_NUMBER_NOT_INT)) == IS_NUMBER_IN_UV) {
-#if defined(USE_64_BIT_INT)
- retval = sqlite3_bind_int64(imp_sth->stmt, i+1, SvIV(value));
-#else
- retval = sqlite3_bind_int(imp_sth->stmt, i+1, SvIV(value));
-#endif
- }
- else if ((numtype & (IS_NUMBER_NOT_INT|IS_NUMBER_INFINITY|IS_NUMBER_NAN)) == IS_NUMBER_NOT_INT) {
- retval = sqlite3_bind_double(imp_sth->stmt, i+1, SvNV(value));
- }
- else {
-#endif
- STRLEN len;
- char *data;
- if (imp_dbh->unicode) {
- sv_utf8_upgrade(value);
- }
- data = SvPV(value, len);
- retval = sqlite3_bind_text(imp_sth->stmt, i+1, data, len, SQLITE_TRANSIENT);
-#if 0
- }
-#endif
- }
-
- if (value) {
- SvREFCNT_dec(value);
- }
- SvREFCNT_dec(sql_type_sv);
- if (retval != SQLITE_OK) {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return -4; /* -> undef in SQLite.xsi */
- }
- }
-
- if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (!imp_dbh->in_tran) ) {
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 2, "BEGIN TRAN");
- if ((retval = sqlite3_exec(imp_dbh->db, "BEGIN TRANSACTION",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
- return -2; /* -> undef in SQLite.xsi */
- }
- imp_dbh->in_tran = TRUE;
- }
-
- imp_sth->nrow = 0;
-
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "Execute returned %d cols\n", DBIc_NUM_FIELDS(imp_sth));
- if (DBIc_NUM_FIELDS(imp_sth) == 0) {
- while ((imp_sth->retval = sqlite3_step(imp_sth->stmt)) != SQLITE_DONE) {
- if (imp_sth->retval == SQLITE_ROW) {
- continue;
- }
- sqlite3_reset(imp_sth->stmt);
- sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return -5; /* -> undef in SQLite.xsi */
- }
- /* warn("Finalize\n"); */
- sqlite3_reset(imp_sth->stmt);
- imp_sth->nrow = sqlite3_changes(imp_dbh->db);
- /* DBIc_ACTIVE_on(imp_sth); */
- /* warn("Total changes: %d\n", sqlite3_total_changes(imp_dbh->db)); */
- /* warn("Nrow: %d\n", imp_sth->nrow); */
- return imp_sth->nrow;
- }
-
- imp_sth->retval = sqlite3_step(imp_sth->stmt);
- switch (imp_sth->retval) {
- case SQLITE_ROW:
- case SQLITE_DONE: DBIc_ACTIVE_on(imp_sth);
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 5, "exec ok - %d rows, %d cols\n", imp_sth->nrow, DBIc_NUM_FIELDS(imp_sth));
- return 0; /* -> '0E0' in SQLite.xsi */
- default: sqlite3_reset(imp_sth->stmt);
- imp_sth->stmt = NULL;
- sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return -6; /* -> undef in SQLite.xsi */
- }
-}
-
-int
-sqlite_st_rows (SV *sth, imp_sth_t *imp_sth)
-{
- return imp_sth->nrow;
-}
-
-/* bind parameter
- * NB: We store the params instead of bind immediately because
- * we might need to re-create the imp_sth->stmt (see top of execute() function)
- * and so we can't lose these params
- */
-int
-sqlite_bind_ph (SV *sth, imp_sth_t *imp_sth,
- SV *param, SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen)
-{
- dTHX;
- int pos;
- if (!looks_like_number(param)) {
- STRLEN len;
- char *paramstring;
- paramstring = SvPV(param, len);
- if(paramstring[len] == 0 && strlen(paramstring) == len) {
- pos = sqlite3_bind_parameter_index(imp_sth->stmt, paramstring);
- if (pos==0) {
- char errmsg[8192];
- sqlite3_snprintf(8191, errmsg, "Unknown named parameter: %s", paramstring);
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, errmsg);
- return FALSE; /* -> &sv_no in SQLite.xsi */
- }
- pos = 2 * (pos - 1);
- }
- else {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, " could not be coerced to a C string");
- return FALSE; /* -> &sv_no in SQLite.xsi */
- }
- }
- else {
- if (is_inout) {
- sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "InOut bind params not implemented");
- return FALSE; /* -> &sv_no in SQLite.xsi */
- }
- }
- pos = 2 * (SvIV(param) - 1);
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "bind into 0x%p: %d => %s (%d) pos %d\n",
- imp_sth->params, SvIV(param), SvPV_nolen_undef_ok(value), sql_type, pos);
- av_store(imp_sth->params, pos, SvREFCNT_inc(value));
- av_store(imp_sth->params, pos+1, newSViv(sql_type));
-
- return TRUE;
-}
-
-int
-sqlite_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type, SV *attribs)
-{
- dTHX;
-
- /* store the type */
- av_store(imp_sth->col_types, SvIV(col)-1, newSViv(sql_type));
-
- /* Allow default implementation to continue */
- return 1;
-}
-
-AV *
-sqlite_st_fetch (SV *sth, imp_sth_t *imp_sth)
-{
- dTHX;
-
- AV *av;
- D_imp_dbh_from_sth;
- int numFields = DBIc_NUM_FIELDS(imp_sth);
- int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
- int i;
-
- sqlite_trace(sth, (imp_xxh_t*)imp_sth, 6, "numFields == %d, nrow == %d\n", numFields, imp_sth->nrow);
-
- if (!DBIc_ACTIVE(imp_sth)) {
- return Nullav;
- }
-
- if (imp_sth->retval == SQLITE_DONE) {
- sqlite_st_finish(sth, imp_sth);
- return Nullav;
- }
-
- if (imp_sth->retval != SQLITE_ROW) {
- /* error */
- sqlite_st_finish(sth, imp_sth);
- sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
- return Nullav; /* -> undef in SQLite.xsi */
- }
-
- imp_sth->nrow++;
-
- av = DBIc_DBISTATE((imp_xxh_t *)imp_sth)->get_fbav(imp_sth);
- for (i = 0; i < numFields; i++) {
- int len;
- char * val;
- int col_type = sqlite3_column_type(imp_sth->stmt, i);
- SV **sql_type = av_fetch(imp_sth->col_types, i, 0);
- if (sql_type && SvOK(*sql_type)) {
- if (SvIV(*sql_type)) {
- col_type = SvIV(*sql_type);
- }
- }
- switch(col_type) {
- case SQLITE_INTEGER:
-#if defined(USE_64_BIT_INT)
- sv_setiv(AvARRAY(av)[i], sqlite3_column_int64(imp_sth->stmt, i));
-#else
- sv_setnv(AvARRAY(av)[i], (double)sqlite3_column_int64(imp_sth->stmt, i));
-#endif
- break;
- case SQLITE_FLOAT:
- sv_setnv(AvARRAY(av)[i], sqlite3_column_double(imp_sth->stmt, i));
- break;
- case SQLITE_TEXT:
- val = (char*)sqlite3_column_text(imp_sth->stmt, i);
- len = sqlite3_column_bytes(imp_sth->stmt, i);
- if (chopBlanks) {
- val = savepv(val);
- while((len > 0) && (val[len-1] == ' ')) {
- len--;
- }
- val[len] = '\0';
- }
- sv_setpvn(AvARRAY(av)[i], val, len);
- if (imp_dbh->unicode) {
- SvUTF8_on(AvARRAY(av)[i]);
- } else {
- SvUTF8_off(AvARRAY(av)[i]);
- }
- if (chopBlanks) Safefree(val);
- break;
- case SQLITE_BLOB:
- len = sqlite3_column_bytes(imp_sth->stmt, i);
- sv_setpvn(AvARRAY(av)[i], sqlite3_column_blob(imp_sth->stmt, i), len);
- SvUTF8_off(AvARRAY(av)[i]);
- break;
- default:
- sv_setsv(AvARRAY(av)[i], &PL_sv_undef);
- SvUTF8_off(AvARRAY(av)[i]);
- break;
- }
- SvSETMAGIC(AvARRAY(av)[i]);
- }
-
- imp_sth->retval = sqlite3_step(imp_sth->stmt);
-
- return av;
-}
-
-int
-sqlite_st_finish (SV *sth, imp_sth_t *imp_sth)
-{
- return sqlite_st_finish3(sth, imp_sth, 0);
-}
-
-int
-sqlite_st_finish3 (SV *sth, imp_sth_t *imp_sth, int is_destroy)
-{
- dTHX;
-
- D_imp_dbh_from_sth;
-
- /* warn("finish statement\n"); */
- if (!DBIc_ACTIVE(imp_sth))
- return 1;
-
- DBIc_ACTIVE_off(imp_sth);
-
- av_clear(imp_sth->col_types);
-
- if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
- return 1;
-
- if (is_destroy) {
- return TRUE;
- }
-
- if ((imp_sth->retval = sqlite3_reset(imp_sth->stmt)) != SQLITE_OK) {
- char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
- /* warn("finalize failed! %s\n", errmsg); */
- sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
- return FALSE; /* -> &sv_no (or void) in SQLite.xsi */
- }
-
- return TRUE;
-}
-
-void
-sqlite_st_destroy (SV *sth, imp_sth_t *imp_sth)
-{
- dTHX;
-
- D_imp_dbh_from_sth;
- /* warn("destroy statement: %s\n", imp_sth->statement); */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_ACTIVE(imp_dbh)) {
- /* finalize sth when active connection */
- sqlite3_finalize(imp_sth->stmt);
- }
- Safefree(imp_sth->statement);
- SvREFCNT_dec((SV*)imp_sth->params);
- SvREFCNT_dec((SV*)imp_sth->col_types);
- DBIc_IMPSET_off(imp_sth);
-}
-
-int
-sqlite_st_blob_read (SV *sth, imp_sth_t *imp_sth,
- int field, long offset, long len, SV *destrv, long destoffset)
-{
- return 0;
-}
-
-int
-sqlite_db_STORE_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
-{
- dTHX;
- char *key = SvPV_nolen(keysv);
- char *errmsg;
- int retval;
-
- if (strEQ(key, "AutoCommit")) {
- if (SvTRUE(valuesv)) {
- /* commit tran? */
- if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (imp_dbh->in_tran) ) {
- sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "COMMIT TRAN");
- if ((retval = sqlite3_exec(imp_dbh->db, "COMMIT TRANSACTION",
- NULL, NULL, &errmsg))
- != SQLITE_OK)
- {
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- return TRUE; /* XXX: is this correct? */
- }
- imp_dbh->in_tran = FALSE;
- }
- }
- DBIc_set(imp_dbh, DBIcf_AutoCommit, SvTRUE(valuesv));
- return TRUE;
- }
- if (strEQ(key, "unicode")) {
-#if (PERL_REVISION <= 5) && ((PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION < 5))
- sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "Unicode support is disabled for this version of perl.");
- imp_dbh->unicode = 0;
-#else
- imp_dbh->unicode = !(! SvTRUE(valuesv));
-#endif
- return TRUE;
- }
- return FALSE;
-}
-
-SV *
-sqlite_db_FETCH_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
-{
- dTHX;
- char *key = SvPV_nolen(keysv);
-
- if (strEQ(key, "sqlite_version")) {
- return newSVpv(sqlite3_version,0);
- }
- if (strEQ(key, "unicode")) {
-#if (PERL_REVISION <= 5) && ((PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION < 5))
- sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "Unicode support is disabled for this version of perl.");
- return newSViv(0);
-#else
- return newSViv(imp_dbh->unicode ? 1 : 0);
-#endif
- }
-
- return NULL;
-}
-
-int
-sqlite_st_STORE_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)
-{
- dTHX;
- char *key = SvPV_nolen(keysv);
- return FALSE;
-}
-
-int
-type_to_odbc_type (int type)
-{
- switch(type) {
- case SQLITE_INTEGER: return SQL_INTEGER;
- case SQLITE_FLOAT: return SQL_DOUBLE;
- case SQLITE_TEXT: return SQL_VARCHAR;
- case SQLITE_BLOB: return SQL_BLOB;
- case SQLITE_NULL: return SQL_UNKNOWN_TYPE;
- default: return SQL_UNKNOWN_TYPE;
- }
-}
-
-SV *
-sqlite_st_FETCH_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv)
-{
- dTHX;
- D_imp_dbh_from_sth;
- char *key = SvPV_nolen(keysv);
- SV *retsv = NULL;
- int i,n;
-
- if (!DBIc_ACTIVE(imp_sth)) {
- return NULL;
- }
-
- /* warn("fetch: %s\n", key); */
-
- i = DBIc_NUM_FIELDS(imp_sth);
-
- if (strEQ(key, "NAME")) {
- AV *av = newAV();
- /* warn("Fetch NAME fields: %d\n", i); */
- av_extend(av, i);
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- for (n = 0; n < i; n++) {
- /* warn("Fetch col name %d\n", n); */
- const char *fieldname = sqlite3_column_name(imp_sth->stmt, n);
- if (fieldname) {
- /* warn("Name [%d]: %s\n", n, fieldname); */
- /* char *dot = instr(fieldname, "."); */
- /* if (dot) drop table name from field name */
- /* fieldname = ++dot; */
- av_store(av, n, newSVpv(fieldname, 0));
- }
- }
- }
- else if (strEQ(key, "PRECISION")) {
- AV *av = newAV();
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- }
- else if (strEQ(key, "TYPE")) {
- AV *av = newAV();
- av_extend(av, i);
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- for (n = 0; n < i; n++) {
- const char *fieldtype = sqlite3_column_decltype(imp_sth->stmt, n);
- int type = sqlite3_column_type(imp_sth->stmt, n);
- /* warn("got type: %d = %s\n", type, fieldtype); */
- type = type_to_odbc_type(type);
- /* av_store(av, n, newSViv(type)); */
- if (fieldtype)
- av_store(av, n, newSVpv(fieldtype, 0));
- else
- av_store(av, n, newSVpv("VARCHAR", 0));
- }
- }
- else if (strEQ(key, "NULLABLE")) {
- AV *av = newAV();
- av_extend(av, i);
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
-#if defined(SQLITE_ENABLE_COLUMN_METADATA)
- for (n = 0; n < i; n++) {
- const char *database = sqlite3_column_database_name(imp_sth->stmt, n);
- const char *tablename = sqlite3_column_table_name(imp_sth->stmt, n);
- const char *fieldname = sqlite3_column_name(imp_sth->stmt, n);
- const char *datatype, *collseq;
- int notnull, primary, autoinc;
- int retval = sqlite3_table_column_metadata(imp_dbh->db, database, tablename, fieldname, &datatype, &collseq, ¬null, &primary, &autoinc);
- if (retval != SQLITE_OK) {
- char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
- sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
- av_store(av, n, newSViv(2)); /* SQL_NULLABLE_UNKNOWN */
- }
- else {
- av_store(av, n, newSViv(!notnull));
- }
- }
-#endif
- }
- else if (strEQ(key, "SCALE")) {
- AV *av = newAV();
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- }
- else if (strEQ(key, "NUM_OF_FIELDS")) {
- retsv = sv_2mortal(newSViv(i));
- }
-
- return retsv;
-}
-
-static void
-sqlite_db_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error )
-{
- STRLEN len;
- char *s;
-
- if ( is_error ) {
- s = SvPV(result, len);
- sqlite3_result_error( context, s, len );
- return;
- }
-
- /* warn("result: %s\n", SvPV_nolen(result)); */
- if ( !SvOK(result) ) {
- sqlite3_result_null( context );
- } else if( SvIOK_UV(result) ) {
- s = SvPV(result, len);
- sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
- }
- else if ( SvIOK(result) ) {
- sqlite3_result_int( context, SvIV(result));
- } else if ( !is_error && SvIOK(result) ) {
- sqlite3_result_double( context, SvNV(result));
- } else {
- s = SvPV(result, len);
- sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
- }
-}
-
-static void
-sqlite_db_func_dispatcher(int is_unicode, sqlite3_context *context, int argc, sqlite3_value **value)
-{
- dTHX;
- dSP;
- int count;
- int i;
- SV *func;
-
- func = sqlite3_user_data(context);
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- for ( i=0; i < argc; i++ ) {
- SV *arg;
- STRLEN len = sqlite3_value_bytes(value[i]);
- int type = sqlite3_value_type(value[i]);
-
- /* warn("func dispatch type: %d, value: %s\n", type, sqlite3_value_text(value[i])); */
- switch(type) {
- case SQLITE_INTEGER:
- arg = sv_2mortal(newSViv(sqlite3_value_int(value[i])));
- break;
- case SQLITE_FLOAT:
- arg = sv_2mortal(newSVnv(sqlite3_value_double(value[i])));
- break;
- case SQLITE_TEXT:
- arg = newSVpvn((const char *)sqlite3_value_text(value[i]), len);
- if (is_unicode) {
- SvUTF8_on(arg);
- }
- arg = sv_2mortal(arg);
- break;
- case SQLITE_BLOB:
- arg = sv_2mortal(newSVpvn(sqlite3_value_blob(value[i]), len));
- break;
- default:
- arg = &PL_sv_undef;
- }
-
- XPUSHs(arg);
- }
- PUTBACK;
-
- count = call_sv(func, G_SCALAR|G_EVAL);
-
- SPAGAIN;
-
- /* Check for an error */
- if (SvTRUE(ERRSV) ) {
- sqlite_db_set_result(aTHX_ context, ERRSV, 1);
- POPs;
- } else if ( count != 1 ) {
- SV *err = sv_2mortal(newSVpvf( "function should return 1 argument, got %d",
- count ));
-
- sqlite_db_set_result(aTHX_ context, err, 1);
- /* Clear the stack */
- for ( i=0; i < count; i++ ) {
- POPs;
- }
- } else {
- sqlite_db_set_result(aTHX_ context, POPs, 0 );
- }
-
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-}
-
-
-static void
-sqlite_db_func_dispatcher_unicode(sqlite3_context *context, int argc, sqlite3_value **value)
-{
- sqlite_db_func_dispatcher(1, context, argc, value);
-}
-
-static void
-sqlite_db_func_dispatcher_no_unicode(sqlite3_context *context, int argc, sqlite3_value **value)
-{
- sqlite_db_func_dispatcher(0, context, argc, value);
-}
-
-void
-sqlite3_db_create_function(pTHX_ SV *dbh, const char *name, int argc, SV *func )
-{
- D_imp_dbh(dbh);
- int retval;
-
- /* Copy the function reference */
- SV *func_sv = newSVsv(func);
- av_push( imp_dbh->functions, func_sv );
-
- /* warn("create_function %s with %d args\n", name, argc); */
- retval = sqlite3_create_function( imp_dbh->db, name, argc, SQLITE_UTF8,
- func_sv,
- imp_dbh->unicode ? sqlite_db_func_dispatcher_unicode
- : sqlite_db_func_dispatcher_no_unicode,
- NULL, NULL );
- if ( retval != SQLITE_OK )
- {
- char errmsg[8192];
- sqlite3_snprintf(8191, errmsg, "sqlite_create_function failed with error %s", sqlite3_errmsg(imp_dbh->db));
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- }
-}
-
-void
-sqlite3_db_enable_load_extension(pTHX_ SV *dbh, int onoff )
-{
- D_imp_dbh(dbh);
- int retval;
-
- retval = sqlite3_enable_load_extension( imp_dbh->db, onoff );
- if ( retval != SQLITE_OK )
- {
- char errmsg[8192];
- sqlite3_snprintf(8191, errmsg, "sqlite_enable_load_extension failed with error %s", sqlite3_errmsg(imp_dbh->db));
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- }
-}
-
-typedef struct aggrInfo aggrInfo;
-struct aggrInfo {
- SV *aggr_inst;
- SV *err;
- int inited;
-};
-
-static void
-sqlite_db_aggr_new_dispatcher(pTHX_ sqlite3_context *context, aggrInfo *aggr_info )
-{
- dSP;
- SV *pkg = NULL;
- int count = 0;
-
- aggr_info->err = NULL;
- aggr_info->aggr_inst = NULL;
-
- pkg = sqlite3_user_data(context);
- if ( !pkg )
- return;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv(pkg) ) );
- PUTBACK;
-
- count = call_method ("new", G_EVAL|G_SCALAR);
- SPAGAIN;
-
- aggr_info->inited = 1;
-
- if ( SvTRUE( ERRSV ) ) {
- aggr_info->err = newSVpvf ("error during aggregator's new(): %s",
- SvPV_nolen (ERRSV));
- POPs;
- } else if ( count != 1 ) {
- int i;
-
- aggr_info->err = newSVpvf( "new() should return one value, got %d",
- count );
- /* Clear the stack */
- for ( i=0; i < count; i++ ) {
- POPs;
- }
- } else {
- SV *aggr = POPs;
- if ( SvROK(aggr) ) {
- aggr_info->aggr_inst = newSVsv(aggr);
- } else{
- aggr_info->err = newSVpvf( "new() should return a blessed reference" );
- }
- }
-
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-
- return;
-}
-
-static void
-sqlite_db_aggr_step_dispatcher (sqlite3_context *context,
- int argc, sqlite3_value **value)
-{
- dTHX;
- dSP;
- int i;
- aggrInfo *aggr;
-
- aggr = sqlite3_aggregate_context (context, sizeof (aggrInfo));
- if ( !aggr )
- return;
-
- ENTER;
- SAVETMPS;
-
- /* initialize on first step */
- if ( !aggr->inited ) {
- sqlite_db_aggr_new_dispatcher(aTHX_ context, aggr );
- }
-
- if ( aggr->err || !aggr->aggr_inst )
- goto cleanup;
-
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
- for ( i=0; i < argc; i++ ) {
- SV *arg;
- int len = sqlite3_value_bytes(value[i]);
- int type = sqlite3_value_type(value[i]);
-
- switch(type) {
- case SQLITE_INTEGER:
- arg = sv_2mortal(newSViv(sqlite3_value_int(value[i])));
- break;
- case SQLITE_FLOAT:
- arg = sv_2mortal(newSVnv(sqlite3_value_double(value[i])));
- break;
- case SQLITE_TEXT:
- arg = sv_2mortal(newSVpvn((const char *)sqlite3_value_text(value[i]), len));
- break;
- case SQLITE_BLOB:
- arg = sv_2mortal(newSVpvn(sqlite3_value_blob(value[i]), len));
- break;
- default:
- arg = &PL_sv_undef;
- }
-
- XPUSHs(arg);
- }
- PUTBACK;
-
- call_method ("step", G_SCALAR|G_EVAL|G_DISCARD);
-
- /* Check for an error */
- if (SvTRUE(ERRSV) ) {
- aggr->err = newSVpvf( "error during aggregator's step(): %s",
- SvPV_nolen(ERRSV));
- POPs;
- }
-
- cleanup:
- FREETMPS;
- LEAVE;
-}
-
-static void
-sqlite_db_aggr_finalize_dispatcher( sqlite3_context *context )
-{
- dTHX;
- dSP;
- aggrInfo *aggr, myAggr;
- int count = 0;
-
- aggr = sqlite3_aggregate_context (context, sizeof (aggrInfo));
-
- ENTER;
- SAVETMPS;
-
- if ( !aggr ) {
- /* SQLite seems to refuse to create a context structure
- from finalize() */
- aggr = &myAggr;
- aggr->aggr_inst = NULL;
- aggr->err = NULL;
- sqlite_db_aggr_new_dispatcher(aTHX_ context, aggr);
- }
-
- if ( ! aggr->err && aggr->aggr_inst ) {
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst )) );
- PUTBACK;
-
- count = call_method( "finalize", G_SCALAR|G_EVAL );
- SPAGAIN;
-
- if ( SvTRUE(ERRSV) ) {
- aggr->err = newSVpvf ("error during aggregator's finalize(): %s",
- SvPV_nolen(ERRSV) ) ;
- POPs;
- } else if ( count != 1 ) {
- int i;
- aggr->err = newSVpvf( "finalize() should return 1 value, got %d",
- count );
- /* Clear the stack */
- for ( i=0; ierr ) {
- warn( "DBD::SQLite: error in aggregator cannot be reported to SQLite: %s",
- SvPV_nolen( aggr->err ) );
-
- /* sqlite_db_set_result(aTHX_ context, aggr->err, 1 ); */
- SvREFCNT_dec( aggr->err );
- aggr->err = NULL;
- }
-
- if ( aggr->aggr_inst ) {
- SvREFCNT_dec( aggr->aggr_inst );
- aggr->aggr_inst = NULL;
- }
-
- FREETMPS;
- LEAVE;
-}
-
-void
-sqlite3_db_create_aggregate(pTHX_ SV *dbh, const char *name, int argc, SV *aggr_pkg )
-{
- D_imp_dbh(dbh);
- int retval;
-
- /* Copy the aggregate reference */
- SV *aggr_pkg_copy = newSVsv(aggr_pkg);
- av_push( imp_dbh->aggregates, aggr_pkg_copy );
-
- retval = sqlite3_create_function( imp_dbh->db, name, argc, SQLITE_UTF8,
- aggr_pkg_copy,
- NULL,
- sqlite_db_aggr_step_dispatcher,
- sqlite_db_aggr_finalize_dispatcher
- );
-
- if ( retval != SQLITE_OK )
- {
- char errmsg[8192];
- sqlite3_snprintf(8191, errmsg, "sqlite_create_aggregate failed with error %s", sqlite3_errmsg(imp_dbh->db));
- sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- }
-}
-
-
-int sqlite_db_collation_dispatcher(void *func, int len1, const void *string1,
- int len2, const void *string2)
-{
- dTHX;
- dSP;
- int cmp;
- int n_retval;
-
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- XPUSHs( sv_2mortal ( newSVpvn( string1, len1) ) );
- XPUSHs( sv_2mortal ( newSVpvn( string2, len2) ) );
- PUTBACK;
- n_retval = call_sv((void*)func, G_SCALAR);
- if (n_retval != 1) {
- croak("collation function returned %d arguments", n_retval);
- }
- SPAGAIN;
- cmp = POPi;
- PUTBACK;
- FREETMPS;
- LEAVE;
-
- return cmp;
-}
-
-int sqlite_db_collation_dispatcher_utf8(
- void *func, int len1, const void *string1,
- int len2, const void *string2)
-{
- dTHX;
- dSP;
- int cmp;
- int n_retval;
- SV *sv1, *sv2;
-
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- sv1 = newSVpvn( string1, len1);
- SvUTF8_on(sv1);
- sv2 = newSVpvn( string2, len2);
- SvUTF8_on(sv2);
- XPUSHs( sv_2mortal ( sv1 ) );
- XPUSHs( sv_2mortal ( sv2 ) );
- PUTBACK;
- n_retval = call_sv((void*)func, G_SCALAR);
- if (n_retval != 1) {
- croak("collation function returned %d arguments", n_retval);
- }
- SPAGAIN;
- cmp = POPi;
- PUTBACK;
- FREETMPS;
- LEAVE;
-
- return cmp;
-}
-
-
-void
-sqlite3_db_create_collation(pTHX_ SV *dbh, const char *name, SV *func )
-{
- D_imp_dbh(dbh);
- int rv, rv2;
- void *aa = "aa";
- void *zz = "zz";
-
- SV *func_sv = newSVsv(func);
-
- /* Check that this is a proper collation function */
- rv = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, aa);
- if (rv != 0) {
- warn("improper collation function: %s(aa, aa) returns %d!", name, rv);
- }
- rv = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, zz);
- rv2 = sqlite_db_collation_dispatcher(func_sv, 2, zz, 2, aa);
- if (rv2 != (rv * -1)) {
- warn("improper collation function: '%s' is not symmetric", name);
- }
-
- /* Copy the func reference so that it can be deallocated at disconnect */
- av_push( imp_dbh->functions, func_sv );
-
- /* Register the func within sqlite3 */
- rv = sqlite3_create_collation(
- imp_dbh->db, name, SQLITE_UTF8,
- func_sv,
- imp_dbh->unicode ? sqlite_db_collation_dispatcher_utf8
- : sqlite_db_collation_dispatcher
- );
-
- if ( rv != SQLITE_OK )
- {
- char errmsg[8192];
- sqlite3_snprintf(8191, errmsg, "sqlite_create_collation failed with error %s", sqlite3_errmsg(imp_dbh->db));
- }
-}
-
-
-int sqlite_db_progress_handler_dispatcher( void *handler )
-{
- dTHX;
- dSP;
- int n_retval;
- int retval;
-
- PUSHMARK(SP);
- n_retval = call_sv( handler, G_SCALAR );
- if ( n_retval != 1 ) {
- croak( "progress_handler returned %d arguments", n_retval );
- }
- SPAGAIN;
- retval = POPi;
- PUTBACK;
-
- return retval;
-}
-
-
-
-void
-sqlite3_db_progress_handler(pTHX_ SV *dbh, int n_opcodes, SV *handler )
-{
- D_imp_dbh(dbh);
-
- if (handler == &PL_sv_undef) {
- /* remove previous handler */
- sqlite3_progress_handler( imp_dbh->db, 0, NULL, NULL);
- }
- else {
- SV *handler_sv = newSVsv(handler);
-
- /* Copy the handler ref so that it can be deallocated at disconnect */
- av_push( imp_dbh->functions, handler_sv );
-
- /* Register the func within sqlite3 */
- sqlite3_progress_handler( imp_dbh->db, n_opcodes,
- sqlite_db_progress_handler_dispatcher,
- handler_sv );
- }
-}
-
-/* end */
+#define PERL_NO_GET_CONTEXT
+
+#include "SQLiteXS.h"
+
+DBISTATE_DECLARE;
+
+#ifndef SvPV_nolen
+#define SvPV_nolen(x) SvPV(x,PL_na)
+#endif
+
+#define SvPV_nolen_undef_ok(x) (SvOK(x) ? SvPV_nolen(x) : "undef")
+
+#ifndef call_method
+#define call_method(x,y) perl_call_method(x,y)
+#endif
+
+#ifndef call_sv
+#define call_sv(x,y) perl_call_sv(x,y)
+#endif
+
+#define sqlite_error(h,xxh,rc,what) _sqlite_error(aTHX_ __FILE__, __LINE__, h, xxh, rc, what)
+
+/* XXX: is there any good way to use pTHX_/aTHX_ here like above? */
+#if defined(__GNUC__) && (__GNUC__ > 2)
+# define sqlite_trace(h,xxh,level,fmt...) _sqlite_tracef(__FILE__, __LINE__, h, xxh, level, fmt)
+#else
+# define sqlite_trace _sqlite_tracef_noline
+#endif
+
+void
+sqlite_init(dbistate_t *dbistate)
+{
+ dTHX;
+ DBISTATE_INIT; /* Initialize the DBI macros */
+}
+
+static void
+_sqlite_error(pTHX_ char *file, int line, SV *h, imp_xxh_t *imp_xxh, int rc, char *what)
+{
+ DBIh_SET_ERR_CHAR(h, imp_xxh, Nullch, rc, what, Nullch, Nullch);
+
+ /* #7753: DBD::SQLite error shouldn't include extraneous info */
+ /* sv_catpvf(errstr, "(%d) at %s line %d", rc, file, line); */
+ if ( DBIc_TRACE_LEVEL(imp_xxh) >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_xxh),
+ "sqlite error %d recorded: %s at %s line %d\n",
+ rc, what, file, line
+ );
+ }
+}
+
+static void
+_sqlite_tracef(char *file, int line, SV *h, imp_xxh_t *imp_xxh, int level, const char *fmt, ...)
+{
+ dTHX;
+
+ va_list ap;
+ if ( DBIc_TRACE_LEVEL(imp_xxh) >= level ) {
+ char format[8192];
+ sqlite3_snprintf(8191, format, "sqlite trace: %s at %s line %d\n", fmt, file, line);
+ va_start(ap, fmt);
+ PerlIO_vprintf(DBIc_LOGPIO(imp_xxh), format, ap);
+ va_end(ap);
+ }
+}
+
+static void
+_sqlite_tracef_noline(SV *h, imp_xxh_t *imp_xxh, int level, const char *fmt, ...)
+{
+ dTHX;
+
+ va_list ap;
+ if ( DBIc_TRACE_LEVEL(imp_xxh) >= level ) {
+ char format[8192];
+ sqlite3_snprintf(8191, format, "sqlite trace: %s\n", fmt);
+ va_start(ap, fmt);
+ PerlIO_vprintf(DBIc_LOGPIO(imp_xxh), format, ap);
+ va_end(ap);
+ }
+}
+
+int
+sqlite_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pass)
+{
+ dTHX;
+ int retval;
+ char *errmsg = NULL;
+
+ if ( DBIc_TRACE_LEVEL(imp_dbh) >= 3 ) {
+ PerlIO_printf(DBILOGFP, " login '%s' (version %s)\n",
+ dbname, sqlite3_version);
+ }
+
+ if ((retval = sqlite3_open(dbname, &(imp_dbh->db))) != SQLITE_OK ) {
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+ DBIc_IMPSET_on(imp_dbh);
+
+ imp_dbh->in_tran = FALSE;
+ imp_dbh->unicode = FALSE;
+ imp_dbh->functions = newAV();
+ imp_dbh->aggregates = newAV();
+ imp_dbh->timeout = SQL_TIMEOUT;
+ imp_dbh->handle_binary_nulls = FALSE;
+
+ sqlite3_busy_timeout(imp_dbh->db, SQL_TIMEOUT);
+
+ if ((retval = sqlite3_exec(imp_dbh->db, "PRAGMA empty_result_callbacks = ON",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ /* warn("failed to set pragma: %s\n", errmsg); */
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+
+ if ((retval = sqlite3_exec(imp_dbh->db, "PRAGMA show_datatypes = ON",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ /* warn("failed to set pragma: %s\n", errmsg); */
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+
+ DBIc_ACTIVE_on(imp_dbh);
+
+/*
+ if ( DBIc_WARN(imp_dbh) ) {
+ warn("DBIc_WARN is on");
+ }
+ else {
+ warn("DBIc_WARN if off");
+ }
+ if ( DBIc_is(imp_dbh, DBIcf_PrintWarn) ) {
+ warn("DBIcf_PrintWarn is on");
+ }
+*/
+
+ return TRUE;
+}
+
+int
+dbd_set_sqlite3_busy_timeout (pTHX_ SV *dbh, int timeout )
+{
+ D_imp_dbh(dbh);
+ if (timeout) {
+ imp_dbh->timeout = timeout;
+ sqlite3_busy_timeout(imp_dbh->db, timeout);
+ }
+ return imp_dbh->timeout;
+}
+
+int
+sqlite_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ sqlite3_stmt *pStmt;
+ DBIc_ACTIVE_off(imp_dbh);
+
+ if (DBIc_is(imp_dbh, DBIcf_AutoCommit) == FALSE) {
+ sqlite_db_rollback(dbh, imp_dbh);
+ }
+
+ while ( (pStmt = sqlite3_next_stmt(imp_dbh->db, 0))!=0 ) {
+ sqlite3_finalize(pStmt);
+ }
+
+ if (sqlite3_close(imp_dbh->db) == SQLITE_BUSY) {
+ /* active statements! */
+ warn("closing dbh with active statement handles");
+ }
+ imp_dbh->db = NULL;
+
+ av_undef(imp_dbh->functions);
+ SvREFCNT_dec(imp_dbh->functions);
+ imp_dbh->functions = (AV *)NULL;
+
+ av_undef(imp_dbh->aggregates);
+ SvREFCNT_dec(imp_dbh->aggregates);
+ imp_dbh->aggregates = (AV *)NULL;
+
+ return TRUE;
+}
+
+void
+sqlite_db_destroy (SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ if (DBIc_ACTIVE(imp_dbh)) {
+ /* warn("DBIc_ACTIVE is on"); */
+ sqlite_db_disconnect(dbh, imp_dbh);
+/*
+ } else {
+ warn("DBIc_ACTIVE is off");
+*/
+ }
+ DBIc_IMPSET_off(imp_dbh);
+}
+
+int
+sqlite_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ int retval;
+ char *errmsg;
+
+ if (imp_dbh->in_tran) {
+ sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "ROLLBACK TRAN");
+ if ((retval = sqlite3_exec(imp_dbh->db, "ROLLBACK TRANSACTION",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ return FALSE; /* -> &sv_no in SQLite.xsi */
+ }
+ imp_dbh->in_tran = FALSE;
+ }
+
+ return TRUE;
+}
+
+int
+sqlite_db_commit(SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ int retval;
+ char *errmsg;
+
+ if (DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
+ /* We don't need to warn, because the DBI layer will do it for us */
+ return TRUE;
+ }
+
+ if (imp_dbh->in_tran) {
+ sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "COMMIT TRAN");
+ if ((retval = sqlite3_exec(imp_dbh->db, "COMMIT TRANSACTION",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ return FALSE; /* -> &sv_no in SQLite.xsi */
+ }
+ imp_dbh->in_tran = FALSE;
+ }
+ return TRUE;
+}
+
+int
+sqlite_discon_all(SV *drh, imp_drh_t *imp_drh)
+{
+ dTHX;
+ return FALSE; /* no way to do this */
+}
+
+SV *
+sqlite_db_last_insert_id(SV *dbh, imp_dbh_t *imp_dbh, SV *catalog, SV *schema, SV *table, SV *field, SV *attr)
+{
+ dTHX;
+ return newSViv(sqlite3_last_insert_rowid(imp_dbh->db));
+}
+
+int
+sqlite_st_prepare (SV *sth, imp_sth_t *imp_sth,
+ char *statement, SV *attribs)
+{
+ dTHX;
+ D_imp_dbh_from_sth;
+ const char *extra;
+ int retval = 0;
+
+ if (!DBIc_ACTIVE(imp_dbh)) {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to prepare on inactive database handle");
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+
+ if (strlen(statement) < 1) {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to prepare empty statement");
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 2, "prepare statement: %s", statement);
+ imp_sth->nrow = -1;
+ imp_sth->retval = SQLITE_OK;
+ imp_sth->params = newAV();
+ imp_sth->col_types = newAV();
+ Newz(0, imp_sth->statement, strlen(statement)+1, char);
+
+ if ((retval = sqlite3_prepare_v2(imp_dbh->db, statement, -1, &(imp_sth->stmt), &extra))
+ != SQLITE_OK)
+ {
+ if (imp_sth->stmt) {
+ sqlite3_finalize(imp_sth->stmt);
+ }
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return FALSE; /* -> undef in lib/DBD/SQLite.pm */
+ }
+
+ /* store the query for later re-use if required */
+ Copy(statement, imp_sth->statement, strlen(statement)+1, char);
+
+ DBIc_NUM_PARAMS(imp_sth) = sqlite3_bind_parameter_count(imp_sth->stmt);
+ DBIc_NUM_FIELDS(imp_sth) = sqlite3_column_count(imp_sth->stmt);
+ DBIc_IMPSET_on(imp_sth);
+
+ return TRUE;
+}
+
+char *
+sqlite_quote(imp_dbh_t *imp_dbh, SV *val)
+{
+ dTHX;
+ STRLEN len;
+ char *cval = SvPV(val, len);
+ SV *ret = sv_2mortal(NEWSV(0, SvCUR(val) + 2));
+ sv_setpvn(ret, "", 0);
+
+ while (len) {
+ switch (*cval) {
+ case '\'':
+ sv_catpvn(ret, "''", 2);
+ break;
+ default:
+ sv_catpvn(ret, cval, 1);
+ }
+ *cval++; len--;
+ }
+ return SvPV_nolen(ret);
+}
+
+void
+sqlite_st_reset (pTHX_ SV *sth)
+{
+ D_imp_sth(sth);
+ if (DBIc_IMPSET(imp_sth))
+ sqlite3_reset(imp_sth->stmt);
+}
+
+int
+sqlite_st_execute (SV *sth, imp_sth_t *imp_sth)
+{
+ dTHX;
+ D_imp_dbh_from_sth;
+ char *errmsg;
+ int num_params = DBIc_NUM_PARAMS(imp_sth);
+ int i;
+ int retval = 0;
+
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "execute");
+
+ /* warn("execute\n"); */
+
+ if (!DBIc_ACTIVE(imp_dbh)) {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "attempt to execute on inactive database handle");
+ return -2; /* -> undef in SQLite.xsi */
+ }
+
+ if (DBIc_ACTIVE(imp_sth)) {
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "execute still active, reset");
+ if ((imp_sth->retval = sqlite3_reset(imp_sth->stmt)) != SQLITE_OK) {
+ char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
+ return -2; /* -> undef in SQLite.xsi */
+ }
+ }
+
+ for (i = 0; i < num_params; i++) {
+ SV *value = av_shift(imp_sth->params);
+ SV *sql_type_sv = av_shift(imp_sth->params);
+ int sql_type = SvIV(sql_type_sv);
+
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 4, "params left in 0x%p: %d", imp_sth->params, 1+av_len(imp_sth->params));
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 4, "bind %d type %d as %s", i, sql_type, SvPV_nolen_undef_ok(value));
+
+ if (!SvOK(value)) {
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 5, "binding null");
+ retval = sqlite3_bind_null(imp_sth->stmt, i+1);
+ }
+ else if (sql_type >= SQL_NUMERIC && sql_type <= SQL_SMALLINT) {
+#if defined(USE_64_BIT_INT)
+ retval = sqlite3_bind_int64(imp_sth->stmt, i+1, SvIV(value));
+#else
+ retval = sqlite3_bind_int(imp_sth->stmt, i+1, SvIV(value));
+#endif
+ }
+ else if (sql_type >= SQL_FLOAT && sql_type <= SQL_DOUBLE) {
+ retval = sqlite3_bind_double(imp_sth->stmt, i+1, SvNV(value));
+ }
+ else if (sql_type == SQL_BLOB) {
+ STRLEN len;
+ char * data = SvPV(value, len);
+ retval = sqlite3_bind_blob(imp_sth->stmt, i+1, data, len, SQLITE_TRANSIENT);
+ }
+ else {
+#if 0
+ /* stop guessing until we figure out better way to do this */
+ const int numtype = looks_like_number(value);
+ if ((numtype & (IS_NUMBER_IN_UV|IS_NUMBER_NOT_INT)) == IS_NUMBER_IN_UV) {
+#if defined(USE_64_BIT_INT)
+ retval = sqlite3_bind_int64(imp_sth->stmt, i+1, SvIV(value));
+#else
+ retval = sqlite3_bind_int(imp_sth->stmt, i+1, SvIV(value));
+#endif
+ }
+ else if ((numtype & (IS_NUMBER_NOT_INT|IS_NUMBER_INFINITY|IS_NUMBER_NAN)) == IS_NUMBER_NOT_INT) {
+ retval = sqlite3_bind_double(imp_sth->stmt, i+1, SvNV(value));
+ }
+ else {
+#endif
+ STRLEN len;
+ char *data;
+ if (imp_dbh->unicode) {
+ sv_utf8_upgrade(value);
+ }
+ data = SvPV(value, len);
+ retval = sqlite3_bind_text(imp_sth->stmt, i+1, data, len, SQLITE_TRANSIENT);
+#if 0
+ }
+#endif
+ }
+
+ if (value) {
+ SvREFCNT_dec(value);
+ }
+ SvREFCNT_dec(sql_type_sv);
+ if (retval != SQLITE_OK) {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return -4; /* -> undef in SQLite.xsi */
+ }
+ }
+
+ if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (!imp_dbh->in_tran) ) {
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 2, "BEGIN TRAN");
+ if ((retval = sqlite3_exec(imp_dbh->db, "BEGIN TRANSACTION",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
+ return -2; /* -> undef in SQLite.xsi */
+ }
+ imp_dbh->in_tran = TRUE;
+ }
+
+ imp_sth->nrow = 0;
+
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "Execute returned %d cols\n", DBIc_NUM_FIELDS(imp_sth));
+ if (DBIc_NUM_FIELDS(imp_sth) == 0) {
+ while ((imp_sth->retval = sqlite3_step(imp_sth->stmt)) != SQLITE_DONE) {
+ if (imp_sth->retval == SQLITE_ROW) {
+ continue;
+ }
+ sqlite3_reset(imp_sth->stmt);
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return -5; /* -> undef in SQLite.xsi */
+ }
+ /* warn("Finalize\n"); */
+ sqlite3_reset(imp_sth->stmt);
+ imp_sth->nrow = sqlite3_changes(imp_dbh->db);
+ /* DBIc_ACTIVE_on(imp_sth); */
+ /* warn("Total changes: %d\n", sqlite3_total_changes(imp_dbh->db)); */
+ /* warn("Nrow: %d\n", imp_sth->nrow); */
+ return imp_sth->nrow;
+ }
+
+ imp_sth->retval = sqlite3_step(imp_sth->stmt);
+ switch (imp_sth->retval) {
+ case SQLITE_ROW:
+ case SQLITE_DONE: DBIc_ACTIVE_on(imp_sth);
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 5, "exec ok - %d rows, %d cols\n", imp_sth->nrow, DBIc_NUM_FIELDS(imp_sth));
+ return 0; /* -> '0E0' in SQLite.xsi */
+ default: sqlite3_reset(imp_sth->stmt);
+ imp_sth->stmt = NULL;
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return -6; /* -> undef in SQLite.xsi */
+ }
+}
+
+int
+sqlite_st_rows (SV *sth, imp_sth_t *imp_sth)
+{
+ return imp_sth->nrow;
+}
+
+/* bind parameter
+ * NB: We store the params instead of bind immediately because
+ * we might need to re-create the imp_sth->stmt (see top of execute() function)
+ * and so we can't lose these params
+ */
+int
+sqlite_bind_ph (SV *sth, imp_sth_t *imp_sth,
+ SV *param, SV *value, IV sql_type, SV *attribs,
+ int is_inout, IV maxlen)
+{
+ dTHX;
+ int pos;
+ if (!looks_like_number(param)) {
+ STRLEN len;
+ char *paramstring;
+ paramstring = SvPV(param, len);
+ if(paramstring[len] == 0 && strlen(paramstring) == len) {
+ pos = sqlite3_bind_parameter_index(imp_sth->stmt, paramstring);
+ if (pos==0) {
+ char errmsg[8192];
+ sqlite3_snprintf(8191, errmsg, "Unknown named parameter: %s", paramstring);
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, errmsg);
+ return FALSE; /* -> &sv_no in SQLite.xsi */
+ }
+ pos = 2 * (pos - 1);
+ }
+ else {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, " could not be coerced to a C string");
+ return FALSE; /* -> &sv_no in SQLite.xsi */
+ }
+ }
+ else {
+ if (is_inout) {
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, -2, "InOut bind params not implemented");
+ return FALSE; /* -> &sv_no in SQLite.xsi */
+ }
+ }
+ pos = 2 * (SvIV(param) - 1);
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 3, "bind into 0x%p: %d => %s (%d) pos %d\n",
+ imp_sth->params, SvIV(param), SvPV_nolen_undef_ok(value), sql_type, pos);
+ av_store(imp_sth->params, pos, SvREFCNT_inc(value));
+ av_store(imp_sth->params, pos+1, newSViv(sql_type));
+
+ return TRUE;
+}
+
+int
+sqlite_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type, SV *attribs)
+{
+ dTHX;
+
+ /* store the type */
+ av_store(imp_sth->col_types, SvIV(col)-1, newSViv(sql_type));
+
+ /* Allow default implementation to continue */
+ return 1;
+}
+
+AV *
+sqlite_st_fetch (SV *sth, imp_sth_t *imp_sth)
+{
+ dTHX;
+
+ AV *av;
+ D_imp_dbh_from_sth;
+ int numFields = DBIc_NUM_FIELDS(imp_sth);
+ int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
+ int i;
+
+ sqlite_trace(sth, (imp_xxh_t*)imp_sth, 6, "numFields == %d, nrow == %d\n", numFields, imp_sth->nrow);
+
+ if (!DBIc_ACTIVE(imp_sth)) {
+ return Nullav;
+ }
+
+ if (imp_sth->retval == SQLITE_DONE) {
+ sqlite_st_finish(sth, imp_sth);
+ return Nullav;
+ }
+
+ if (imp_sth->retval != SQLITE_ROW) {
+ /* error */
+ sqlite_st_finish(sth, imp_sth);
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
+ return Nullav; /* -> undef in SQLite.xsi */
+ }
+
+ imp_sth->nrow++;
+
+ av = DBIc_DBISTATE((imp_xxh_t *)imp_sth)->get_fbav(imp_sth);
+ for (i = 0; i < numFields; i++) {
+ int len;
+ char * val;
+ int col_type = sqlite3_column_type(imp_sth->stmt, i);
+ SV **sql_type = av_fetch(imp_sth->col_types, i, 0);
+ if (sql_type && SvOK(*sql_type)) {
+ if (SvIV(*sql_type)) {
+ col_type = SvIV(*sql_type);
+ }
+ }
+ switch(col_type) {
+ case SQLITE_INTEGER:
+#if defined(USE_64_BIT_INT)
+ sv_setiv(AvARRAY(av)[i], sqlite3_column_int64(imp_sth->stmt, i));
+#else
+ sv_setnv(AvARRAY(av)[i], (double)sqlite3_column_int64(imp_sth->stmt, i));
+#endif
+ break;
+ case SQLITE_FLOAT:
+ sv_setnv(AvARRAY(av)[i], sqlite3_column_double(imp_sth->stmt, i));
+ break;
+ case SQLITE_TEXT:
+ val = (char*)sqlite3_column_text(imp_sth->stmt, i);
+ len = sqlite3_column_bytes(imp_sth->stmt, i);
+ if (chopBlanks) {
+ val = savepv(val);
+ while((len > 0) && (val[len-1] == ' ')) {
+ len--;
+ }
+ val[len] = '\0';
+ }
+ sv_setpvn(AvARRAY(av)[i], val, len);
+ if (imp_dbh->unicode) {
+ SvUTF8_on(AvARRAY(av)[i]);
+ } else {
+ SvUTF8_off(AvARRAY(av)[i]);
+ }
+ if (chopBlanks) Safefree(val);
+ break;
+ case SQLITE_BLOB:
+ len = sqlite3_column_bytes(imp_sth->stmt, i);
+ sv_setpvn(AvARRAY(av)[i], sqlite3_column_blob(imp_sth->stmt, i), len);
+ SvUTF8_off(AvARRAY(av)[i]);
+ break;
+ default:
+ sv_setsv(AvARRAY(av)[i], &PL_sv_undef);
+ SvUTF8_off(AvARRAY(av)[i]);
+ break;
+ }
+ SvSETMAGIC(AvARRAY(av)[i]);
+ }
+
+ imp_sth->retval = sqlite3_step(imp_sth->stmt);
+
+ return av;
+}
+
+int
+sqlite_st_finish (SV *sth, imp_sth_t *imp_sth)
+{
+ return sqlite_st_finish3(sth, imp_sth, 0);
+}
+
+int
+sqlite_st_finish3 (SV *sth, imp_sth_t *imp_sth, int is_destroy)
+{
+ dTHX;
+
+ D_imp_dbh_from_sth;
+
+ /* warn("finish statement\n"); */
+ if (!DBIc_ACTIVE(imp_sth))
+ return 1;
+
+ DBIc_ACTIVE_off(imp_sth);
+
+ av_clear(imp_sth->col_types);
+
+ if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
+ return 1;
+
+ if (is_destroy) {
+ return TRUE;
+ }
+
+ if ((imp_sth->retval = sqlite3_reset(imp_sth->stmt)) != SQLITE_OK) {
+ char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
+ /* warn("finalize failed! %s\n", errmsg); */
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
+ return FALSE; /* -> &sv_no (or void) in SQLite.xsi */
+ }
+
+ return TRUE;
+}
+
+void
+sqlite_st_destroy (SV *sth, imp_sth_t *imp_sth)
+{
+ dTHX;
+
+ D_imp_dbh_from_sth;
+ /* warn("destroy statement: %s\n", imp_sth->statement); */
+ DBIc_ACTIVE_off(imp_sth);
+ if (DBIc_ACTIVE(imp_dbh)) {
+ /* finalize sth when active connection */
+ sqlite3_finalize(imp_sth->stmt);
+ }
+ Safefree(imp_sth->statement);
+ SvREFCNT_dec((SV*)imp_sth->params);
+ SvREFCNT_dec((SV*)imp_sth->col_types);
+ DBIc_IMPSET_off(imp_sth);
+}
+
+int
+sqlite_st_blob_read (SV *sth, imp_sth_t *imp_sth,
+ int field, long offset, long len, SV *destrv, long destoffset)
+{
+ return 0;
+}
+
+int
+sqlite_db_STORE_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
+{
+ dTHX;
+ char *key = SvPV_nolen(keysv);
+ char *errmsg;
+ int retval;
+
+ if (strEQ(key, "AutoCommit")) {
+ if (SvTRUE(valuesv)) {
+ /* commit tran? */
+ if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (imp_dbh->in_tran) ) {
+ sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "COMMIT TRAN");
+ if ((retval = sqlite3_exec(imp_dbh->db, "COMMIT TRANSACTION",
+ NULL, NULL, &errmsg))
+ != SQLITE_OK)
+ {
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ return TRUE; /* XXX: is this correct? */
+ }
+ imp_dbh->in_tran = FALSE;
+ }
+ }
+ DBIc_set(imp_dbh, DBIcf_AutoCommit, SvTRUE(valuesv));
+ return TRUE;
+ }
+ if (strEQ(key, "unicode")) {
+#if (PERL_REVISION <= 5) && ((PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION < 5))
+ sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "Unicode support is disabled for this version of perl.");
+ imp_dbh->unicode = 0;
+#else
+ imp_dbh->unicode = !(! SvTRUE(valuesv));
+#endif
+ return TRUE;
+ }
+ return FALSE;
+}
+
+SV *
+sqlite_db_FETCH_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
+{
+ dTHX;
+ char *key = SvPV_nolen(keysv);
+
+ if (strEQ(key, "sqlite_version")) {
+ return newSVpv(sqlite3_version,0);
+ }
+ if (strEQ(key, "unicode")) {
+#if (PERL_REVISION <= 5) && ((PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION < 5))
+ sqlite_trace(dbh, (imp_xxh_t*)imp_dbh, 2, "Unicode support is disabled for this version of perl.");
+ return newSViv(0);
+#else
+ return newSViv(imp_dbh->unicode ? 1 : 0);
+#endif
+ }
+
+ return NULL;
+}
+
+int
+sqlite_st_STORE_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)
+{
+ dTHX;
+ char *key = SvPV_nolen(keysv);
+ return FALSE;
+}
+
+int
+type_to_odbc_type (int type)
+{
+ switch(type) {
+ case SQLITE_INTEGER: return SQL_INTEGER;
+ case SQLITE_FLOAT: return SQL_DOUBLE;
+ case SQLITE_TEXT: return SQL_VARCHAR;
+ case SQLITE_BLOB: return SQL_BLOB;
+ case SQLITE_NULL: return SQL_UNKNOWN_TYPE;
+ default: return SQL_UNKNOWN_TYPE;
+ }
+}
+
+SV *
+sqlite_st_FETCH_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv)
+{
+ dTHX;
+ D_imp_dbh_from_sth;
+ char *key = SvPV_nolen(keysv);
+ SV *retsv = NULL;
+ int i,n;
+
+ if (!DBIc_ACTIVE(imp_sth)) {
+ return NULL;
+ }
+
+ /* warn("fetch: %s\n", key); */
+
+ i = DBIc_NUM_FIELDS(imp_sth);
+
+ if (strEQ(key, "NAME")) {
+ AV *av = newAV();
+ /* warn("Fetch NAME fields: %d\n", i); */
+ av_extend(av, i);
+ retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
+ for (n = 0; n < i; n++) {
+ /* warn("Fetch col name %d\n", n); */
+ const char *fieldname = sqlite3_column_name(imp_sth->stmt, n);
+ if (fieldname) {
+ /* warn("Name [%d]: %s\n", n, fieldname); */
+ /* char *dot = instr(fieldname, "."); */
+ /* if (dot) drop table name from field name */
+ /* fieldname = ++dot; */
+ av_store(av, n, newSVpv(fieldname, 0));
+ }
+ }
+ }
+ else if (strEQ(key, "PRECISION")) {
+ AV *av = newAV();
+ retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
+ }
+ else if (strEQ(key, "TYPE")) {
+ AV *av = newAV();
+ av_extend(av, i);
+ retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
+ for (n = 0; n < i; n++) {
+ const char *fieldtype = sqlite3_column_decltype(imp_sth->stmt, n);
+ int type = sqlite3_column_type(imp_sth->stmt, n);
+ /* warn("got type: %d = %s\n", type, fieldtype); */
+ type = type_to_odbc_type(type);
+ /* av_store(av, n, newSViv(type)); */
+ if (fieldtype)
+ av_store(av, n, newSVpv(fieldtype, 0));
+ else
+ av_store(av, n, newSVpv("VARCHAR", 0));
+ }
+ }
+ else if (strEQ(key, "NULLABLE")) {
+ AV *av = newAV();
+ av_extend(av, i);
+ retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
+#if defined(SQLITE_ENABLE_COLUMN_METADATA)
+ for (n = 0; n < i; n++) {
+ const char *database = sqlite3_column_database_name(imp_sth->stmt, n);
+ const char *tablename = sqlite3_column_table_name(imp_sth->stmt, n);
+ const char *fieldname = sqlite3_column_name(imp_sth->stmt, n);
+ const char *datatype, *collseq;
+ int notnull, primary, autoinc;
+ int retval = sqlite3_table_column_metadata(imp_dbh->db, database, tablename, fieldname, &datatype, &collseq, ¬null, &primary, &autoinc);
+ if (retval != SQLITE_OK) {
+ char *errmsg = (char*)sqlite3_errmsg(imp_dbh->db);
+ sqlite_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
+ av_store(av, n, newSViv(2)); /* SQL_NULLABLE_UNKNOWN */
+ }
+ else {
+ av_store(av, n, newSViv(!notnull));
+ }
+ }
+#endif
+ }
+ else if (strEQ(key, "SCALE")) {
+ AV *av = newAV();
+ retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
+ }
+ else if (strEQ(key, "NUM_OF_FIELDS")) {
+ retsv = sv_2mortal(newSViv(i));
+ }
+
+ return retsv;
+}
+
+static void
+sqlite_db_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error )
+{
+ STRLEN len;
+ char *s;
+
+ if ( is_error ) {
+ s = SvPV(result, len);
+ sqlite3_result_error( context, s, len );
+ return;
+ }
+
+ /* warn("result: %s\n", SvPV_nolen(result)); */
+ if ( !SvOK(result) ) {
+ sqlite3_result_null( context );
+ } else if( SvIOK_UV(result) ) {
+ s = SvPV(result, len);
+ sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
+ }
+ else if ( SvIOK(result) ) {
+ sqlite3_result_int( context, SvIV(result));
+ } else if ( !is_error && SvIOK(result) ) {
+ sqlite3_result_double( context, SvNV(result));
+ } else {
+ s = SvPV(result, len);
+ sqlite3_result_text( context, s, len, SQLITE_TRANSIENT );
+ }
+}
+
+static void
+sqlite_db_func_dispatcher(int is_unicode, sqlite3_context *context, int argc, sqlite3_value **value)
+{
+ dTHX;
+ dSP;
+ int count;
+ int i;
+ SV *func;
+
+ func = sqlite3_user_data(context);
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ for ( i=0; i < argc; i++ ) {
+ SV *arg;
+ STRLEN len = sqlite3_value_bytes(value[i]);
+ int type = sqlite3_value_type(value[i]);
+
+ /* warn("func dispatch type: %d, value: %s\n", type, sqlite3_value_text(value[i])); */
+ switch(type) {
+ case SQLITE_INTEGER:
+ arg = sv_2mortal(newSViv(sqlite3_value_int(value[i])));
+ break;
+ case SQLITE_FLOAT:
+ arg = sv_2mortal(newSVnv(sqlite3_value_double(value[i])));
+ break;
+ case SQLITE_TEXT:
+ arg = newSVpvn((const char *)sqlite3_value_text(value[i]), len);
+ if (is_unicode) {
+ SvUTF8_on(arg);
+ }
+ arg = sv_2mortal(arg);
+ break;
+ case SQLITE_BLOB:
+ arg = sv_2mortal(newSVpvn(sqlite3_value_blob(value[i]), len));
+ break;
+ default:
+ arg = &PL_sv_undef;
+ }
+
+ XPUSHs(arg);
+ }
+ PUTBACK;
+
+ count = call_sv(func, G_SCALAR|G_EVAL);
+
+ SPAGAIN;
+
+ /* Check for an error */
+ if (SvTRUE(ERRSV) ) {
+ sqlite_db_set_result(aTHX_ context, ERRSV, 1);
+ POPs;
+ } else if ( count != 1 ) {
+ SV *err = sv_2mortal(newSVpvf( "function should return 1 argument, got %d",
+ count ));
+
+ sqlite_db_set_result(aTHX_ context, err, 1);
+ /* Clear the stack */
+ for ( i=0; i < count; i++ ) {
+ POPs;
+ }
+ } else {
+ sqlite_db_set_result(aTHX_ context, POPs, 0 );
+ }
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+}
+
+
+static void
+sqlite_db_func_dispatcher_unicode(sqlite3_context *context, int argc, sqlite3_value **value)
+{
+ sqlite_db_func_dispatcher(1, context, argc, value);
+}
+
+static void
+sqlite_db_func_dispatcher_no_unicode(sqlite3_context *context, int argc, sqlite3_value **value)
+{
+ sqlite_db_func_dispatcher(0, context, argc, value);
+}
+
+void
+sqlite3_db_create_function(pTHX_ SV *dbh, const char *name, int argc, SV *func )
+{
+ D_imp_dbh(dbh);
+ int retval;
+
+ /* Copy the function reference */
+ SV *func_sv = newSVsv(func);
+ av_push( imp_dbh->functions, func_sv );
+
+ /* warn("create_function %s with %d args\n", name, argc); */
+ retval = sqlite3_create_function( imp_dbh->db, name, argc, SQLITE_UTF8,
+ func_sv,
+ imp_dbh->unicode ? sqlite_db_func_dispatcher_unicode
+ : sqlite_db_func_dispatcher_no_unicode,
+ NULL, NULL );
+ if ( retval != SQLITE_OK )
+ {
+ char errmsg[8192];
+ sqlite3_snprintf(8191, errmsg, "sqlite_create_function failed with error %s", sqlite3_errmsg(imp_dbh->db));
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ }
+}
+
+void
+sqlite3_db_enable_load_extension(pTHX_ SV *dbh, int onoff )
+{
+ D_imp_dbh(dbh);
+ int retval;
+
+ retval = sqlite3_enable_load_extension( imp_dbh->db, onoff );
+ if ( retval != SQLITE_OK )
+ {
+ char errmsg[8192];
+ sqlite3_snprintf(8191, errmsg, "sqlite_enable_load_extension failed with error %s", sqlite3_errmsg(imp_dbh->db));
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ }
+}
+
+typedef struct aggrInfo aggrInfo;
+struct aggrInfo {
+ SV *aggr_inst;
+ SV *err;
+ int inited;
+};
+
+static void
+sqlite_db_aggr_new_dispatcher(pTHX_ sqlite3_context *context, aggrInfo *aggr_info )
+{
+ dSP;
+ SV *pkg = NULL;
+ int count = 0;
+
+ aggr_info->err = NULL;
+ aggr_info->aggr_inst = NULL;
+
+ pkg = sqlite3_user_data(context);
+ if ( !pkg )
+ return;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs( sv_2mortal( newSVsv(pkg) ) );
+ PUTBACK;
+
+ count = call_method ("new", G_EVAL|G_SCALAR);
+ SPAGAIN;
+
+ aggr_info->inited = 1;
+
+ if ( SvTRUE( ERRSV ) ) {
+ aggr_info->err = newSVpvf ("error during aggregator's new(): %s",
+ SvPV_nolen (ERRSV));
+ POPs;
+ } else if ( count != 1 ) {
+ int i;
+
+ aggr_info->err = newSVpvf( "new() should return one value, got %d",
+ count );
+ /* Clear the stack */
+ for ( i=0; i < count; i++ ) {
+ POPs;
+ }
+ } else {
+ SV *aggr = POPs;
+ if ( SvROK(aggr) ) {
+ aggr_info->aggr_inst = newSVsv(aggr);
+ } else{
+ aggr_info->err = newSVpvf( "new() should return a blessed reference" );
+ }
+ }
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return;
+}
+
+static void
+sqlite_db_aggr_step_dispatcher (sqlite3_context *context,
+ int argc, sqlite3_value **value)
+{
+ dTHX;
+ dSP;
+ int i;
+ aggrInfo *aggr;
+
+ aggr = sqlite3_aggregate_context (context, sizeof (aggrInfo));
+ if ( !aggr )
+ return;
+
+ ENTER;
+ SAVETMPS;
+
+ /* initialize on first step */
+ if ( !aggr->inited ) {
+ sqlite_db_aggr_new_dispatcher(aTHX_ context, aggr );
+ }
+
+ if ( aggr->err || !aggr->aggr_inst )
+ goto cleanup;
+
+ PUSHMARK(SP);
+ XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
+ for ( i=0; i < argc; i++ ) {
+ SV *arg;
+ int len = sqlite3_value_bytes(value[i]);
+ int type = sqlite3_value_type(value[i]);
+
+ switch(type) {
+ case SQLITE_INTEGER:
+ arg = sv_2mortal(newSViv(sqlite3_value_int(value[i])));
+ break;
+ case SQLITE_FLOAT:
+ arg = sv_2mortal(newSVnv(sqlite3_value_double(value[i])));
+ break;
+ case SQLITE_TEXT:
+ arg = sv_2mortal(newSVpvn((const char *)sqlite3_value_text(value[i]), len));
+ break;
+ case SQLITE_BLOB:
+ arg = sv_2mortal(newSVpvn(sqlite3_value_blob(value[i]), len));
+ break;
+ default:
+ arg = &PL_sv_undef;
+ }
+
+ XPUSHs(arg);
+ }
+ PUTBACK;
+
+ call_method ("step", G_SCALAR|G_EVAL|G_DISCARD);
+
+ /* Check for an error */
+ if (SvTRUE(ERRSV) ) {
+ aggr->err = newSVpvf( "error during aggregator's step(): %s",
+ SvPV_nolen(ERRSV));
+ POPs;
+ }
+
+ cleanup:
+ FREETMPS;
+ LEAVE;
+}
+
+static void
+sqlite_db_aggr_finalize_dispatcher( sqlite3_context *context )
+{
+ dTHX;
+ dSP;
+ aggrInfo *aggr, myAggr;
+ int count = 0;
+
+ aggr = sqlite3_aggregate_context (context, sizeof (aggrInfo));
+
+ ENTER;
+ SAVETMPS;
+
+ if ( !aggr ) {
+ /* SQLite seems to refuse to create a context structure
+ from finalize() */
+ aggr = &myAggr;
+ aggr->aggr_inst = NULL;
+ aggr->err = NULL;
+ sqlite_db_aggr_new_dispatcher(aTHX_ context, aggr);
+ }
+
+ if ( ! aggr->err && aggr->aggr_inst ) {
+ PUSHMARK(SP);
+ XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst )) );
+ PUTBACK;
+
+ count = call_method( "finalize", G_SCALAR|G_EVAL );
+ SPAGAIN;
+
+ if ( SvTRUE(ERRSV) ) {
+ aggr->err = newSVpvf ("error during aggregator's finalize(): %s",
+ SvPV_nolen(ERRSV) ) ;
+ POPs;
+ } else if ( count != 1 ) {
+ int i;
+ aggr->err = newSVpvf( "finalize() should return 1 value, got %d",
+ count );
+ /* Clear the stack */
+ for ( i=0; ierr ) {
+ warn( "DBD::SQLite: error in aggregator cannot be reported to SQLite: %s",
+ SvPV_nolen( aggr->err ) );
+
+ /* sqlite_db_set_result(aTHX_ context, aggr->err, 1 ); */
+ SvREFCNT_dec( aggr->err );
+ aggr->err = NULL;
+ }
+
+ if ( aggr->aggr_inst ) {
+ SvREFCNT_dec( aggr->aggr_inst );
+ aggr->aggr_inst = NULL;
+ }
+
+ FREETMPS;
+ LEAVE;
+}
+
+void
+sqlite3_db_create_aggregate(pTHX_ SV *dbh, const char *name, int argc, SV *aggr_pkg )
+{
+ D_imp_dbh(dbh);
+ int retval;
+
+ /* Copy the aggregate reference */
+ SV *aggr_pkg_copy = newSVsv(aggr_pkg);
+ av_push( imp_dbh->aggregates, aggr_pkg_copy );
+
+ retval = sqlite3_create_function( imp_dbh->db, name, argc, SQLITE_UTF8,
+ aggr_pkg_copy,
+ NULL,
+ sqlite_db_aggr_step_dispatcher,
+ sqlite_db_aggr_finalize_dispatcher
+ );
+
+ if ( retval != SQLITE_OK )
+ {
+ char errmsg[8192];
+ sqlite3_snprintf(8191, errmsg, "sqlite_create_aggregate failed with error %s", sqlite3_errmsg(imp_dbh->db));
+ sqlite_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
+ }
+}
+
+
+int sqlite_db_collation_dispatcher(void *func, int len1, const void *string1,
+ int len2, const void *string2)
+{
+ dTHX;
+ dSP;
+ int cmp;
+ int n_retval;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs( sv_2mortal ( newSVpvn( string1, len1) ) );
+ XPUSHs( sv_2mortal ( newSVpvn( string2, len2) ) );
+ PUTBACK;
+ n_retval = call_sv((void*)func, G_SCALAR);
+ if (n_retval != 1) {
+ croak("collation function returned %d arguments", n_retval);
+ }
+ SPAGAIN;
+ cmp = POPi;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return cmp;
+}
+
+int sqlite_db_collation_dispatcher_utf8(
+ void *func, int len1, const void *string1,
+ int len2, const void *string2)
+{
+ dTHX;
+ dSP;
+ int cmp;
+ int n_retval;
+ SV *sv1, *sv2;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ sv1 = newSVpvn( string1, len1);
+ SvUTF8_on(sv1);
+ sv2 = newSVpvn( string2, len2);
+ SvUTF8_on(sv2);
+ XPUSHs( sv_2mortal ( sv1 ) );
+ XPUSHs( sv_2mortal ( sv2 ) );
+ PUTBACK;
+ n_retval = call_sv((void*)func, G_SCALAR);
+ if (n_retval != 1) {
+ croak("collation function returned %d arguments", n_retval);
+ }
+ SPAGAIN;
+ cmp = POPi;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return cmp;
+}
+
+
+void
+sqlite3_db_create_collation(pTHX_ SV *dbh, const char *name, SV *func )
+{
+ D_imp_dbh(dbh);
+ int rv, rv2;
+ void *aa = "aa";
+ void *zz = "zz";
+
+ SV *func_sv = newSVsv(func);
+
+ /* Check that this is a proper collation function */
+ rv = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, aa);
+ if (rv != 0) {
+ warn("improper collation function: %s(aa, aa) returns %d!", name, rv);
+ }
+ rv = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, zz);
+ rv2 = sqlite_db_collation_dispatcher(func_sv, 2, zz, 2, aa);
+ if (rv2 != (rv * -1)) {
+ warn("improper collation function: '%s' is not symmetric", name);
+ }
+
+ /* Copy the func reference so that it can be deallocated at disconnect */
+ av_push( imp_dbh->functions, func_sv );
+
+ /* Register the func within sqlite3 */
+ rv = sqlite3_create_collation(
+ imp_dbh->db, name, SQLITE_UTF8,
+ func_sv,
+ imp_dbh->unicode ? sqlite_db_collation_dispatcher_utf8
+ : sqlite_db_collation_dispatcher
+ );
+
+ if ( rv != SQLITE_OK )
+ {
+ char errmsg[8192];
+ sqlite3_snprintf(8191, errmsg, "sqlite_create_collation failed with error %s", sqlite3_errmsg(imp_dbh->db));
+ }
+}
+
+
+int sqlite_db_progress_handler_dispatcher( void *handler )
+{
+ dTHX;
+ dSP;
+ int n_retval;
+ int retval;
+
+ PUSHMARK(SP);
+ n_retval = call_sv( handler, G_SCALAR );
+ if ( n_retval != 1 ) {
+ croak( "progress_handler returned %d arguments", n_retval );
+ }
+ SPAGAIN;
+ retval = POPi;
+ PUTBACK;
+
+ return retval;
+}
+
+
+
+void
+sqlite3_db_progress_handler(pTHX_ SV *dbh, int n_opcodes, SV *handler )
+{
+ D_imp_dbh(dbh);
+
+ if (handler == &PL_sv_undef) {
+ /* remove previous handler */
+ sqlite3_progress_handler( imp_dbh->db, 0, NULL, NULL);
+ }
+ else {
+ SV *handler_sv = newSVsv(handler);
+
+ /* Copy the handler ref so that it can be deallocated at disconnect */
+ av_push( imp_dbh->functions, handler_sv );
+
+ /* Register the func within sqlite3 */
+ sqlite3_progress_handler( imp_dbh->db, n_opcodes,
+ sqlite_db_progress_handler_dispatcher,
+ handler_sv );
+ }
+}
+
+/* end */
diff --git a/dbdimp.h b/dbdimp.h
index a7c26f9..78f7c5e 100644
--- a/dbdimp.h
+++ b/dbdimp.h
@@ -1,116 +1,116 @@
-
-#ifndef _DBDIMP_H
-#define _DBDIMP_H 1
-
-#include "SQLiteXS.h"
-#include "sqlite3.h"
-
-/* 30 second timeout by default */
-#define SQL_TIMEOUT 30000
-
-/* Driver Handle */
-struct imp_drh_st {
- dbih_drc_t com;
- /* sqlite specific bits */
-};
-
-/* Database Handle */
-struct imp_dbh_st {
- dbih_dbc_t com;
- /* sqlite specific bits */
- sqlite3 *db;
- bool in_tran;
- bool unicode;
- bool handle_binary_nulls;
- int timeout;
- AV *functions;
- AV *aggregates;
-};
-
-/* Statement Handle */
-struct imp_sth_st {
- dbih_stc_t com;
- /* sqlite specific bits */
- sqlite3_stmt *stmt;
- /*
- char **results;
- char **coldata;
- */
- int retval;
- int nrow;
- char *statement;
- AV *params;
- AV *col_types;
-};
-
-#define dbd_init sqlite_init
-#define dbd_discon_all sqlite_discon_all
-#define dbd_db_login sqlite_db_login
-#define dbd_db_do sqlite_db_do
-#define dbd_db_commit sqlite_db_commit
-#define dbd_db_rollback sqlite_db_rollback
-#define dbd_db_disconnect sqlite_db_disconnect
-#define dbd_db_destroy sqlite_db_destroy
-#define dbd_db_STORE_attrib sqlite_db_STORE_attrib
-#define dbd_db_FETCH_attrib sqlite_db_FETCH_attrib
-#define dbd_db_STORE_attrib_k sqlite_db_STORE_attrib_k
-#define dbd_db_FETCH_attrib_k sqlite_db_FETCH_attrib_k
-#define dbd_db_last_insert_id sqlite_db_last_insert_id
-#define dbd_st_prepare sqlite_st_prepare
-#define dbd_st_rows sqlite_st_rows
-#define dbd_st_execute sqlite_st_execute
-#define dbd_st_fetch sqlite_st_fetch
-#define dbd_st_finish3 sqlite_st_finish3
-#define dbd_st_finish sqlite_st_finish
-#define dbd_st_destroy sqlite_st_destroy
-#define dbd_st_blob_read sqlite_st_blob_read
-#define dbd_st_STORE_attrib sqlite_st_STORE_attrib
-#define dbd_st_FETCH_attrib sqlite_st_FETCH_attrib
-#define dbd_st_STORE_attrib_k sqlite_st_STORE_attrib_k
-#define dbd_st_FETCH_attrib_k sqlite_st_FETCH_attrib_k
-#define dbd_bind_ph sqlite_bind_ph
-#define dbd_st_bind_col sqlite_bind_col
-
-void sqlite3_db_create_function(pTHX_ SV *dbh, const char *name, int argc, SV *func);
-void sqlite3_db_enable_load_extension(pTHX_ SV *dbh, int onoff);
-void sqlite3_db_create_aggregate(pTHX_ SV *dbh, const char *name, int argc, SV *aggr );
-void sqlite3_db_create_collation(pTHX_ SV *dbh, const char *name, SV *func);
-void sqlite3_db_progress_handler(pTHX_ SV *dbh, int n_opcodes, SV *handler);
-void sqlite_st_reset(pTHX_ SV *sth );
-int sqlite_bind_col( SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type, SV *attribs );
-int dbd_set_sqlite3_busy_timeout (pTHX_ SV *dbh, int timeout );
-
-#ifdef SvUTF8_on
-
-static SV *
-newUTF8SVpv(char *s, STRLEN len) {
- dTHX;
- register SV *sv;
-
- sv = newSVpv(s, len);
- SvUTF8_on(sv);
- return sv;
-}
-
-static SV *
-newUTF8SVpvn(char *s, STRLEN len) {
- dTHX;
- register SV *sv;
-
- sv = newSV(0);
- sv_setpvn(sv, s, len);
- SvUTF8_on(sv);
- return sv;
-}
-
-#else /* #ifdef SvUTF8_on */
-
-#define newUTF8SVpv newSVpv
-#define newUTF8SVpvn newSVpvn
-#define SvUTF8_on(a) (a)
-#define SvUTF8_off(a) (a)
-#define sv_utf8_upgrade(a) (a)
-
-#endif /* #ifdef SvUTF8_on */
-
-#endif /* #ifndef _DBDIMP_H */
+
+#ifndef _DBDIMP_H
+#define _DBDIMP_H 1
+
+#include "SQLiteXS.h"
+#include "sqlite3.h"
+
+/* 30 second timeout by default */
+#define SQL_TIMEOUT 30000
+
+/* Driver Handle */
+struct imp_drh_st {
+ dbih_drc_t com;
+ /* sqlite specific bits */
+};
+
+/* Database Handle */
+struct imp_dbh_st {
+ dbih_dbc_t com;
+ /* sqlite specific bits */
+ sqlite3 *db;
+ bool in_tran;
+ bool unicode;
+ bool handle_binary_nulls;
+ int timeout;
+ AV *functions;
+ AV *aggregates;
+};
+
+/* Statement Handle */
+struct imp_sth_st {
+ dbih_stc_t com;
+ /* sqlite specific bits */
+ sqlite3_stmt *stmt;
+ /*
+ char **results;
+ char **coldata;
+ */
+ int retval;
+ int nrow;
+ char *statement;
+ AV *params;
+ AV *col_types;
+};
+
+#define dbd_init sqlite_init
+#define dbd_discon_all sqlite_discon_all
+#define dbd_db_login sqlite_db_login
+#define dbd_db_do sqlite_db_do
+#define dbd_db_commit sqlite_db_commit
+#define dbd_db_rollback sqlite_db_rollback
+#define dbd_db_disconnect sqlite_db_disconnect
+#define dbd_db_destroy sqlite_db_destroy
+#define dbd_db_STORE_attrib sqlite_db_STORE_attrib
+#define dbd_db_FETCH_attrib sqlite_db_FETCH_attrib
+#define dbd_db_STORE_attrib_k sqlite_db_STORE_attrib_k
+#define dbd_db_FETCH_attrib_k sqlite_db_FETCH_attrib_k
+#define dbd_db_last_insert_id sqlite_db_last_insert_id
+#define dbd_st_prepare sqlite_st_prepare
+#define dbd_st_rows sqlite_st_rows
+#define dbd_st_execute sqlite_st_execute
+#define dbd_st_fetch sqlite_st_fetch
+#define dbd_st_finish3 sqlite_st_finish3
+#define dbd_st_finish sqlite_st_finish
+#define dbd_st_destroy sqlite_st_destroy
+#define dbd_st_blob_read sqlite_st_blob_read
+#define dbd_st_STORE_attrib sqlite_st_STORE_attrib
+#define dbd_st_FETCH_attrib sqlite_st_FETCH_attrib
+#define dbd_st_STORE_attrib_k sqlite_st_STORE_attrib_k
+#define dbd_st_FETCH_attrib_k sqlite_st_FETCH_attrib_k
+#define dbd_bind_ph sqlite_bind_ph
+#define dbd_st_bind_col sqlite_bind_col
+
+void sqlite3_db_create_function(pTHX_ SV *dbh, const char *name, int argc, SV *func);
+void sqlite3_db_enable_load_extension(pTHX_ SV *dbh, int onoff);
+void sqlite3_db_create_aggregate(pTHX_ SV *dbh, const char *name, int argc, SV *aggr );
+void sqlite3_db_create_collation(pTHX_ SV *dbh, const char *name, SV *func);
+void sqlite3_db_progress_handler(pTHX_ SV *dbh, int n_opcodes, SV *handler);
+void sqlite_st_reset(pTHX_ SV *sth );
+int sqlite_bind_col( SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type, SV *attribs );
+int dbd_set_sqlite3_busy_timeout (pTHX_ SV *dbh, int timeout );
+
+#ifdef SvUTF8_on
+
+static SV *
+newUTF8SVpv(char *s, STRLEN len) {
+ dTHX;
+ register SV *sv;
+
+ sv = newSVpv(s, len);
+ SvUTF8_on(sv);
+ return sv;
+}
+
+static SV *
+newUTF8SVpvn(char *s, STRLEN len) {
+ dTHX;
+ register SV *sv;
+
+ sv = newSV(0);
+ sv_setpvn(sv, s, len);
+ SvUTF8_on(sv);
+ return sv;
+}
+
+#else /* #ifdef SvUTF8_on */
+
+#define newUTF8SVpv newSVpv
+#define newUTF8SVpvn newSVpvn
+#define SvUTF8_on(a) (a)
+#define SvUTF8_off(a) (a)
+#define sv_utf8_upgrade(a) (a)
+
+#endif /* #ifdef SvUTF8_on */
+
+#endif /* #ifndef _DBDIMP_H */
diff --git a/ppport.h b/ppport.h
index 86f69d0..8868336 100644
--- a/ppport.h
+++ b/ppport.h
@@ -1,6984 +1,6984 @@
-#if 0
-<<'SKIP';
-#endif
-/*
-----------------------------------------------------------------------
-
- ppport.h -- Perl/Pollution/Portability Version 3.17
-
- Automatically created by Devel::PPPort running under perl 5.008008.
-
- Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
- includes in parts/inc/ instead.
-
- Use 'perldoc ppport.h' to view the documentation below.
-
-----------------------------------------------------------------------
-
-SKIP
-
-=pod
-
-=head1 NAME
-
-ppport.h - Perl/Pollution/Portability version 3.17
-
-=head1 SYNOPSIS
-
- perl ppport.h [options] [source files]
-
- Searches current directory for files if no [source files] are given
-
- --help show short help
-
- --version show version
-
- --patch=file write one patch file with changes
- --copy=suffix write changed copies with suffix
- --diff=program use diff program and options
-
- --compat-version=version provide compatibility with Perl version
- --cplusplus accept C++ comments
-
- --quiet don't output anything except fatal errors
- --nodiag don't show diagnostics
- --nohints don't show hints
- --nochanges don't suggest changes
- --nofilter don't filter input files
-
- --strip strip all script and doc functionality from
- ppport.h
-
- --list-provided list provided API
- --list-unsupported list unsupported API
- --api-info=name show Perl API portability information
-
-=head1 COMPATIBILITY
-
-This version of F is designed to support operation with Perl
-installations back to 5.003, and has been tested up to 5.10.0.
-
-=head1 OPTIONS
-
-=head2 --help
-
-Display a brief usage summary.
-
-=head2 --version
-
-Display the version of F.
-
-=head2 --patch=I
-
-If this option is given, a single patch file will be created if
-any changes are suggested. This requires a working diff program
-to be installed on your system.
-
-=head2 --copy=I
-
-If this option is given, a copy of each file will be saved with
-the given suffix that contains the suggested changes. This does
-not require any external programs. Note that this does not
-automagially add a dot between the original filename and the
-suffix. If you want the dot, you have to include it in the option
-argument.
-
-If neither C<--patch> or C<--copy> are given, the default is to
-simply print the diffs for each file. This requires either
-C or a C program to be installed.
-
-=head2 --diff=I
-
-Manually set the diff program and options to use. The default
-is to use C, when installed, and output unified
-context diffs.
-
-=head2 --compat-version=I
-
-Tell F to check for compatibility with the given
-Perl version. The default is to check for compatibility with Perl
-version 5.003. You can use this option to reduce the output
-of F if you intend to be backward compatible only
-down to a certain Perl version.
-
-=head2 --cplusplus
-
-Usually, F will detect C++ style comments and
-replace them with C style comments for portability reasons.
-Using this option instructs F to leave C++
-comments untouched.
-
-=head2 --quiet
-
-Be quiet. Don't print anything except fatal errors.
-
-=head2 --nodiag
-
-Don't output any diagnostic messages. Only portability
-alerts will be printed.
-
-=head2 --nohints
-
-Don't output any hints. Hints often contain useful portability
-notes. Warnings will still be displayed.
-
-=head2 --nochanges
-
-Don't suggest any changes. Only give diagnostic output and hints
-unless these are also deactivated.
-
-=head2 --nofilter
-
-Don't filter the list of input files. By default, files not looking
-like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
-
-=head2 --strip
-
-Strip all script and documentation functionality from F.
-This reduces the size of F dramatically and may be useful
-if you want to include F in smaller modules without
-increasing their distribution size too much.
-
-The stripped F will have a C<--unstrip> option that allows
-you to undo the stripping, but only if an appropriate C
-module is installed.
-
-=head2 --list-provided
-
-Lists the API elements for which compatibility is provided by
-F. Also lists if it must be explicitly requested,
-if it has dependencies, and if there are hints or warnings for it.
-
-=head2 --list-unsupported
-
-Lists the API elements that are known not to be supported by
-F and below which version of Perl they probably
-won't be available or work.
-
-=head2 --api-info=I
-
-Show portability information for API elements matching I.
-If I is surrounded by slashes, it is interpreted as a regular
-expression.
-
-=head1 DESCRIPTION
-
-In order for a Perl extension (XS) module to be as portable as possible
-across differing versions of Perl itself, certain steps need to be taken.
-
-=over 4
-
-=item *
-
-Including this header is the first major one. This alone will give you
-access to a large part of the Perl API that hasn't been available in
-earlier Perl releases. Use
-
- perl ppport.h --list-provided
-
-to see which API elements are provided by ppport.h.
-
-=item *
-
-You should avoid using deprecated parts of the API. For example, using
-global Perl variables without the C prefix is deprecated. Also,
-some API functions used to have a C prefix. Using this form is
-also deprecated. You can safely use the supported API, as F
-will provide wrappers for older Perl versions.
-
-=item *
-
-If you use one of a few functions or variables that were not present in
-earlier versions of Perl, and that can't be provided using a macro, you
-have to explicitly request support for these functions by adding one or
-more C<#define>s in your source code before the inclusion of F.
-
-These functions or variables will be marked C in the list shown
-by C<--list-provided>.
-
-Depending on whether you module has a single or multiple files that
-use such functions or variables, you want either C or global
-variants.
-
-For a C function or variable (used only in a single source
-file), use:
-
- #define NEED_function
- #define NEED_variable
-
-For a global function or variable (used in multiple source files),
-use:
-
- #define NEED_function_GLOBAL
- #define NEED_variable_GLOBAL
-
-Note that you mustn't have more than one global request for the
-same function or variable in your project.
-
- Function / Variable Static Request Global Request
- -----------------------------------------------------------------------------------------
- PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
- PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
- eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
- grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
- grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
- grok_number() NEED_grok_number NEED_grok_number_GLOBAL
- grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
- grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
- load_module() NEED_load_module NEED_load_module_GLOBAL
- my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
- my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
- my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
- my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
- newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
- newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
- newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
- newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
- pv_display() NEED_pv_display NEED_pv_display_GLOBAL
- pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
- pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
- sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
- sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
- sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
- sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
- sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
- sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
- sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
- vload_module() NEED_vload_module NEED_vload_module_GLOBAL
- vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
- warner() NEED_warner NEED_warner_GLOBAL
-
-To avoid namespace conflicts, you can change the namespace of the
-explicitly exported functions / variables using the C
-macro. Just C<#define> the macro before including C:
-
- #define DPPP_NAMESPACE MyOwnNamespace_
- #include "ppport.h"
-
-The default namespace is C.
-
-=back
-
-The good thing is that most of the above can be checked by running
-F on your source code. See the next section for
-details.
-
-=head1 EXAMPLES
-
-To verify whether F is needed for your module, whether you
-should make any changes to your code, and whether any special defines
-should be used, F can be run as a Perl script to check your
-source code. Simply say:
-
- perl ppport.h
-
-The result will usually be a list of patches suggesting changes
-that should at least be acceptable, if not necessarily the most
-efficient solution, or a fix for all possible problems.
-
-If you know that your XS module uses features only available in
-newer Perl releases, if you're aware that it uses C++ comments,
-and if you want all suggestions as a single patch file, you could
-use something like this:
-
- perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
-
-If you only want your code to be scanned without any suggestions
-for changes, use:
-
- perl ppport.h --nochanges
-
-You can specify a different C program or options, using
-the C<--diff> option:
-
- perl ppport.h --diff='diff -C 10'
-
-This would output context diffs with 10 lines of context.
-
-If you want to create patched copies of your files instead, use:
-
- perl ppport.h --copy=.new
-
-To display portability information for the C function,
-use:
-
- perl ppport.h --api-info=newSVpvn
-
-Since the argument to C<--api-info> can be a regular expression,
-you can use
-
- perl ppport.h --api-info=/_nomg$/
-
-to display portability information for all C<_nomg> functions or
-
- perl ppport.h --api-info=/./
-
-to display information for all known API elements.
-
-=head1 BUGS
-
-If this version of F is causing failure during
-the compilation of this module, please check if newer versions
-of either this module or C are available on CPAN
-before sending a bug report.
-
-If F was generated using the latest version of
-C and is causing failure of this module, please
-file a bug report using the CPAN Request Tracker at L.
-
-Please include the following information:
-
-=over 4
-
-=item 1.
-
-The complete output from running "perl -V"
-
-=item 2.
-
-This file.
-
-=item 3.
-
-The name and version of the module you were trying to build.
-
-=item 4.
-
-A full log of the build that failed.
-
-=item 5.
-
-Any other information that you think could be relevant.
-
-=back
-
-For the latest version of this code, please get the C
-module from CPAN.
-
-=head1 COPYRIGHT
-
-Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
-
-Version 2.x, Copyright (C) 2001, Paul Marquess.
-
-Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-See L.
-
-=cut
-
-use strict;
-
-# Disable broken TRIE-optimization
-BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
-
-my $VERSION = 3.17;
-
-my %opt = (
- quiet => 0,
- diag => 1,
- hints => 1,
- changes => 1,
- cplusplus => 0,
- filter => 1,
- strip => 0,
- version => 0,
-);
-
-my($ppport) = $0 =~ /([\w.]+)$/;
-my $LF = '(?:\r\n|[\r\n])'; # line feed
-my $HS = "[ \t]"; # horizontal whitespace
-
-# Never use C comments in this file!
-my $ccs = '/'.'*';
-my $cce = '*'.'/';
-my $rccs = quotemeta $ccs;
-my $rcce = quotemeta $cce;
-
-eval {
- require Getopt::Long;
- Getopt::Long::GetOptions(\%opt, qw(
- help quiet diag! filter! hints! changes! cplusplus strip version
- patch=s copy=s diff=s compat-version=s
- list-provided list-unsupported api-info=s
- )) or usage();
-};
-
-if ($@ and grep /^-/, @ARGV) {
- usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
- die "Getopt::Long not found. Please don't use any options.\n";
-}
-
-if ($opt{version}) {
- print "This is $0 $VERSION.\n";
- exit 0;
-}
-
-usage() if $opt{help};
-strip() if $opt{strip};
-
-if (exists $opt{'compat-version'}) {
- my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
- if ($@) {
- die "Invalid version number format: '$opt{'compat-version'}'\n";
- }
- die "Only Perl 5 is supported\n" if $r != 5;
- die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
- $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
-}
-else {
- $opt{'compat-version'} = 5;
-}
-
-my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
- ? ( $1 => {
- ($2 ? ( base => $2 ) : ()),
- ($3 ? ( todo => $3 ) : ()),
- (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
- (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
- (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
- } )
- : die "invalid spec: $_" } qw(
-AvFILLp|5.004050||p
-AvFILL|||
-CLASS|||n
-CPERLscope|5.005000||p
-CX_CURPAD_SAVE|||
-CX_CURPAD_SV|||
-CopFILEAV|5.006000||p
-CopFILEGV_set|5.006000||p
-CopFILEGV|5.006000||p
-CopFILESV|5.006000||p
-CopFILE_set|5.006000||p
-CopFILE|5.006000||p
-CopSTASHPV_set|5.006000||p
-CopSTASHPV|5.006000||p
-CopSTASH_eq|5.006000||p
-CopSTASH_set|5.006000||p
-CopSTASH|5.006000||p
-CopyD|5.009002||p
-Copy|||
-CvPADLIST|||
-CvSTASH|||
-CvWEAKOUTSIDE|||
-DEFSV_set|5.011000||p
-DEFSV|5.004050||p
-END_EXTERN_C|5.005000||p
-ENTER|||
-ERRSV|5.004050||p
-EXTEND|||
-EXTERN_C|5.005000||p
-F0convert|||n
-FREETMPS|||
-GIMME_V||5.004000|n
-GIMME|||n
-GROK_NUMERIC_RADIX|5.007002||p
-G_ARRAY|||
-G_DISCARD|||
-G_EVAL|||
-G_METHOD|5.006001||p
-G_NOARGS|||
-G_SCALAR|||
-G_VOID||5.004000|
-GetVars|||
-GvSV|||
-Gv_AMupdate|||
-HEf_SVKEY||5.004000|
-HeHASH||5.004000|
-HeKEY||5.004000|
-HeKLEN||5.004000|
-HePV||5.004000|
-HeSVKEY_force||5.004000|
-HeSVKEY_set||5.004000|
-HeSVKEY||5.004000|
-HeUTF8||5.011000|
-HeVAL||5.004000|
-HvNAME|||
-INT2PTR|5.006000||p
-IN_LOCALE_COMPILETIME|5.007002||p
-IN_LOCALE_RUNTIME|5.007002||p
-IN_LOCALE|5.007002||p
-IN_PERL_COMPILETIME|5.008001||p
-IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
-IS_NUMBER_INFINITY|5.007002||p
-IS_NUMBER_IN_UV|5.007002||p
-IS_NUMBER_NAN|5.007003||p
-IS_NUMBER_NEG|5.007002||p
-IS_NUMBER_NOT_INT|5.007002||p
-IVSIZE|5.006000||p
-IVTYPE|5.006000||p
-IVdf|5.006000||p
-LEAVE|||
-LVRET|||
-MARK|||
-MULTICALL||5.011000|
-MY_CXT_CLONE|5.009002||p
-MY_CXT_INIT|5.007003||p
-MY_CXT|5.007003||p
-MoveD|5.009002||p
-Move|||
-NOOP|5.005000||p
-NUM2PTR|5.006000||p
-NVTYPE|5.006000||p
-NVef|5.006001||p
-NVff|5.006001||p
-NVgf|5.006001||p
-Newxc|5.009003||p
-Newxz|5.009003||p
-Newx|5.009003||p
-Nullav|||
-Nullch|||
-Nullcv|||
-Nullhv|||
-Nullsv|||
-ORIGMARK|||
-PAD_BASE_SV|||
-PAD_CLONE_VARS|||
-PAD_COMPNAME_FLAGS|||
-PAD_COMPNAME_GEN_set|||
-PAD_COMPNAME_GEN|||
-PAD_COMPNAME_OURSTASH|||
-PAD_COMPNAME_PV|||
-PAD_COMPNAME_TYPE|||
-PAD_DUP|||
-PAD_RESTORE_LOCAL|||
-PAD_SAVE_LOCAL|||
-PAD_SAVE_SETNULLPAD|||
-PAD_SETSV|||
-PAD_SET_CUR_NOSAVE|||
-PAD_SET_CUR|||
-PAD_SVl|||
-PAD_SV|||
-PERLIO_FUNCS_CAST|5.009003||p
-PERLIO_FUNCS_DECL|5.009003||p
-PERL_ABS|5.008001||p
-PERL_BCDVERSION|5.011000||p
-PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
-PERL_HASH|5.004000||p
-PERL_INT_MAX|5.004000||p
-PERL_INT_MIN|5.004000||p
-PERL_LONG_MAX|5.004000||p
-PERL_LONG_MIN|5.004000||p
-PERL_MAGIC_arylen|5.007002||p
-PERL_MAGIC_backref|5.007002||p
-PERL_MAGIC_bm|5.007002||p
-PERL_MAGIC_collxfrm|5.007002||p
-PERL_MAGIC_dbfile|5.007002||p
-PERL_MAGIC_dbline|5.007002||p
-PERL_MAGIC_defelem|5.007002||p
-PERL_MAGIC_envelem|5.007002||p
-PERL_MAGIC_env|5.007002||p
-PERL_MAGIC_ext|5.007002||p
-PERL_MAGIC_fm|5.007002||p
-PERL_MAGIC_glob|5.011000||p
-PERL_MAGIC_isaelem|5.007002||p
-PERL_MAGIC_isa|5.007002||p
-PERL_MAGIC_mutex|5.011000||p
-PERL_MAGIC_nkeys|5.007002||p
-PERL_MAGIC_overload_elem|5.007002||p
-PERL_MAGIC_overload_table|5.007002||p
-PERL_MAGIC_overload|5.007002||p
-PERL_MAGIC_pos|5.007002||p
-PERL_MAGIC_qr|5.007002||p
-PERL_MAGIC_regdata|5.007002||p
-PERL_MAGIC_regdatum|5.007002||p
-PERL_MAGIC_regex_global|5.007002||p
-PERL_MAGIC_shared_scalar|5.007003||p
-PERL_MAGIC_shared|5.007003||p
-PERL_MAGIC_sigelem|5.007002||p
-PERL_MAGIC_sig|5.007002||p
-PERL_MAGIC_substr|5.007002||p
-PERL_MAGIC_sv|5.007002||p
-PERL_MAGIC_taint|5.007002||p
-PERL_MAGIC_tiedelem|5.007002||p
-PERL_MAGIC_tiedscalar|5.007002||p
-PERL_MAGIC_tied|5.007002||p
-PERL_MAGIC_utf8|5.008001||p
-PERL_MAGIC_uvar_elem|5.007003||p
-PERL_MAGIC_uvar|5.007002||p
-PERL_MAGIC_vec|5.007002||p
-PERL_MAGIC_vstring|5.008001||p
-PERL_PV_ESCAPE_ALL|5.009004||p
-PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
-PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
-PERL_PV_ESCAPE_NOCLEAR|5.009004||p
-PERL_PV_ESCAPE_QUOTE|5.009004||p
-PERL_PV_ESCAPE_RE|5.009005||p
-PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
-PERL_PV_ESCAPE_UNI|5.009004||p
-PERL_PV_PRETTY_DUMP|5.009004||p
-PERL_PV_PRETTY_ELLIPSES|5.010000||p
-PERL_PV_PRETTY_LTGT|5.009004||p
-PERL_PV_PRETTY_NOCLEAR|5.010000||p
-PERL_PV_PRETTY_QUOTE|5.009004||p
-PERL_PV_PRETTY_REGPROP|5.009004||p
-PERL_QUAD_MAX|5.004000||p
-PERL_QUAD_MIN|5.004000||p
-PERL_REVISION|5.006000||p
-PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
-PERL_SCAN_DISALLOW_PREFIX|5.007003||p
-PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
-PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
-PERL_SHORT_MAX|5.004000||p
-PERL_SHORT_MIN|5.004000||p
-PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
-PERL_SUBVERSION|5.006000||p
-PERL_UCHAR_MAX|5.004000||p
-PERL_UCHAR_MIN|5.004000||p
-PERL_UINT_MAX|5.004000||p
-PERL_UINT_MIN|5.004000||p
-PERL_ULONG_MAX|5.004000||p
-PERL_ULONG_MIN|5.004000||p
-PERL_UNUSED_ARG|5.009003||p
-PERL_UNUSED_CONTEXT|5.009004||p
-PERL_UNUSED_DECL|5.007002||p
-PERL_UNUSED_VAR|5.007002||p
-PERL_UQUAD_MAX|5.004000||p
-PERL_UQUAD_MIN|5.004000||p
-PERL_USE_GCC_BRACE_GROUPS|5.009004||p
-PERL_USHORT_MAX|5.004000||p
-PERL_USHORT_MIN|5.004000||p
-PERL_VERSION|5.006000||p
-PL_DBsignal|5.005000||p
-PL_DBsingle|||pn
-PL_DBsub|||pn
-PL_DBtrace|||pn
-PL_Sv|5.005000||p
-PL_bufend|5.011000||p
-PL_bufptr|5.011000||p
-PL_compiling|5.004050||p
-PL_copline|5.011000||p
-PL_curcop|5.004050||p
-PL_curstash|5.004050||p
-PL_debstash|5.004050||p
-PL_defgv|5.004050||p
-PL_diehook|5.004050||p
-PL_dirty|5.004050||p
-PL_dowarn|||pn
-PL_errgv|5.004050||p
-PL_expect|5.011000||p
-PL_hexdigit|5.005000||p
-PL_hints|5.005000||p
-PL_last_in_gv|||n
-PL_laststatval|5.005000||p
-PL_lex_state|5.011000||p
-PL_lex_stuff|5.011000||p
-PL_linestr|5.011000||p
-PL_modglobal||5.005000|n
-PL_na|5.004050||pn
-PL_no_modify|5.006000||p
-PL_ofsgv|||n
-PL_parser|5.009005||p
-PL_perl_destruct_level|5.004050||p
-PL_perldb|5.004050||p
-PL_ppaddr|5.006000||p
-PL_rsfp_filters|5.004050||p
-PL_rsfp|5.004050||p
-PL_rs|||n
-PL_signals|5.008001||p
-PL_stack_base|5.004050||p
-PL_stack_sp|5.004050||p
-PL_statcache|5.005000||p
-PL_stdingv|5.004050||p
-PL_sv_arenaroot|5.004050||p
-PL_sv_no|5.004050||pn
-PL_sv_undef|5.004050||pn
-PL_sv_yes|5.004050||pn
-PL_tainted|5.004050||p
-PL_tainting|5.004050||p
-PL_tokenbuf|5.011000||p
-POP_MULTICALL||5.011000|
-POPi|||n
-POPl|||n
-POPn|||n
-POPpbytex||5.007001|n
-POPpx||5.005030|n
-POPp|||n
-POPs|||n
-PTR2IV|5.006000||p
-PTR2NV|5.006000||p
-PTR2UV|5.006000||p
-PTR2nat|5.009003||p
-PTR2ul|5.007001||p
-PTRV|5.006000||p
-PUSHMARK|||
-PUSH_MULTICALL||5.011000|
-PUSHi|||
-PUSHmortal|5.009002||p
-PUSHn|||
-PUSHp|||
-PUSHs|||
-PUSHu|5.004000||p
-PUTBACK|||
-PerlIO_clearerr||5.007003|
-PerlIO_close||5.007003|
-PerlIO_context_layers||5.009004|
-PerlIO_eof||5.007003|
-PerlIO_error||5.007003|
-PerlIO_fileno||5.007003|
-PerlIO_fill||5.007003|
-PerlIO_flush||5.007003|
-PerlIO_get_base||5.007003|
-PerlIO_get_bufsiz||5.007003|
-PerlIO_get_cnt||5.007003|
-PerlIO_get_ptr||5.007003|
-PerlIO_read||5.007003|
-PerlIO_seek||5.007003|
-PerlIO_set_cnt||5.007003|
-PerlIO_set_ptrcnt||5.007003|
-PerlIO_setlinebuf||5.007003|
-PerlIO_stderr||5.007003|
-PerlIO_stdin||5.007003|
-PerlIO_stdout||5.007003|
-PerlIO_tell||5.007003|
-PerlIO_unread||5.007003|
-PerlIO_write||5.007003|
-Perl_signbit||5.009005|n
-PoisonFree|5.009004||p
-PoisonNew|5.009004||p
-PoisonWith|5.009004||p
-Poison|5.008000||p
-RETVAL|||n
-Renewc|||
-Renew|||
-SAVECLEARSV|||
-SAVECOMPPAD|||
-SAVEPADSV|||
-SAVETMPS|||
-SAVE_DEFSV|5.004050||p
-SPAGAIN|||
-SP|||
-START_EXTERN_C|5.005000||p
-START_MY_CXT|5.007003||p
-STMT_END|||p
-STMT_START|||p
-STR_WITH_LEN|5.009003||p
-ST|||
-SV_CONST_RETURN|5.009003||p
-SV_COW_DROP_PV|5.008001||p
-SV_COW_SHARED_HASH_KEYS|5.009005||p
-SV_GMAGIC|5.007002||p
-SV_HAS_TRAILING_NUL|5.009004||p
-SV_IMMEDIATE_UNREF|5.007001||p
-SV_MUTABLE_RETURN|5.009003||p
-SV_NOSTEAL|5.009002||p
-SV_SMAGIC|5.009003||p
-SV_UTF8_NO_ENCODING|5.008001||p
-SVf_UTF8|5.006000||p
-SVf|5.006000||p
-SVt_IV|||
-SVt_NV|||
-SVt_PVAV|||
-SVt_PVCV|||
-SVt_PVHV|||
-SVt_PVMG|||
-SVt_PV|||
-Safefree|||
-Slab_Alloc|||
-Slab_Free|||
-Slab_to_rw|||
-StructCopy|||
-SvCUR_set|||
-SvCUR|||
-SvEND|||
-SvGAMAGIC||5.006001|
-SvGETMAGIC|5.004050||p
-SvGROW|||
-SvIOK_UV||5.006000|
-SvIOK_notUV||5.006000|
-SvIOK_off|||
-SvIOK_only_UV||5.006000|
-SvIOK_only|||
-SvIOK_on|||
-SvIOKp|||
-SvIOK|||
-SvIVX|||
-SvIV_nomg|5.009001||p
-SvIV_set|||
-SvIVx|||
-SvIV|||
-SvIsCOW_shared_hash||5.008003|
-SvIsCOW||5.008003|
-SvLEN_set|||
-SvLEN|||
-SvLOCK||5.007003|
-SvMAGIC_set|5.009003||p
-SvNIOK_off|||
-SvNIOKp|||
-SvNIOK|||
-SvNOK_off|||
-SvNOK_only|||
-SvNOK_on|||
-SvNOKp|||
-SvNOK|||
-SvNVX|||
-SvNV_set|||
-SvNVx|||
-SvNV|||
-SvOK|||
-SvOOK_offset||5.011000|
-SvOOK|||
-SvPOK_off|||
-SvPOK_only_UTF8||5.006000|
-SvPOK_only|||
-SvPOK_on|||
-SvPOKp|||
-SvPOK|||
-SvPVX_const|5.009003||p
-SvPVX_mutable|5.009003||p
-SvPVX|||
-SvPV_const|5.009003||p
-SvPV_flags_const_nolen|5.009003||p
-SvPV_flags_const|5.009003||p
-SvPV_flags_mutable|5.009003||p
-SvPV_flags|5.007002||p
-SvPV_force_flags_mutable|5.009003||p
-SvPV_force_flags_nolen|5.009003||p
-SvPV_force_flags|5.007002||p
-SvPV_force_mutable|5.009003||p
-SvPV_force_nolen|5.009003||p
-SvPV_force_nomg_nolen|5.009003||p
-SvPV_force_nomg|5.007002||p
-SvPV_force|||p
-SvPV_mutable|5.009003||p
-SvPV_nolen_const|5.009003||p
-SvPV_nolen|5.006000||p
-SvPV_nomg_const_nolen|5.009003||p
-SvPV_nomg_const|5.009003||p
-SvPV_nomg|5.007002||p
-SvPV_renew|5.009003||p
-SvPV_set|||
-SvPVbyte_force||5.009002|
-SvPVbyte_nolen||5.006000|
-SvPVbytex_force||5.006000|
-SvPVbytex||5.006000|
-SvPVbyte|5.006000||p
-SvPVutf8_force||5.006000|
-SvPVutf8_nolen||5.006000|
-SvPVutf8x_force||5.006000|
-SvPVutf8x||5.006000|
-SvPVutf8||5.006000|
-SvPVx|||
-SvPV|||
-SvREFCNT_dec|||
-SvREFCNT_inc_NN|5.009004||p
-SvREFCNT_inc_simple_NN|5.009004||p
-SvREFCNT_inc_simple_void_NN|5.009004||p
-SvREFCNT_inc_simple_void|5.009004||p
-SvREFCNT_inc_simple|5.009004||p
-SvREFCNT_inc_void_NN|5.009004||p
-SvREFCNT_inc_void|5.009004||p
-SvREFCNT_inc|||p
-SvREFCNT|||
-SvROK_off|||
-SvROK_on|||
-SvROK|||
-SvRV_set|5.009003||p
-SvRV|||
-SvRXOK||5.009005|
-SvRX||5.009005|
-SvSETMAGIC|||
-SvSHARED_HASH|5.009003||p
-SvSHARE||5.007003|
-SvSTASH_set|5.009003||p
-SvSTASH|||
-SvSetMagicSV_nosteal||5.004000|
-SvSetMagicSV||5.004000|
-SvSetSV_nosteal||5.004000|
-SvSetSV|||
-SvTAINTED_off||5.004000|
-SvTAINTED_on||5.004000|
-SvTAINTED||5.004000|
-SvTAINT|||
-SvTRUE|||
-SvTYPE|||
-SvUNLOCK||5.007003|
-SvUOK|5.007001|5.006000|p
-SvUPGRADE|||
-SvUTF8_off||5.006000|
-SvUTF8_on||5.006000|
-SvUTF8||5.006000|
-SvUVXx|5.004000||p
-SvUVX|5.004000||p
-SvUV_nomg|5.009001||p
-SvUV_set|5.009003||p
-SvUVx|5.004000||p
-SvUV|5.004000||p
-SvVOK||5.008001|
-SvVSTRING_mg|5.009004||p
-THIS|||n
-UNDERBAR|5.009002||p
-UTF8_MAXBYTES|5.009002||p
-UVSIZE|5.006000||p
-UVTYPE|5.006000||p
-UVXf|5.007001||p
-UVof|5.006000||p
-UVuf|5.006000||p
-UVxf|5.006000||p
-WARN_ALL|5.006000||p
-WARN_AMBIGUOUS|5.006000||p
-WARN_ASSERTIONS|5.011000||p
-WARN_BAREWORD|5.006000||p
-WARN_CLOSED|5.006000||p
-WARN_CLOSURE|5.006000||p
-WARN_DEBUGGING|5.006000||p
-WARN_DEPRECATED|5.006000||p
-WARN_DIGIT|5.006000||p
-WARN_EXEC|5.006000||p
-WARN_EXITING|5.006000||p
-WARN_GLOB|5.006000||p
-WARN_INPLACE|5.006000||p
-WARN_INTERNAL|5.006000||p
-WARN_IO|5.006000||p
-WARN_LAYER|5.008000||p
-WARN_MALLOC|5.006000||p
-WARN_MISC|5.006000||p
-WARN_NEWLINE|5.006000||p
-WARN_NUMERIC|5.006000||p
-WARN_ONCE|5.006000||p
-WARN_OVERFLOW|5.006000||p
-WARN_PACK|5.006000||p
-WARN_PARENTHESIS|5.006000||p
-WARN_PIPE|5.006000||p
-WARN_PORTABLE|5.006000||p
-WARN_PRECEDENCE|5.006000||p
-WARN_PRINTF|5.006000||p
-WARN_PROTOTYPE|5.006000||p
-WARN_QW|5.006000||p
-WARN_RECURSION|5.006000||p
-WARN_REDEFINE|5.006000||p
-WARN_REGEXP|5.006000||p
-WARN_RESERVED|5.006000||p
-WARN_SEMICOLON|5.006000||p
-WARN_SEVERE|5.006000||p
-WARN_SIGNAL|5.006000||p
-WARN_SUBSTR|5.006000||p
-WARN_SYNTAX|5.006000||p
-WARN_TAINT|5.006000||p
-WARN_THREADS|5.008000||p
-WARN_UNINITIALIZED|5.006000||p
-WARN_UNOPENED|5.006000||p
-WARN_UNPACK|5.006000||p
-WARN_UNTIE|5.006000||p
-WARN_UTF8|5.006000||p
-WARN_VOID|5.006000||p
-XCPT_CATCH|5.009002||p
-XCPT_RETHROW|5.009002||p
-XCPT_TRY_END|5.009002||p
-XCPT_TRY_START|5.009002||p
-XPUSHi|||
-XPUSHmortal|5.009002||p
-XPUSHn|||
-XPUSHp|||
-XPUSHs|||
-XPUSHu|5.004000||p
-XSRETURN_EMPTY|||
-XSRETURN_IV|||
-XSRETURN_NO|||
-XSRETURN_NV|||
-XSRETURN_PV|||
-XSRETURN_UNDEF|||
-XSRETURN_UV|5.008001||p
-XSRETURN_YES|||
-XSRETURN|||p
-XST_mIV|||
-XST_mNO|||
-XST_mNV|||
-XST_mPV|||
-XST_mUNDEF|||
-XST_mUV|5.008001||p
-XST_mYES|||
-XS_VERSION_BOOTCHECK|||
-XS_VERSION|||
-XSprePUSH|5.006000||p
-XS|||
-ZeroD|5.009002||p
-Zero|||
-_aMY_CXT|5.007003||p
-_pMY_CXT|5.007003||p
-aMY_CXT_|5.007003||p
-aMY_CXT|5.007003||p
-aTHXR_|5.011000||p
-aTHXR|5.011000||p
-aTHX_|5.006000||p
-aTHX|5.006000||p
-add_data|||n
-addmad|||
-allocmy|||
-amagic_call|||
-amagic_cmp_locale|||
-amagic_cmp|||
-amagic_i_ncmp|||
-amagic_ncmp|||
-any_dup|||
-ao|||
-append_elem|||
-append_list|||
-append_madprops|||
-apply_attrs_my|||
-apply_attrs_string||5.006001|
-apply_attrs|||
-apply|||
-atfork_lock||5.007003|n
-atfork_unlock||5.007003|n
-av_arylen_p||5.009003|
-av_clear|||
-av_create_and_push||5.009005|
-av_create_and_unshift_one||5.009005|
-av_delete||5.006000|
-av_exists||5.006000|
-av_extend|||
-av_fetch|||
-av_fill|||
-av_iter_p||5.011000|
-av_len|||
-av_make|||
-av_pop|||
-av_push|||
-av_reify|||
-av_shift|||
-av_store|||
-av_undef|||
-av_unshift|||
-ax|||n
-bad_type|||
-bind_match|||
-block_end|||
-block_gimme||5.004000|
-block_start|||
-boolSV|5.004000||p
-boot_core_PerlIO|||
-boot_core_UNIVERSAL|||
-boot_core_mro|||
-boot_core_xsutils|||
-bytes_from_utf8||5.007001|
-bytes_to_uni|||n
-bytes_to_utf8||5.006001|
-call_argv|5.006000||p
-call_atexit||5.006000|
-call_list||5.004000|
-call_method|5.006000||p
-call_pv|5.006000||p
-call_sv|5.006000||p
-calloc||5.007002|n
-cando|||
-cast_i32||5.006000|
-cast_iv||5.006000|
-cast_ulong||5.006000|
-cast_uv||5.006000|
-check_type_and_open|||
-check_uni|||
-checkcomma|||
-checkposixcc|||
-ckWARN|5.006000||p
-ck_anoncode|||
-ck_bitop|||
-ck_concat|||
-ck_defined|||
-ck_delete|||
-ck_die|||
-ck_each|||
-ck_eof|||
-ck_eval|||
-ck_exec|||
-ck_exists|||
-ck_exit|||
-ck_ftst|||
-ck_fun|||
-ck_glob|||
-ck_grep|||
-ck_index|||
-ck_join|||
-ck_lfun|||
-ck_listiob|||
-ck_match|||
-ck_method|||
-ck_null|||
-ck_open|||
-ck_readline|||
-ck_repeat|||
-ck_require|||
-ck_return|||
-ck_rfun|||
-ck_rvconst|||
-ck_sassign|||
-ck_select|||
-ck_shift|||
-ck_sort|||
-ck_spair|||
-ck_split|||
-ck_subr|||
-ck_substr|||
-ck_svconst|||
-ck_trunc|||
-ck_unpack|||
-ckwarn_d||5.009003|
-ckwarn||5.009003|
-cl_and|||n
-cl_anything|||n
-cl_init_zero|||n
-cl_init|||n
-cl_is_anything|||n
-cl_or|||n
-clear_placeholders|||
-closest_cop|||
-convert|||
-cop_free|||
-cr_textfilter|||
-create_eval_scope|||
-croak_nocontext|||vn
-croak_xs_usage||5.011000|
-croak|||v
-csighandler||5.009003|n
-curmad|||
-custom_op_desc||5.007003|
-custom_op_name||5.007003|
-cv_ckproto_len|||
-cv_clone|||
-cv_const_sv||5.004000|
-cv_dump|||
-cv_undef|||
-cx_dump||5.005000|
-cx_dup|||
-cxinc|||
-dAXMARK|5.009003||p
-dAX|5.007002||p
-dITEMS|5.007002||p
-dMARK|||
-dMULTICALL||5.009003|
-dMY_CXT_SV|5.007003||p
-dMY_CXT|5.007003||p
-dNOOP|5.006000||p
-dORIGMARK|||
-dSP|||
-dTHR|5.004050||p
-dTHXR|5.011000||p
-dTHXa|5.006000||p
-dTHXoa|5.006000||p
-dTHX|5.006000||p
-dUNDERBAR|5.009002||p
-dVAR|5.009003||p
-dXCPT|5.009002||p
-dXSARGS|||
-dXSI32|||
-dXSTARG|5.006000||p
-deb_curcv|||
-deb_nocontext|||vn
-deb_stack_all|||
-deb_stack_n|||
-debop||5.005000|
-debprofdump||5.005000|
-debprof|||
-debstackptrs||5.007003|
-debstack||5.007003|
-debug_start_match|||
-deb||5.007003|v
-del_sv|||
-delete_eval_scope|||
-delimcpy||5.004000|
-deprecate_old|||
-deprecate|||
-despatch_signals||5.007001|
-destroy_matcher|||
-die_nocontext|||vn
-die_where|||
-die|||v
-dirp_dup|||
-div128|||
-djSP|||
-do_aexec5|||
-do_aexec|||
-do_aspawn|||
-do_binmode||5.004050|
-do_chomp|||
-do_chop|||
-do_close|||
-do_dump_pad|||
-do_eof|||
-do_exec3|||
-do_execfree|||
-do_exec|||
-do_gv_dump||5.006000|
-do_gvgv_dump||5.006000|
-do_hv_dump||5.006000|
-do_ipcctl|||
-do_ipcget|||
-do_join|||
-do_kv|||
-do_magic_dump||5.006000|
-do_msgrcv|||
-do_msgsnd|||
-do_oddball|||
-do_op_dump||5.006000|
-do_op_xmldump|||
-do_open9||5.006000|
-do_openn||5.007001|
-do_open||5.004000|
-do_pmop_dump||5.006000|
-do_pmop_xmldump|||
-do_print|||
-do_readline|||
-do_seek|||
-do_semop|||
-do_shmio|||
-do_smartmatch|||
-do_spawn_nowait|||
-do_spawn|||
-do_sprintf|||
-do_sv_dump||5.006000|
-do_sysseek|||
-do_tell|||
-do_trans_complex_utf8|||
-do_trans_complex|||
-do_trans_count_utf8|||
-do_trans_count|||
-do_trans_simple_utf8|||
-do_trans_simple|||
-do_trans|||
-do_vecget|||
-do_vecset|||
-do_vop|||
-docatch|||
-doeval|||
-dofile|||
-dofindlabel|||
-doform|||
-doing_taint||5.008001|n
-dooneliner|||
-doopen_pm|||
-doparseform|||
-dopoptoeval|||
-dopoptogiven|||
-dopoptolabel|||
-dopoptoloop|||
-dopoptosub_at|||
-dopoptowhen|||
-doref||5.009003|
-dounwind|||
-dowantarray|||
-dump_all||5.006000|
-dump_eval||5.006000|
-dump_exec_pos|||
-dump_fds|||
-dump_form||5.006000|
-dump_indent||5.006000|v
-dump_mstats|||
-dump_packsubs||5.006000|
-dump_sub||5.006000|
-dump_sv_child|||
-dump_trie_interim_list|||
-dump_trie_interim_table|||
-dump_trie|||
-dump_vindent||5.006000|
-dumpuntil|||
-dup_attrlist|||
-emulate_cop_io|||
-eval_pv|5.006000||p
-eval_sv|5.006000||p
-exec_failed|||
-expect_number|||
-fbm_compile||5.005000|
-fbm_instr||5.005000|
-feature_is_enabled|||
-fetch_cop_label||5.011000|
-filter_add|||
-filter_del|||
-filter_gets|||
-filter_read|||
-find_and_forget_pmops|||
-find_array_subscript|||
-find_beginning|||
-find_byclass|||
-find_hash_subscript|||
-find_in_my_stash|||
-find_runcv||5.008001|
-find_rundefsvoffset||5.009002|
-find_script|||
-find_uninit_var|||
-first_symbol|||n
-fold_constants|||
-forbid_setid|||
-force_ident|||
-force_list|||
-force_next|||
-force_version|||
-force_word|||
-forget_pmop|||
-form_nocontext|||vn
-form||5.004000|v
-fp_dup|||
-fprintf_nocontext|||vn
-free_global_struct|||
-free_tied_hv_pool|||
-free_tmps|||
-gen_constant_list|||
-get_arena|||
-get_aux_mg|||
-get_av|5.006000||p
-get_context||5.006000|n
-get_cvn_flags||5.009005|
-get_cv|5.006000||p
-get_db_sub|||
-get_debug_opts|||
-get_hash_seed|||
-get_hv|5.006000||p
-get_isa_hash|||
-get_mstats|||
-get_no_modify|||
-get_num|||
-get_op_descs||5.005000|
-get_op_names||5.005000|
-get_opargs|||
-get_ppaddr||5.006000|
-get_re_arg|||
-get_sv|5.006000||p
-get_vtbl||5.005030|
-getcwd_sv||5.007002|
-getenv_len|||
-glob_2number|||
-glob_2pv|||
-glob_assign_glob|||
-glob_assign_ref|||
-gp_dup|||
-gp_free|||
-gp_ref|||
-grok_bin|5.007003||p
-grok_hex|5.007003||p
-grok_number|5.007002||p
-grok_numeric_radix|5.007002||p
-grok_oct|5.007003||p
-group_end|||
-gv_AVadd|||
-gv_HVadd|||
-gv_IOadd|||
-gv_SVadd|||
-gv_autoload4||5.004000|
-gv_check|||
-gv_const_sv||5.009003|
-gv_dump||5.006000|
-gv_efullname3||5.004000|
-gv_efullname4||5.006001|
-gv_efullname|||
-gv_ename|||
-gv_fetchfile_flags||5.009005|
-gv_fetchfile|||
-gv_fetchmeth_autoload||5.007003|
-gv_fetchmethod_autoload||5.004000|
-gv_fetchmethod_flags||5.011000|
-gv_fetchmethod|||
-gv_fetchmeth|||
-gv_fetchpvn_flags||5.009002|
-gv_fetchpv|||
-gv_fetchsv||5.009002|
-gv_fullname3||5.004000|
-gv_fullname4||5.006001|
-gv_fullname|||
-gv_get_super_pkg|||
-gv_handler||5.007001|
-gv_init_sv|||
-gv_init|||
-gv_name_set||5.009004|
-gv_stashpvn|5.004000||p
-gv_stashpvs||5.009003|
-gv_stashpv|||
-gv_stashsv|||
-he_dup|||
-hek_dup|||
-hfreeentries|||
-hsplit|||
-hv_assert||5.011000|
-hv_auxinit|||n
-hv_backreferences_p|||
-hv_clear_placeholders||5.009001|
-hv_clear|||
-hv_common_key_len||5.010000|
-hv_common||5.010000|
-hv_copy_hints_hv|||
-hv_delayfree_ent||5.004000|
-hv_delete_common|||
-hv_delete_ent||5.004000|
-hv_delete|||
-hv_eiter_p||5.009003|
-hv_eiter_set||5.009003|
-hv_exists_ent||5.004000|
-hv_exists|||
-hv_fetch_ent||5.004000|
-hv_fetchs|5.009003||p
-hv_fetch|||
-hv_free_ent||5.004000|
-hv_iterinit|||
-hv_iterkeysv||5.004000|
-hv_iterkey|||
-hv_iternext_flags||5.008000|
-hv_iternextsv|||
-hv_iternext|||
-hv_iterval|||
-hv_kill_backrefs|||
-hv_ksplit||5.004000|
-hv_magic_check|||n
-hv_magic|||
-hv_name_set||5.009003|
-hv_notallowed|||
-hv_placeholders_get||5.009003|
-hv_placeholders_p||5.009003|
-hv_placeholders_set||5.009003|
-hv_riter_p||5.009003|
-hv_riter_set||5.009003|
-hv_scalar||5.009001|
-hv_store_ent||5.004000|
-hv_store_flags||5.008000|
-hv_stores|5.009004||p
-hv_store|||
-hv_undef|||
-ibcmp_locale||5.004000|
-ibcmp_utf8||5.007003|
-ibcmp|||
-incline|||
-incpush_if_exists|||
-incpush_use_sep|||
-incpush|||
-ingroup|||
-init_argv_symbols|||
-init_debugger|||
-init_global_struct|||
-init_i18nl10n||5.006000|
-init_i18nl14n||5.006000|
-init_ids|||
-init_interp|||
-init_main_stash|||
-init_perllib|||
-init_postdump_symbols|||
-init_predump_symbols|||
-init_stacks||5.005000|
-init_tm||5.007002|
-instr|||
-intro_my|||
-intuit_method|||
-intuit_more|||
-invert|||
-io_close|||
-isALNUMC|5.006000||p
-isALNUM|||
-isALPHA|||
-isASCII|5.006000||p
-isBLANK|5.006001||p
-isCNTRL|5.006000||p
-isDIGIT|||
-isGRAPH|5.006000||p
-isLOWER|||
-isPRINT|5.004000||p
-isPSXSPC|5.006001||p
-isPUNCT|5.006000||p
-isSPACE|||
-isUPPER|||
-isXDIGIT|5.006000||p
-is_an_int|||
-is_gv_magical_sv|||
-is_handle_constructor|||n
-is_list_assignment|||
-is_lvalue_sub||5.007001|
-is_uni_alnum_lc||5.006000|
-is_uni_alnumc_lc||5.006000|
-is_uni_alnumc||5.006000|
-is_uni_alnum||5.006000|
-is_uni_alpha_lc||5.006000|
-is_uni_alpha||5.006000|
-is_uni_ascii_lc||5.006000|
-is_uni_ascii||5.006000|
-is_uni_cntrl_lc||5.006000|
-is_uni_cntrl||5.006000|
-is_uni_digit_lc||5.006000|
-is_uni_digit||5.006000|
-is_uni_graph_lc||5.006000|
-is_uni_graph||5.006000|
-is_uni_idfirst_lc||5.006000|
-is_uni_idfirst||5.006000|
-is_uni_lower_lc||5.006000|
-is_uni_lower||5.006000|
-is_uni_print_lc||5.006000|
-is_uni_print||5.006000|
-is_uni_punct_lc||5.006000|
-is_uni_punct||5.006000|
-is_uni_space_lc||5.006000|
-is_uni_space||5.006000|
-is_uni_upper_lc||5.006000|
-is_uni_upper||5.006000|
-is_uni_xdigit_lc||5.006000|
-is_uni_xdigit||5.006000|
-is_utf8_alnumc||5.006000|
-is_utf8_alnum||5.006000|
-is_utf8_alpha||5.006000|
-is_utf8_ascii||5.006000|
-is_utf8_char_slow|||n
-is_utf8_char||5.006000|
-is_utf8_cntrl||5.006000|
-is_utf8_common|||
-is_utf8_digit||5.006000|
-is_utf8_graph||5.006000|
-is_utf8_idcont||5.008000|
-is_utf8_idfirst||5.006000|
-is_utf8_lower||5.006000|
-is_utf8_mark||5.006000|
-is_utf8_print||5.006000|
-is_utf8_punct||5.006000|
-is_utf8_space||5.006000|
-is_utf8_string_loclen||5.009003|
-is_utf8_string_loc||5.008001|
-is_utf8_string||5.006001|
-is_utf8_upper||5.006000|
-is_utf8_xdigit||5.006000|
-isa_lookup|||
-items|||n
-ix|||n
-jmaybe|||
-join_exact|||
-keyword|||
-leave_scope|||
-lex_end|||
-lex_start|||
-linklist|||
-listkids|||
-list|||
-load_module_nocontext|||vn
-load_module|5.006000||pv
-localize|||
-looks_like_bool|||
-looks_like_number|||
-lop|||
-mPUSHi|5.009002||p
-mPUSHn|5.009002||p
-mPUSHp|5.009002||p
-mPUSHs|5.011000||p
-mPUSHu|5.009002||p
-mXPUSHi|5.009002||p
-mXPUSHn|5.009002||p
-mXPUSHp|5.009002||p
-mXPUSHs|5.011000||p
-mXPUSHu|5.009002||p
-mad_free|||
-madlex|||
-madparse|||
-magic_clear_all_env|||
-magic_clearenv|||
-magic_clearhint|||
-magic_clearisa|||
-magic_clearpack|||
-magic_clearsig|||
-magic_dump||5.006000|
-magic_existspack|||
-magic_freearylen_p|||
-magic_freeovrld|||
-magic_getarylen|||
-magic_getdefelem|||
-magic_getnkeys|||
-magic_getpack|||
-magic_getpos|||
-magic_getsig|||
-magic_getsubstr|||
-magic_gettaint|||
-magic_getuvar|||
-magic_getvec|||
-magic_get|||
-magic_killbackrefs|||
-magic_len|||
-magic_methcall|||
-magic_methpack|||
-magic_nextpack|||
-magic_regdata_cnt|||
-magic_regdatum_get|||
-magic_regdatum_set|||
-magic_scalarpack|||
-magic_set_all_env|||
-magic_setamagic|||
-magic_setarylen|||
-magic_setcollxfrm|||
-magic_setdbline|||
-magic_setdefelem|||
-magic_setenv|||
-magic_sethint|||
-magic_setisa|||
-magic_setmglob|||
-magic_setnkeys|||
-magic_setpack|||
-magic_setpos|||
-magic_setregexp|||
-magic_setsig|||
-magic_setsubstr|||
-magic_settaint|||
-magic_setutf8|||
-magic_setuvar|||
-magic_setvec|||
-magic_set|||
-magic_sizepack|||
-magic_wipepack|||
-make_matcher|||
-make_trie_failtable|||
-make_trie|||
-malloc_good_size|||n
-malloced_size|||n
-malloc||5.007002|n
-markstack_grow|||
-matcher_matches_sv|||
-measure_struct|||
-memEQ|5.004000||p
-memNE|5.004000||p
-mem_collxfrm|||
-mem_log_common|||n
-mess_alloc|||
-mess_nocontext|||vn
-mess||5.006000|v
-method_common|||
-mfree||5.007002|n
-mg_clear|||
-mg_copy|||
-mg_dup|||
-mg_find|||
-mg_free|||
-mg_get|||
-mg_length||5.005000|
-mg_localize|||
-mg_magical|||
-mg_set|||
-mg_size||5.005000|
-mini_mktime||5.007002|
-missingterm|||
-mode_from_discipline|||
-modkids|||
-mod|||
-more_bodies|||
-more_sv|||
-moreswitches|||
-mro_get_from_name||5.011000|
-mro_get_linear_isa_dfs|||
-mro_get_linear_isa||5.009005|
-mro_get_private_data||5.011000|
-mro_isa_changed_in|||
-mro_meta_dup|||
-mro_meta_init|||
-mro_method_changed_in||5.009005|
-mro_register||5.011000|
-mro_set_mro||5.011000|
-mro_set_private_data||5.011000|
-mul128|||
-mulexp10|||n
-my_atof2||5.007002|
-my_atof||5.006000|
-my_attrs|||
-my_bcopy|||n
-my_betoh16|||n
-my_betoh32|||n
-my_betoh64|||n
-my_betohi|||n
-my_betohl|||n
-my_betohs|||n
-my_bzero|||n
-my_chsize|||
-my_clearenv|||
-my_cxt_index|||
-my_cxt_init|||
-my_dirfd||5.009005|
-my_exit_jump|||
-my_exit|||
-my_failure_exit||5.004000|
-my_fflush_all||5.006000|
-my_fork||5.007003|n
-my_htobe16|||n
-my_htobe32|||n
-my_htobe64|||n
-my_htobei|||n
-my_htobel|||n
-my_htobes|||n
-my_htole16|||n
-my_htole32|||n
-my_htole64|||n
-my_htolei|||n
-my_htolel|||n
-my_htoles|||n
-my_htonl|||
-my_kid|||
-my_letoh16|||n
-my_letoh32|||n
-my_letoh64|||n
-my_letohi|||n
-my_letohl|||n
-my_letohs|||n
-my_lstat|||
-my_memcmp||5.004000|n
-my_memset|||n
-my_ntohl|||
-my_pclose||5.004000|
-my_popen_list||5.007001|
-my_popen||5.004000|
-my_setenv|||
-my_snprintf|5.009004||pvn
-my_socketpair||5.007003|n
-my_sprintf|5.009003||pvn
-my_stat|||
-my_strftime||5.007002|
-my_strlcat|5.009004||pn
-my_strlcpy|5.009004||pn
-my_swabn|||n
-my_swap|||
-my_unexec|||
-my_vsnprintf||5.009004|n
-need_utf8|||n
-newANONATTRSUB||5.006000|
-newANONHASH|||
-newANONLIST|||
-newANONSUB|||
-newASSIGNOP|||
-newATTRSUB||5.006000|
-newAVREF|||
-newAV|||
-newBINOP|||
-newCONDOP|||
-newCONSTSUB|5.004050||p
-newCVREF|||
-newDEFSVOP|||
-newFORM|||
-newFOROP|||
-newGIVENOP||5.009003|
-newGIVWHENOP|||
-newGP|||
-newGVOP|||
-newGVREF|||
-newGVgen|||
-newHVREF|||
-newHVhv||5.005000|
-newHV|||
-newIO|||
-newLISTOP|||
-newLOGOP|||
-newLOOPEX|||
-newLOOPOP|||
-newMADPROP|||
-newMADsv|||
-newMYSUB|||
-newNULLLIST|||
-newOP|||
-newPADOP|||
-newPMOP|||
-newPROG|||
-newPVOP|||
-newRANGE|||
-newRV_inc|5.004000||p
-newRV_noinc|5.004000||p
-newRV|||
-newSLICEOP|||
-newSTATEOP|||
-newSUB|||
-newSVOP|||
-newSVREF|||
-newSV_type||5.009005|
-newSVhek||5.009003|
-newSViv|||
-newSVnv|||
-newSVpvf_nocontext|||vn
-newSVpvf||5.004000|v
-newSVpvn_flags|5.011000||p
-newSVpvn_share|5.007001||p
-newSVpvn_utf8|5.011000||p
-newSVpvn|5.004050||p
-newSVpvs_flags|5.011000||p
-newSVpvs_share||5.009003|
-newSVpvs|5.009003||p
-newSVpv|||
-newSVrv|||
-newSVsv|||
-newSVuv|5.006000||p
-newSV|||
-newTOKEN|||
-newUNOP|||
-newWHENOP||5.009003|
-newWHILEOP||5.009003|
-newXS_flags||5.009004|
-newXSproto||5.006000|
-newXS||5.006000|
-new_collate||5.006000|
-new_constant|||
-new_ctype||5.006000|
-new_he|||
-new_logop|||
-new_numeric||5.006000|
-new_stackinfo||5.005000|
-new_version||5.009000|
-new_warnings_bitfield|||
-next_symbol|||
-nextargv|||
-nextchar|||
-ninstr|||
-no_bareword_allowed|||
-no_fh_allowed|||
-no_op|||
-not_a_number|||
-nothreadhook||5.008000|
-nuke_stacks|||
-num_overflow|||n
-offer_nice_chunk|||
-oopsAV|||
-oopsHV|||
-op_clear|||
-op_const_sv|||
-op_dump||5.006000|
-op_free|||
-op_getmad_weak|||
-op_getmad|||
-op_null||5.007002|
-op_refcnt_dec|||
-op_refcnt_inc|||
-op_refcnt_lock||5.009002|
-op_refcnt_unlock||5.009002|
-op_xmldump|||
-open_script|||
-pMY_CXT_|5.007003||p
-pMY_CXT|5.007003||p
-pTHX_|5.006000||p
-pTHX|5.006000||p
-packWARN|5.007003||p
-pack_cat||5.007003|
-pack_rec|||
-package|||
-packlist||5.008001|
-pad_add_anon|||
-pad_add_name|||
-pad_alloc|||
-pad_block_start|||
-pad_check_dup|||
-pad_compname_type|||
-pad_findlex|||
-pad_findmy|||
-pad_fixup_inner_anons|||
-pad_free|||
-pad_leavemy|||
-pad_new|||
-pad_peg|||n
-pad_push|||
-pad_reset|||
-pad_setsv|||
-pad_sv||5.011000|
-pad_swipe|||
-pad_tidy|||
-pad_undef|||
-parse_body|||
-parse_unicode_opts|||
-parser_dup|||
-parser_free|||
-path_is_absolute|||n
-peep|||
-pending_Slabs_to_ro|||
-perl_alloc_using|||n
-perl_alloc|||n
-perl_clone_using|||n
-perl_clone|||n
-perl_construct|||n
-perl_destruct||5.007003|n
-perl_free|||n
-perl_parse||5.006000|n
-perl_run|||n
-pidgone|||
-pm_description|||
-pmflag|||
-pmop_dump||5.006000|
-pmop_xmldump|||
-pmruntime|||
-pmtrans|||
-pop_scope|||
-pregcomp||5.009005|
-pregexec|||
-pregfree2||5.011000|
-pregfree|||
-prepend_elem|||
-prepend_madprops|||
-printbuf|||
-printf_nocontext|||vn
-process_special_blocks|||
-ptr_table_clear||5.009005|
-ptr_table_fetch||5.009005|
-ptr_table_find|||n
-ptr_table_free||5.009005|
-ptr_table_new||5.009005|
-ptr_table_split||5.009005|
-ptr_table_store||5.009005|
-push_scope|||
-put_byte|||
-pv_display|5.006000||p
-pv_escape|5.009004||p
-pv_pretty|5.009004||p
-pv_uni_display||5.007003|
-qerror|||
-qsortsvu|||
-re_compile||5.009005|
-re_croak2|||
-re_dup_guts|||
-re_intuit_start||5.009005|
-re_intuit_string||5.006000|
-readpipe_override|||
-realloc||5.007002|n
-reentrant_free|||
-reentrant_init|||
-reentrant_retry|||vn
-reentrant_size|||
-ref_array_or_hash|||
-refcounted_he_chain_2hv|||
-refcounted_he_fetch|||
-refcounted_he_free|||
-refcounted_he_new_common|||
-refcounted_he_new|||
-refcounted_he_value|||
-refkids|||
-refto|||
-ref||5.011000|
-reg_check_named_buff_matched|||
-reg_named_buff_all||5.009005|
-reg_named_buff_exists||5.009005|
-reg_named_buff_fetch||5.009005|
-reg_named_buff_firstkey||5.009005|
-reg_named_buff_iter|||
-reg_named_buff_nextkey||5.009005|
-reg_named_buff_scalar||5.009005|
-reg_named_buff|||
-reg_namedseq|||
-reg_node|||
-reg_numbered_buff_fetch|||
-reg_numbered_buff_length|||
-reg_numbered_buff_store|||
-reg_qr_package|||
-reg_recode|||
-reg_scan_name|||
-reg_skipcomment|||
-reg_temp_copy|||
-reganode|||
-regatom|||
-regbranch|||
-regclass_swash||5.009004|
-regclass|||
-regcppop|||
-regcppush|||
-regcurly|||n
-regdump_extflags|||
-regdump||5.005000|
-regdupe_internal|||
-regexec_flags||5.005000|
-regfree_internal||5.009005|
-reghop3|||n
-reghop4|||n
-reghopmaybe3|||n
-reginclass|||
-reginitcolors||5.006000|
-reginsert|||
-regmatch|||
-regnext||5.005000|
-regpiece|||
-regpposixcc|||
-regprop|||
-regrepeat|||
-regtail_study|||
-regtail|||
-regtry|||
-reguni|||
-regwhite|||n
-reg|||
-repeatcpy|||
-report_evil_fh|||
-report_uninit|||
-require_pv||5.006000|
-require_tie_mod|||
-restore_magic|||
-rninstr|||
-rsignal_restore|||
-rsignal_save|||
-rsignal_state||5.004000|
-rsignal||5.004000|
-run_body|||
-run_user_filter|||
-runops_debug||5.005000|
-runops_standard||5.005000|
-rvpv_dup|||
-rxres_free|||
-rxres_restore|||
-rxres_save|||
-safesyscalloc||5.006000|n
-safesysfree||5.006000|n
-safesysmalloc||5.006000|n
-safesysrealloc||5.006000|n
-same_dirent|||
-save_I16||5.004000|
-save_I32|||
-save_I8||5.006000|
-save_adelete||5.011000|
-save_aelem||5.004050|
-save_alloc||5.006000|
-save_aptr|||
-save_ary|||
-save_bool||5.008001|
-save_clearsv|||
-save_delete|||
-save_destructor_x||5.006000|
-save_destructor||5.006000|
-save_freeop|||
-save_freepv|||
-save_freesv|||
-save_generic_pvref||5.006001|
-save_generic_svref||5.005030|
-save_gp||5.004000|
-save_hash|||
-save_hek_flags|||n
-save_helem_flags||5.011000|
-save_helem||5.004050|
-save_hints|||
-save_hptr|||
-save_int|||
-save_item|||
-save_iv||5.005000|
-save_lines|||
-save_list|||
-save_long|||
-save_magic|||
-save_mortalizesv||5.007001|
-save_nogv|||
-save_op|||
-save_padsv_and_mortalize||5.011000|
-save_pptr|||
-save_pushi32ptr|||
-save_pushptri32ptr|||
-save_pushptrptr|||
-save_pushptr||5.011000|
-save_re_context||5.006000|
-save_scalar_at|||
-save_scalar|||
-save_set_svflags||5.009000|
-save_shared_pvref||5.007003|
-save_sptr|||
-save_svref|||
-save_vptr||5.006000|
-savepvn|||
-savepvs||5.009003|
-savepv|||
-savesharedpvn||5.009005|
-savesharedpv||5.007003|
-savestack_grow_cnt||5.008001|
-savestack_grow|||
-savesvpv||5.009002|
-sawparens|||
-scalar_mod_type|||n
-scalarboolean|||
-scalarkids|||
-scalarseq|||
-scalarvoid|||
-scalar|||
-scan_bin||5.006000|
-scan_commit|||
-scan_const|||
-scan_formline|||
-scan_heredoc|||
-scan_hex|||
-scan_ident|||
-scan_inputsymbol|||
-scan_num||5.007001|
-scan_oct|||
-scan_pat|||
-scan_str|||
-scan_subst|||
-scan_trans|||
-scan_version||5.009001|
-scan_vstring||5.009005|
-scan_word|||
-scope|||
-screaminstr||5.005000|
-search_const|||
-seed||5.008001|
-sequence_num|||
-sequence_tail|||
-sequence|||
-set_context||5.006000|n
-set_numeric_local||5.006000|
-set_numeric_radix||5.006000|
-set_numeric_standard||5.006000|
-setdefout|||
-share_hek_flags|||
-share_hek||5.004000|
-si_dup|||
-sighandler|||n
-simplify_sort|||
-skipspace0|||
-skipspace1|||
-skipspace2|||
-skipspace|||
-softref2xv|||
-sortcv_stacked|||
-sortcv_xsub|||
-sortcv|||
-sortsv_flags||5.009003|
-sortsv||5.007003|
-space_join_names_mortal|||
-ss_dup|||
-stack_grow|||
-start_force|||
-start_glob|||
-start_subparse||5.004000|
-stashpv_hvname_match||5.011000|
-stdize_locale|||
-store_cop_label|||
-strEQ|||
-strGE|||
-strGT|||
-strLE|||
-strLT|||
-strNE|||
-str_to_version||5.006000|
-strip_return|||
-strnEQ|||
-strnNE|||
-study_chunk|||
-sub_crush_depth|||
-sublex_done|||
-sublex_push|||
-sublex_start|||
-sv_2bool|||
-sv_2cv|||
-sv_2io|||
-sv_2iuv_common|||
-sv_2iuv_non_preserve|||
-sv_2iv_flags||5.009001|
-sv_2iv|||
-sv_2mortal|||
-sv_2num|||
-sv_2nv|||
-sv_2pv_flags|5.007002||p
-sv_2pv_nolen|5.006000||p
-sv_2pvbyte_nolen|5.006000||p
-sv_2pvbyte|5.006000||p
-sv_2pvutf8_nolen||5.006000|
-sv_2pvutf8||5.006000|
-sv_2pv|||
-sv_2uv_flags||5.009001|
-sv_2uv|5.004000||p
-sv_add_arena|||
-sv_add_backref|||
-sv_backoff|||
-sv_bless|||
-sv_cat_decode||5.008001|
-sv_catpv_mg|5.004050||p
-sv_catpvf_mg_nocontext|||pvn
-sv_catpvf_mg|5.006000|5.004000|pv
-sv_catpvf_nocontext|||vn
-sv_catpvf||5.004000|v
-sv_catpvn_flags||5.007002|
-sv_catpvn_mg|5.004050||p
-sv_catpvn_nomg|5.007002||p
-sv_catpvn|||
-sv_catpvs|5.009003||p
-sv_catpv|||
-sv_catsv_flags||5.007002|
-sv_catsv_mg|5.004050||p
-sv_catsv_nomg|5.007002||p
-sv_catsv|||
-sv_catxmlpvn|||
-sv_catxmlsv|||
-sv_chop|||
-sv_clean_all|||
-sv_clean_objs|||
-sv_clear|||
-sv_cmp_locale||5.004000|
-sv_cmp|||
-sv_collxfrm|||
-sv_compile_2op||5.008001|
-sv_copypv||5.007003|
-sv_dec|||
-sv_del_backref|||
-sv_derived_from||5.004000|
-sv_destroyable||5.010000|
-sv_does||5.009004|
-sv_dump|||
-sv_dup|||
-sv_eq|||
-sv_exp_grow|||
-sv_force_normal_flags||5.007001|
-sv_force_normal||5.006000|
-sv_free2|||
-sv_free_arenas|||
-sv_free|||
-sv_gets||5.004000|
-sv_grow|||
-sv_i_ncmp|||
-sv_inc|||
-sv_insert_flags||5.011000|
-sv_insert|||
-sv_isa|||
-sv_isobject|||
-sv_iv||5.005000|
-sv_kill_backrefs|||
-sv_len_utf8||5.006000|
-sv_len|||
-sv_magic_portable|5.011000|5.004000|p
-sv_magicext||5.007003|
-sv_magic|||
-sv_mortalcopy|||
-sv_ncmp|||
-sv_newmortal|||
-sv_newref|||
-sv_nolocking||5.007003|
-sv_nosharing||5.007003|
-sv_nounlocking|||
-sv_nv||5.005000|
-sv_peek||5.005000|
-sv_pos_b2u_midway|||
-sv_pos_b2u||5.006000|
-sv_pos_u2b_cached|||
-sv_pos_u2b_forwards|||n
-sv_pos_u2b_midway|||n
-sv_pos_u2b||5.006000|
-sv_pvbyten_force||5.006000|
-sv_pvbyten||5.006000|
-sv_pvbyte||5.006000|
-sv_pvn_force_flags|5.007002||p
-sv_pvn_force|||
-sv_pvn_nomg|5.007003|5.005000|p
-sv_pvn||5.005000|
-sv_pvutf8n_force||5.006000|
-sv_pvutf8n||5.006000|
-sv_pvutf8||5.006000|
-sv_pv||5.006000|
-sv_recode_to_utf8||5.007003|
-sv_reftype|||
-sv_release_COW|||
-sv_replace|||
-sv_report_used|||
-sv_reset|||
-sv_rvweaken||5.006000|
-sv_setiv_mg|5.004050||p
-sv_setiv|||
-sv_setnv_mg|5.006000||p
-sv_setnv|||
-sv_setpv_mg|5.004050||p
-sv_setpvf_mg_nocontext|||pvn
-sv_setpvf_mg|5.006000|5.004000|pv
-sv_setpvf_nocontext|||vn
-sv_setpvf||5.004000|v
-sv_setpviv_mg||5.008001|
-sv_setpviv||5.008001|
-sv_setpvn_mg|5.004050||p
-sv_setpvn|||
-sv_setpvs|5.009004||p
-sv_setpv|||
-sv_setref_iv|||
-sv_setref_nv|||
-sv_setref_pvn|||
-sv_setref_pv|||
-sv_setref_uv||5.007001|
-sv_setsv_cow|||
-sv_setsv_flags||5.007002|
-sv_setsv_mg|5.004050||p
-sv_setsv_nomg|5.007002||p
-sv_setsv|||
-sv_setuv_mg|5.004050||p
-sv_setuv|5.004000||p
-sv_tainted||5.004000|
-sv_taint||5.004000|
-sv_true||5.005000|
-sv_unglob|||
-sv_uni_display||5.007003|
-sv_unmagic|||
-sv_unref_flags||5.007001|
-sv_unref|||
-sv_untaint||5.004000|
-sv_upgrade|||
-sv_usepvn_flags||5.009004|
-sv_usepvn_mg|5.004050||p
-sv_usepvn|||
-sv_utf8_decode||5.006000|
-sv_utf8_downgrade||5.006000|
-sv_utf8_encode||5.006000|
-sv_utf8_upgrade_flags_grow||5.011000|
-sv_utf8_upgrade_flags||5.007002|
-sv_utf8_upgrade_nomg||5.007002|
-sv_utf8_upgrade||5.007001|
-sv_uv|5.005000||p
-sv_vcatpvf_mg|5.006000|5.004000|p
-sv_vcatpvfn||5.004000|
-sv_vcatpvf|5.006000|5.004000|p
-sv_vsetpvf_mg|5.006000|5.004000|p
-sv_vsetpvfn||5.004000|
-sv_vsetpvf|5.006000|5.004000|p
-sv_xmlpeek|||
-svtype|||
-swallow_bom|||
-swap_match_buff|||
-swash_fetch||5.007002|
-swash_get|||
-swash_init||5.006000|
-sys_init3||5.010000|n
-sys_init||5.010000|n
-sys_intern_clear|||
-sys_intern_dup|||
-sys_intern_init|||
-sys_term||5.010000|n
-taint_env|||
-taint_proper|||
-tmps_grow||5.006000|
-toLOWER|||
-toUPPER|||
-to_byte_substr|||
-to_uni_fold||5.007003|
-to_uni_lower_lc||5.006000|
-to_uni_lower||5.007003|
-to_uni_title_lc||5.006000|
-to_uni_title||5.007003|
-to_uni_upper_lc||5.006000|
-to_uni_upper||5.007003|
-to_utf8_case||5.007003|
-to_utf8_fold||5.007003|
-to_utf8_lower||5.007003|
-to_utf8_substr|||
-to_utf8_title||5.007003|
-to_utf8_upper||5.007003|
-token_free|||
-token_getmad|||
-tokenize_use|||
-tokeq|||
-tokereport|||
-too_few_arguments|||
-too_many_arguments|||
-uiv_2buf|||n
-unlnk|||
-unpack_rec|||
-unpack_str||5.007003|
-unpackstring||5.008001|
-unshare_hek_or_pvn|||
-unshare_hek|||
-unsharepvn||5.004000|
-unwind_handler_stack|||
-update_debugger_info|||
-upg_version||5.009005|
-usage|||
-utf16_to_utf8_reversed||5.006001|
-utf16_to_utf8||5.006001|
-utf8_distance||5.006000|
-utf8_hop||5.006000|
-utf8_length||5.007001|
-utf8_mg_pos_cache_update|||
-utf8_to_bytes||5.006001|
-utf8_to_uvchr||5.007001|
-utf8_to_uvuni||5.007001|
-utf8n_to_uvchr|||
-utf8n_to_uvuni||5.007001|
-utilize|||
-uvchr_to_utf8_flags||5.007003|
-uvchr_to_utf8|||
-uvuni_to_utf8_flags||5.007003|
-uvuni_to_utf8||5.007001|
-validate_suid|||
-varname|||
-vcmp||5.009000|
-vcroak||5.006000|
-vdeb||5.007003|
-vdie_common|||
-vdie_croak_common|||
-vdie|||
-vform||5.006000|
-visit|||
-vivify_defelem|||
-vivify_ref|||
-vload_module|5.006000||p
-vmess||5.006000|
-vnewSVpvf|5.006000|5.004000|p
-vnormal||5.009002|
-vnumify||5.009000|
-vstringify||5.009000|
-vverify||5.009003|
-vwarner||5.006000|
-vwarn||5.006000|
-wait4pid|||
-warn_nocontext|||vn
-warner_nocontext|||vn
-warner|5.006000|5.004000|pv
-warn|||v
-watch|||
-whichsig|||
-write_no_mem|||
-write_to_stderr|||
-xmldump_all|||
-xmldump_attr|||
-xmldump_eval|||
-xmldump_form|||
-xmldump_indent|||v
-xmldump_packsubs|||
-xmldump_sub|||
-xmldump_vindent|||
-yyerror|||
-yylex|||
-yyparse|||
-yywarn|||
-);
-
-if (exists $opt{'list-unsupported'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{todo};
- print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
- }
- exit 0;
-}
-
-# Scan for possible replacement candidates
-
-my(%replace, %need, %hints, %warnings, %depends);
-my $replace = 0;
-my($hint, $define, $function);
-
-sub find_api
-{
- my $code = shift;
- $code =~ s{
- / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
- grep { exists $API{$_} } $code =~ /(\w+)/mg;
-}
-
-while () {
- if ($hint) {
- my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
- if (m{^\s*\*\s(.*?)\s*$}) {
- for (@{$hint->[1]}) {
- $h->{$_} ||= ''; # suppress warning with older perls
- $h->{$_} .= "$1\n";
- }
- }
- else { undef $hint }
- }
-
- $hint = [$1, [split /,?\s+/, $2]]
- if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
-
- if ($define) {
- if ($define->[1] =~ /\\$/) {
- $define->[1] .= $_;
- }
- else {
- if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
- my @n = find_api($define->[1]);
- push @{$depends{$define->[0]}}, @n if @n
- }
- undef $define;
- }
- }
-
- $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
-
- if ($function) {
- if (/^}/) {
- if (exists $API{$function->[0]}) {
- my @n = find_api($function->[1]);
- push @{$depends{$function->[0]}}, @n if @n
- }
- undef $function;
- }
- else {
- $function->[1] .= $_;
- }
- }
-
- $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
-
- $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
- $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
- $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
- $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
-
- if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
- my @deps = map { s/\s+//g; $_ } split /,/, $3;
- my $d;
- for $d (map { s/\s+//g; $_ } split /,/, $1) {
- push @{$depends{$d}}, @deps;
- }
- }
-
- $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
-}
-
-for (values %depends) {
- my %s;
- $_ = [sort grep !$s{$_}++, @$_];
-}
-
-if (exists $opt{'api-info'}) {
- my $f;
- my $count = 0;
- my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $f =~ /$match/;
- print "\n=== $f ===\n\n";
- my $info = 0;
- if ($API{$f}{base} || $API{$f}{todo}) {
- my $base = format_version($API{$f}{base} || $API{$f}{todo});
- print "Supported at least starting from perl-$base.\n";
- $info++;
- }
- if ($API{$f}{provided}) {
- my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
- print "Support by $ppport provided back to perl-$todo.\n";
- print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
- print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
- print "\n$hints{$f}" if exists $hints{$f};
- print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
- $info++;
- }
- print "No portability information available.\n" unless $info;
- $count++;
- }
- $count or print "Found no API matching '$opt{'api-info'}'.";
- print "\n";
- exit 0;
-}
-
-if (exists $opt{'list-provided'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{provided};
- my @flags;
- push @flags, 'explicit' if exists $need{$f};
- push @flags, 'depend' if exists $depends{$f};
- push @flags, 'hint' if exists $hints{$f};
- push @flags, 'warning' if exists $warnings{$f};
- my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
- print "$f$flags\n";
- }
- exit 0;
-}
-
-my @files;
-my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
-my $srcext = join '|', map { quotemeta $_ } @srcext;
-
-if (@ARGV) {
- my %seen;
- for (@ARGV) {
- if (-e) {
- if (-f) {
- push @files, $_ unless $seen{$_}++;
- }
- else { warn "'$_' is not a file.\n" }
- }
- else {
- my @new = grep { -f } glob $_
- or warn "'$_' does not exist.\n";
- push @files, grep { !$seen{$_}++ } @new;
- }
- }
-}
-else {
- eval {
- require File::Find;
- File::Find::find(sub {
- $File::Find::name =~ /($srcext)$/i
- and push @files, $File::Find::name;
- }, '.');
- };
- if ($@) {
- @files = map { glob "*$_" } @srcext;
- }
-}
-
-if (!@ARGV || $opt{filter}) {
- my(@in, @out);
- my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
- for (@files) {
- my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
- push @{ $out ? \@out : \@in }, $_;
- }
- if (@ARGV && @out) {
- warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
- }
- @files = @in;
-}
-
-die "No input files given!\n" unless @files;
-
-my(%files, %global, %revreplace);
-%revreplace = reverse %replace;
-my $filename;
-my $patch_opened = 0;
-
-for $filename (@files) {
- unless (open IN, "<$filename") {
- warn "Unable to read from $filename: $!\n";
- next;
- }
-
- info("Scanning $filename ...");
-
- my $c = do { local $/; };
- close IN;
-
- my %file = (orig => $c, changes => 0);
-
- # Temporarily remove C/XS comments and strings from the code
- my @ccom;
-
- $c =~ s{
- ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
- | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
- | ( ^$HS*\#[^\r\n]*
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*'
- | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
- }{ defined $2 and push @ccom, $2;
- defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
-
- $file{ccom} = \@ccom;
- $file{code} = $c;
- $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
-
- my $func;
-
- for $func (keys %API) {
- my $match = $func;
- $match .= "|$revreplace{$func}" if exists $revreplace{$func};
- if ($c =~ /\b(?:Perl_)?($match)\b/) {
- $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
- $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
- if (exists $API{$func}{provided}) {
- $file{uses_provided}{$func}++;
- if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
- $file{uses}{$func}++;
- my @deps = rec_depend($func);
- if (@deps) {
- $file{uses_deps}{$func} = \@deps;
- for (@deps) {
- $file{uses}{$_} = 0 unless exists $file{uses}{$_};
- }
- }
- for ($func, @deps) {
- $file{needs}{$_} = 'static' if exists $need{$_};
- }
- }
- }
- if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
- if ($c =~ /\b$func\b/) {
- $file{uses_todo}{$func}++;
- }
- }
- }
- }
-
- while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
- if (exists $need{$2}) {
- $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- }
- else { warning("Possibly wrong #define $1 in $filename") }
- }
-
- for (qw(uses needs uses_todo needed_global needed_static)) {
- for $func (keys %{$file{$_}}) {
- push @{$global{$_}{$func}}, $filename;
- }
- }
-
- $files{$filename} = \%file;
-}
-
-# Globally resolve NEED_'s
-my $need;
-for $need (keys %{$global{needs}}) {
- if (@{$global{needs}{$need}} > 1) {
- my @targets = @{$global{needs}{$need}};
- my @t = grep $files{$_}{needed_global}{$need}, @targets;
- @targets = @t if @t;
- @t = grep /\.xs$/i, @targets;
- @targets = @t if @t;
- my $target = shift @targets;
- $files{$target}{needs}{$need} = 'global';
- for (@{$global{needs}{$need}}) {
- $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
- }
- }
-}
-
-for $filename (@files) {
- exists $files{$filename} or next;
-
- info("=== Analyzing $filename ===");
-
- my %file = %{$files{$filename}};
- my $func;
- my $c = $file{code};
- my $warnings = 0;
-
- for $func (sort keys %{$file{uses_Perl}}) {
- if ($API{$func}{varargs}) {
- unless ($API{$func}{nothxarg}) {
- my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
- { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
- if ($changes) {
- warning("Doesn't pass interpreter argument aTHX to Perl_$func");
- $file{changes} += $changes;
- }
- }
- }
- else {
- warning("Uses Perl_$func instead of $func");
- $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
- {$func$1(}g);
- }
- }
-
- for $func (sort keys %{$file{uses_replace}}) {
- warning("Uses $func instead of $replace{$func}");
- $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
- }
-
- for $func (sort keys %{$file{uses_provided}}) {
- if ($file{uses}{$func}) {
- if (exists $file{uses_deps}{$func}) {
- diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
- }
- else {
- diag("Uses $func");
- }
- }
- $warnings += hint($func);
- }
-
- unless ($opt{quiet}) {
- for $func (sort keys %{$file{uses_todo}}) {
- print "*** WARNING: Uses $func, which may not be portable below perl ",
- format_version($API{$func}{todo}), ", even with '$ppport'\n";
- $warnings++;
- }
- }
-
- for $func (sort keys %{$file{needed_static}}) {
- my $message = '';
- if (not exists $file{uses}{$func}) {
- $message = "No need to define NEED_$func if $func is never used";
- }
- elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
- $message = "No need to define NEED_$func when already needed globally";
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
- }
- }
-
- for $func (sort keys %{$file{needed_global}}) {
- my $message = '';
- if (not exists $global{uses}{$func}) {
- $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
- }
- elsif (exists $file{needs}{$func}) {
- if ($file{needs}{$func} eq 'extern') {
- $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
- }
- elsif ($file{needs}{$func} eq 'static') {
- $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
- }
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
- }
- }
-
- $file{needs_inc_ppport} = keys %{$file{uses}};
-
- if ($file{needs_inc_ppport}) {
- my $pp = '';
-
- for $func (sort keys %{$file{needs}}) {
- my $type = $file{needs}{$func};
- next if $type eq 'extern';
- my $suffix = $type eq 'global' ? '_GLOBAL' : '';
- unless (exists $file{"needed_$type"}{$func}) {
- if ($type eq 'global') {
- diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
- }
- else {
- diag("File needs $func, adding static request");
- }
- $pp .= "#define NEED_$func$suffix\n";
- }
- }
-
- if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
- $pp = '';
- $file{changes}++;
- }
-
- unless ($file{has_inc_ppport}) {
- diag("Needs to include '$ppport'");
- $pp .= qq(#include "$ppport"\n)
- }
-
- if ($pp) {
- $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
- || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
- || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
- || ($c =~ s/^/$pp/);
- }
- }
- else {
- if ($file{has_inc_ppport}) {
- diag("No need to include '$ppport'");
- $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
- }
- }
-
- # put back in our C comments
- my $ix;
- my $cppc = 0;
- my @ccom = @{$file{ccom}};
- for $ix (0 .. $#ccom) {
- if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
- $cppc++;
- $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
- }
- else {
- $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
- }
- }
-
- if ($cppc) {
- my $s = $cppc != 1 ? 's' : '';
- warning("Uses $cppc C++ style comment$s, which is not portable");
- }
-
- my $s = $warnings != 1 ? 's' : '';
- my $warn = $warnings ? " ($warnings warning$s)" : '';
- info("Analysis completed$warn");
-
- if ($file{changes}) {
- if (exists $opt{copy}) {
- my $newfile = "$filename$opt{copy}";
- if (-e $newfile) {
- error("'$newfile' already exists, refusing to write copy of '$filename'");
- }
- else {
- local *F;
- if (open F, ">$newfile") {
- info("Writing copy of '$filename' with changes to '$newfile'");
- print F $c;
- close F;
- }
- else {
- error("Cannot open '$newfile' for writing: $!");
- }
- }
- }
- elsif (exists $opt{patch} || $opt{changes}) {
- if (exists $opt{patch}) {
- unless ($patch_opened) {
- if (open PATCH, ">$opt{patch}") {
- $patch_opened = 1;
- }
- else {
- error("Cannot open '$opt{patch}' for writing: $!");
- delete $opt{patch};
- $opt{changes} = 1;
- goto fallback;
- }
- }
- mydiff(\*PATCH, $filename, $c);
- }
- else {
-fallback:
- info("Suggested changes:");
- mydiff(\*STDOUT, $filename, $c);
- }
- }
- else {
- my $s = $file{changes} == 1 ? '' : 's';
- info("$file{changes} potentially required change$s detected");
- }
- }
- else {
- info("Looks good");
- }
-}
-
-close PATCH if $patch_opened;
-
-exit 0;
-
-
-sub try_use { eval "use @_;"; return $@ eq '' }
-
-sub mydiff
-{
- local *F = shift;
- my($file, $str) = @_;
- my $diff;
-
- if (exists $opt{diff}) {
- $diff = run_diff($opt{diff}, $file, $str);
- }
-
- if (!defined $diff and try_use('Text::Diff')) {
- $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
- $diff = <$tmp") {
- print F $str;
- close F;
-
- if (open F, "$prog $file $tmp |") {
- while () {
- s/\Q$tmp\E/$file.patched/;
- $diff .= $_;
- }
- close F;
- unlink $tmp;
- return $diff;
- }
-
- unlink $tmp;
- }
- else {
- error("Cannot open '$tmp' for writing: $!");
- }
-
- return undef;
-}
-
-sub rec_depend
-{
- my($func, $seen) = @_;
- return () unless exists $depends{$func};
- $seen = {%{$seen||{}}};
- return () if $seen->{$func}++;
- my %s;
- grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
-}
-
-sub parse_version
-{
- my $ver = shift;
-
- if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
- return ($1, $2, $3);
- }
- elsif ($ver !~ /^\d+\.[\d_]+$/) {
- die "cannot parse version '$ver'\n";
- }
-
- $ver =~ s/_//g;
- $ver =~ s/$/000000/;
-
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "cannot parse version '$ver'\n";
- }
- }
-
- return ($r, $v, $s);
-}
-
-sub format_version
-{
- my $ver = shift;
-
- $ver =~ s/$/000000/;
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "invalid version '$ver'\n";
- }
- $s /= 10;
-
- $ver = sprintf "%d.%03d", $r, $v;
- $s > 0 and $ver .= sprintf "_%02d", $s;
-
- return $ver;
- }
-
- return sprintf "%d.%d.%d", $r, $v, $s;
-}
-
-sub info
-{
- $opt{quiet} and return;
- print @_, "\n";
-}
-
-sub diag
-{
- $opt{quiet} and return;
- $opt{diag} and print @_, "\n";
-}
-
-sub warning
-{
- $opt{quiet} and return;
- print "*** ", @_, "\n";
-}
-
-sub error
-{
- print "*** ERROR: ", @_, "\n";
-}
-
-my %given_hints;
-my %given_warnings;
-sub hint
-{
- $opt{quiet} and return;
- my $func = shift;
- my $rv = 0;
- if (exists $warnings{$func} && !$given_warnings{$func}++) {
- my $warn = $warnings{$func};
- $warn =~ s!^!*** !mg;
- print "*** WARNING: $func\n", $warn;
- $rv++;
- }
- if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
- my $hint = $hints{$func};
- $hint =~ s/^/ /mg;
- print " --- hint for $func ---\n", $hint;
- }
- $rv;
-}
-
-sub usage
-{
- my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
- my %M = ( 'I' => '*' );
- $usage =~ s/^\s*perl\s+\S+/$^X $0/;
- $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
-
- print < };
- my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
- $copy =~ s/^(?=\S+)/ /gms;
- $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
- $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
-if (\@ARGV && \$ARGV[0] eq '--unstrip') {
- eval { require Devel::PPPort };
- \$@ and die "Cannot require Devel::PPPort, please install.\\n";
- if (eval \$Devel::PPPort::VERSION < $VERSION) {
- die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
- . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
- . "Please install a newer version, or --unstrip will not work.\\n";
- }
- Devel::PPPort::WriteFile(\$0);
- exit 0;
-}
-print <$0" or die "cannot strip $0: $!\n";
- print OUT "$pl$c\n";
-
- exit 0;
-}
-
-__DATA__
-*/
-
-#ifndef _P_P_PORTABILITY_H_
-#define _P_P_PORTABILITY_H_
-
-#ifndef DPPP_NAMESPACE
-# define DPPP_NAMESPACE DPPP_
-#endif
-
-#define DPPP_CAT2(x,y) CAT2(x,y)
-#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
-
-#ifndef PERL_REVISION
-# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
-# define PERL_PATCHLEVEL_H_IMPLICIT
-# include
-# endif
-# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
-# include
-# endif
-# ifndef PERL_REVISION
-# define PERL_REVISION (5)
- /* Replace: 1 */
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
- /* Replace PERL_PATCHLEVEL with PERL_VERSION */
- /* Replace: 0 */
-# endif
-#endif
-
-#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
-#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
-
-/* It is very unlikely that anyone will try to use this with Perl 6
- (or greater), but who knows.
- */
-#if PERL_REVISION != 5
-# error ppport.h only works with Perl version 5
-#endif /* PERL_REVISION != 5 */
-#ifndef dTHR
-# define dTHR dNOOP
-#endif
-#ifndef dTHX
-# define dTHX dNOOP
-#endif
-
-#ifndef dTHXa
-# define dTHXa(x) dNOOP
-#endif
-#ifndef pTHX
-# define pTHX void
-#endif
-
-#ifndef pTHX_
-# define pTHX_
-#endif
-
-#ifndef aTHX
-# define aTHX
-#endif
-
-#ifndef aTHX_
-# define aTHX_
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# ifdef USE_THREADS
-# define aTHXR thr
-# define aTHXR_ thr,
-# else
-# define aTHXR
-# define aTHXR_
-# endif
-# define dTHXR dTHR
-#else
-# define aTHXR aTHX
-# define aTHXR_ aTHX_
-# define dTHXR dTHX
-#endif
-#ifndef dTHXoa
-# define dTHXoa(x) dTHXa(x)
-#endif
-
-#ifdef I_LIMITS
-# include
-#endif
-
-#ifndef PERL_UCHAR_MIN
-# define PERL_UCHAR_MIN ((unsigned char)0)
-#endif
-
-#ifndef PERL_UCHAR_MAX
-# ifdef UCHAR_MAX
-# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
-# else
-# ifdef MAXUCHAR
-# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
-# else
-# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_USHORT_MIN
-# define PERL_USHORT_MIN ((unsigned short)0)
-#endif
-
-#ifndef PERL_USHORT_MAX
-# ifdef USHORT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
-# else
-# ifdef MAXUSHORT
-# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
-# else
-# ifdef USHRT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
-# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MAX
-# ifdef SHORT_MAX
-# define PERL_SHORT_MAX ((short)SHORT_MAX)
-# else
-# ifdef MAXSHORT /* Often used in */
-# define PERL_SHORT_MAX ((short)MAXSHORT)
-# else
-# ifdef SHRT_MAX
-# define PERL_SHORT_MAX ((short)SHRT_MAX)
-# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MIN
-# ifdef SHORT_MIN
-# define PERL_SHORT_MIN ((short)SHORT_MIN)
-# else
-# ifdef MINSHORT
-# define PERL_SHORT_MIN ((short)MINSHORT)
-# else
-# ifdef SHRT_MIN
-# define PERL_SHORT_MIN ((short)SHRT_MIN)
-# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MAX
-# ifdef UINT_MAX
-# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
-# else
-# ifdef MAXUINT
-# define PERL_UINT_MAX ((unsigned int)MAXUINT)
-# else
-# define PERL_UINT_MAX (~(unsigned int)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MIN
-# define PERL_UINT_MIN ((unsigned int)0)
-#endif
-
-#ifndef PERL_INT_MAX
-# ifdef INT_MAX
-# define PERL_INT_MAX ((int)INT_MAX)
-# else
-# ifdef MAXINT /* Often used in */
-# define PERL_INT_MAX ((int)MAXINT)
-# else
-# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_INT_MIN
-# ifdef INT_MIN
-# define PERL_INT_MIN ((int)INT_MIN)
-# else
-# ifdef MININT
-# define PERL_INT_MIN ((int)MININT)
-# else
-# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MAX
-# ifdef ULONG_MAX
-# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
-# else
-# ifdef MAXULONG
-# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
-# else
-# define PERL_ULONG_MAX (~(unsigned long)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MIN
-# define PERL_ULONG_MIN ((unsigned long)0L)
-#endif
-
-#ifndef PERL_LONG_MAX
-# ifdef LONG_MAX
-# define PERL_LONG_MAX ((long)LONG_MAX)
-# else
-# ifdef MAXLONG
-# define PERL_LONG_MAX ((long)MAXLONG)
-# else
-# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_LONG_MIN
-# ifdef LONG_MIN
-# define PERL_LONG_MIN ((long)LONG_MIN)
-# else
-# ifdef MINLONG
-# define PERL_LONG_MIN ((long)MINLONG)
-# else
-# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
-# ifndef PERL_UQUAD_MAX
-# ifdef ULONGLONG_MAX
-# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
-# else
-# ifdef MAXULONGLONG
-# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
-# else
-# define PERL_UQUAD_MAX (~(unsigned long long)0)
-# endif
-# endif
-# endif
-
-# ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN ((unsigned long long)0L)
-# endif
-
-# ifndef PERL_QUAD_MAX
-# ifdef LONGLONG_MAX
-# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
-# else
-# ifdef MAXLONGLONG
-# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
-# else
-# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
-# endif
-# endif
-# endif
-
-# ifndef PERL_QUAD_MIN
-# ifdef LONGLONG_MIN
-# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
-# else
-# ifdef MINLONGLONG
-# define PERL_QUAD_MIN ((long long)MINLONGLONG)
-# else
-# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-/* This is based on code from 5.003 perl.h */
-#ifdef HAS_QUAD
-# ifdef cray
-#ifndef IVTYPE
-# define IVTYPE int
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_INT_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_INT_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UINT_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UINT_MAX
-#endif
-
-# ifdef INTSIZE
-#ifndef IVSIZE
-# define IVSIZE INTSIZE
-#endif
-
-# endif
-# else
-# if defined(convex) || defined(uts)
-#ifndef IVTYPE
-# define IVTYPE long long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_QUAD_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_QUAD_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UQUAD_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UQUAD_MAX
-#endif
-
-# ifdef LONGLONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGLONGSIZE
-#endif
-
-# endif
-# else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-# ifdef LONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGSIZE
-#endif
-
-# endif
-# endif
-# endif
-#ifndef IVSIZE
-# define IVSIZE 8
-#endif
-
-#ifndef PERL_QUAD_MIN
-# define PERL_QUAD_MIN IV_MIN
-#endif
-
-#ifndef PERL_QUAD_MAX
-# define PERL_QUAD_MAX IV_MAX
-#endif
-
-#ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN UV_MIN
-#endif
-
-#ifndef PERL_UQUAD_MAX
-# define PERL_UQUAD_MAX UV_MAX
-#endif
-
-#else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-#endif
-
-#ifndef IVSIZE
-# ifdef LONGSIZE
-# define IVSIZE LONGSIZE
-# else
-# define IVSIZE 4 /* A bold guess, but the best we can make. */
-# endif
-#endif
-#ifndef UVTYPE
-# define UVTYPE unsigned IVTYPE
-#endif
-
-#ifndef UVSIZE
-# define UVSIZE IVSIZE
-#endif
-#ifndef sv_setuv
-# define sv_setuv(sv, uv) \
- STMT_START { \
- UV TeMpUv = uv; \
- if (TeMpUv <= IV_MAX) \
- sv_setiv(sv, TeMpUv); \
- else \
- sv_setnv(sv, (double)TeMpUv); \
- } STMT_END
-#endif
-#ifndef newSVuv
-# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
-#endif
-#ifndef sv_2uv
-# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
-#endif
-
-#ifndef SvUVX
-# define SvUVX(sv) ((UV)SvIVX(sv))
-#endif
-
-#ifndef SvUVXx
-# define SvUVXx(sv) SvUVX(sv)
-#endif
-
-#ifndef SvUV
-# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
-#endif
-
-#ifndef SvUVx
-# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
-#endif
-
-/* Hint: sv_uv
- * Always use the SvUVx() macro instead of sv_uv().
- */
-#ifndef sv_uv
-# define sv_uv(sv) SvUVx(sv)
-#endif
-
-#if !defined(SvUOK) && defined(SvIOK_UV)
-# define SvUOK(sv) SvIOK_UV(sv)
-#endif
-#ifndef XST_mUV
-# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
-#endif
-
-#ifndef XSRETURN_UV
-# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
-#endif
-#ifndef PUSHu
-# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
-#endif
-
-#ifndef XPUSHu
-# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
-#endif
-
-#ifdef HAS_MEMCMP
-#ifndef memNE
-# define memNE(s1,s2,l) (memcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
-#endif
-
-#else
-#ifndef memNE
-# define memNE(s1,s2,l) (bcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
-#endif
-
-#endif
-#ifndef MoveD
-# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifndef CopyD
-# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifdef HAS_MEMSET
-#ifndef ZeroD
-# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
-#endif
-
-#else
-#ifndef ZeroD
-# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
-#endif
-
-#endif
-#ifndef PoisonWith
-# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
-#endif
-
-#ifndef PoisonNew
-# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
-#endif
-
-#ifndef PoisonFree
-# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
-#endif
-
-#ifndef Poison
-# define Poison(d,n,t) PoisonFree(d,n,t)
-#endif
-#ifndef Newx
-# define Newx(v,n,t) New(0,v,n,t)
-#endif
-
-#ifndef Newxc
-# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
-#endif
-
-#ifndef Newxz
-# define Newxz(v,n,t) Newz(0,v,n,t)
-#endif
-
-#ifndef PERL_UNUSED_DECL
-# ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
-# else
-# define PERL_UNUSED_DECL __attribute__((unused))
-# endif
-# else
-# define PERL_UNUSED_DECL
-# endif
-#endif
-
-#ifndef PERL_UNUSED_ARG
-# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-# include
-# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-# else
-# define PERL_UNUSED_ARG(x) ((void)x)
-# endif
-#endif
-
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
-#endif
-
-#ifndef PERL_UNUSED_CONTEXT
-# ifdef USE_ITHREADS
-# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
-# else
-# define PERL_UNUSED_CONTEXT
-# endif
-#endif
-#ifndef NOOP
-# define NOOP /*EMPTY*/(void)0
-#endif
-
-#ifndef dNOOP
-# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef NVTYPE
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-# define NVTYPE long double
-# else
-# define NVTYPE double
-# endif
-typedef NVTYPE NV;
-#endif
-
-#ifndef INT2PTR
-# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
-# define PTRV UV
-# define INT2PTR(any,d) (any)(d)
-# else
-# if PTRSIZE == LONGSIZE
-# define PTRV unsigned long
-# else
-# define PTRV unsigned
-# endif
-# define INT2PTR(any,d) (any)(PTRV)(d)
-# endif
-#endif
-
-#ifndef PTR2ul
-# if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-# endif
-#endif
-#ifndef PTR2nat
-# define PTR2nat(p) (PTRV)(p)
-#endif
-
-#ifndef NUM2PTR
-# define NUM2PTR(any,d) (any)PTR2nat(d)
-#endif
-
-#ifndef PTR2IV
-# define PTR2IV(p) INT2PTR(IV,p)
-#endif
-
-#ifndef PTR2UV
-# define PTR2UV(p) INT2PTR(UV,p)
-#endif
-
-#ifndef PTR2NV
-# define PTR2NV(p) NUM2PTR(NV,p)
-#endif
-
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-# define START_EXTERN_C extern "C" {
-# define END_EXTERN_C }
-# define EXTERN_C extern "C"
-#else
-# define START_EXTERN_C
-# define END_EXTERN_C
-# define EXTERN_C extern
-#endif
-
-#if defined(PERL_GCC_PEDANTIC)
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
-#endif
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
-# ifndef PERL_USE_GCC_BRACE_GROUPS
-# define PERL_USE_GCC_BRACE_GROUPS
-# endif
-#endif
-
-#undef STMT_START
-#undef STMT_END
-#ifdef PERL_USE_GCC_BRACE_GROUPS
-# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
-# define STMT_END )
-#else
-# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
-# define STMT_START if (1)
-# define STMT_END else (void)0
-# else
-# define STMT_START do
-# define STMT_END while (0)
-# endif
-#endif
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
-#endif
-
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
-#endif
-
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
-#endif
-
-#ifndef DEFSV_set
-# define DEFSV_set(sv) (DEFSV = (sv))
-#endif
-
-/* Older perls (<=5.003) lack AvFILLp */
-#ifndef AvFILLp
-# define AvFILLp AvFILL
-#endif
-#ifndef ERRSV
-# define ERRSV get_sv("@",FALSE)
-#endif
-
-/* Hint: gv_stashpvn
- * This function's backport doesn't support the length parameter, but
- * rather ignores it. Portability can only be ensured if the length
- * parameter is used for speed reasons, but the length can always be
- * correctly computed from the string argument.
- */
-#ifndef gv_stashpvn
-# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
-#endif
-
-/* Replace: 1 */
-#ifndef get_cv
-# define get_cv perl_get_cv
-#endif
-
-#ifndef get_sv
-# define get_sv perl_get_sv
-#endif
-
-#ifndef get_av
-# define get_av perl_get_av
-#endif
-
-#ifndef get_hv
-# define get_hv perl_get_hv
-#endif
-
-/* Replace: 0 */
-#ifndef dUNDERBAR
-# define dUNDERBAR dNOOP
-#endif
-
-#ifndef UNDERBAR
-# define UNDERBAR DEFSV
-#endif
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
-#endif
-
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
-#endif
-#ifndef dXSTARG
-# define dXSTARG SV * targ = sv_newmortal()
-#endif
-#ifndef dAXMARK
-# define dAXMARK I32 ax = POPMARK; \
- register SV ** const mark = PL_stack_base + ax++
-#endif
-#ifndef XSprePUSH
-# define XSprePUSH (sp = PL_stack_base + ax - 1)
-#endif
-
-#if (PERL_BCDVERSION < 0x5005000)
-# undef XSRETURN
-# define XSRETURN(off) \
- STMT_START { \
- PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
- return; \
- } STMT_END
-#endif
-#ifndef PERL_ABS
-# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
-#endif
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-#ifndef SVf
-# define SVf "_"
-#endif
-#ifndef UTF8_MAXBYTES
-# define UTF8_MAXBYTES UTF8_MAXLEN
-#endif
-#ifndef CPERLscope
-# define CPERLscope(x) x
-#endif
-#ifndef PERL_HASH
-# define PERL_HASH(hash,str,len) \
- STMT_START { \
- const char *s_PeRlHaSh = str; \
- I32 i_PeRlHaSh = len; \
- U32 hash_PeRlHaSh = 0; \
- while (i_PeRlHaSh--) \
- hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
- (hash) = hash_PeRlHaSh; \
- } STMT_END
-#endif
-
-#ifndef PERLIO_FUNCS_DECL
-# ifdef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
-# else
-# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (funcs)
-# endif
-#endif
-
-/* provide these typedefs for older perls */
-#if (PERL_BCDVERSION < 0x5009003)
-
-# ifdef ARGSproto
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
-# else
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
-# endif
-
-typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-
-#endif
-#ifndef isPSXSPC
-# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
-#endif
-
-#ifndef isBLANK
-# define isBLANK(c) ((c) == ' ' || (c) == '\t')
-#endif
-
-#ifdef EBCDIC
-#ifndef isALNUMC
-# define isALNUMC(c) isalnum(c)
-#endif
-
-#ifndef isASCII
-# define isASCII(c) isascii(c)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) iscntrl(c)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) isgraph(c)
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) isprint(c)
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) ispunct(c)
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) isxdigit(c)
-#endif
-
-#else
-# if (PERL_BCDVERSION < 0x5010000)
-/* Hint: isPRINT
- * The implementation in older perl versions includes all of the
- * isSPACE() characters, which is wrong. The version provided by
- * Devel::PPPort always overrides a present buggy version.
- */
-# undef isPRINT
-# endif
-#ifndef isALNUMC
-# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
-#endif
-
-#ifndef isASCII
-# define isASCII(c) ((c) <= 127)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) ((c) < ' ' || (c) == 127)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) (((c) >= 32 && (c) < 127))
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
-#endif
-
-#endif
-
-#ifndef PERL_SIGNALS_UNSAFE_FLAG
-
-#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-
-#if (PERL_BCDVERSION < 0x5008000)
-# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
-#else
-# define D_PPP_PERL_SIGNALS_INIT 0
-#endif
-
-#if defined(NEED_PL_signals)
-static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#elif defined(NEED_PL_signals_GLOBAL)
-U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#else
-extern U32 DPPP_(my_PL_signals);
-#endif
-#define PL_signals DPPP_(my_PL_signals)
-
-#endif
-
-/* Hint: PL_ppaddr
- * Calling an op via PL_ppaddr requires passing a context argument
- * for threaded builds. Since the context argument is different for
- * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
- * automatically be defined as the correct argument.
- */
-
-#if (PERL_BCDVERSION <= 0x5005005)
-/* Replace: 1 */
-# define PL_ppaddr ppaddr
-# define PL_no_modify no_modify
-/* Replace: 0 */
-#endif
-
-#if (PERL_BCDVERSION <= 0x5004005)
-/* Replace: 1 */
-# define PL_DBsignal DBsignal
-# define PL_DBsingle DBsingle
-# define PL_DBsub DBsub
-# define PL_DBtrace DBtrace
-# define PL_Sv Sv
-# define PL_bufend bufend
-# define PL_bufptr bufptr
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_debstash debstash
-# define PL_defgv defgv
-# define PL_diehook diehook
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_errgv errgv
-# define PL_expect expect
-# define PL_hexdigit hexdigit
-# define PL_hints hints
-# define PL_laststatval laststatval
-# define PL_lex_state lex_state
-# define PL_lex_stuff lex_stuff
-# define PL_linestr linestr
-# define PL_na na
-# define PL_perl_destruct_level perl_destruct_level
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stack_base stack_base
-# define PL_stack_sp stack_sp
-# define PL_statcache statcache
-# define PL_stdingv stdingv
-# define PL_sv_arenaroot sv_arenaroot
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_tainted tainted
-# define PL_tainting tainting
-# define PL_tokenbuf tokenbuf
-/* Replace: 0 */
-#endif
-
-/* Warning: PL_parser
- * For perl versions earlier than 5.9.5, this is an always
- * non-NULL dummy. Also, it cannot be dereferenced. Don't
- * use it if you can avoid is and unless you absolutely know
- * what you're doing.
- * If you always check that PL_parser is non-NULL, you can
- * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
- * a dummy parser structure.
- */
-
-#if (PERL_BCDVERSION >= 0x5009005)
-# ifdef DPPP_PL_parser_NO_DUMMY
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (croak("panic: PL_parser == NULL in %s:%d", \
- __FILE__, __LINE__), (yy_parser *) NULL))->var)
-# else
-# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
-# define D_PPP_parser_dummy_warning(var)
-# else
-# define D_PPP_parser_dummy_warning(var) \
- warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
-# endif
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
-#if defined(NEED_PL_parser)
-static yy_parser DPPP_(dummy_PL_parser);
-#elif defined(NEED_PL_parser_GLOBAL)
-yy_parser DPPP_(dummy_PL_parser);
-#else
-extern yy_parser DPPP_(dummy_PL_parser);
-#endif
-
-# endif
-
-/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
-/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
- * Do not use this variable unless you know exactly what you're
- * doint. It is internal to the perl parser and may change or even
- * be removed in the future. As of perl 5.9.5, you have to check
- * for (PL_parser != NULL) for this variable to have any effect.
- * An always non-NULL PL_parser dummy is provided for earlier
- * perl versions.
- * If PL_parser is NULL when you try to access this variable, a
- * dummy is being accessed instead and a warning is issued unless
- * you define DPPP_PL_parser_NO_DUMMY_WARNING.
- * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
- * this variable will croak with a panic message.
- */
-
-# define PL_expect D_PPP_my_PL_parser_var(expect)
-# define PL_copline D_PPP_my_PL_parser_var(copline)
-# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
-# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
-# define PL_linestr D_PPP_my_PL_parser_var(linestr)
-# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
-# define PL_bufend D_PPP_my_PL_parser_var(bufend)
-# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
-# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
-# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
-
-#else
-
-/* ensure that PL_parser != NULL and cannot be dereferenced */
-# define PL_parser ((void *) 1)
-
-#endif
-#ifndef mPUSHs
-# define mPUSHs(s) PUSHs(sv_2mortal(s))
-#endif
-
-#ifndef PUSHmortal
-# define PUSHmortal PUSHs(sv_newmortal())
-#endif
-
-#ifndef mPUSHp
-# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
-#endif
-
-#ifndef mPUSHn
-# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
-#endif
-
-#ifndef mPUSHi
-# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
-#endif
-
-#ifndef mPUSHu
-# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
-#endif
-#ifndef mXPUSHs
-# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
-#endif
-
-#ifndef XPUSHmortal
-# define XPUSHmortal XPUSHs(sv_newmortal())
-#endif
-
-#ifndef mXPUSHp
-# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
-#endif
-
-#ifndef mXPUSHn
-# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
-#endif
-
-#ifndef mXPUSHi
-# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
-#endif
-
-#ifndef mXPUSHu
-# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
-#endif
-
-/* Replace: 1 */
-#ifndef call_sv
-# define call_sv perl_call_sv
-#endif
-
-#ifndef call_pv
-# define call_pv perl_call_pv
-#endif
-
-#ifndef call_argv
-# define call_argv perl_call_argv
-#endif
-
-#ifndef call_method
-# define call_method perl_call_method
-#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
-#endif
-
-/* Replace: 0 */
-#ifndef PERL_LOADMOD_DENY
-# define PERL_LOADMOD_DENY 0x1
-#endif
-
-#ifndef PERL_LOADMOD_NOIMPORT
-# define PERL_LOADMOD_NOIMPORT 0x2
-#endif
-
-#ifndef PERL_LOADMOD_IMPORT_OPS
-# define PERL_LOADMOD_IMPORT_OPS 0x4
-#endif
-
-#ifndef G_METHOD
-# define G_METHOD 64
-# ifdef call_sv
-# undef call_sv
-# endif
-# if (PERL_BCDVERSION < 0x5006000)
-# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
-# else
-# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
-# endif
-#endif
-
-/* Replace perl_eval_pv with eval_pv */
-
-#ifndef eval_pv
-#if defined(NEED_eval_pv)
-static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-static
-#else
-extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-#endif
-
-#ifdef eval_pv
-# undef eval_pv
-#endif
-#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(my_eval_pv)
-
-#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
-
-SV*
-DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
-{
- dSP;
- SV* sv = newSVpv(p, 0);
-
- PUSHMARK(sp);
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
-
- SPAGAIN;
- sv = POPs;
- PUTBACK;
-
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
-
- return sv;
-}
-
-#endif
-#endif
-
-#ifndef vload_module
-#if defined(NEED_vload_module)
-static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-static
-#else
-extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-#endif
-
-#ifdef vload_module
-# undef vload_module
-#endif
-#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
-#define Perl_vload_module DPPP_(my_vload_module)
-
-#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
-
-void
-DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
-{
- dTHR;
- dVAR;
- OP *veop, *imop;
-
- OP * const modname = newSVOP(OP_CONST, 0, name);
- /* 5.005 has a somewhat hacky force_normal that doesn't croak on
- SvREADONLY() if PL_compling is true. Current perls take care in
- ck_require() to correctly turn off SvREADONLY before calling
- force_normal_flags(). This seems a better fix than fudging PL_compling
- */
- SvREADONLY_off(((SVOP*)modname)->op_sv);
- modname->op_private |= OPpCONST_BARE;
- if (ver) {
- veop = newSVOP(OP_CONST, 0, ver);
- }
- else
- veop = NULL;
- if (flags & PERL_LOADMOD_NOIMPORT) {
- imop = sawparens(newNULLLIST());
- }
- else if (flags & PERL_LOADMOD_IMPORT_OPS) {
- imop = va_arg(*args, OP*);
- }
- else {
- SV *sv;
- imop = NULL;
- sv = va_arg(*args, SV*);
- while (sv) {
- imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
- sv = va_arg(*args, SV*);
- }
- }
- {
- const line_t ocopline = PL_copline;
- COP * const ocurcop = PL_curcop;
- const int oexpect = PL_expect;
-
-#if (PERL_BCDVERSION >= 0x5004000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
- veop, modname, imop);
-#else
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- modname, imop);
-#endif
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
-}
-
-#endif
-#endif
-
-#ifndef load_module
-#if defined(NEED_load_module)
-static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-static
-#else
-extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-#endif
-
-#ifdef load_module
-# undef load_module
-#endif
-#define load_module DPPP_(my_load_module)
-#define Perl_load_module DPPP_(my_load_module)
-
-#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
-
-void
-DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
-{
- va_list args;
- va_start(args, ver);
- vload_module(flags, name, ver, &args);
- va_end(args);
-}
-
-#endif
-#endif
-#ifndef newRV_inc
-# define newRV_inc(sv) newRV(sv) /* Replace */
-#endif
-
-#ifndef newRV_noinc
-#if defined(NEED_newRV_noinc)
-static SV * DPPP_(my_newRV_noinc)(SV *sv);
-static
-#else
-extern SV * DPPP_(my_newRV_noinc)(SV *sv);
-#endif
-
-#ifdef newRV_noinc
-# undef newRV_noinc
-#endif
-#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
-#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
-
-#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
-SV *
-DPPP_(my_newRV_noinc)(SV *sv)
-{
- SV *rv = (SV *)newRV(sv);
- SvREFCNT_dec(sv);
- return rv;
-}
-#endif
-#endif
-
-/* Hint: newCONSTSUB
- * Returns a CV* as of perl-5.7.1. This return value is not supported
- * by Devel::PPPort.
- */
-
-/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
-#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
-#if defined(NEED_newCONSTSUB)
-static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-static
-#else
-extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-#endif
-
-#ifdef newCONSTSUB
-# undef newCONSTSUB
-#endif
-#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
-#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
-
-#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
-
-/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
-/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
-#define D_PPP_PL_copline PL_copline
-
-void
-DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
-{
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = D_PPP_PL_copline;
-
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if (stash)
- PL_curstash = PL_curcop->cop_stash = stash;
-
- newSUB(
-
-#if (PERL_BCDVERSION < 0x5003022)
- start_subparse(),
-#elif (PERL_BCDVERSION == 0x5003022)
- start_subparse(0),
-#else /* 5.003_23 onwards */
- start_subparse(FALSE, 0),
-#endif
-
- newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
- newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
-
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
-#endif
-#endif
-
-/*
- * Boilerplate macros for initializing and accessing interpreter-local
- * data from C. All statics in extensions should be reworked to use
- * this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros.
- *
- * Code that uses these macros is responsible for the following:
- * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
- * 2. Declare a typedef named my_cxt_t that is a structure that contains
- * all the data that needs to be interpreter-local.
- * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
- * 4. Use the MY_CXT_INIT macro such that it is called exactly once
- * (typically put in the BOOT: section).
- * 5. Use the members of the my_cxt_t structure everywhere as
- * MY_CXT.member.
- * 6. Use the dMY_CXT macro (a declaration) in all the functions that
- * access MY_CXT.
- */
-
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
- defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
-
-#ifndef START_MY_CXT
-
-/* This must appear in all extensions that define a my_cxt_t structure,
- * right after the definition (i.e. at file scope). The non-threads
- * case below uses it to declare the data as static. */
-#define START_MY_CXT
-
-#if (PERL_BCDVERSION < 0x5004068)
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
-#else /* >= perl5.004_68 */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
-#endif /* < perl5.004_68 */
-
-/* This declaration should be used within all functions that use the
- * interpreter-local data. */
-#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
-
-/* Creates and zeroes the per-interpreter data.
- * (We allocate my_cxtp in a Perl SV so that it will be released when
- * the interpreter goes away.) */
-#define MY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-
-/* This macro must be used to access members of the my_cxt_t structure.
- * e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
-
-/* Judicious use of these macros can reduce the number of times dMY_CXT
- * is used. Use is similar to pTHX, aTHX etc. */
-#define pMY_CXT my_cxt_t *my_cxtp
-#define pMY_CXT_ pMY_CXT,
-#define _pMY_CXT ,pMY_CXT
-#define aMY_CXT my_cxtp
-#define aMY_CXT_ aMY_CXT,
-#define _aMY_CXT ,aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-#endif
-
-#else /* single interpreter */
-
-#ifndef START_MY_CXT
-
-#define START_MY_CXT static my_cxt_t my_cxt;
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT dNOOP
-#define MY_CXT_INIT NOOP
-#define MY_CXT my_cxt
-
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-#define MY_CXT_CLONE NOOP
-#endif
-
-#endif
-
-#ifndef IVdf
-# if IVSIZE == LONGSIZE
-# define IVdf "ld"
-# define UVuf "lu"
-# define UVof "lo"
-# define UVxf "lx"
-# define UVXf "lX"
-# else
-# if IVSIZE == INTSIZE
-# define IVdf "d"
-# define UVuf "u"
-# define UVof "o"
-# define UVxf "x"
-# define UVXf "X"
-# endif
-# endif
-#endif
-
-#ifndef NVef
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
- defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
- /* Not very likely, but let's try anyway. */
-# define NVef PERL_PRIeldbl
-# define NVff PERL_PRIfldbl
-# define NVgf PERL_PRIgldbl
-# else
-# define NVef "e"
-# define NVff "f"
-# define NVgf "g"
-# endif
-#endif
-
-#ifndef SvREFCNT_inc
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (SvREFCNT(_sv))++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc(sv) \
- ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_simple
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_simple(sv) \
- ({ \
- if (sv) \
- (SvREFCNT(sv))++; \
- (SV *)(sv); \
- })
-# else
-# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_NN
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_NN(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- SvREFCNT(_sv)++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_void
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_void(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (void)(SvREFCNT(_sv)++); \
- })
-# else
-# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
-# endif
-#endif
-#ifndef SvREFCNT_inc_simple_void
-# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
-#endif
-
-#ifndef SvREFCNT_inc_simple_NN
-# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
-#endif
-
-#ifndef SvREFCNT_inc_void_NN
-# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#ifndef SvREFCNT_inc_simple_void_NN
-# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
-#else
-# define D_PPP_CONSTPV_ARG(x) (x)
-#endif
-#ifndef newSVpvn
-# define newSVpvn(data,len) ((data) \
- ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
- : newSV(0))
-#endif
-#ifndef newSVpvn_utf8
-# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
-#endif
-#ifndef SVf_UTF8
-# define SVf_UTF8 0
-#endif
-
-#ifndef newSVpvn_flags
-
-#if defined(NEED_newSVpvn_flags)
-static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-#endif
-
-#ifdef newSVpvn_flags
-# undef newSVpvn_flags
-#endif
-#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
-#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
-
-#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
-{
- SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
- SvFLAGS(sv) |= (flags & SVf_UTF8);
- return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
-}
-
-#endif
-
-#endif
-
-/* Backwards compatibility stuff... :-( */
-#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
-# define NEED_sv_2pv_flags
-#endif
-#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
-# define NEED_sv_2pv_flags_GLOBAL
-#endif
-
-/* Hint: sv_2pv_nolen
- * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
- */
-#ifndef sv_2pv_nolen
-# define sv_2pv_nolen(sv) SvPV_nolen(sv)
-#endif
-
-#ifdef SvPVbyte
-
-/* Hint: SvPVbyte
- * Does not work in perl-5.6.1, ppport.h implements a version
- * borrowed from perl-5.7.3.
- */
-
-#if (PERL_BCDVERSION < 0x5007000)
-
-#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-static
-#else
-extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-#endif
-
-#ifdef sv_2pvbyte
-# undef sv_2pvbyte
-#endif
-#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
-
-#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-
-char *
-DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
-{
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
-}
-
-#endif
-
-/* Hint: sv_2pvbyte
- * Use the SvPVbyte() macro instead of sv_2pvbyte().
- */
-
-#undef SvPVbyte
-
-#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
-
-#endif
-
-#else
-
-# define SvPVbyte SvPV
-# define sv_2pvbyte sv_2pv
-
-#endif
-#ifndef sv_2pvbyte_nolen
-# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
-#endif
-
-/* Hint: sv_pvn
- * Always use the SvPV() macro instead of sv_pvn().
- */
-
-/* Hint: sv_pvn_force
- * Always use the SvPV_force() macro instead of sv_pvn_force().
- */
-
-/* If these are undefined, they're not handled by the core anyway */
-#ifndef SV_IMMEDIATE_UNREF
-# define SV_IMMEDIATE_UNREF 0
-#endif
-
-#ifndef SV_GMAGIC
-# define SV_GMAGIC 0
-#endif
-
-#ifndef SV_COW_DROP_PV
-# define SV_COW_DROP_PV 0
-#endif
-
-#ifndef SV_UTF8_NO_ENCODING
-# define SV_UTF8_NO_ENCODING 0
-#endif
-
-#ifndef SV_NOSTEAL
-# define SV_NOSTEAL 0
-#endif
-
-#ifndef SV_CONST_RETURN
-# define SV_CONST_RETURN 0
-#endif
-
-#ifndef SV_MUTABLE_RETURN
-# define SV_MUTABLE_RETURN 0
-#endif
-
-#ifndef SV_SMAGIC
-# define SV_SMAGIC 0
-#endif
-
-#ifndef SV_HAS_TRAILING_NUL
-# define SV_HAS_TRAILING_NUL 0
-#endif
-
-#ifndef SV_COW_SHARED_HASH_KEYS
-# define SV_COW_SHARED_HASH_KEYS 0
-#endif
-
-#if (PERL_BCDVERSION < 0x5007002)
-
-#if defined(NEED_sv_2pv_flags)
-static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_2pv_flags
-# undef sv_2pv_flags
-#endif
-#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
-#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
-
-#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_2pv(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#if defined(NEED_sv_pvn_force_flags)
-static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_pvn_force_flags
-# undef sv_pvn_force_flags
-#endif
-#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
-#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
-
-#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_pvn_force(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
-# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
-#else
-# define DPPP_SVPV_NOLEN_LP_ARG 0
-#endif
-#ifndef SvPV_const
-# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_mutable
-# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-#ifndef SvPV_flags
-# define SvPV_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_flags_const
-# define SvPV_flags_const(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
- (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_const_nolen
-# define SvPV_flags_const_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : \
- (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_mutable
-# define SvPV_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
- sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_force
-# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_mutable
-# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nomg
-# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_force_nomg_nolen
-# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
-#endif
-#ifndef SvPV_force_flags
-# define SvPV_force_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_force_flags_nolen
-# define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
-#endif
-#ifndef SvPV_force_flags_mutable
-# define SvPV_force_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
- : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_nolen
-# define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
-#endif
-#ifndef SvPV_nolen_const
-# define SvPV_nolen_const(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_nomg
-# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const
-# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const_nolen
-# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
-#endif
-#ifndef SvPV_renew
-# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
- SvPV_set((sv), (char *) saferealloc( \
- (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
- } STMT_END
-#endif
-#ifndef SvMAGIC_set
-# define SvMAGIC_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5009003)
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) (0 + SvPVX(sv))
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- ((sv)->sv_u.svu_rv = (val)); } STMT_END
-#endif
-
-#endif
-#ifndef SvSTASH_set
-# define SvSTASH_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5004000)
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
-#if defined(NEED_vnewSVpvf)
-static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-static
-#else
-extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-#endif
-
-#ifdef vnewSVpvf
-# undef vnewSVpvf
-#endif
-#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
-#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
-
-#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
-
-SV *
-DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
-{
- register SV *sv = newSV(0);
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
- return sv;
-}
-
-#endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
-# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
-# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
-#if defined(NEED_sv_catpvf_mg)
-static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
-
-#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
-#if defined(NEED_sv_catpvf_mg_nocontext)
-static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-
-#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
-#ifndef sv_catpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
-# else
-# define sv_catpvf_mg Perl_sv_catpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
-# define sv_vcatpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
-#if defined(NEED_sv_setpvf_mg)
-static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
-
-#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
-#if defined(NEED_sv_setpvf_mg_nocontext)
-static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-
-#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
-#ifndef sv_setpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
-# else
-# define sv_setpvf_mg Perl_sv_setpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
-# define sv_vsetpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-#ifndef newSVpvn_share
-
-#if defined(NEED_newSVpvn_share)
-static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-#endif
-
-#ifdef newSVpvn_share
-# undef newSVpvn_share
-#endif
-#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
-#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
-
-#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
-{
- SV *sv;
- if (len < 0)
- len = -len;
- if (!hash)
- PERL_HASH(hash, (char*) src, len);
- sv = newSVpvn((char *) src, len);
- sv_upgrade(sv, SVt_PVIV);
- SvIVX(sv) = hash;
- SvREADONLY_on(sv);
- SvPOK_on(sv);
- return sv;
-}
-
-#endif
-
-#endif
-#ifndef SvSHARED_HASH
-# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
-#endif
-#ifndef WARN_ALL
-# define WARN_ALL 0
-#endif
-
-#ifndef WARN_CLOSURE
-# define WARN_CLOSURE 1
-#endif
-
-#ifndef WARN_DEPRECATED
-# define WARN_DEPRECATED 2
-#endif
-
-#ifndef WARN_EXITING
-# define WARN_EXITING 3
-#endif
-
-#ifndef WARN_GLOB
-# define WARN_GLOB 4
-#endif
-
-#ifndef WARN_IO
-# define WARN_IO 5
-#endif
-
-#ifndef WARN_CLOSED
-# define WARN_CLOSED 6
-#endif
-
-#ifndef WARN_EXEC
-# define WARN_EXEC 7
-#endif
-
-#ifndef WARN_LAYER
-# define WARN_LAYER 8
-#endif
-
-#ifndef WARN_NEWLINE
-# define WARN_NEWLINE 9
-#endif
-
-#ifndef WARN_PIPE
-# define WARN_PIPE 10
-#endif
-
-#ifndef WARN_UNOPENED
-# define WARN_UNOPENED 11
-#endif
-
-#ifndef WARN_MISC
-# define WARN_MISC 12
-#endif
-
-#ifndef WARN_NUMERIC
-# define WARN_NUMERIC 13
-#endif
-
-#ifndef WARN_ONCE
-# define WARN_ONCE 14
-#endif
-
-#ifndef WARN_OVERFLOW
-# define WARN_OVERFLOW 15
-#endif
-
-#ifndef WARN_PACK
-# define WARN_PACK 16
-#endif
-
-#ifndef WARN_PORTABLE
-# define WARN_PORTABLE 17
-#endif
-
-#ifndef WARN_RECURSION
-# define WARN_RECURSION 18
-#endif
-
-#ifndef WARN_REDEFINE
-# define WARN_REDEFINE 19
-#endif
-
-#ifndef WARN_REGEXP
-# define WARN_REGEXP 20
-#endif
-
-#ifndef WARN_SEVERE
-# define WARN_SEVERE 21
-#endif
-
-#ifndef WARN_DEBUGGING
-# define WARN_DEBUGGING 22
-#endif
-
-#ifndef WARN_INPLACE
-# define WARN_INPLACE 23
-#endif
-
-#ifndef WARN_INTERNAL
-# define WARN_INTERNAL 24
-#endif
-
-#ifndef WARN_MALLOC
-# define WARN_MALLOC 25
-#endif
-
-#ifndef WARN_SIGNAL
-# define WARN_SIGNAL 26
-#endif
-
-#ifndef WARN_SUBSTR
-# define WARN_SUBSTR 27
-#endif
-
-#ifndef WARN_SYNTAX
-# define WARN_SYNTAX 28
-#endif
-
-#ifndef WARN_AMBIGUOUS
-# define WARN_AMBIGUOUS 29
-#endif
-
-#ifndef WARN_BAREWORD
-# define WARN_BAREWORD 30
-#endif
-
-#ifndef WARN_DIGIT
-# define WARN_DIGIT 31
-#endif
-
-#ifndef WARN_PARENTHESIS
-# define WARN_PARENTHESIS 32
-#endif
-
-#ifndef WARN_PRECEDENCE
-# define WARN_PRECEDENCE 33
-#endif
-
-#ifndef WARN_PRINTF
-# define WARN_PRINTF 34
-#endif
-
-#ifndef WARN_PROTOTYPE
-# define WARN_PROTOTYPE 35
-#endif
-
-#ifndef WARN_QW
-# define WARN_QW 36
-#endif
-
-#ifndef WARN_RESERVED
-# define WARN_RESERVED 37
-#endif
-
-#ifndef WARN_SEMICOLON
-# define WARN_SEMICOLON 38
-#endif
-
-#ifndef WARN_TAINT
-# define WARN_TAINT 39
-#endif
-
-#ifndef WARN_THREADS
-# define WARN_THREADS 40
-#endif
-
-#ifndef WARN_UNINITIALIZED
-# define WARN_UNINITIALIZED 41
-#endif
-
-#ifndef WARN_UNPACK
-# define WARN_UNPACK 42
-#endif
-
-#ifndef WARN_UNTIE
-# define WARN_UNTIE 43
-#endif
-
-#ifndef WARN_UTF8
-# define WARN_UTF8 44
-#endif
-
-#ifndef WARN_VOID
-# define WARN_VOID 45
-#endif
-
-#ifndef WARN_ASSERTIONS
-# define WARN_ASSERTIONS 46
-#endif
-#ifndef packWARN
-# define packWARN(a) (a)
-#endif
-
-#ifndef ckWARN
-# ifdef G_WARN_ON
-# define ckWARN(a) (PL_dowarn & G_WARN_ON)
-# else
-# define ckWARN(a) PL_dowarn
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
-#if defined(NEED_warner)
-static void DPPP_(my_warner)(U32 err, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
-#endif
-
-#define Perl_warner DPPP_(my_warner)
-
-#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
-
-void
-DPPP_(my_warner)(U32 err, const char *pat, ...)
-{
- SV *sv;
- va_list args;
-
- PERL_UNUSED_ARG(err);
-
- va_start(args, pat);
- sv = vnewSVpvf(pat, &args);
- va_end(args);
- sv_2mortal(sv);
- warn("%s", SvPV_nolen(sv));
-}
-
-#define warner Perl_warner
-
-#define Perl_warner_nocontext Perl_warner
-
-#endif
-#endif
-
-/* concatenating with "" ensures that only literal strings are accepted as argument
- * note that STR_WITH_LEN() can't be used as argument to macros or functions that
- * under some configurations might be macros
- */
-#ifndef STR_WITH_LEN
-# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
-#endif
-#ifndef newSVpvs
-# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
-#endif
-
-#ifndef newSVpvs_flags
-# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
-#endif
-
-#ifndef sv_catpvs
-# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef sv_setpvs
-# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef hv_fetchs
-# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
-#endif
-
-#ifndef hv_stores
-# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
-#endif
-#ifndef SvGETMAGIC
-# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
-#endif
-#ifndef PERL_MAGIC_sv
-# define PERL_MAGIC_sv '\0'
-#endif
-
-#ifndef PERL_MAGIC_overload
-# define PERL_MAGIC_overload 'A'
-#endif
-
-#ifndef PERL_MAGIC_overload_elem
-# define PERL_MAGIC_overload_elem 'a'
-#endif
-
-#ifndef PERL_MAGIC_overload_table
-# define PERL_MAGIC_overload_table 'c'
-#endif
-
-#ifndef PERL_MAGIC_bm
-# define PERL_MAGIC_bm 'B'
-#endif
-
-#ifndef PERL_MAGIC_regdata
-# define PERL_MAGIC_regdata 'D'
-#endif
-
-#ifndef PERL_MAGIC_regdatum
-# define PERL_MAGIC_regdatum 'd'
-#endif
-
-#ifndef PERL_MAGIC_env
-# define PERL_MAGIC_env 'E'
-#endif
-
-#ifndef PERL_MAGIC_envelem
-# define PERL_MAGIC_envelem 'e'
-#endif
-
-#ifndef PERL_MAGIC_fm
-# define PERL_MAGIC_fm 'f'
-#endif
-
-#ifndef PERL_MAGIC_regex_global
-# define PERL_MAGIC_regex_global 'g'
-#endif
-
-#ifndef PERL_MAGIC_isa
-# define PERL_MAGIC_isa 'I'
-#endif
-
-#ifndef PERL_MAGIC_isaelem
-# define PERL_MAGIC_isaelem 'i'
-#endif
-
-#ifndef PERL_MAGIC_nkeys
-# define PERL_MAGIC_nkeys 'k'
-#endif
-
-#ifndef PERL_MAGIC_dbfile
-# define PERL_MAGIC_dbfile 'L'
-#endif
-
-#ifndef PERL_MAGIC_dbline
-# define PERL_MAGIC_dbline 'l'
-#endif
-
-#ifndef PERL_MAGIC_mutex
-# define PERL_MAGIC_mutex 'm'
-#endif
-
-#ifndef PERL_MAGIC_shared
-# define PERL_MAGIC_shared 'N'
-#endif
-
-#ifndef PERL_MAGIC_shared_scalar
-# define PERL_MAGIC_shared_scalar 'n'
-#endif
-
-#ifndef PERL_MAGIC_collxfrm
-# define PERL_MAGIC_collxfrm 'o'
-#endif
-
-#ifndef PERL_MAGIC_tied
-# define PERL_MAGIC_tied 'P'
-#endif
-
-#ifndef PERL_MAGIC_tiedelem
-# define PERL_MAGIC_tiedelem 'p'
-#endif
-
-#ifndef PERL_MAGIC_tiedscalar
-# define PERL_MAGIC_tiedscalar 'q'
-#endif
-
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
-#endif
-
-#ifndef PERL_MAGIC_sig
-# define PERL_MAGIC_sig 'S'
-#endif
-
-#ifndef PERL_MAGIC_sigelem
-# define PERL_MAGIC_sigelem 's'
-#endif
-
-#ifndef PERL_MAGIC_taint
-# define PERL_MAGIC_taint 't'
-#endif
-
-#ifndef PERL_MAGIC_uvar
-# define PERL_MAGIC_uvar 'U'
-#endif
-
-#ifndef PERL_MAGIC_uvar_elem
-# define PERL_MAGIC_uvar_elem 'u'
-#endif
-
-#ifndef PERL_MAGIC_vstring
-# define PERL_MAGIC_vstring 'V'
-#endif
-
-#ifndef PERL_MAGIC_vec
-# define PERL_MAGIC_vec 'v'
-#endif
-
-#ifndef PERL_MAGIC_utf8
-# define PERL_MAGIC_utf8 'w'
-#endif
-
-#ifndef PERL_MAGIC_substr
-# define PERL_MAGIC_substr 'x'
-#endif
-
-#ifndef PERL_MAGIC_defelem
-# define PERL_MAGIC_defelem 'y'
-#endif
-
-#ifndef PERL_MAGIC_glob
-# define PERL_MAGIC_glob '*'
-#endif
-
-#ifndef PERL_MAGIC_arylen
-# define PERL_MAGIC_arylen '#'
-#endif
-
-#ifndef PERL_MAGIC_pos
-# define PERL_MAGIC_pos '.'
-#endif
-
-#ifndef PERL_MAGIC_backref
-# define PERL_MAGIC_backref '<'
-#endif
-
-#ifndef PERL_MAGIC_ext
-# define PERL_MAGIC_ext '~'
-#endif
-
-/* That's the best we can do... */
-#ifndef sv_catpvn_nomg
-# define sv_catpvn_nomg sv_catpvn
-#endif
-
-#ifndef sv_catsv_nomg
-# define sv_catsv_nomg sv_catsv
-#endif
-
-#ifndef sv_setsv_nomg
-# define sv_setsv_nomg sv_setsv
-#endif
-
-#ifndef sv_pvn_nomg
-# define sv_pvn_nomg sv_pvn
-#endif
-
-#ifndef SvIV_nomg
-# define SvIV_nomg SvIV
-#endif
-
-#ifndef SvUV_nomg
-# define SvUV_nomg SvUV
-#endif
-
-#ifndef sv_catpv_mg
-# define sv_catpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catpvn_mg
-# define sv_catpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catsv_mg
-# define sv_catsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_catsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setiv_mg
-# define sv_setiv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setiv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setnv_mg
-# define sv_setnv_mg(sv, num) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setnv(TeMpSv,num); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpv_mg
-# define sv_setpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpvn_mg
-# define sv_setpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setsv_mg
-# define sv_setsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_setsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setuv_mg
-# define sv_setuv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setuv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_usepvn_mg
-# define sv_usepvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_usepvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-#ifndef SvVSTRING_mg
-# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
-#endif
-
-/* Hint: sv_magic_portable
- * This is a compatibility function that is only available with
- * Devel::PPPort. It is NOT in the perl core.
- * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
- * it is being passed a name pointer with namlen == 0. In that
- * case, perl 5.8.0 and later store the pointer, not a copy of it.
- * The compatibility can be provided back to perl 5.004. With
- * earlier versions, the code will not compile.
- */
-
-#if (PERL_BCDVERSION < 0x5004000)
-
- /* code that uses sv_magic_portable will not compile */
-
-#elif (PERL_BCDVERSION < 0x5008000)
-
-# define sv_magic_portable(sv, obj, how, name, namlen) \
- STMT_START { \
- SV *SvMp_sv = (sv); \
- char *SvMp_name = (char *) (name); \
- I32 SvMp_namlen = (namlen); \
- if (SvMp_name && SvMp_namlen == 0) \
- { \
- MAGIC *mg; \
- sv_magic(SvMp_sv, obj, how, 0, 0); \
- mg = SvMAGIC(SvMp_sv); \
- mg->mg_len = -42; /* XXX: this is the tricky part */ \
- mg->mg_ptr = SvMp_name; \
- } \
- else \
- { \
- sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
- } \
- } STMT_END
-
-#else
-
-# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
-
-#endif
-
-#ifdef USE_ITHREADS
-#ifndef CopFILE
-# define CopFILE(c) ((c)->cop_file)
-#endif
-
-#ifndef CopFILEGV
-# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) ((c)->cop_stashpv)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
- || (CopSTASHPV(c) && HvNAME(hv) \
- && strEQ(CopSTASHPV(c), HvNAME(hv)))))
-#endif
-
-#else
-#ifndef CopFILEGV
-# define CopFILEGV(c) ((c)->cop_filegv)
-#endif
-
-#ifndef CopFILEGV_set
-# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
-#endif
-
-#ifndef CopFILE
-# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) ((c)->cop_stash)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
-#endif
-
-#endif /* USE_ITHREADS */
-#ifndef IN_PERL_COMPILETIME
-# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
-#endif
-
-#ifndef IN_LOCALE_RUNTIME
-# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE_COMPILETIME
-# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE
-# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-#endif
-#ifndef IS_NUMBER_IN_UV
-# define IS_NUMBER_IN_UV 0x01
-#endif
-
-#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
-# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef IS_NUMBER_NOT_INT
-# define IS_NUMBER_NOT_INT 0x04
-#endif
-
-#ifndef IS_NUMBER_NEG
-# define IS_NUMBER_NEG 0x08
-#endif
-
-#ifndef IS_NUMBER_INFINITY
-# define IS_NUMBER_INFINITY 0x10
-#endif
-
-#ifndef IS_NUMBER_NAN
-# define IS_NUMBER_NAN 0x20
-#endif
-#ifndef GROK_NUMERIC_RADIX
-# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
-#endif
-#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
-# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef PERL_SCAN_SILENT_ILLDIGIT
-# define PERL_SCAN_SILENT_ILLDIGIT 0x04
-#endif
-
-#ifndef PERL_SCAN_ALLOW_UNDERSCORES
-# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
-#endif
-
-#ifndef PERL_SCAN_DISALLOW_PREFIX
-# define PERL_SCAN_DISALLOW_PREFIX 0x02
-#endif
-
-#ifndef grok_numeric_radix
-#if defined(NEED_grok_numeric_radix)
-static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-static
-#else
-extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-#endif
-
-#ifdef grok_numeric_radix
-# undef grok_numeric_radix
-#endif
-#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
-#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
-
-#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
-bool
-DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
-{
-#ifdef USE_LOCALE_NUMERIC
-#ifdef PL_numeric_radix_sv
- if (PL_numeric_radix_sv && IN_LOCALE) {
- STRLEN len;
- char* radix = SvPV(PL_numeric_radix_sv, len);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#else
- /* older perls don't have PL_numeric_radix_sv so the radix
- * must manually be requested from locale.h
- */
-#include
- dTHR; /* needed for older threaded perls */
- struct lconv *lc = localeconv();
- char *radix = lc->decimal_point;
- if (radix && IN_LOCALE) {
- STRLEN len = strlen(radix);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#endif
-#endif /* USE_LOCALE_NUMERIC */
- /* always try "." if numeric radix didn't match because
- * we may have data from different locales mixed */
- if (*sp < send && **sp == '.') {
- ++*sp;
- return TRUE;
- }
- return FALSE;
-}
-#endif
-#endif
-
-#ifndef grok_number
-#if defined(NEED_grok_number)
-static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-static
-#else
-extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-#endif
-
-#ifdef grok_number
-# undef grok_number
-#endif
-#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
-#define Perl_grok_number DPPP_(my_grok_number)
-
-#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
-int
-DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
-{
- const char *s = pv;
- const char *send = pv + len;
- const UV max_div_10 = UV_MAX / 10;
- const char max_mod_10 = UV_MAX % 10;
- int numtype = 0;
- int sawinf = 0;
- int sawnan = 0;
-
- while (s < send && isSPACE(*s))
- s++;
- if (s == send) {
- return 0;
- } else if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
- if (s == send)
- return 0;
-
- /* next must be digit or the radix separator or beginning of infinity */
- if (isDIGIT(*s)) {
- /* UVs are at least 32 bits, so the first 9 decimal digits cannot
- overflow. */
- UV value = *s - '0';
- /* This construction seems to be more optimiser friendly.
- (without it gcc does the isDIGIT test and the *s - '0' separately)
- With it gcc on arm is managing 6 instructions (6 cycles) per digit.
- In theory the optimiser could deduce how far to unroll the loop
- before checking for overflow. */
- if (++s < send) {
- int digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- /* Now got 9 digits, so need to check
- each time for overflow. */
- digit = *s - '0';
- while (digit >= 0 && digit <= 9
- && (value < max_div_10
- || (value == max_div_10
- && digit <= max_mod_10))) {
- value = value * 10 + digit;
- if (++s < send)
- digit = *s - '0';
- else
- break;
- }
- if (digit >= 0 && digit <= 9
- && (s < send)) {
- /* value overflowed.
- skip the remaining digits, don't
- worry about setting *valuep. */
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- numtype |=
- IS_NUMBER_GREATER_THAN_UV_MAX;
- goto skip_value;
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- numtype |= IS_NUMBER_IN_UV;
- if (valuep)
- *valuep = value;
-
- skip_value:
- if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT;
- while (s < send && isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
- /* no digits before the radix means we need digits after it */
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- if (valuep) {
- /* integer approximation is valid - it's 0. */
- *valuep = 0;
- }
- }
- else
- return 0;
- } else if (*s == 'I' || *s == 'i') {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
- s++; if (s < send && (*s == 'I' || *s == 'i')) {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
- s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
- s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
- s++;
- }
- sawinf = 1;
- } else if (*s == 'N' || *s == 'n') {
- /* XXX TODO: There are signaling NaNs and quiet NaNs. */
- s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++;
- sawnan = 1;
- } else
- return 0;
-
- if (sawinf) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
- } else if (sawnan) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
- } else if (s < send) {
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- /* The only flag we keep is sign. Blow away any "it's UV" */
- numtype &= IS_NUMBER_NEG;
- numtype |= IS_NUMBER_NOT_INT;
- s++;
- if (s < send && (*s == '-' || *s == '+'))
- s++;
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- }
- else
- return 0;
- }
- }
- while (s < send && isSPACE(*s))
- s++;
- if (s >= send)
- return numtype;
- if (len == 10 && memEQ(pv, "0 but true", 10)) {
- if (valuep)
- *valuep = 0;
- return IS_NUMBER_IN_UV;
- }
- return 0;
-}
-#endif
-#endif
-
-/*
- * The grok_* routines have been modified to use warn() instead of
- * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
- * which is why the stack variable has been renamed to 'xdigit'.
- */
-
-#ifndef grok_bin
-#if defined(NEED_grok_bin)
-static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_bin
-# undef grok_bin
-#endif
-#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
-#define Perl_grok_bin DPPP_(my_grok_bin)
-
-#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
-UV
-DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_2 = UV_MAX / 2;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading b or 0b.
- for compatibility silently suffer "b" and "0b" as valid binary
- numbers. */
- if (len >= 1) {
- if (s[0] == 'b') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- char bit = *s;
- if (bit == '0' || bit == '1') {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_bin. */
- redo:
- if (!overflowed) {
- if (value <= max_div_2) {
- value = (value << 1) | (bit - '0');
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in binary number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 2.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount. */
- value_nv += (NV)(bit - '0');
- continue;
- }
- if (bit == '_' && len && allow_underscores && (bit = s[1])
- && (bit == '0' || bit == '1'))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal binary digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Binary number > 0b11111111111111111111111111111111 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_hex
-#if defined(NEED_grok_hex)
-static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_hex
-# undef grok_hex
-#endif
-#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
-#define Perl_grok_hex DPPP_(my_grok_hex)
-
-#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
-UV
-DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_16 = UV_MAX / 16;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
- const char *xdigit;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading x or 0x.
- for compatibility silently suffer "x" and "0x" as valid hex numbers.
- */
- if (len >= 1) {
- if (s[0] == 'x') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- xdigit = strchr((char *) PL_hexdigit, *s);
- if (xdigit) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_hex. */
- redo:
- if (!overflowed) {
- if (value <= max_div_16) {
- value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
- continue;
- }
- warn("Integer overflow in hexadecimal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 16.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 16-tuples. */
- value_nv += (NV)((xdigit - PL_hexdigit) & 15);
- continue;
- }
- if (*s == '_' && len && allow_underscores && s[1]
- && (xdigit = strchr((char *) PL_hexdigit, s[1])))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal hexadecimal digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Hexadecimal number > 0xffffffff non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_oct
-#if defined(NEED_grok_oct)
-static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_oct
-# undef grok_oct
-#endif
-#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
-#define Perl_grok_oct DPPP_(my_grok_oct)
-
-#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
-UV
-DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_8 = UV_MAX / 8;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- for (; len-- && *s; s++) {
- /* gcc 2.95 optimiser not smart enough to figure that this subtraction
- out front allows slicker code. */
- int digit = *s - '0';
- if (digit >= 0 && digit <= 7) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- */
- redo:
- if (!overflowed) {
- if (value <= max_div_8) {
- value = (value << 3) | digit;
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in octal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 8.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 8-tuples. */
- value_nv += (NV)digit;
- continue;
- }
- if (digit == ('_' - '0') && len && allow_underscores
- && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
- {
- --len;
- ++s;
- goto redo;
- }
- /* Allow \octal to work the DWIM way (that is, stop scanning
- * as soon as non-octal characters are seen, complain only iff
- * someone seems to want to use the digits eight and nine). */
- if (digit == 8 || digit == 9) {
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal octal digit '%c' ignored", *s);
- }
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Octal number > 037777777777 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#if !defined(my_snprintf)
-#if defined(NEED_my_snprintf)
-static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-static
-#else
-extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-#endif
-
-#define my_snprintf DPPP_(my_my_snprintf)
-#define Perl_my_snprintf DPPP_(my_my_snprintf)
-
-#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
-
-int
-DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
-{
- dTHX;
- int retval;
- va_list ap;
- va_start(ap, format);
-#ifdef HAS_VSNPRINTF
- retval = vsnprintf(buffer, len, format, ap);
-#else
- retval = vsprintf(buffer, format, ap);
-#endif
- va_end(ap);
- if (retval < 0 || (len > 0 && (Size_t)retval >= len))
- Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
- return retval;
-}
-
-#endif
-#endif
-
-#if !defined(my_sprintf)
-#if defined(NEED_my_sprintf)
-static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-static
-#else
-extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-#endif
-
-#define my_sprintf DPPP_(my_my_sprintf)
-#define Perl_my_sprintf DPPP_(my_my_sprintf)
-
-#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
-
-int
-DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
-{
- va_list args;
- va_start(args, pat);
- vsprintf(buffer, pat, args);
- va_end(args);
- return strlen(buffer);
-}
-
-#endif
-#endif
-
-#ifdef NO_XSLOCKS
-# ifdef dJMPENV
-# define dXCPT dJMPENV; int rEtV = 0
-# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
-# define XCPT_TRY_END JMPENV_POP;
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW JMPENV_JUMP(rEtV)
-# else
-# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
-# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
-# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
-# endif
-#endif
-
-#if !defined(my_strlcat)
-#if defined(NEED_my_strlcat)
-static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcat DPPP_(my_my_strlcat)
-#define Perl_my_strlcat DPPP_(my_my_strlcat)
-
-#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
-{
- Size_t used, length, copy;
-
- used = strlen(dst);
- length = strlen(src);
- if (size > 0 && used < size - 1) {
- copy = (length >= size - used) ? size - used - 1 : length;
- memcpy(dst + used, src, copy);
- dst[used + copy] = '\0';
- }
- return used + length;
-}
-#endif
-#endif
-
-#if !defined(my_strlcpy)
-#if defined(NEED_my_strlcpy)
-static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcpy DPPP_(my_my_strlcpy)
-#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
-
-#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
-{
- Size_t length, copy;
-
- length = strlen(src);
- if (size > 0) {
- copy = (length >= size) ? size - 1 : length;
- memcpy(dst, src, copy);
- dst[copy] = '\0';
- }
- return length;
-}
-
-#endif
-#endif
-#ifndef PERL_PV_ESCAPE_QUOTE
-# define PERL_PV_ESCAPE_QUOTE 0x0001
-#endif
-
-#ifndef PERL_PV_PRETTY_QUOTE
-# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_ELLIPSES
-# define PERL_PV_PRETTY_ELLIPSES 0x0002
-#endif
-
-#ifndef PERL_PV_PRETTY_LTGT
-# define PERL_PV_PRETTY_LTGT 0x0004
-#endif
-
-#ifndef PERL_PV_ESCAPE_FIRSTCHAR
-# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI
-# define PERL_PV_ESCAPE_UNI 0x0100
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI_DETECT
-# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
-#endif
-
-#ifndef PERL_PV_ESCAPE_ALL
-# define PERL_PV_ESCAPE_ALL 0x1000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOBACKSLASH
-# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOCLEAR
-# define PERL_PV_ESCAPE_NOCLEAR 0x4000
-#endif
-
-#ifndef PERL_PV_ESCAPE_RE
-# define PERL_PV_ESCAPE_RE 0x8000
-#endif
-
-#ifndef PERL_PV_PRETTY_NOCLEAR
-# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
-#endif
-#ifndef PERL_PV_PRETTY_DUMP
-# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_REGPROP
-# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
-#endif
-
-/* Hint: pv_escape
- * Note that unicode functionality is only backported to
- * those perl versions that support it. For older perl
- * versions, the implementation will fall back to bytes.
- */
-
-#ifndef pv_escape
-#if defined(NEED_pv_escape)
-static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-#endif
-
-#ifdef pv_escape
-# undef pv_escape
-#endif
-#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
-#define Perl_pv_escape DPPP_(my_pv_escape)
-
-#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
-
-char *
-DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
- const STRLEN count, const STRLEN max,
- STRLEN * const escaped, const U32 flags)
-{
- const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
- const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
- char octbuf[32] = "%123456789ABCDF";
- STRLEN wrote = 0;
- STRLEN chsize = 0;
- STRLEN readsize = 1;
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
-#endif
- const char *pv = str;
- const char * const end = pv + count;
- octbuf[0] = esc;
-
- if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
- sv_setpvs(dsv, "");
-
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
- isuni = 1;
-#endif
-
- for (; pv < end && (!max || wrote < max) ; pv += readsize) {
- const UV u =
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
-#endif
- (U8)*pv;
- const U8 c = (U8)u & 0xFF;
-
- if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%"UVxf, u);
- else
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%cx{%"UVxf"}", esc, u);
- } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
- chsize = 1;
- } else {
- if (c == dq || c == esc || !isPRINT(c)) {
- chsize = 2;
- switch (c) {
- case '\\' : /* fallthrough */
- case '%' : if (c == esc)
- octbuf[1] = esc;
- else
- chsize = 1;
- break;
- case '\v' : octbuf[1] = 'v'; break;
- case '\t' : octbuf[1] = 't'; break;
- case '\r' : octbuf[1] = 'r'; break;
- case '\n' : octbuf[1] = 'n'; break;
- case '\f' : octbuf[1] = 'f'; break;
- case '"' : if (dq == '"')
- octbuf[1] = '"';
- else
- chsize = 1;
- break;
- default: chsize = my_snprintf(octbuf, sizeof octbuf,
- pv < end && isDIGIT((U8)*(pv+readsize))
- ? "%c%03o" : "%c%o", esc, c);
- }
- } else {
- chsize = 1;
- }
- }
- if (max && wrote + chsize > max) {
- break;
- } else if (chsize > 1) {
- sv_catpvn(dsv, octbuf, chsize);
- wrote += chsize;
- } else {
- char tmp[2];
- my_snprintf(tmp, sizeof tmp, "%c", c);
- sv_catpvn(dsv, tmp, 1);
- wrote++;
- }
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- break;
- }
- if (escaped != NULL)
- *escaped= pv - str;
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_pretty
-#if defined(NEED_pv_pretty)
-static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-#endif
-
-#ifdef pv_pretty
-# undef pv_pretty
-#endif
-#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
-#define Perl_pv_pretty DPPP_(my_pv_pretty)
-
-#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
-
-char *
-DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
- const STRLEN max, char const * const start_color, char const * const end_color,
- const U32 flags)
-{
- const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
- STRLEN escaped;
-
- if (!(flags & PERL_PV_PRETTY_NOCLEAR))
- sv_setpvs(dsv, "");
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, "<");
-
- if (start_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
-
- pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
-
- if (end_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, ">");
-
- if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
- sv_catpvs(dsv, "...");
-
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_display
-#if defined(NEED_pv_display)
-static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-static
-#else
-extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-#endif
-
-#ifdef pv_display
-# undef pv_display
-#endif
-#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
-#define Perl_pv_display DPPP_(my_pv_display)
-
-#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
-
-char *
-DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
-{
- pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
- if (len > cur && pv[cur] == '\0')
- sv_catpvs(dsv, "\\0");
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#endif /* _P_P_PORTABILITY_H_ */
-
-/* End of File ppport.h */
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version 3.17
+
+ Automatically created by Devel::PPPort running under perl 5.008008.
+
+ Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
+ includes in parts/inc/ instead.
+
+ Use 'perldoc ppport.h' to view the documentation below.
+
+----------------------------------------------------------------------
+
+SKIP
+
+=pod
+
+=head1 NAME
+
+ppport.h - Perl/Pollution/Portability version 3.17
+
+=head1 SYNOPSIS
+
+ perl ppport.h [options] [source files]
+
+ Searches current directory for files if no [source files] are given
+
+ --help show short help
+
+ --version show version
+
+ --patch=file write one patch file with changes
+ --copy=suffix write changed copies with suffix
+ --diff=program use diff program and options
+
+ --compat-version=version provide compatibility with Perl version
+ --cplusplus accept C++ comments
+
+ --quiet don't output anything except fatal errors
+ --nodiag don't show diagnostics
+ --nohints don't show hints
+ --nochanges don't suggest changes
+ --nofilter don't filter input files
+
+ --strip strip all script and doc functionality from
+ ppport.h
+
+ --list-provided list provided API
+ --list-unsupported list unsupported API
+ --api-info=name show Perl API portability information
+
+=head1 COMPATIBILITY
+
+This version of F is designed to support operation with Perl
+installations back to 5.003, and has been tested up to 5.10.0.
+
+=head1 OPTIONS
+
+=head2 --help
+
+Display a brief usage summary.
+
+=head2 --version
+
+Display the version of F.
+
+=head2 --patch=I
+
+If this option is given, a single patch file will be created if
+any changes are suggested. This requires a working diff program
+to be installed on your system.
+
+=head2 --copy=I
+
+If this option is given, a copy of each file will be saved with
+the given suffix that contains the suggested changes. This does
+not require any external programs. Note that this does not
+automagially add a dot between the original filename and the
+suffix. If you want the dot, you have to include it in the option
+argument.
+
+If neither C<--patch> or C<--copy> are given, the default is to
+simply print the diffs for each file. This requires either
+C or a C program to be installed.
+
+=head2 --diff=I
+
+Manually set the diff program and options to use. The default
+is to use C, when installed, and output unified
+context diffs.
+
+=head2 --compat-version=I
+
+Tell F to check for compatibility with the given
+Perl version. The default is to check for compatibility with Perl
+version 5.003. You can use this option to reduce the output
+of F if you intend to be backward compatible only
+down to a certain Perl version.
+
+=head2 --cplusplus
+
+Usually, F will detect C++ style comments and
+replace them with C style comments for portability reasons.
+Using this option instructs F to leave C++
+comments untouched.
+
+=head2 --quiet
+
+Be quiet. Don't print anything except fatal errors.
+
+=head2 --nodiag
+
+Don't output any diagnostic messages. Only portability
+alerts will be printed.
+
+=head2 --nohints
+
+Don't output any hints. Hints often contain useful portability
+notes. Warnings will still be displayed.
+
+=head2 --nochanges
+
+Don't suggest any changes. Only give diagnostic output and hints
+unless these are also deactivated.
+
+=head2 --nofilter
+
+Don't filter the list of input files. By default, files not looking
+like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
+
+=head2 --strip
+
+Strip all script and documentation functionality from F.
+This reduces the size of F dramatically and may be useful
+if you want to include F in smaller modules without
+increasing their distribution size too much.
+
+The stripped F will have a C<--unstrip> option that allows
+you to undo the stripping, but only if an appropriate C
+module is installed.
+
+=head2 --list-provided
+
+Lists the API elements for which compatibility is provided by
+F. Also lists if it must be explicitly requested,
+if it has dependencies, and if there are hints or warnings for it.
+
+=head2 --list-unsupported
+
+Lists the API elements that are known not to be supported by
+F and below which version of Perl they probably
+won't be available or work.
+
+=head2 --api-info=I
+
+Show portability information for API elements matching I.
+If I is surrounded by slashes, it is interpreted as a regular
+expression.
+
+=head1 DESCRIPTION
+
+In order for a Perl extension (XS) module to be as portable as possible
+across differing versions of Perl itself, certain steps need to be taken.
+
+=over 4
+
+=item *
+
+Including this header is the first major one. This alone will give you
+access to a large part of the Perl API that hasn't been available in
+earlier Perl releases. Use
+
+ perl ppport.h --list-provided
+
+to see which API elements are provided by ppport.h.
+
+=item *
+
+You should avoid using deprecated parts of the API. For example, using
+global Perl variables without the C prefix is deprecated. Also,
+some API functions used to have a C prefix. Using this form is
+also deprecated. You can safely use the supported API, as F
+will provide wrappers for older Perl versions.
+
+=item *
+
+If you use one of a few functions or variables that were not present in
+earlier versions of Perl, and that can't be provided using a macro, you
+have to explicitly request support for these functions by adding one or
+more C<#define>s in your source code before the inclusion of F.
+
+These functions or variables will be marked C in the list shown
+by C<--list-provided>.
+
+Depending on whether you module has a single or multiple files that
+use such functions or variables, you want either C or global
+variants.
+
+For a C function or variable (used only in a single source
+file), use:
+
+ #define NEED_function
+ #define NEED_variable
+
+For a global function or variable (used in multiple source files),
+use:
+
+ #define NEED_function_GLOBAL
+ #define NEED_variable_GLOBAL
+
+Note that you mustn't have more than one global request for the
+same function or variable in your project.
+
+ Function / Variable Static Request Global Request
+ -----------------------------------------------------------------------------------------
+ PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
+ PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
+ eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+ grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+ grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+ grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+ grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+ grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+ load_module() NEED_load_module NEED_load_module_GLOBAL
+ my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
+ my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
+ my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
+ my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+ newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
+ newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
+ pv_display() NEED_pv_display NEED_pv_display_GLOBAL
+ pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
+ pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
+ sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
+ sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+ sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+ sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+ sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
+ sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+ sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+ vload_module() NEED_vload_module NEED_vload_module_GLOBAL
+ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
+ warner() NEED_warner NEED_warner_GLOBAL
+
+To avoid namespace conflicts, you can change the namespace of the
+explicitly exported functions / variables using the C
+macro. Just C<#define> the macro before including C:
+
+ #define DPPP_NAMESPACE MyOwnNamespace_
+ #include "ppport.h"
+
+The default namespace is C.
+
+=back
+
+The good thing is that most of the above can be checked by running
+F on your source code. See the next section for
+details.
+
+=head1 EXAMPLES
+
+To verify whether F is needed for your module, whether you
+should make any changes to your code, and whether any special defines
+should be used, F can be run as a Perl script to check your
+source code. Simply say:
+
+ perl ppport.h
+
+The result will usually be a list of patches suggesting changes
+that should at least be acceptable, if not necessarily the most
+efficient solution, or a fix for all possible problems.
+
+If you know that your XS module uses features only available in
+newer Perl releases, if you're aware that it uses C++ comments,
+and if you want all suggestions as a single patch file, you could
+use something like this:
+
+ perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
+
+If you only want your code to be scanned without any suggestions
+for changes, use:
+
+ perl ppport.h --nochanges
+
+You can specify a different C program or options, using
+the C<--diff> option:
+
+ perl ppport.h --diff='diff -C 10'
+
+This would output context diffs with 10 lines of context.
+
+If you want to create patched copies of your files instead, use:
+
+ perl ppport.h --copy=.new
+
+To display portability information for the C function,
+use:
+
+ perl ppport.h --api-info=newSVpvn
+
+Since the argument to C<--api-info> can be a regular expression,
+you can use
+
+ perl ppport.h --api-info=/_nomg$/
+
+to display portability information for all C<_nomg> functions or
+
+ perl ppport.h --api-info=/./
+
+to display information for all known API elements.
+
+=head1 BUGS
+
+If this version of F is causing failure during
+the compilation of this module, please check if newer versions
+of either this module or C are available on CPAN
+before sending a bug report.
+
+If F was generated using the latest version of
+C and is causing failure of this module, please
+file a bug report using the CPAN Request Tracker at L.
+
+Please include the following information:
+
+=over 4
+
+=item 1.
+
+The complete output from running "perl -V"
+
+=item 2.
+
+This file.
+
+=item 3.
+
+The name and version of the module you were trying to build.
+
+=item 4.
+
+A full log of the build that failed.
+
+=item 5.
+
+Any other information that you think could be relevant.
+
+=back
+
+For the latest version of this code, please get the C
+module from CPAN.
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
+
+Version 2.x, Copyright (C) 2001, Paul Marquess.
+
+Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L.
+
+=cut
+
+use strict;
+
+# Disable broken TRIE-optimization
+BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
+
+my $VERSION = 3.17;
+
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+ filter => 1,
+ strip => 0,
+ version => 0,
+);
+
+my($ppport) = $0 =~ /([\w.]+)$/;
+my $LF = '(?:\r\n|[\r\n])'; # line feed
+my $HS = "[ \t]"; # horizontal whitespace
+
+# Never use C comments in this file!
+my $ccs = '/'.'*';
+my $cce = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+
+eval {
+ require Getopt::Long;
+ Getopt::Long::GetOptions(\%opt, qw(
+ help quiet diag! filter! hints! changes! cplusplus strip version
+ patch=s copy=s diff=s compat-version=s
+ list-provided list-unsupported api-info=s
+ )) or usage();
+};
+
+if ($@ and grep /^-/, @ARGV) {
+ usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
+ die "Getopt::Long not found. Please don't use any options.\n";
+}
+
+if ($opt{version}) {
+ print "This is $0 $VERSION.\n";
+ exit 0;
+}
+
+usage() if $opt{help};
+strip() if $opt{strip};
+
+if (exists $opt{'compat-version'}) {
+ my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
+ if ($@) {
+ die "Invalid version number format: '$opt{'compat-version'}'\n";
+ }
+ die "Only Perl 5 is supported\n" if $r != 5;
+ die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
+ $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
+}
+else {
+ $opt{'compat-version'} = 5;
+}
+
+my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
+ ? ( $1 => {
+ ($2 ? ( base => $2 ) : ()),
+ ($3 ? ( todo => $3 ) : ()),
+ (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
+ (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
+ (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
+ } )
+ : die "invalid spec: $_" } qw(
+AvFILLp|5.004050||p
+AvFILL|||
+CLASS|||n
+CPERLscope|5.005000||p
+CX_CURPAD_SAVE|||
+CX_CURPAD_SV|||
+CopFILEAV|5.006000||p
+CopFILEGV_set|5.006000||p
+CopFILEGV|5.006000||p
+CopFILESV|5.006000||p
+CopFILE_set|5.006000||p
+CopFILE|5.006000||p
+CopSTASHPV_set|5.006000||p
+CopSTASHPV|5.006000||p
+CopSTASH_eq|5.006000||p
+CopSTASH_set|5.006000||p
+CopSTASH|5.006000||p
+CopyD|5.009002||p
+Copy|||
+CvPADLIST|||
+CvSTASH|||
+CvWEAKOUTSIDE|||
+DEFSV_set|5.011000||p
+DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+EXTERN_C|5.005000||p
+F0convert|||n
+FREETMPS|||
+GIMME_V||5.004000|n
+GIMME|||n
+GROK_NUMERIC_RADIX|5.007002||p
+G_ARRAY|||
+G_DISCARD|||
+G_EVAL|||
+G_METHOD|5.006001||p
+G_NOARGS|||
+G_SCALAR|||
+G_VOID||5.004000|
+GetVars|||
+GvSV|||
+Gv_AMupdate|||
+HEf_SVKEY||5.004000|
+HeHASH||5.004000|
+HeKEY||5.004000|
+HeKLEN||5.004000|
+HePV||5.004000|
+HeSVKEY_force||5.004000|
+HeSVKEY_set||5.004000|
+HeSVKEY||5.004000|
+HeUTF8||5.011000|
+HeVAL||5.004000|
+HvNAME|||
+INT2PTR|5.006000||p
+IN_LOCALE_COMPILETIME|5.007002||p
+IN_LOCALE_RUNTIME|5.007002||p
+IN_LOCALE|5.007002||p
+IN_PERL_COMPILETIME|5.008001||p
+IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
+IS_NUMBER_INFINITY|5.007002||p
+IS_NUMBER_IN_UV|5.007002||p
+IS_NUMBER_NAN|5.007003||p
+IS_NUMBER_NEG|5.007002||p
+IS_NUMBER_NOT_INT|5.007002||p
+IVSIZE|5.006000||p
+IVTYPE|5.006000||p
+IVdf|5.006000||p
+LEAVE|||
+LVRET|||
+MARK|||
+MULTICALL||5.011000|
+MY_CXT_CLONE|5.009002||p
+MY_CXT_INIT|5.007003||p
+MY_CXT|5.007003||p
+MoveD|5.009002||p
+Move|||
+NOOP|5.005000||p
+NUM2PTR|5.006000||p
+NVTYPE|5.006000||p
+NVef|5.006001||p
+NVff|5.006001||p
+NVgf|5.006001||p
+Newxc|5.009003||p
+Newxz|5.009003||p
+Newx|5.009003||p
+Nullav|||
+Nullch|||
+Nullcv|||
+Nullhv|||
+Nullsv|||
+ORIGMARK|||
+PAD_BASE_SV|||
+PAD_CLONE_VARS|||
+PAD_COMPNAME_FLAGS|||
+PAD_COMPNAME_GEN_set|||
+PAD_COMPNAME_GEN|||
+PAD_COMPNAME_OURSTASH|||
+PAD_COMPNAME_PV|||
+PAD_COMPNAME_TYPE|||
+PAD_DUP|||
+PAD_RESTORE_LOCAL|||
+PAD_SAVE_LOCAL|||
+PAD_SAVE_SETNULLPAD|||
+PAD_SETSV|||
+PAD_SET_CUR_NOSAVE|||
+PAD_SET_CUR|||
+PAD_SVl|||
+PAD_SV|||
+PERLIO_FUNCS_CAST|5.009003||p
+PERLIO_FUNCS_DECL|5.009003||p
+PERL_ABS|5.008001||p
+PERL_BCDVERSION|5.011000||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
+PERL_HASH|5.004000||p
+PERL_INT_MAX|5.004000||p
+PERL_INT_MIN|5.004000||p
+PERL_LONG_MAX|5.004000||p
+PERL_LONG_MIN|5.004000||p
+PERL_MAGIC_arylen|5.007002||p
+PERL_MAGIC_backref|5.007002||p
+PERL_MAGIC_bm|5.007002||p
+PERL_MAGIC_collxfrm|5.007002||p
+PERL_MAGIC_dbfile|5.007002||p
+PERL_MAGIC_dbline|5.007002||p
+PERL_MAGIC_defelem|5.007002||p
+PERL_MAGIC_envelem|5.007002||p
+PERL_MAGIC_env|5.007002||p
+PERL_MAGIC_ext|5.007002||p
+PERL_MAGIC_fm|5.007002||p
+PERL_MAGIC_glob|5.011000||p
+PERL_MAGIC_isaelem|5.007002||p
+PERL_MAGIC_isa|5.007002||p
+PERL_MAGIC_mutex|5.011000||p
+PERL_MAGIC_nkeys|5.007002||p
+PERL_MAGIC_overload_elem|5.007002||p
+PERL_MAGIC_overload_table|5.007002||p
+PERL_MAGIC_overload|5.007002||p
+PERL_MAGIC_pos|5.007002||p
+PERL_MAGIC_qr|5.007002||p
+PERL_MAGIC_regdata|5.007002||p
+PERL_MAGIC_regdatum|5.007002||p
+PERL_MAGIC_regex_global|5.007002||p
+PERL_MAGIC_shared_scalar|5.007003||p
+PERL_MAGIC_shared|5.007003||p
+PERL_MAGIC_sigelem|5.007002||p
+PERL_MAGIC_sig|5.007002||p
+PERL_MAGIC_substr|5.007002||p
+PERL_MAGIC_sv|5.007002||p
+PERL_MAGIC_taint|5.007002||p
+PERL_MAGIC_tiedelem|5.007002||p
+PERL_MAGIC_tiedscalar|5.007002||p
+PERL_MAGIC_tied|5.007002||p
+PERL_MAGIC_utf8|5.008001||p
+PERL_MAGIC_uvar_elem|5.007003||p
+PERL_MAGIC_uvar|5.007002||p
+PERL_MAGIC_vec|5.007002||p
+PERL_MAGIC_vstring|5.008001||p
+PERL_PV_ESCAPE_ALL|5.009004||p
+PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
+PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
+PERL_PV_ESCAPE_NOCLEAR|5.009004||p
+PERL_PV_ESCAPE_QUOTE|5.009004||p
+PERL_PV_ESCAPE_RE|5.009005||p
+PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
+PERL_PV_ESCAPE_UNI|5.009004||p
+PERL_PV_PRETTY_DUMP|5.009004||p
+PERL_PV_PRETTY_ELLIPSES|5.010000||p
+PERL_PV_PRETTY_LTGT|5.009004||p
+PERL_PV_PRETTY_NOCLEAR|5.010000||p
+PERL_PV_PRETTY_QUOTE|5.009004||p
+PERL_PV_PRETTY_REGPROP|5.009004||p
+PERL_QUAD_MAX|5.004000||p
+PERL_QUAD_MIN|5.004000||p
+PERL_REVISION|5.006000||p
+PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
+PERL_SCAN_DISALLOW_PREFIX|5.007003||p
+PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
+PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
+PERL_SHORT_MAX|5.004000||p
+PERL_SHORT_MIN|5.004000||p
+PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
+PERL_SUBVERSION|5.006000||p
+PERL_UCHAR_MAX|5.004000||p
+PERL_UCHAR_MIN|5.004000||p
+PERL_UINT_MAX|5.004000||p
+PERL_UINT_MIN|5.004000||p
+PERL_ULONG_MAX|5.004000||p
+PERL_ULONG_MIN|5.004000||p
+PERL_UNUSED_ARG|5.009003||p
+PERL_UNUSED_CONTEXT|5.009004||p
+PERL_UNUSED_DECL|5.007002||p
+PERL_UNUSED_VAR|5.007002||p
+PERL_UQUAD_MAX|5.004000||p
+PERL_UQUAD_MIN|5.004000||p
+PERL_USE_GCC_BRACE_GROUPS|5.009004||p
+PERL_USHORT_MAX|5.004000||p
+PERL_USHORT_MIN|5.004000||p
+PERL_VERSION|5.006000||p
+PL_DBsignal|5.005000||p
+PL_DBsingle|||pn
+PL_DBsub|||pn
+PL_DBtrace|||pn
+PL_Sv|5.005000||p
+PL_bufend|5.011000||p
+PL_bufptr|5.011000||p
+PL_compiling|5.004050||p
+PL_copline|5.011000||p
+PL_curcop|5.004050||p
+PL_curstash|5.004050||p
+PL_debstash|5.004050||p
+PL_defgv|5.004050||p
+PL_diehook|5.004050||p
+PL_dirty|5.004050||p
+PL_dowarn|||pn
+PL_errgv|5.004050||p
+PL_expect|5.011000||p
+PL_hexdigit|5.005000||p
+PL_hints|5.005000||p
+PL_last_in_gv|||n
+PL_laststatval|5.005000||p
+PL_lex_state|5.011000||p
+PL_lex_stuff|5.011000||p
+PL_linestr|5.011000||p
+PL_modglobal||5.005000|n
+PL_na|5.004050||pn
+PL_no_modify|5.006000||p
+PL_ofsgv|||n
+PL_parser|5.009005||p
+PL_perl_destruct_level|5.004050||p
+PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
+PL_rsfp_filters|5.004050||p
+PL_rsfp|5.004050||p
+PL_rs|||n
+PL_signals|5.008001||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
+PL_statcache|5.005000||p
+PL_stdingv|5.004050||p
+PL_sv_arenaroot|5.004050||p
+PL_sv_no|5.004050||pn
+PL_sv_undef|5.004050||pn
+PL_sv_yes|5.004050||pn
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
+PL_tokenbuf|5.011000||p
+POP_MULTICALL||5.011000|
+POPi|||n
+POPl|||n
+POPn|||n
+POPpbytex||5.007001|n
+POPpx||5.005030|n
+POPp|||n
+POPs|||n
+PTR2IV|5.006000||p
+PTR2NV|5.006000||p
+PTR2UV|5.006000||p
+PTR2nat|5.009003||p
+PTR2ul|5.007001||p
+PTRV|5.006000||p
+PUSHMARK|||
+PUSH_MULTICALL||5.011000|
+PUSHi|||
+PUSHmortal|5.009002||p
+PUSHn|||
+PUSHp|||
+PUSHs|||
+PUSHu|5.004000||p
+PUTBACK|||
+PerlIO_clearerr||5.007003|
+PerlIO_close||5.007003|
+PerlIO_context_layers||5.009004|
+PerlIO_eof||5.007003|
+PerlIO_error||5.007003|
+PerlIO_fileno||5.007003|
+PerlIO_fill||5.007003|
+PerlIO_flush||5.007003|
+PerlIO_get_base||5.007003|
+PerlIO_get_bufsiz||5.007003|
+PerlIO_get_cnt||5.007003|
+PerlIO_get_ptr||5.007003|
+PerlIO_read||5.007003|
+PerlIO_seek||5.007003|
+PerlIO_set_cnt||5.007003|
+PerlIO_set_ptrcnt||5.007003|
+PerlIO_setlinebuf||5.007003|
+PerlIO_stderr||5.007003|
+PerlIO_stdin||5.007003|
+PerlIO_stdout||5.007003|
+PerlIO_tell||5.007003|
+PerlIO_unread||5.007003|
+PerlIO_write||5.007003|
+Perl_signbit||5.009005|n
+PoisonFree|5.009004||p
+PoisonNew|5.009004||p
+PoisonWith|5.009004||p
+Poison|5.008000||p
+RETVAL|||n
+Renewc|||
+Renew|||
+SAVECLEARSV|||
+SAVECOMPPAD|||
+SAVEPADSV|||
+SAVETMPS|||
+SAVE_DEFSV|5.004050||p
+SPAGAIN|||
+SP|||
+START_EXTERN_C|5.005000||p
+START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
+STR_WITH_LEN|5.009003||p
+ST|||
+SV_CONST_RETURN|5.009003||p
+SV_COW_DROP_PV|5.008001||p
+SV_COW_SHARED_HASH_KEYS|5.009005||p
+SV_GMAGIC|5.007002||p
+SV_HAS_TRAILING_NUL|5.009004||p
+SV_IMMEDIATE_UNREF|5.007001||p
+SV_MUTABLE_RETURN|5.009003||p
+SV_NOSTEAL|5.009002||p
+SV_SMAGIC|5.009003||p
+SV_UTF8_NO_ENCODING|5.008001||p
+SVf_UTF8|5.006000||p
+SVf|5.006000||p
+SVt_IV|||
+SVt_NV|||
+SVt_PVAV|||
+SVt_PVCV|||
+SVt_PVHV|||
+SVt_PVMG|||
+SVt_PV|||
+Safefree|||
+Slab_Alloc|||
+Slab_Free|||
+Slab_to_rw|||
+StructCopy|||
+SvCUR_set|||
+SvCUR|||
+SvEND|||
+SvGAMAGIC||5.006001|
+SvGETMAGIC|5.004050||p
+SvGROW|||
+SvIOK_UV||5.006000|
+SvIOK_notUV||5.006000|
+SvIOK_off|||
+SvIOK_only_UV||5.006000|
+SvIOK_only|||
+SvIOK_on|||
+SvIOKp|||
+SvIOK|||
+SvIVX|||
+SvIV_nomg|5.009001||p
+SvIV_set|||
+SvIVx|||
+SvIV|||
+SvIsCOW_shared_hash||5.008003|
+SvIsCOW||5.008003|
+SvLEN_set|||
+SvLEN|||
+SvLOCK||5.007003|
+SvMAGIC_set|5.009003||p
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+SvNV_set|||
+SvNVx|||
+SvNV|||
+SvOK|||
+SvOOK_offset||5.011000|
+SvOOK|||
+SvPOK_off|||
+SvPOK_only_UTF8||5.006000|
+SvPOK_only|||
+SvPOK_on|||
+SvPOKp|||
+SvPOK|||
+SvPVX_const|5.009003||p
+SvPVX_mutable|5.009003||p
+SvPVX|||
+SvPV_const|5.009003||p
+SvPV_flags_const_nolen|5.009003||p
+SvPV_flags_const|5.009003||p
+SvPV_flags_mutable|5.009003||p
+SvPV_flags|5.007002||p
+SvPV_force_flags_mutable|5.009003||p
+SvPV_force_flags_nolen|5.009003||p
+SvPV_force_flags|5.007002||p
+SvPV_force_mutable|5.009003||p
+SvPV_force_nolen|5.009003||p
+SvPV_force_nomg_nolen|5.009003||p
+SvPV_force_nomg|5.007002||p
+SvPV_force|||p
+SvPV_mutable|5.009003||p
+SvPV_nolen_const|5.009003||p
+SvPV_nolen|5.006000||p
+SvPV_nomg_const_nolen|5.009003||p
+SvPV_nomg_const|5.009003||p
+SvPV_nomg|5.007002||p
+SvPV_renew|5.009003||p
+SvPV_set|||
+SvPVbyte_force||5.009002|
+SvPVbyte_nolen||5.006000|
+SvPVbytex_force||5.006000|
+SvPVbytex||5.006000|
+SvPVbyte|5.006000||p
+SvPVutf8_force||5.006000|
+SvPVutf8_nolen||5.006000|
+SvPVutf8x_force||5.006000|
+SvPVutf8x||5.006000|
+SvPVutf8||5.006000|
+SvPVx|||
+SvPV|||
+SvREFCNT_dec|||
+SvREFCNT_inc_NN|5.009004||p
+SvREFCNT_inc_simple_NN|5.009004||p
+SvREFCNT_inc_simple_void_NN|5.009004||p
+SvREFCNT_inc_simple_void|5.009004||p
+SvREFCNT_inc_simple|5.009004||p
+SvREFCNT_inc_void_NN|5.009004||p
+SvREFCNT_inc_void|5.009004||p
+SvREFCNT_inc|||p
+SvREFCNT|||
+SvROK_off|||
+SvROK_on|||
+SvROK|||
+SvRV_set|5.009003||p
+SvRV|||
+SvRXOK||5.009005|
+SvRX||5.009005|
+SvSETMAGIC|||
+SvSHARED_HASH|5.009003||p
+SvSHARE||5.007003|
+SvSTASH_set|5.009003||p
+SvSTASH|||
+SvSetMagicSV_nosteal||5.004000|
+SvSetMagicSV||5.004000|
+SvSetSV_nosteal||5.004000|
+SvSetSV|||
+SvTAINTED_off||5.004000|
+SvTAINTED_on||5.004000|
+SvTAINTED||5.004000|
+SvTAINT|||
+SvTRUE|||
+SvTYPE|||
+SvUNLOCK||5.007003|
+SvUOK|5.007001|5.006000|p
+SvUPGRADE|||
+SvUTF8_off||5.006000|
+SvUTF8_on||5.006000|
+SvUTF8||5.006000|
+SvUVXx|5.004000||p
+SvUVX|5.004000||p
+SvUV_nomg|5.009001||p
+SvUV_set|5.009003||p
+SvUVx|5.004000||p
+SvUV|5.004000||p
+SvVOK||5.008001|
+SvVSTRING_mg|5.009004||p
+THIS|||n
+UNDERBAR|5.009002||p
+UTF8_MAXBYTES|5.009002||p
+UVSIZE|5.006000||p
+UVTYPE|5.006000||p
+UVXf|5.007001||p
+UVof|5.006000||p
+UVuf|5.006000||p
+UVxf|5.006000||p
+WARN_ALL|5.006000||p
+WARN_AMBIGUOUS|5.006000||p
+WARN_ASSERTIONS|5.011000||p
+WARN_BAREWORD|5.006000||p
+WARN_CLOSED|5.006000||p
+WARN_CLOSURE|5.006000||p
+WARN_DEBUGGING|5.006000||p
+WARN_DEPRECATED|5.006000||p
+WARN_DIGIT|5.006000||p
+WARN_EXEC|5.006000||p
+WARN_EXITING|5.006000||p
+WARN_GLOB|5.006000||p
+WARN_INPLACE|5.006000||p
+WARN_INTERNAL|5.006000||p
+WARN_IO|5.006000||p
+WARN_LAYER|5.008000||p
+WARN_MALLOC|5.006000||p
+WARN_MISC|5.006000||p
+WARN_NEWLINE|5.006000||p
+WARN_NUMERIC|5.006000||p
+WARN_ONCE|5.006000||p
+WARN_OVERFLOW|5.006000||p
+WARN_PACK|5.006000||p
+WARN_PARENTHESIS|5.006000||p
+WARN_PIPE|5.006000||p
+WARN_PORTABLE|5.006000||p
+WARN_PRECEDENCE|5.006000||p
+WARN_PRINTF|5.006000||p
+WARN_PROTOTYPE|5.006000||p
+WARN_QW|5.006000||p
+WARN_RECURSION|5.006000||p
+WARN_REDEFINE|5.006000||p
+WARN_REGEXP|5.006000||p
+WARN_RESERVED|5.006000||p
+WARN_SEMICOLON|5.006000||p
+WARN_SEVERE|5.006000||p
+WARN_SIGNAL|5.006000||p
+WARN_SUBSTR|5.006000||p
+WARN_SYNTAX|5.006000||p
+WARN_TAINT|5.006000||p
+WARN_THREADS|5.008000||p
+WARN_UNINITIALIZED|5.006000||p
+WARN_UNOPENED|5.006000||p
+WARN_UNPACK|5.006000||p
+WARN_UNTIE|5.006000||p
+WARN_UTF8|5.006000||p
+WARN_VOID|5.006000||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu|5.004000||p
+XSRETURN_EMPTY|||
+XSRETURN_IV|||
+XSRETURN_NO|||
+XSRETURN_NV|||
+XSRETURN_PV|||
+XSRETURN_UNDEF|||
+XSRETURN_UV|5.008001||p
+XSRETURN_YES|||
+XSRETURN|||p
+XST_mIV|||
+XST_mNO|||
+XST_mNV|||
+XST_mPV|||
+XST_mUNDEF|||
+XST_mUV|5.008001||p
+XST_mYES|||
+XS_VERSION_BOOTCHECK|||
+XS_VERSION|||
+XSprePUSH|5.006000||p
+XS|||
+ZeroD|5.009002||p
+Zero|||
+_aMY_CXT|5.007003||p
+_pMY_CXT|5.007003||p
+aMY_CXT_|5.007003||p
+aMY_CXT|5.007003||p
+aTHXR_|5.011000||p
+aTHXR|5.011000||p
+aTHX_|5.006000||p
+aTHX|5.006000||p
+add_data|||n
+addmad|||
+allocmy|||
+amagic_call|||
+amagic_cmp_locale|||
+amagic_cmp|||
+amagic_i_ncmp|||
+amagic_ncmp|||
+any_dup|||
+ao|||
+append_elem|||
+append_list|||
+append_madprops|||
+apply_attrs_my|||
+apply_attrs_string||5.006001|
+apply_attrs|||
+apply|||
+atfork_lock||5.007003|n
+atfork_unlock||5.007003|n
+av_arylen_p||5.009003|
+av_clear|||
+av_create_and_push||5.009005|
+av_create_and_unshift_one||5.009005|
+av_delete||5.006000|
+av_exists||5.006000|
+av_extend|||
+av_fetch|||
+av_fill|||
+av_iter_p||5.011000|
+av_len|||
+av_make|||
+av_pop|||
+av_push|||
+av_reify|||
+av_shift|||
+av_store|||
+av_undef|||
+av_unshift|||
+ax|||n
+bad_type|||
+bind_match|||
+block_end|||
+block_gimme||5.004000|
+block_start|||
+boolSV|5.004000||p
+boot_core_PerlIO|||
+boot_core_UNIVERSAL|||
+boot_core_mro|||
+boot_core_xsutils|||
+bytes_from_utf8||5.007001|
+bytes_to_uni|||n
+bytes_to_utf8||5.006001|
+call_argv|5.006000||p
+call_atexit||5.006000|
+call_list||5.004000|
+call_method|5.006000||p
+call_pv|5.006000||p
+call_sv|5.006000||p
+calloc||5.007002|n
+cando|||
+cast_i32||5.006000|
+cast_iv||5.006000|
+cast_ulong||5.006000|
+cast_uv||5.006000|
+check_type_and_open|||
+check_uni|||
+checkcomma|||
+checkposixcc|||
+ckWARN|5.006000||p
+ck_anoncode|||
+ck_bitop|||
+ck_concat|||
+ck_defined|||
+ck_delete|||
+ck_die|||
+ck_each|||
+ck_eof|||
+ck_eval|||
+ck_exec|||
+ck_exists|||
+ck_exit|||
+ck_ftst|||
+ck_fun|||
+ck_glob|||
+ck_grep|||
+ck_index|||
+ck_join|||
+ck_lfun|||
+ck_listiob|||
+ck_match|||
+ck_method|||
+ck_null|||
+ck_open|||
+ck_readline|||
+ck_repeat|||
+ck_require|||
+ck_return|||
+ck_rfun|||
+ck_rvconst|||
+ck_sassign|||
+ck_select|||
+ck_shift|||
+ck_sort|||
+ck_spair|||
+ck_split|||
+ck_subr|||
+ck_substr|||
+ck_svconst|||
+ck_trunc|||
+ck_unpack|||
+ckwarn_d||5.009003|
+ckwarn||5.009003|
+cl_and|||n
+cl_anything|||n
+cl_init_zero|||n
+cl_init|||n
+cl_is_anything|||n
+cl_or|||n
+clear_placeholders|||
+closest_cop|||
+convert|||
+cop_free|||
+cr_textfilter|||
+create_eval_scope|||
+croak_nocontext|||vn
+croak_xs_usage||5.011000|
+croak|||v
+csighandler||5.009003|n
+curmad|||
+custom_op_desc||5.007003|
+custom_op_name||5.007003|
+cv_ckproto_len|||
+cv_clone|||
+cv_const_sv||5.004000|
+cv_dump|||
+cv_undef|||
+cx_dump||5.005000|
+cx_dup|||
+cxinc|||
+dAXMARK|5.009003||p
+dAX|5.007002||p
+dITEMS|5.007002||p
+dMARK|||
+dMULTICALL||5.009003|
+dMY_CXT_SV|5.007003||p
+dMY_CXT|5.007003||p
+dNOOP|5.006000||p
+dORIGMARK|||
+dSP|||
+dTHR|5.004050||p
+dTHXR|5.011000||p
+dTHXa|5.006000||p
+dTHXoa|5.006000||p
+dTHX|5.006000||p
+dUNDERBAR|5.009002||p
+dVAR|5.009003||p
+dXCPT|5.009002||p
+dXSARGS|||
+dXSI32|||
+dXSTARG|5.006000||p
+deb_curcv|||
+deb_nocontext|||vn
+deb_stack_all|||
+deb_stack_n|||
+debop||5.005000|
+debprofdump||5.005000|
+debprof|||
+debstackptrs||5.007003|
+debstack||5.007003|
+debug_start_match|||
+deb||5.007003|v
+del_sv|||
+delete_eval_scope|||
+delimcpy||5.004000|
+deprecate_old|||
+deprecate|||
+despatch_signals||5.007001|
+destroy_matcher|||
+die_nocontext|||vn
+die_where|||
+die|||v
+dirp_dup|||
+div128|||
+djSP|||
+do_aexec5|||
+do_aexec|||
+do_aspawn|||
+do_binmode||5.004050|
+do_chomp|||
+do_chop|||
+do_close|||
+do_dump_pad|||
+do_eof|||
+do_exec3|||
+do_execfree|||
+do_exec|||
+do_gv_dump||5.006000|
+do_gvgv_dump||5.006000|
+do_hv_dump||5.006000|
+do_ipcctl|||
+do_ipcget|||
+do_join|||
+do_kv|||
+do_magic_dump||5.006000|
+do_msgrcv|||
+do_msgsnd|||
+do_oddball|||
+do_op_dump||5.006000|
+do_op_xmldump|||
+do_open9||5.006000|
+do_openn||5.007001|
+do_open||5.004000|
+do_pmop_dump||5.006000|
+do_pmop_xmldump|||
+do_print|||
+do_readline|||
+do_seek|||
+do_semop|||
+do_shmio|||
+do_smartmatch|||
+do_spawn_nowait|||
+do_spawn|||
+do_sprintf|||
+do_sv_dump||5.006000|
+do_sysseek|||
+do_tell|||
+do_trans_complex_utf8|||
+do_trans_complex|||
+do_trans_count_utf8|||
+do_trans_count|||
+do_trans_simple_utf8|||
+do_trans_simple|||
+do_trans|||
+do_vecget|||
+do_vecset|||
+do_vop|||
+docatch|||
+doeval|||
+dofile|||
+dofindlabel|||
+doform|||
+doing_taint||5.008001|n
+dooneliner|||
+doopen_pm|||
+doparseform|||
+dopoptoeval|||
+dopoptogiven|||
+dopoptolabel|||
+dopoptoloop|||
+dopoptosub_at|||
+dopoptowhen|||
+doref||5.009003|
+dounwind|||
+dowantarray|||
+dump_all||5.006000|
+dump_eval||5.006000|
+dump_exec_pos|||
+dump_fds|||
+dump_form||5.006000|
+dump_indent||5.006000|v
+dump_mstats|||
+dump_packsubs||5.006000|
+dump_sub||5.006000|
+dump_sv_child|||
+dump_trie_interim_list|||
+dump_trie_interim_table|||
+dump_trie|||
+dump_vindent||5.006000|
+dumpuntil|||
+dup_attrlist|||
+emulate_cop_io|||
+eval_pv|5.006000||p
+eval_sv|5.006000||p
+exec_failed|||
+expect_number|||
+fbm_compile||5.005000|
+fbm_instr||5.005000|
+feature_is_enabled|||
+fetch_cop_label||5.011000|
+filter_add|||
+filter_del|||
+filter_gets|||
+filter_read|||
+find_and_forget_pmops|||
+find_array_subscript|||
+find_beginning|||
+find_byclass|||
+find_hash_subscript|||
+find_in_my_stash|||
+find_runcv||5.008001|
+find_rundefsvoffset||5.009002|
+find_script|||
+find_uninit_var|||
+first_symbol|||n
+fold_constants|||
+forbid_setid|||
+force_ident|||
+force_list|||
+force_next|||
+force_version|||
+force_word|||
+forget_pmop|||
+form_nocontext|||vn
+form||5.004000|v
+fp_dup|||
+fprintf_nocontext|||vn
+free_global_struct|||
+free_tied_hv_pool|||
+free_tmps|||
+gen_constant_list|||
+get_arena|||
+get_aux_mg|||
+get_av|5.006000||p
+get_context||5.006000|n
+get_cvn_flags||5.009005|
+get_cv|5.006000||p
+get_db_sub|||
+get_debug_opts|||
+get_hash_seed|||
+get_hv|5.006000||p
+get_isa_hash|||
+get_mstats|||
+get_no_modify|||
+get_num|||
+get_op_descs||5.005000|
+get_op_names||5.005000|
+get_opargs|||
+get_ppaddr||5.006000|
+get_re_arg|||
+get_sv|5.006000||p
+get_vtbl||5.005030|
+getcwd_sv||5.007002|
+getenv_len|||
+glob_2number|||
+glob_2pv|||
+glob_assign_glob|||
+glob_assign_ref|||
+gp_dup|||
+gp_free|||
+gp_ref|||
+grok_bin|5.007003||p
+grok_hex|5.007003||p
+grok_number|5.007002||p
+grok_numeric_radix|5.007002||p
+grok_oct|5.007003||p
+group_end|||
+gv_AVadd|||
+gv_HVadd|||
+gv_IOadd|||
+gv_SVadd|||
+gv_autoload4||5.004000|
+gv_check|||
+gv_const_sv||5.009003|
+gv_dump||5.006000|
+gv_efullname3||5.004000|
+gv_efullname4||5.006001|
+gv_efullname|||
+gv_ename|||
+gv_fetchfile_flags||5.009005|
+gv_fetchfile|||
+gv_fetchmeth_autoload||5.007003|
+gv_fetchmethod_autoload||5.004000|
+gv_fetchmethod_flags||5.011000|
+gv_fetchmethod|||
+gv_fetchmeth|||
+gv_fetchpvn_flags||5.009002|
+gv_fetchpv|||
+gv_fetchsv||5.009002|
+gv_fullname3||5.004000|
+gv_fullname4||5.006001|
+gv_fullname|||
+gv_get_super_pkg|||
+gv_handler||5.007001|
+gv_init_sv|||
+gv_init|||
+gv_name_set||5.009004|
+gv_stashpvn|5.004000||p
+gv_stashpvs||5.009003|
+gv_stashpv|||
+gv_stashsv|||
+he_dup|||
+hek_dup|||
+hfreeentries|||
+hsplit|||
+hv_assert||5.011000|
+hv_auxinit|||n
+hv_backreferences_p|||
+hv_clear_placeholders||5.009001|
+hv_clear|||
+hv_common_key_len||5.010000|
+hv_common||5.010000|
+hv_copy_hints_hv|||
+hv_delayfree_ent||5.004000|
+hv_delete_common|||
+hv_delete_ent||5.004000|
+hv_delete|||
+hv_eiter_p||5.009003|
+hv_eiter_set||5.009003|
+hv_exists_ent||5.004000|
+hv_exists|||
+hv_fetch_ent||5.004000|
+hv_fetchs|5.009003||p
+hv_fetch|||
+hv_free_ent||5.004000|
+hv_iterinit|||
+hv_iterkeysv||5.004000|
+hv_iterkey|||
+hv_iternext_flags||5.008000|
+hv_iternextsv|||
+hv_iternext|||
+hv_iterval|||
+hv_kill_backrefs|||
+hv_ksplit||5.004000|
+hv_magic_check|||n
+hv_magic|||
+hv_name_set||5.009003|
+hv_notallowed|||
+hv_placeholders_get||5.009003|
+hv_placeholders_p||5.009003|
+hv_placeholders_set||5.009003|
+hv_riter_p||5.009003|
+hv_riter_set||5.009003|
+hv_scalar||5.009001|
+hv_store_ent||5.004000|
+hv_store_flags||5.008000|
+hv_stores|5.009004||p
+hv_store|||
+hv_undef|||
+ibcmp_locale||5.004000|
+ibcmp_utf8||5.007003|
+ibcmp|||
+incline|||
+incpush_if_exists|||
+incpush_use_sep|||
+incpush|||
+ingroup|||
+init_argv_symbols|||
+init_debugger|||
+init_global_struct|||
+init_i18nl10n||5.006000|
+init_i18nl14n||5.006000|
+init_ids|||
+init_interp|||
+init_main_stash|||
+init_perllib|||
+init_postdump_symbols|||
+init_predump_symbols|||
+init_stacks||5.005000|
+init_tm||5.007002|
+instr|||
+intro_my|||
+intuit_method|||
+intuit_more|||
+invert|||
+io_close|||
+isALNUMC|5.006000||p
+isALNUM|||
+isALPHA|||
+isASCII|5.006000||p
+isBLANK|5.006001||p
+isCNTRL|5.006000||p
+isDIGIT|||
+isGRAPH|5.006000||p
+isLOWER|||
+isPRINT|5.004000||p
+isPSXSPC|5.006001||p
+isPUNCT|5.006000||p
+isSPACE|||
+isUPPER|||
+isXDIGIT|5.006000||p
+is_an_int|||
+is_gv_magical_sv|||
+is_handle_constructor|||n
+is_list_assignment|||
+is_lvalue_sub||5.007001|
+is_uni_alnum_lc||5.006000|
+is_uni_alnumc_lc||5.006000|
+is_uni_alnumc||5.006000|
+is_uni_alnum||5.006000|
+is_uni_alpha_lc||5.006000|
+is_uni_alpha||5.006000|
+is_uni_ascii_lc||5.006000|
+is_uni_ascii||5.006000|
+is_uni_cntrl_lc||5.006000|
+is_uni_cntrl||5.006000|
+is_uni_digit_lc||5.006000|
+is_uni_digit||5.006000|
+is_uni_graph_lc||5.006000|
+is_uni_graph||5.006000|
+is_uni_idfirst_lc||5.006000|
+is_uni_idfirst||5.006000|
+is_uni_lower_lc||5.006000|
+is_uni_lower||5.006000|
+is_uni_print_lc||5.006000|
+is_uni_print||5.006000|
+is_uni_punct_lc||5.006000|
+is_uni_punct||5.006000|
+is_uni_space_lc||5.006000|
+is_uni_space||5.006000|
+is_uni_upper_lc||5.006000|
+is_uni_upper||5.006000|
+is_uni_xdigit_lc||5.006000|
+is_uni_xdigit||5.006000|
+is_utf8_alnumc||5.006000|
+is_utf8_alnum||5.006000|
+is_utf8_alpha||5.006000|
+is_utf8_ascii||5.006000|
+is_utf8_char_slow|||n
+is_utf8_char||5.006000|
+is_utf8_cntrl||5.006000|
+is_utf8_common|||
+is_utf8_digit||5.006000|
+is_utf8_graph||5.006000|
+is_utf8_idcont||5.008000|
+is_utf8_idfirst||5.006000|
+is_utf8_lower||5.006000|
+is_utf8_mark||5.006000|
+is_utf8_print||5.006000|
+is_utf8_punct||5.006000|
+is_utf8_space||5.006000|
+is_utf8_string_loclen||5.009003|
+is_utf8_string_loc||5.008001|
+is_utf8_string||5.006001|
+is_utf8_upper||5.006000|
+is_utf8_xdigit||5.006000|
+isa_lookup|||
+items|||n
+ix|||n
+jmaybe|||
+join_exact|||
+keyword|||
+leave_scope|||
+lex_end|||
+lex_start|||
+linklist|||
+listkids|||
+list|||
+load_module_nocontext|||vn
+load_module|5.006000||pv
+localize|||
+looks_like_bool|||
+looks_like_number|||
+lop|||
+mPUSHi|5.009002||p
+mPUSHn|5.009002||p
+mPUSHp|5.009002||p
+mPUSHs|5.011000||p
+mPUSHu|5.009002||p
+mXPUSHi|5.009002||p
+mXPUSHn|5.009002||p
+mXPUSHp|5.009002||p
+mXPUSHs|5.011000||p
+mXPUSHu|5.009002||p
+mad_free|||
+madlex|||
+madparse|||
+magic_clear_all_env|||
+magic_clearenv|||
+magic_clearhint|||
+magic_clearisa|||
+magic_clearpack|||
+magic_clearsig|||
+magic_dump||5.006000|
+magic_existspack|||
+magic_freearylen_p|||
+magic_freeovrld|||
+magic_getarylen|||
+magic_getdefelem|||
+magic_getnkeys|||
+magic_getpack|||
+magic_getpos|||
+magic_getsig|||
+magic_getsubstr|||
+magic_gettaint|||
+magic_getuvar|||
+magic_getvec|||
+magic_get|||
+magic_killbackrefs|||
+magic_len|||
+magic_methcall|||
+magic_methpack|||
+magic_nextpack|||
+magic_regdata_cnt|||
+magic_regdatum_get|||
+magic_regdatum_set|||
+magic_scalarpack|||
+magic_set_all_env|||
+magic_setamagic|||
+magic_setarylen|||
+magic_setcollxfrm|||
+magic_setdbline|||
+magic_setdefelem|||
+magic_setenv|||
+magic_sethint|||
+magic_setisa|||
+magic_setmglob|||
+magic_setnkeys|||
+magic_setpack|||
+magic_setpos|||
+magic_setregexp|||
+magic_setsig|||
+magic_setsubstr|||
+magic_settaint|||
+magic_setutf8|||
+magic_setuvar|||
+magic_setvec|||
+magic_set|||
+magic_sizepack|||
+magic_wipepack|||
+make_matcher|||
+make_trie_failtable|||
+make_trie|||
+malloc_good_size|||n
+malloced_size|||n
+malloc||5.007002|n
+markstack_grow|||
+matcher_matches_sv|||
+measure_struct|||
+memEQ|5.004000||p
+memNE|5.004000||p
+mem_collxfrm|||
+mem_log_common|||n
+mess_alloc|||
+mess_nocontext|||vn
+mess||5.006000|v
+method_common|||
+mfree||5.007002|n
+mg_clear|||
+mg_copy|||
+mg_dup|||
+mg_find|||
+mg_free|||
+mg_get|||
+mg_length||5.005000|
+mg_localize|||
+mg_magical|||
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|
+missingterm|||
+mode_from_discipline|||
+modkids|||
+mod|||
+more_bodies|||
+more_sv|||
+moreswitches|||
+mro_get_from_name||5.011000|
+mro_get_linear_isa_dfs|||
+mro_get_linear_isa||5.009005|
+mro_get_private_data||5.011000|
+mro_isa_changed_in|||
+mro_meta_dup|||
+mro_meta_init|||
+mro_method_changed_in||5.009005|
+mro_register||5.011000|
+mro_set_mro||5.011000|
+mro_set_private_data||5.011000|
+mul128|||
+mulexp10|||n
+my_atof2||5.007002|
+my_atof||5.006000|
+my_attrs|||
+my_bcopy|||n
+my_betoh16|||n
+my_betoh32|||n
+my_betoh64|||n
+my_betohi|||n
+my_betohl|||n
+my_betohs|||n
+my_bzero|||n
+my_chsize|||
+my_clearenv|||
+my_cxt_index|||
+my_cxt_init|||
+my_dirfd||5.009005|
+my_exit_jump|||
+my_exit|||
+my_failure_exit||5.004000|
+my_fflush_all||5.006000|
+my_fork||5.007003|n
+my_htobe16|||n
+my_htobe32|||n
+my_htobe64|||n
+my_htobei|||n
+my_htobel|||n
+my_htobes|||n
+my_htole16|||n
+my_htole32|||n
+my_htole64|||n
+my_htolei|||n
+my_htolel|||n
+my_htoles|||n
+my_htonl|||
+my_kid|||
+my_letoh16|||n
+my_letoh32|||n
+my_letoh64|||n
+my_letohi|||n
+my_letohl|||n
+my_letohs|||n
+my_lstat|||
+my_memcmp||5.004000|n
+my_memset|||n
+my_ntohl|||
+my_pclose||5.004000|
+my_popen_list||5.007001|
+my_popen||5.004000|
+my_setenv|||
+my_snprintf|5.009004||pvn
+my_socketpair||5.007003|n
+my_sprintf|5.009003||pvn
+my_stat|||
+my_strftime||5.007002|
+my_strlcat|5.009004||pn
+my_strlcpy|5.009004||pn
+my_swabn|||n
+my_swap|||
+my_unexec|||
+my_vsnprintf||5.009004|n
+need_utf8|||n
+newANONATTRSUB||5.006000|
+newANONHASH|||
+newANONLIST|||
+newANONSUB|||
+newASSIGNOP|||
+newATTRSUB||5.006000|
+newAVREF|||
+newAV|||
+newBINOP|||
+newCONDOP|||
+newCONSTSUB|5.004050||p
+newCVREF|||
+newDEFSVOP|||
+newFORM|||
+newFOROP|||
+newGIVENOP||5.009003|
+newGIVWHENOP|||
+newGP|||
+newGVOP|||
+newGVREF|||
+newGVgen|||
+newHVREF|||
+newHVhv||5.005000|
+newHV|||
+newIO|||
+newLISTOP|||
+newLOGOP|||
+newLOOPEX|||
+newLOOPOP|||
+newMADPROP|||
+newMADsv|||
+newMYSUB|||
+newNULLLIST|||
+newOP|||
+newPADOP|||
+newPMOP|||
+newPROG|||
+newPVOP|||
+newRANGE|||
+newRV_inc|5.004000||p
+newRV_noinc|5.004000||p
+newRV|||
+newSLICEOP|||
+newSTATEOP|||
+newSUB|||
+newSVOP|||
+newSVREF|||
+newSV_type||5.009005|
+newSVhek||5.009003|
+newSViv|||
+newSVnv|||
+newSVpvf_nocontext|||vn
+newSVpvf||5.004000|v
+newSVpvn_flags|5.011000||p
+newSVpvn_share|5.007001||p
+newSVpvn_utf8|5.011000||p
+newSVpvn|5.004050||p
+newSVpvs_flags|5.011000||p
+newSVpvs_share||5.009003|
+newSVpvs|5.009003||p
+newSVpv|||
+newSVrv|||
+newSVsv|||
+newSVuv|5.006000||p
+newSV|||
+newTOKEN|||
+newUNOP|||
+newWHENOP||5.009003|
+newWHILEOP||5.009003|
+newXS_flags||5.009004|
+newXSproto||5.006000|
+newXS||5.006000|
+new_collate||5.006000|
+new_constant|||
+new_ctype||5.006000|
+new_he|||
+new_logop|||
+new_numeric||5.006000|
+new_stackinfo||5.005000|
+new_version||5.009000|
+new_warnings_bitfield|||
+next_symbol|||
+nextargv|||
+nextchar|||
+ninstr|||
+no_bareword_allowed|||
+no_fh_allowed|||
+no_op|||
+not_a_number|||
+nothreadhook||5.008000|
+nuke_stacks|||
+num_overflow|||n
+offer_nice_chunk|||
+oopsAV|||
+oopsHV|||
+op_clear|||
+op_const_sv|||
+op_dump||5.006000|
+op_free|||
+op_getmad_weak|||
+op_getmad|||
+op_null||5.007002|
+op_refcnt_dec|||
+op_refcnt_inc|||
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
+op_xmldump|||
+open_script|||
+pMY_CXT_|5.007003||p
+pMY_CXT|5.007003||p
+pTHX_|5.006000||p
+pTHX|5.006000||p
+packWARN|5.007003||p
+pack_cat||5.007003|
+pack_rec|||
+package|||
+packlist||5.008001|
+pad_add_anon|||
+pad_add_name|||
+pad_alloc|||
+pad_block_start|||
+pad_check_dup|||
+pad_compname_type|||
+pad_findlex|||
+pad_findmy|||
+pad_fixup_inner_anons|||
+pad_free|||
+pad_leavemy|||
+pad_new|||
+pad_peg|||n
+pad_push|||
+pad_reset|||
+pad_setsv|||
+pad_sv||5.011000|
+pad_swipe|||
+pad_tidy|||
+pad_undef|||
+parse_body|||
+parse_unicode_opts|||
+parser_dup|||
+parser_free|||
+path_is_absolute|||n
+peep|||
+pending_Slabs_to_ro|||
+perl_alloc_using|||n
+perl_alloc|||n
+perl_clone_using|||n
+perl_clone|||n
+perl_construct|||n
+perl_destruct||5.007003|n
+perl_free|||n
+perl_parse||5.006000|n
+perl_run|||n
+pidgone|||
+pm_description|||
+pmflag|||
+pmop_dump||5.006000|
+pmop_xmldump|||
+pmruntime|||
+pmtrans|||
+pop_scope|||
+pregcomp||5.009005|
+pregexec|||
+pregfree2||5.011000|
+pregfree|||
+prepend_elem|||
+prepend_madprops|||
+printbuf|||
+printf_nocontext|||vn
+process_special_blocks|||
+ptr_table_clear||5.009005|
+ptr_table_fetch||5.009005|
+ptr_table_find|||n
+ptr_table_free||5.009005|
+ptr_table_new||5.009005|
+ptr_table_split||5.009005|
+ptr_table_store||5.009005|
+push_scope|||
+put_byte|||
+pv_display|5.006000||p
+pv_escape|5.009004||p
+pv_pretty|5.009004||p
+pv_uni_display||5.007003|
+qerror|||
+qsortsvu|||
+re_compile||5.009005|
+re_croak2|||
+re_dup_guts|||
+re_intuit_start||5.009005|
+re_intuit_string||5.006000|
+readpipe_override|||
+realloc||5.007002|n
+reentrant_free|||
+reentrant_init|||
+reentrant_retry|||vn
+reentrant_size|||
+ref_array_or_hash|||
+refcounted_he_chain_2hv|||
+refcounted_he_fetch|||
+refcounted_he_free|||
+refcounted_he_new_common|||
+refcounted_he_new|||
+refcounted_he_value|||
+refkids|||
+refto|||
+ref||5.011000|
+reg_check_named_buff_matched|||
+reg_named_buff_all||5.009005|
+reg_named_buff_exists||5.009005|
+reg_named_buff_fetch||5.009005|
+reg_named_buff_firstkey||5.009005|
+reg_named_buff_iter|||
+reg_named_buff_nextkey||5.009005|
+reg_named_buff_scalar||5.009005|
+reg_named_buff|||
+reg_namedseq|||
+reg_node|||
+reg_numbered_buff_fetch|||
+reg_numbered_buff_length|||
+reg_numbered_buff_store|||
+reg_qr_package|||
+reg_recode|||
+reg_scan_name|||
+reg_skipcomment|||
+reg_temp_copy|||
+reganode|||
+regatom|||
+regbranch|||
+regclass_swash||5.009004|
+regclass|||
+regcppop|||
+regcppush|||
+regcurly|||n
+regdump_extflags|||
+regdump||5.005000|
+regdupe_internal|||
+regexec_flags||5.005000|
+regfree_internal||5.009005|
+reghop3|||n
+reghop4|||n
+reghopmaybe3|||n
+reginclass|||
+reginitcolors||5.006000|
+reginsert|||
+regmatch|||
+regnext||5.005000|
+regpiece|||
+regpposixcc|||
+regprop|||
+regrepeat|||
+regtail_study|||
+regtail|||
+regtry|||
+reguni|||
+regwhite|||n
+reg|||
+repeatcpy|||
+report_evil_fh|||
+report_uninit|||
+require_pv||5.006000|
+require_tie_mod|||
+restore_magic|||
+rninstr|||
+rsignal_restore|||
+rsignal_save|||
+rsignal_state||5.004000|
+rsignal||5.004000|
+run_body|||
+run_user_filter|||
+runops_debug||5.005000|
+runops_standard||5.005000|
+rvpv_dup|||
+rxres_free|||
+rxres_restore|||
+rxres_save|||
+safesyscalloc||5.006000|n
+safesysfree||5.006000|n
+safesysmalloc||5.006000|n
+safesysrealloc||5.006000|n
+same_dirent|||
+save_I16||5.004000|
+save_I32|||
+save_I8||5.006000|
+save_adelete||5.011000|
+save_aelem||5.004050|
+save_alloc||5.006000|
+save_aptr|||
+save_ary|||
+save_bool||5.008001|
+save_clearsv|||
+save_delete|||
+save_destructor_x||5.006000|
+save_destructor||5.006000|
+save_freeop|||
+save_freepv|||
+save_freesv|||
+save_generic_pvref||5.006001|
+save_generic_svref||5.005030|
+save_gp||5.004000|
+save_hash|||
+save_hek_flags|||n
+save_helem_flags||5.011000|
+save_helem||5.004050|
+save_hints|||
+save_hptr|||
+save_int|||
+save_item|||
+save_iv||5.005000|
+save_lines|||
+save_list|||
+save_long|||
+save_magic|||
+save_mortalizesv||5.007001|
+save_nogv|||
+save_op|||
+save_padsv_and_mortalize||5.011000|
+save_pptr|||
+save_pushi32ptr|||
+save_pushptri32ptr|||
+save_pushptrptr|||
+save_pushptr||5.011000|
+save_re_context||5.006000|
+save_scalar_at|||
+save_scalar|||
+save_set_svflags||5.009000|
+save_shared_pvref||5.007003|
+save_sptr|||
+save_svref|||
+save_vptr||5.006000|
+savepvn|||
+savepvs||5.009003|
+savepv|||
+savesharedpvn||5.009005|
+savesharedpv||5.007003|
+savestack_grow_cnt||5.008001|
+savestack_grow|||
+savesvpv||5.009002|
+sawparens|||
+scalar_mod_type|||n
+scalarboolean|||
+scalarkids|||
+scalarseq|||
+scalarvoid|||
+scalar|||
+scan_bin||5.006000|
+scan_commit|||
+scan_const|||
+scan_formline|||
+scan_heredoc|||
+scan_hex|||
+scan_ident|||
+scan_inputsymbol|||
+scan_num||5.007001|
+scan_oct|||
+scan_pat|||
+scan_str|||
+scan_subst|||
+scan_trans|||
+scan_version||5.009001|
+scan_vstring||5.009005|
+scan_word|||
+scope|||
+screaminstr||5.005000|
+search_const|||
+seed||5.008001|
+sequence_num|||
+sequence_tail|||
+sequence|||
+set_context||5.006000|n
+set_numeric_local||5.006000|
+set_numeric_radix||5.006000|
+set_numeric_standard||5.006000|
+setdefout|||
+share_hek_flags|||
+share_hek||5.004000|
+si_dup|||
+sighandler|||n
+simplify_sort|||
+skipspace0|||
+skipspace1|||
+skipspace2|||
+skipspace|||
+softref2xv|||
+sortcv_stacked|||
+sortcv_xsub|||
+sortcv|||
+sortsv_flags||5.009003|
+sortsv||5.007003|
+space_join_names_mortal|||
+ss_dup|||
+stack_grow|||
+start_force|||
+start_glob|||
+start_subparse||5.004000|
+stashpv_hvname_match||5.011000|
+stdize_locale|||
+store_cop_label|||
+strEQ|||
+strGE|||
+strGT|||
+strLE|||
+strLT|||
+strNE|||
+str_to_version||5.006000|
+strip_return|||
+strnEQ|||
+strnNE|||
+study_chunk|||
+sub_crush_depth|||
+sublex_done|||
+sublex_push|||
+sublex_start|||
+sv_2bool|||
+sv_2cv|||
+sv_2io|||
+sv_2iuv_common|||
+sv_2iuv_non_preserve|||
+sv_2iv_flags||5.009001|
+sv_2iv|||
+sv_2mortal|||
+sv_2num|||
+sv_2nv|||
+sv_2pv_flags|5.007002||p
+sv_2pv_nolen|5.006000||p
+sv_2pvbyte_nolen|5.006000||p
+sv_2pvbyte|5.006000||p
+sv_2pvutf8_nolen||5.006000|
+sv_2pvutf8||5.006000|
+sv_2pv|||
+sv_2uv_flags||5.009001|
+sv_2uv|5.004000||p
+sv_add_arena|||
+sv_add_backref|||
+sv_backoff|||
+sv_bless|||
+sv_cat_decode||5.008001|
+sv_catpv_mg|5.004050||p
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
+sv_catpvf_nocontext|||vn
+sv_catpvf||5.004000|v
+sv_catpvn_flags||5.007002|
+sv_catpvn_mg|5.004050||p
+sv_catpvn_nomg|5.007002||p
+sv_catpvn|||
+sv_catpvs|5.009003||p
+sv_catpv|||
+sv_catsv_flags||5.007002|
+sv_catsv_mg|5.004050||p
+sv_catsv_nomg|5.007002||p
+sv_catsv|||
+sv_catxmlpvn|||
+sv_catxmlsv|||
+sv_chop|||
+sv_clean_all|||
+sv_clean_objs|||
+sv_clear|||
+sv_cmp_locale||5.004000|
+sv_cmp|||
+sv_collxfrm|||
+sv_compile_2op||5.008001|
+sv_copypv||5.007003|
+sv_dec|||
+sv_del_backref|||
+sv_derived_from||5.004000|
+sv_destroyable||5.010000|
+sv_does||5.009004|
+sv_dump|||
+sv_dup|||
+sv_eq|||
+sv_exp_grow|||
+sv_force_normal_flags||5.007001|
+sv_force_normal||5.006000|
+sv_free2|||
+sv_free_arenas|||
+sv_free|||
+sv_gets||5.004000|
+sv_grow|||
+sv_i_ncmp|||
+sv_inc|||
+sv_insert_flags||5.011000|
+sv_insert|||
+sv_isa|||
+sv_isobject|||
+sv_iv||5.005000|
+sv_kill_backrefs|||
+sv_len_utf8||5.006000|
+sv_len|||
+sv_magic_portable|5.011000|5.004000|p
+sv_magicext||5.007003|
+sv_magic|||
+sv_mortalcopy|||
+sv_ncmp|||
+sv_newmortal|||
+sv_newref|||
+sv_nolocking||5.007003|
+sv_nosharing||5.007003|
+sv_nounlocking|||
+sv_nv||5.005000|
+sv_peek||5.005000|
+sv_pos_b2u_midway|||
+sv_pos_b2u||5.006000|
+sv_pos_u2b_cached|||
+sv_pos_u2b_forwards|||n
+sv_pos_u2b_midway|||n
+sv_pos_u2b||5.006000|
+sv_pvbyten_force||5.006000|
+sv_pvbyten||5.006000|
+sv_pvbyte||5.006000|
+sv_pvn_force_flags|5.007002||p
+sv_pvn_force|||
+sv_pvn_nomg|5.007003|5.005000|p
+sv_pvn||5.005000|
+sv_pvutf8n_force||5.006000|
+sv_pvutf8n||5.006000|
+sv_pvutf8||5.006000|
+sv_pv||5.006000|
+sv_recode_to_utf8||5.007003|
+sv_reftype|||
+sv_release_COW|||
+sv_replace|||
+sv_report_used|||
+sv_reset|||
+sv_rvweaken||5.006000|
+sv_setiv_mg|5.004050||p
+sv_setiv|||
+sv_setnv_mg|5.006000||p
+sv_setnv|||
+sv_setpv_mg|5.004050||p
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
+sv_setpvf_nocontext|||vn
+sv_setpvf||5.004000|v
+sv_setpviv_mg||5.008001|
+sv_setpviv||5.008001|
+sv_setpvn_mg|5.004050||p
+sv_setpvn|||
+sv_setpvs|5.009004||p
+sv_setpv|||
+sv_setref_iv|||
+sv_setref_nv|||
+sv_setref_pvn|||
+sv_setref_pv|||
+sv_setref_uv||5.007001|
+sv_setsv_cow|||
+sv_setsv_flags||5.007002|
+sv_setsv_mg|5.004050||p
+sv_setsv_nomg|5.007002||p
+sv_setsv|||
+sv_setuv_mg|5.004050||p
+sv_setuv|5.004000||p
+sv_tainted||5.004000|
+sv_taint||5.004000|
+sv_true||5.005000|
+sv_unglob|||
+sv_uni_display||5.007003|
+sv_unmagic|||
+sv_unref_flags||5.007001|
+sv_unref|||
+sv_untaint||5.004000|
+sv_upgrade|||
+sv_usepvn_flags||5.009004|
+sv_usepvn_mg|5.004050||p
+sv_usepvn|||
+sv_utf8_decode||5.006000|
+sv_utf8_downgrade||5.006000|
+sv_utf8_encode||5.006000|
+sv_utf8_upgrade_flags_grow||5.011000|
+sv_utf8_upgrade_flags||5.007002|
+sv_utf8_upgrade_nomg||5.007002|
+sv_utf8_upgrade||5.007001|
+sv_uv|5.005000||p
+sv_vcatpvf_mg|5.006000|5.004000|p
+sv_vcatpvfn||5.004000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
+sv_vsetpvfn||5.004000|
+sv_vsetpvf|5.006000|5.004000|p
+sv_xmlpeek|||
+svtype|||
+swallow_bom|||
+swap_match_buff|||
+swash_fetch||5.007002|
+swash_get|||
+swash_init||5.006000|
+sys_init3||5.010000|n
+sys_init||5.010000|n
+sys_intern_clear|||
+sys_intern_dup|||
+sys_intern_init|||
+sys_term||5.010000|n
+taint_env|||
+taint_proper|||
+tmps_grow||5.006000|
+toLOWER|||
+toUPPER|||
+to_byte_substr|||
+to_uni_fold||5.007003|
+to_uni_lower_lc||5.006000|
+to_uni_lower||5.007003|
+to_uni_title_lc||5.006000|
+to_uni_title||5.007003|
+to_uni_upper_lc||5.006000|
+to_uni_upper||5.007003|
+to_utf8_case||5.007003|
+to_utf8_fold||5.007003|
+to_utf8_lower||5.007003|
+to_utf8_substr|||
+to_utf8_title||5.007003|
+to_utf8_upper||5.007003|
+token_free|||
+token_getmad|||
+tokenize_use|||
+tokeq|||
+tokereport|||
+too_few_arguments|||
+too_many_arguments|||
+uiv_2buf|||n
+unlnk|||
+unpack_rec|||
+unpack_str||5.007003|
+unpackstring||5.008001|
+unshare_hek_or_pvn|||
+unshare_hek|||
+unsharepvn||5.004000|
+unwind_handler_stack|||
+update_debugger_info|||
+upg_version||5.009005|
+usage|||
+utf16_to_utf8_reversed||5.006001|
+utf16_to_utf8||5.006001|
+utf8_distance||5.006000|
+utf8_hop||5.006000|
+utf8_length||5.007001|
+utf8_mg_pos_cache_update|||
+utf8_to_bytes||5.006001|
+utf8_to_uvchr||5.007001|
+utf8_to_uvuni||5.007001|
+utf8n_to_uvchr|||
+utf8n_to_uvuni||5.007001|
+utilize|||
+uvchr_to_utf8_flags||5.007003|
+uvchr_to_utf8|||
+uvuni_to_utf8_flags||5.007003|
+uvuni_to_utf8||5.007001|
+validate_suid|||
+varname|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vdie_common|||
+vdie_croak_common|||
+vdie|||
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module|5.006000||p
+vmess||5.006000|
+vnewSVpvf|5.006000|5.004000|p
+vnormal||5.009002|
+vnumify||5.009000|
+vstringify||5.009000|
+vverify||5.009003|
+vwarner||5.006000|
+vwarn||5.006000|
+wait4pid|||
+warn_nocontext|||vn
+warner_nocontext|||vn
+warner|5.006000|5.004000|pv
+warn|||v
+watch|||
+whichsig|||
+write_no_mem|||
+write_to_stderr|||
+xmldump_all|||
+xmldump_attr|||
+xmldump_eval|||
+xmldump_form|||
+xmldump_indent|||v
+xmldump_packsubs|||
+xmldump_sub|||
+xmldump_vindent|||
+yyerror|||
+yylex|||
+yyparse|||
+yywarn|||
+);
+
+if (exists $opt{'list-unsupported'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{todo};
+ print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
+ }
+ exit 0;
+}
+
+# Scan for possible replacement candidates
+
+my(%replace, %need, %hints, %warnings, %depends);
+my $replace = 0;
+my($hint, $define, $function);
+
+sub find_api
+{
+ my $code = shift;
+ $code =~ s{
+ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
+ grep { exists $API{$_} } $code =~ /(\w+)/mg;
+}
+
+while () {
+ if ($hint) {
+ my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
+ if (m{^\s*\*\s(.*?)\s*$}) {
+ for (@{$hint->[1]}) {
+ $h->{$_} ||= ''; # suppress warning with older perls
+ $h->{$_} .= "$1\n";
+ }
+ }
+ else { undef $hint }
+ }
+
+ $hint = [$1, [split /,?\s+/, $2]]
+ if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
+
+ if ($define) {
+ if ($define->[1] =~ /\\$/) {
+ $define->[1] .= $_;
+ }
+ else {
+ if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
+ my @n = find_api($define->[1]);
+ push @{$depends{$define->[0]}}, @n if @n
+ }
+ undef $define;
+ }
+ }
+
+ $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
+
+ if ($function) {
+ if (/^}/) {
+ if (exists $API{$function->[0]}) {
+ my @n = find_api($function->[1]);
+ push @{$depends{$function->[0]}}, @n if @n
+ }
+ undef $function;
+ }
+ else {
+ $function->[1] .= $_;
+ }
+ }
+
+ $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
+
+ $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
+ $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
+ $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
+ $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
+
+ if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
+ my @deps = map { s/\s+//g; $_ } split /,/, $3;
+ my $d;
+ for $d (map { s/\s+//g; $_ } split /,/, $1) {
+ push @{$depends{$d}}, @deps;
+ }
+ }
+
+ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
+}
+
+for (values %depends) {
+ my %s;
+ $_ = [sort grep !$s{$_}++, @$_];
+}
+
+if (exists $opt{'api-info'}) {
+ my $f;
+ my $count = 0;
+ my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $f =~ /$match/;
+ print "\n=== $f ===\n\n";
+ my $info = 0;
+ if ($API{$f}{base} || $API{$f}{todo}) {
+ my $base = format_version($API{$f}{base} || $API{$f}{todo});
+ print "Supported at least starting from perl-$base.\n";
+ $info++;
+ }
+ if ($API{$f}{provided}) {
+ my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
+ print "Support by $ppport provided back to perl-$todo.\n";
+ print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
+ print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
+ print "\n$hints{$f}" if exists $hints{$f};
+ print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
+ $info++;
+ }
+ print "No portability information available.\n" unless $info;
+ $count++;
+ }
+ $count or print "Found no API matching '$opt{'api-info'}'.";
+ print "\n";
+ exit 0;
+}
+
+if (exists $opt{'list-provided'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{provided};
+ my @flags;
+ push @flags, 'explicit' if exists $need{$f};
+ push @flags, 'depend' if exists $depends{$f};
+ push @flags, 'hint' if exists $hints{$f};
+ push @flags, 'warning' if exists $warnings{$f};
+ my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
+ print "$f$flags\n";
+ }
+ exit 0;
+}
+
+my @files;
+my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
+my $srcext = join '|', map { quotemeta $_ } @srcext;
+
+if (@ARGV) {
+ my %seen;
+ for (@ARGV) {
+ if (-e) {
+ if (-f) {
+ push @files, $_ unless $seen{$_}++;
+ }
+ else { warn "'$_' is not a file.\n" }
+ }
+ else {
+ my @new = grep { -f } glob $_
+ or warn "'$_' does not exist.\n";
+ push @files, grep { !$seen{$_}++ } @new;
+ }
+ }
+}
+else {
+ eval {
+ require File::Find;
+ File::Find::find(sub {
+ $File::Find::name =~ /($srcext)$/i
+ and push @files, $File::Find::name;
+ }, '.');
+ };
+ if ($@) {
+ @files = map { glob "*$_" } @srcext;
+ }
+}
+
+if (!@ARGV || $opt{filter}) {
+ my(@in, @out);
+ my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
+ for (@files) {
+ my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
+ push @{ $out ? \@out : \@in }, $_;
+ }
+ if (@ARGV && @out) {
+ warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
+ }
+ @files = @in;
+}
+
+die "No input files given!\n" unless @files;
+
+my(%files, %global, %revreplace);
+%revreplace = reverse %replace;
+my $filename;
+my $patch_opened = 0;
+
+for $filename (@files) {
+ unless (open IN, "<$filename") {
+ warn "Unable to read from $filename: $!\n";
+ next;
+ }
+
+ info("Scanning $filename ...");
+
+ my $c = do { local $/; };
+ close IN;
+
+ my %file = (orig => $c, changes => 0);
+
+ # Temporarily remove C/XS comments and strings from the code
+ my @ccom;
+
+ $c =~ s{
+ ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
+ | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
+ | ( ^$HS*\#[^\r\n]*
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*'
+ | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
+ }{ defined $2 and push @ccom, $2;
+ defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
+
+ $file{ccom} = \@ccom;
+ $file{code} = $c;
+ $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
+
+ my $func;
+
+ for $func (keys %API) {
+ my $match = $func;
+ $match .= "|$revreplace{$func}" if exists $revreplace{$func};
+ if ($c =~ /\b(?:Perl_)?($match)\b/) {
+ $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
+ $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
+ if (exists $API{$func}{provided}) {
+ $file{uses_provided}{$func}++;
+ if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
+ $file{uses}{$func}++;
+ my @deps = rec_depend($func);
+ if (@deps) {
+ $file{uses_deps}{$func} = \@deps;
+ for (@deps) {
+ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
+ }
+ }
+ for ($func, @deps) {
+ $file{needs}{$_} = 'static' if exists $need{$_};
+ }
+ }
+ }
+ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
+ if ($c =~ /\b$func\b/) {
+ $file{uses_todo}{$func}++;
+ }
+ }
+ }
+ }
+
+ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
+ if (exists $need{$2}) {
+ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
+ }
+ else { warning("Possibly wrong #define $1 in $filename") }
+ }
+
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
+ $files{$filename} = \%file;
+}
+
+# Globally resolve NEED_'s
+my $need;
+for $need (keys %{$global{needs}}) {
+ if (@{$global{needs}{$need}} > 1) {
+ my @targets = @{$global{needs}{$need}};
+ my @t = grep $files{$_}{needed_global}{$need}, @targets;
+ @targets = @t if @t;
+ @t = grep /\.xs$/i, @targets;
+ @targets = @t if @t;
+ my $target = shift @targets;
+ $files{$target}{needs}{$need} = 'global';
+ for (@{$global{needs}{$need}}) {
+ $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
+ }
+ }
+}
+
+for $filename (@files) {
+ exists $files{$filename} or next;
+
+ info("=== Analyzing $filename ===");
+
+ my %file = %{$files{$filename}};
+ my $func;
+ my $c = $file{code};
+ my $warnings = 0;
+
+ for $func (sort keys %{$file{uses_Perl}}) {
+ if ($API{$func}{varargs}) {
+ unless ($API{$func}{nothxarg}) {
+ my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
+ { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
+ if ($changes) {
+ warning("Doesn't pass interpreter argument aTHX to Perl_$func");
+ $file{changes} += $changes;
+ }
+ }
+ }
+ else {
+ warning("Uses Perl_$func instead of $func");
+ $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
+ {$func$1(}g);
+ }
+ }
+
+ for $func (sort keys %{$file{uses_replace}}) {
+ warning("Uses $func instead of $replace{$func}");
+ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
+ }
+
+ for $func (sort keys %{$file{uses_provided}}) {
+ if ($file{uses}{$func}) {
+ if (exists $file{uses_deps}{$func}) {
+ diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
+ }
+ else {
+ diag("Uses $func");
+ }
+ }
+ $warnings += hint($func);
+ }
+
+ unless ($opt{quiet}) {
+ for $func (sort keys %{$file{uses_todo}}) {
+ print "*** WARNING: Uses $func, which may not be portable below perl ",
+ format_version($API{$func}{todo}), ", even with '$ppport'\n";
+ $warnings++;
+ }
+ }
+
+ for $func (sort keys %{$file{needed_static}}) {
+ my $message = '';
+ if (not exists $file{uses}{$func}) {
+ $message = "No need to define NEED_$func if $func is never used";
+ }
+ elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
+ $message = "No need to define NEED_$func when already needed globally";
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
+ }
+ }
+
+ for $func (sort keys %{$file{needed_global}}) {
+ my $message = '';
+ if (not exists $global{uses}{$func}) {
+ $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
+ }
+ elsif (exists $file{needs}{$func}) {
+ if ($file{needs}{$func} eq 'extern') {
+ $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
+ }
+ elsif ($file{needs}{$func} eq 'static') {
+ $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
+ }
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
+ }
+ }
+
+ $file{needs_inc_ppport} = keys %{$file{uses}};
+
+ if ($file{needs_inc_ppport}) {
+ my $pp = '';
+
+ for $func (sort keys %{$file{needs}}) {
+ my $type = $file{needs}{$func};
+ next if $type eq 'extern';
+ my $suffix = $type eq 'global' ? '_GLOBAL' : '';
+ unless (exists $file{"needed_$type"}{$func}) {
+ if ($type eq 'global') {
+ diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
+ }
+ else {
+ diag("File needs $func, adding static request");
+ }
+ $pp .= "#define NEED_$func$suffix\n";
+ }
+ }
+
+ if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
+ $pp = '';
+ $file{changes}++;
+ }
+
+ unless ($file{has_inc_ppport}) {
+ diag("Needs to include '$ppport'");
+ $pp .= qq(#include "$ppport"\n)
+ }
+
+ if ($pp) {
+ $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
+ || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
+ || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
+ || ($c =~ s/^/$pp/);
+ }
+ }
+ else {
+ if ($file{has_inc_ppport}) {
+ diag("No need to include '$ppport'");
+ $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
+ }
+ }
+
+ # put back in our C comments
+ my $ix;
+ my $cppc = 0;
+ my @ccom = @{$file{ccom}};
+ for $ix (0 .. $#ccom) {
+ if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
+ $cppc++;
+ $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
+ }
+ else {
+ $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
+ }
+ }
+
+ if ($cppc) {
+ my $s = $cppc != 1 ? 's' : '';
+ warning("Uses $cppc C++ style comment$s, which is not portable");
+ }
+
+ my $s = $warnings != 1 ? 's' : '';
+ my $warn = $warnings ? " ($warnings warning$s)" : '';
+ info("Analysis completed$warn");
+
+ if ($file{changes}) {
+ if (exists $opt{copy}) {
+ my $newfile = "$filename$opt{copy}";
+ if (-e $newfile) {
+ error("'$newfile' already exists, refusing to write copy of '$filename'");
+ }
+ else {
+ local *F;
+ if (open F, ">$newfile") {
+ info("Writing copy of '$filename' with changes to '$newfile'");
+ print F $c;
+ close F;
+ }
+ else {
+ error("Cannot open '$newfile' for writing: $!");
+ }
+ }
+ }
+ elsif (exists $opt{patch} || $opt{changes}) {
+ if (exists $opt{patch}) {
+ unless ($patch_opened) {
+ if (open PATCH, ">$opt{patch}") {
+ $patch_opened = 1;
+ }
+ else {
+ error("Cannot open '$opt{patch}' for writing: $!");
+ delete $opt{patch};
+ $opt{changes} = 1;
+ goto fallback;
+ }
+ }
+ mydiff(\*PATCH, $filename, $c);
+ }
+ else {
+fallback:
+ info("Suggested changes:");
+ mydiff(\*STDOUT, $filename, $c);
+ }
+ }
+ else {
+ my $s = $file{changes} == 1 ? '' : 's';
+ info("$file{changes} potentially required change$s detected");
+ }
+ }
+ else {
+ info("Looks good");
+ }
+}
+
+close PATCH if $patch_opened;
+
+exit 0;
+
+
+sub try_use { eval "use @_;"; return $@ eq '' }
+
+sub mydiff
+{
+ local *F = shift;
+ my($file, $str) = @_;
+ my $diff;
+
+ if (exists $opt{diff}) {
+ $diff = run_diff($opt{diff}, $file, $str);
+ }
+
+ if (!defined $diff and try_use('Text::Diff')) {
+ $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
+ $diff = <$tmp") {
+ print F $str;
+ close F;
+
+ if (open F, "$prog $file $tmp |") {
+ while () {
+ s/\Q$tmp\E/$file.patched/;
+ $diff .= $_;
+ }
+ close F;
+ unlink $tmp;
+ return $diff;
+ }
+
+ unlink $tmp;
+ }
+ else {
+ error("Cannot open '$tmp' for writing: $!");
+ }
+
+ return undef;
+}
+
+sub rec_depend
+{
+ my($func, $seen) = @_;
+ return () unless exists $depends{$func};
+ $seen = {%{$seen||{}}};
+ return () if $seen->{$func}++;
+ my %s;
+ grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
+}
+
+sub parse_version
+{
+ my $ver = shift;
+
+ if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
+ return ($1, $2, $3);
+ }
+ elsif ($ver !~ /^\d+\.[\d_]+$/) {
+ die "cannot parse version '$ver'\n";
+ }
+
+ $ver =~ s/_//g;
+ $ver =~ s/$/000000/;
+
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "cannot parse version '$ver'\n";
+ }
+ }
+
+ return ($r, $v, $s);
+}
+
+sub format_version
+{
+ my $ver = shift;
+
+ $ver =~ s/$/000000/;
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "invalid version '$ver'\n";
+ }
+ $s /= 10;
+
+ $ver = sprintf "%d.%03d", $r, $v;
+ $s > 0 and $ver .= sprintf "_%02d", $s;
+
+ return $ver;
+ }
+
+ return sprintf "%d.%d.%d", $r, $v, $s;
+}
+
+sub info
+{
+ $opt{quiet} and return;
+ print @_, "\n";
+}
+
+sub diag
+{
+ $opt{quiet} and return;
+ $opt{diag} and print @_, "\n";
+}
+
+sub warning
+{
+ $opt{quiet} and return;
+ print "*** ", @_, "\n";
+}
+
+sub error
+{
+ print "*** ERROR: ", @_, "\n";
+}
+
+my %given_hints;
+my %given_warnings;
+sub hint
+{
+ $opt{quiet} and return;
+ my $func = shift;
+ my $rv = 0;
+ if (exists $warnings{$func} && !$given_warnings{$func}++) {
+ my $warn = $warnings{$func};
+ $warn =~ s!^!*** !mg;
+ print "*** WARNING: $func\n", $warn;
+ $rv++;
+ }
+ if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
+ my $hint = $hints{$func};
+ $hint =~ s/^/ /mg;
+ print " --- hint for $func ---\n", $hint;
+ }
+ $rv;
+}
+
+sub usage
+{
+ my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
+ my %M = ( 'I' => '*' );
+ $usage =~ s/^\s*perl\s+\S+/$^X $0/;
+ $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
+
+ print < };
+ my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
+ $copy =~ s/^(?=\S+)/ /gms;
+ $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
+ $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
+if (\@ARGV && \$ARGV[0] eq '--unstrip') {
+ eval { require Devel::PPPort };
+ \$@ and die "Cannot require Devel::PPPort, please install.\\n";
+ if (eval \$Devel::PPPort::VERSION < $VERSION) {
+ die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
+ . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
+ . "Please install a newer version, or --unstrip will not work.\\n";
+ }
+ Devel::PPPort::WriteFile(\$0);
+ exit 0;
+}
+print <$0" or die "cannot strip $0: $!\n";
+ print OUT "$pl$c\n";
+
+ exit 0;
+}
+
+__DATA__
+*/
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef DPPP_NAMESPACE
+# define DPPP_NAMESPACE DPPP_
+#endif
+
+#define DPPP_CAT2(x,y) CAT2(x,y)
+#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
+
+#ifndef PERL_REVISION
+# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
+# define PERL_PATCHLEVEL_H_IMPLICIT
+# include
+# endif
+# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
+# include
+# endif
+# ifndef PERL_REVISION
+# define PERL_REVISION (5)
+ /* Replace: 1 */
+# define PERL_VERSION PATCHLEVEL
+# define PERL_SUBVERSION SUBVERSION
+ /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+ /* Replace: 0 */
+# endif
+#endif
+
+#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
+#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
+
+/* It is very unlikely that anyone will try to use this with Perl 6
+ (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+# error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+#ifndef dTHR
+# define dTHR dNOOP
+#endif
+#ifndef dTHX
+# define dTHX dNOOP
+#endif
+
+#ifndef dTHXa
+# define dTHXa(x) dNOOP
+#endif
+#ifndef pTHX
+# define pTHX void
+#endif
+
+#ifndef pTHX_
+# define pTHX_
+#endif
+
+#ifndef aTHX
+# define aTHX
+#endif
+
+#ifndef aTHX_
+# define aTHX_
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# ifdef USE_THREADS
+# define aTHXR thr
+# define aTHXR_ thr,
+# else
+# define aTHXR
+# define aTHXR_
+# endif
+# define dTHXR dTHR
+#else
+# define aTHXR aTHX
+# define aTHXR_ aTHX_
+# define dTHXR dTHX
+#endif
+#ifndef dTHXoa
+# define dTHXoa(x) dTHXa(x)
+#endif
+
+#ifdef I_LIMITS
+# include
+#endif
+
+#ifndef PERL_UCHAR_MIN
+# define PERL_UCHAR_MIN ((unsigned char)0)
+#endif
+
+#ifndef PERL_UCHAR_MAX
+# ifdef UCHAR_MAX
+# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
+# else
+# ifdef MAXUCHAR
+# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
+# else
+# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_USHORT_MIN
+# define PERL_USHORT_MIN ((unsigned short)0)
+#endif
+
+#ifndef PERL_USHORT_MAX
+# ifdef USHORT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
+# else
+# ifdef MAXUSHORT
+# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
+# else
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MAX
+# ifdef SHORT_MAX
+# define PERL_SHORT_MAX ((short)SHORT_MAX)
+# else
+# ifdef MAXSHORT /* Often used in */
+# define PERL_SHORT_MAX ((short)MAXSHORT)
+# else
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MIN
+# ifdef SHORT_MIN
+# define PERL_SHORT_MIN ((short)SHORT_MIN)
+# else
+# ifdef MINSHORT
+# define PERL_SHORT_MIN ((short)MINSHORT)
+# else
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MAX
+# ifdef UINT_MAX
+# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
+# else
+# ifdef MAXUINT
+# define PERL_UINT_MAX ((unsigned int)MAXUINT)
+# else
+# define PERL_UINT_MAX (~(unsigned int)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MIN
+# define PERL_UINT_MIN ((unsigned int)0)
+#endif
+
+#ifndef PERL_INT_MAX
+# ifdef INT_MAX
+# define PERL_INT_MAX ((int)INT_MAX)
+# else
+# ifdef MAXINT /* Often used in */
+# define PERL_INT_MAX ((int)MAXINT)
+# else
+# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_INT_MIN
+# ifdef INT_MIN
+# define PERL_INT_MIN ((int)INT_MIN)
+# else
+# ifdef MININT
+# define PERL_INT_MIN ((int)MININT)
+# else
+# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MAX
+# ifdef ULONG_MAX
+# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
+# else
+# ifdef MAXULONG
+# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
+# else
+# define PERL_ULONG_MAX (~(unsigned long)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MIN
+# define PERL_ULONG_MIN ((unsigned long)0L)
+#endif
+
+#ifndef PERL_LONG_MAX
+# ifdef LONG_MAX
+# define PERL_LONG_MAX ((long)LONG_MAX)
+# else
+# ifdef MAXLONG
+# define PERL_LONG_MAX ((long)MAXLONG)
+# else
+# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_LONG_MIN
+# ifdef LONG_MIN
+# define PERL_LONG_MIN ((long)LONG_MIN)
+# else
+# ifdef MINLONG
+# define PERL_LONG_MIN ((long)MINLONG)
+# else
+# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
+# ifndef PERL_UQUAD_MAX
+# ifdef ULONGLONG_MAX
+# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
+# else
+# ifdef MAXULONGLONG
+# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
+# else
+# define PERL_UQUAD_MAX (~(unsigned long long)0)
+# endif
+# endif
+# endif
+
+# ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN ((unsigned long long)0L)
+# endif
+
+# ifndef PERL_QUAD_MAX
+# ifdef LONGLONG_MAX
+# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
+# else
+# ifdef MAXLONGLONG
+# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
+# else
+# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
+# endif
+# endif
+# endif
+
+# ifndef PERL_QUAD_MIN
+# ifdef LONGLONG_MIN
+# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
+# else
+# ifdef MINLONGLONG
+# define PERL_QUAD_MIN ((long long)MINLONGLONG)
+# else
+# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+/* This is based on code from 5.003 perl.h */
+#ifdef HAS_QUAD
+# ifdef cray
+#ifndef IVTYPE
+# define IVTYPE int
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_INT_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_INT_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UINT_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UINT_MAX
+#endif
+
+# ifdef INTSIZE
+#ifndef IVSIZE
+# define IVSIZE INTSIZE
+#endif
+
+# endif
+# else
+# if defined(convex) || defined(uts)
+#ifndef IVTYPE
+# define IVTYPE long long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_QUAD_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_QUAD_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UQUAD_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UQUAD_MAX
+#endif
+
+# ifdef LONGLONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGLONGSIZE
+#endif
+
+# endif
+# else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+# ifdef LONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGSIZE
+#endif
+
+# endif
+# endif
+# endif
+#ifndef IVSIZE
+# define IVSIZE 8
+#endif
+
+#ifndef PERL_QUAD_MIN
+# define PERL_QUAD_MIN IV_MIN
+#endif
+
+#ifndef PERL_QUAD_MAX
+# define PERL_QUAD_MAX IV_MAX
+#endif
+
+#ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN UV_MIN
+#endif
+
+#ifndef PERL_UQUAD_MAX
+# define PERL_UQUAD_MAX UV_MAX
+#endif
+
+#else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+#endif
+
+#ifndef IVSIZE
+# ifdef LONGSIZE
+# define IVSIZE LONGSIZE
+# else
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
+# endif
+#endif
+#ifndef UVTYPE
+# define UVTYPE unsigned IVTYPE
+#endif
+
+#ifndef UVSIZE
+# define UVSIZE IVSIZE
+#endif
+#ifndef sv_setuv
+# define sv_setuv(sv, uv) \
+ STMT_START { \
+ UV TeMpUv = uv; \
+ if (TeMpUv <= IV_MAX) \
+ sv_setiv(sv, TeMpUv); \
+ else \
+ sv_setnv(sv, (double)TeMpUv); \
+ } STMT_END
+#endif
+#ifndef newSVuv
+# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
+#endif
+#ifndef sv_2uv
+# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+#endif
+
+#ifndef SvUVX
+# define SvUVX(sv) ((UV)SvIVX(sv))
+#endif
+
+#ifndef SvUVXx
+# define SvUVXx(sv) SvUVX(sv)
+#endif
+
+#ifndef SvUV
+# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+#endif
+
+#ifndef SvUVx
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+#endif
+
+/* Hint: sv_uv
+ * Always use the SvUVx() macro instead of sv_uv().
+ */
+#ifndef sv_uv
+# define sv_uv(sv) SvUVx(sv)
+#endif
+
+#if !defined(SvUOK) && defined(SvIOK_UV)
+# define SvUOK(sv) SvIOK_UV(sv)
+#endif
+#ifndef XST_mUV
+# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
+#endif
+
+#ifndef XSRETURN_UV
+# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
+
+#ifdef HAS_MEMCMP
+#ifndef memNE
+# define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#endif
+
+#else
+#ifndef memNE
+# define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+#endif
+#ifndef MoveD
+# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifndef CopyD
+# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifdef HAS_MEMSET
+#ifndef ZeroD
+# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#endif
+
+#else
+#ifndef ZeroD
+# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
+#endif
+
+#endif
+#ifndef PoisonWith
+# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
+#endif
+
+#ifndef PoisonNew
+# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
+#endif
+
+#ifndef PoisonFree
+# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
+#endif
+
+#ifndef Poison
+# define Poison(d,n,t) PoisonFree(d,n,t)
+#endif
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif
+
+#ifndef Newxc
+# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
+#endif
+
+#ifndef Newxz
+# define Newxz(v,n,t) Newz(0,v,n,t)
+#endif
+
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+# else
+# define PERL_UNUSED_DECL
+# endif
+#endif
+
+#ifndef PERL_UNUSED_ARG
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
+# include
+# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+# else
+# define PERL_UNUSED_ARG(x) ((void)x)
+# endif
+#endif
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif
+
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
+#endif
+#ifndef NOOP
+# define NOOP /*EMPTY*/(void)0
+#endif
+
+#ifndef dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+# else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
+# endif
+#endif
+
+#ifndef PTR2ul
+# if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+# else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+# endif
+#endif
+#ifndef PTR2nat
+# define PTR2nat(p) (PTRV)(p)
+#endif
+
+#ifndef NUM2PTR
+# define NUM2PTR(any,d) (any)PTR2nat(d)
+#endif
+
+#ifndef PTR2IV
+# define PTR2IV(p) INT2PTR(IV,p)
+#endif
+
+#ifndef PTR2UV
+# define PTR2UV(p) INT2PTR(UV,p)
+#endif
+
+#ifndef PTR2NV
+# define PTR2NV(p) NUM2PTR(NV,p)
+#endif
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
+#if defined(PERL_GCC_PEDANTIC)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#ifdef PERL_USE_GCC_BRACE_GROUPS
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+#else
+# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+#endif
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+#ifndef DEFSV_set
+# define DEFSV_set(sv) (DEFSV = (sv))
+#endif
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
+#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
+#endif
+
+/* Hint: gv_stashpvn
+ * This function's backport doesn't support the length parameter, but
+ * rather ignores it. Portability can only be ensured if the length
+ * parameter is used for speed reasons, but the length can always be
+ * correctly computed from the string argument.
+ */
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
+#endif
+
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
+#endif
+
+#ifndef get_sv
+# define get_sv perl_get_sv
+#endif
+
+#ifndef get_av
+# define get_av perl_get_av
+#endif
+
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
+
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
+#endif
+
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
+#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
+#endif
+
+#ifndef dITEMS
+# define dITEMS I32 items = SP - MARK
+#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
+#ifndef dAXMARK
+# define dAXMARK I32 ax = POPMARK; \
+ register SV ** const mark = PL_stack_base + ax++
+#endif
+#ifndef XSprePUSH
+# define XSprePUSH (sp = PL_stack_base + ax - 1)
+#endif
+
+#if (PERL_BCDVERSION < 0x5005000)
+# undef XSRETURN
+# define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
+#endif
+#ifndef PERL_ABS
+# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+#ifndef SVf
+# define SVf "_"
+#endif
+#ifndef UTF8_MAXBYTES
+# define UTF8_MAXBYTES UTF8_MAXLEN
+#endif
+#ifndef CPERLscope
+# define CPERLscope(x) x
+#endif
+#ifndef PERL_HASH
+# define PERL_HASH(hash,str,len) \
+ STMT_START { \
+ const char *s_PeRlHaSh = str; \
+ I32 i_PeRlHaSh = len; \
+ U32 hash_PeRlHaSh = 0; \
+ while (i_PeRlHaSh--) \
+ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
+ (hash) = hash_PeRlHaSh; \
+ } STMT_END
+#endif
+
+#ifndef PERLIO_FUNCS_DECL
+# ifdef PERLIO_FUNCS_CONST
+# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
+# else
+# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (funcs)
+# endif
+#endif
+
+/* provide these typedefs for older perls */
+#if (PERL_BCDVERSION < 0x5009003)
+
+# ifdef ARGSproto
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
+# else
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+# endif
+
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
+
+#endif
+#ifndef isPSXSPC
+# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+#endif
+
+#ifndef isBLANK
+# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#endif
+
+#ifdef EBCDIC
+#ifndef isALNUMC
+# define isALNUMC(c) isalnum(c)
+#endif
+
+#ifndef isASCII
+# define isASCII(c) isascii(c)
+#endif
+
+#ifndef isCNTRL
+# define isCNTRL(c) iscntrl(c)
+#endif
+
+#ifndef isGRAPH
+# define isGRAPH(c) isgraph(c)
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) isprint(c)
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) ispunct(c)
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) isxdigit(c)
+#endif
+
+#else
+# if (PERL_BCDVERSION < 0x5010000)
+/* Hint: isPRINT
+ * The implementation in older perl versions includes all of the
+ * isSPACE() characters, which is wrong. The version provided by
+ * Devel::PPPort always overrides a present buggy version.
+ */
+# undef isPRINT
+# endif
+#ifndef isALNUMC
+# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
+#endif
+
+#ifndef isASCII
+# define isASCII(c) ((c) <= 127)
+#endif
+
+#ifndef isCNTRL
+# define isCNTRL(c) ((c) < ' ' || (c) == 127)
+#endif
+
+#ifndef isGRAPH
+# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) (((c) >= 32 && (c) < 127))
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#endif
+
+#endif
+
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
+
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
+#endif
+
+#if defined(NEED_PL_signals)
+static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#elif defined(NEED_PL_signals_GLOBAL)
+U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#else
+extern U32 DPPP_(my_PL_signals);
+#endif
+#define PL_signals DPPP_(my_PL_signals)
+
+#endif
+
+/* Hint: PL_ppaddr
+ * Calling an op via PL_ppaddr requires passing a context argument
+ * for threaded builds. Since the context argument is different for
+ * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
+ * automatically be defined as the correct argument.
+ */
+
+#if (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
+#endif
+
+#if (PERL_BCDVERSION <= 0x5004005)
+/* Replace: 1 */
+# define PL_DBsignal DBsignal
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_DBtrace DBtrace
+# define PL_Sv Sv
+# define PL_bufend bufend
+# define PL_bufptr bufptr
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_expect expect
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_laststatval laststatval
+# define PL_lex_state lex_state
+# define PL_lex_stuff lex_stuff
+# define PL_linestr linestr
+# define PL_na na
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_statcache statcache
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
+# define PL_tokenbuf tokenbuf
+/* Replace: 0 */
+#endif
+
+/* Warning: PL_parser
+ * For perl versions earlier than 5.9.5, this is an always
+ * non-NULL dummy. Also, it cannot be dereferenced. Don't
+ * use it if you can avoid is and unless you absolutely know
+ * what you're doing.
+ * If you always check that PL_parser is non-NULL, you can
+ * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
+ * a dummy parser structure.
+ */
+
+#if (PERL_BCDVERSION >= 0x5009005)
+# ifdef DPPP_PL_parser_NO_DUMMY
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (croak("panic: PL_parser == NULL in %s:%d", \
+ __FILE__, __LINE__), (yy_parser *) NULL))->var)
+# else
+# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
+# define D_PPP_parser_dummy_warning(var)
+# else
+# define D_PPP_parser_dummy_warning(var) \
+ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
+# endif
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
+#if defined(NEED_PL_parser)
+static yy_parser DPPP_(dummy_PL_parser);
+#elif defined(NEED_PL_parser_GLOBAL)
+yy_parser DPPP_(dummy_PL_parser);
+#else
+extern yy_parser DPPP_(dummy_PL_parser);
+#endif
+
+# endif
+
+/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
+ * Do not use this variable unless you know exactly what you're
+ * doint. It is internal to the perl parser and may change or even
+ * be removed in the future. As of perl 5.9.5, you have to check
+ * for (PL_parser != NULL) for this variable to have any effect.
+ * An always non-NULL PL_parser dummy is provided for earlier
+ * perl versions.
+ * If PL_parser is NULL when you try to access this variable, a
+ * dummy is being accessed instead and a warning is issued unless
+ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
+ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
+ * this variable will croak with a panic message.
+ */
+
+# define PL_expect D_PPP_my_PL_parser_var(expect)
+# define PL_copline D_PPP_my_PL_parser_var(copline)
+# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
+# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
+# define PL_linestr D_PPP_my_PL_parser_var(linestr)
+# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
+# define PL_bufend D_PPP_my_PL_parser_var(bufend)
+# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
+# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
+# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
+
+#else
+
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
+
+#endif
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
+#endif
+
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#endif
+
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
+#endif
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
+#endif
+
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#endif
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
+
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
+#endif
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#endif
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#endif
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#endif
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#endif
+
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
+#endif
+
+#ifndef call_pv
+# define call_pv perl_call_pv
+#endif
+
+#ifndef call_argv
+# define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+# define call_method perl_call_method
+#endif
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
+#endif
+
+/* Replace: 0 */
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
+#endif
+
+#ifndef PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
+#endif
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
+#endif
+
+#ifndef G_METHOD
+# define G_METHOD 64
+# ifdef call_sv
+# undef call_sv
+# endif
+# if (PERL_BCDVERSION < 0x5006000)
+# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
+# else
+# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
+# endif
+#endif
+
+/* Replace perl_eval_pv with eval_pv */
+
+#ifndef eval_pv
+#if defined(NEED_eval_pv)
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+static
+#else
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#endif
+
+#ifdef eval_pv
+# undef eval_pv
+#endif
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
+
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+SV*
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
+{
+ dSP;
+ SV* sv = newSVpv(p, 0);
+
+ PUSHMARK(sp);
+ eval_sv(sv, G_SCALAR);
+ SvREFCNT_dec(sv);
+
+ SPAGAIN;
+ sv = POPs;
+ PUTBACK;
+
+ if (croak_on_error && SvTRUE(GvSV(errgv)))
+ croak(SvPVx(GvSV(errgv), na));
+
+ return sv;
+}
+
+#endif
+#endif
+
+#ifndef vload_module
+#if defined(NEED_vload_module)
+static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+static
+#else
+extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+#endif
+
+#ifdef vload_module
+# undef vload_module
+#endif
+#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
+#define Perl_vload_module DPPP_(my_vload_module)
+
+#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+
+void
+DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
+{
+ dTHR;
+ dVAR;
+ OP *veop, *imop;
+
+ OP * const modname = newSVOP(OP_CONST, 0, name);
+ /* 5.005 has a somewhat hacky force_normal that doesn't croak on
+ SvREADONLY() if PL_compling is true. Current perls take care in
+ ck_require() to correctly turn off SvREADONLY before calling
+ force_normal_flags(). This seems a better fix than fudging PL_compling
+ */
+ SvREADONLY_off(((SVOP*)modname)->op_sv);
+ modname->op_private |= OPpCONST_BARE;
+ if (ver) {
+ veop = newSVOP(OP_CONST, 0, ver);
+ }
+ else
+ veop = NULL;
+ if (flags & PERL_LOADMOD_NOIMPORT) {
+ imop = sawparens(newNULLLIST());
+ }
+ else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+ imop = va_arg(*args, OP*);
+ }
+ else {
+ SV *sv;
+ imop = NULL;
+ sv = va_arg(*args, SV*);
+ while (sv) {
+ imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+ sv = va_arg(*args, SV*);
+ }
+ }
+ {
+ const line_t ocopline = PL_copline;
+ COP * const ocurcop = PL_curcop;
+ const int oexpect = PL_expect;
+
+#if (PERL_BCDVERSION >= 0x5004000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+#else
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ modname, imop);
+#endif
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
+#endif
+#endif
+
+#ifndef load_module
+#if defined(NEED_load_module)
+static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+static
+#else
+extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+#endif
+
+#ifdef load_module
+# undef load_module
+#endif
+#define load_module DPPP_(my_load_module)
+#define Perl_load_module DPPP_(my_load_module)
+
+#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
+
+void
+DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
+{
+ va_list args;
+ va_start(args, ver);
+ vload_module(flags, name, ver, &args);
+ va_end(args);
+}
+
+#endif
+#endif
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
+#endif
+
+#ifndef newRV_noinc
+#if defined(NEED_newRV_noinc)
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
+#endif
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#endif
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
+
+#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
+SV *
+DPPP_(my_newRV_noinc)(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
+#endif
+#endif
+
+/* Hint: newCONSTSUB
+ * Returns a CV* as of perl-5.7.1. This return value is not supported
+ * by Devel::PPPort.
+ */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+#endif
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#endif
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
+/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
+#define D_PPP_PL_copline PL_copline
+
+void
+DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
+{
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = D_PPP_PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if (PERL_BCDVERSION < 0x5003022)
+ start_subparse(),
+#elif (PERL_BCDVERSION == 0x5003022)
+ start_subparse(0),
+#else /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
+#endif
+
+ newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
+}
+#endif
+#endif
+
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C. All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe. See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ * all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ * (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ * MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ * access MY_CXT.
+ */
+
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
+ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+
+#ifndef START_MY_CXT
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope). The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT
+
+#if (PERL_BCDVERSION < 0x5004068)
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
+ sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+ dMY_CXT_SV; \
+ /* newSV() allocates one more than needed */ \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Zero(my_cxtp, 1, my_cxt_t); \
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT (*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used. Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT my_cxt_t *my_cxtp
+#define pMY_CXT_ pMY_CXT,
+#define _pMY_CXT ,pMY_CXT
+#define aMY_CXT my_cxtp
+#define aMY_CXT_ aMY_CXT,
+#define _aMY_CXT ,aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
+#else /* single interpreter */
+
+#ifndef START_MY_CXT
+
+#define START_MY_CXT static my_cxt_t my_cxt;
+#define dMY_CXT_SV dNOOP
+#define dMY_CXT dNOOP
+#define MY_CXT_INIT NOOP
+#define MY_CXT my_cxt
+
+#define pMY_CXT void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
+#endif
+
+#endif
+
+#ifndef IVdf
+# if IVSIZE == LONGSIZE
+# define IVdf "ld"
+# define UVuf "lu"
+# define UVof "lo"
+# define UVxf "lx"
+# define UVXf "lX"
+# else
+# if IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# endif
+# endif
+#endif
+
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
+ /* Not very likely, but let's try anyway. */
+# define NVef PERL_PRIeldbl
+# define NVff PERL_PRIfldbl
+# define NVgf PERL_PRIgldbl
+# else
+# define NVef "e"
+# define NVff "f"
+# define NVgf "g"
+# endif
+#endif
+
+#ifndef SvREFCNT_inc
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (SvREFCNT(_sv))++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc(sv) \
+ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_simple
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_simple(sv) \
+ ({ \
+ if (sv) \
+ (SvREFCNT(sv))++; \
+ (SV *)(sv); \
+ })
+# else
+# define SvREFCNT_inc_simple(sv) \
+ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_NN
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_NN(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ SvREFCNT(_sv)++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc_NN(sv) \
+ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_void
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_void(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (void)(SvREFCNT(_sv)++); \
+ })
+# else
+# define SvREFCNT_inc_void(sv) \
+ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+# endif
+#endif
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
+#endif
+
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
+#endif
+
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
+#else
+# define D_PPP_CONSTPV_ARG(x) (x)
+#endif
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#endif
+#ifndef newSVpvn_utf8
+# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+#endif
+#ifndef SVf_UTF8
+# define SVf_UTF8 0
+#endif
+
+#ifndef newSVpvn_flags
+
+#if defined(NEED_newSVpvn_flags)
+static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+#endif
+
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
+#endif
+#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
+#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
+
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
+{
+ SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
+ SvFLAGS(sv) |= (flags & SVf_UTF8);
+ return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+}
+
+#endif
+
+#endif
+
+/* Backwards compatibility stuff... :-( */
+#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
+# define NEED_sv_2pv_flags
+#endif
+#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
+# define NEED_sv_2pv_flags_GLOBAL
+#endif
+
+/* Hint: sv_2pv_nolen
+ * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
+ */
+#ifndef sv_2pv_nolen
+# define sv_2pv_nolen(sv) SvPV_nolen(sv)
+#endif
+
+#ifdef SvPVbyte
+
+/* Hint: SvPVbyte
+ * Does not work in perl-5.6.1, ppport.h implements a version
+ * borrowed from perl-5.7.3.
+ */
+
+#if (PERL_BCDVERSION < 0x5007000)
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+static
+#else
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+#endif
+
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
+
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
+
+char *
+DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
+{
+ sv_utf8_downgrade(sv,0);
+ return SvPV(sv,*lp);
+}
+
+#endif
+
+/* Hint: sv_2pvbyte
+ * Use the SvPVbyte() macro instead of sv_2pvbyte().
+ */
+
+#undef SvPVbyte
+
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+
+#endif
+
+#else
+
+# define SvPVbyte SvPV
+# define sv_2pvbyte sv_2pv
+
+#endif
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
+#endif
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+
+/* If these are undefined, they're not handled by the core anyway */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
+#endif
+
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
+#endif
+
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
+#endif
+
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
+#endif
+
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
+#endif
+
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
+#endif
+
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
+#endif
+
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
+#endif
+
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
+
+#if (PERL_BCDVERSION < 0x5007002)
+
+#if defined(NEED_sv_2pv_flags)
+static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
+#endif
+#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
+#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
+
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_2pv(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#if defined(NEED_sv_pvn_force_flags)
+static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_flags
+#endif
+#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
+#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
+
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_pvn_force(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
+# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
+#else
+# define DPPP_SVPV_NOLEN_LP_ARG 0
+#endif
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+#ifndef SvPV_flags
+# define SvPV_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_flags_const
+# define SvPV_flags_const(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
+ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_const_nolen
+# define SvPV_flags_const_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : \
+ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_mutable
+# define SvPV_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
+ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
+#endif
+#ifndef SvPV_force_flags
+# define SvPV_force_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_force_flags_nolen
+# define SvPV_force_flags_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
+#endif
+#ifndef SvPV_force_flags_mutable
+# define SvPV_force_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
+ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
+#endif
+#ifndef SvPV_nolen_const
+# define SvPV_nolen_const(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#endif
+#ifndef SvPV_renew
+# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (char *) saferealloc( \
+ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
+ } STMT_END
+#endif
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ ((sv)->sv_u.svu_rv = (val)); } STMT_END
+#endif
+
+#endif
+#ifndef SvSTASH_set
+# define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5004000)
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+#endif
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+SV *
+DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+#ifndef newSVpvn_share
+
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#endif
+
+#ifdef newSVpvn_share
+# undef newSVpvn_share
+#endif
+#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
+#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
+
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+{
+ SV *sv;
+ if (len < 0)
+ len = -len;
+ if (!hash)
+ PERL_HASH(hash, (char*) src, len);
+ sv = newSVpvn((char *) src, len);
+ sv_upgrade(sv, SVt_PVIV);
+ SvIVX(sv) = hash;
+ SvREADONLY_on(sv);
+ SvPOK_on(sv);
+ return sv;
+}
+
+#endif
+
+#endif
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
+#endif
+#ifndef WARN_ALL
+# define WARN_ALL 0
+#endif
+
+#ifndef WARN_CLOSURE
+# define WARN_CLOSURE 1
+#endif
+
+#ifndef WARN_DEPRECATED
+# define WARN_DEPRECATED 2
+#endif
+
+#ifndef WARN_EXITING
+# define WARN_EXITING 3
+#endif
+
+#ifndef WARN_GLOB
+# define WARN_GLOB 4
+#endif
+
+#ifndef WARN_IO
+# define WARN_IO 5
+#endif
+
+#ifndef WARN_CLOSED
+# define WARN_CLOSED 6
+#endif
+
+#ifndef WARN_EXEC
+# define WARN_EXEC 7
+#endif
+
+#ifndef WARN_LAYER
+# define WARN_LAYER 8
+#endif
+
+#ifndef WARN_NEWLINE
+# define WARN_NEWLINE 9
+#endif
+
+#ifndef WARN_PIPE
+# define WARN_PIPE 10
+#endif
+
+#ifndef WARN_UNOPENED
+# define WARN_UNOPENED 11
+#endif
+
+#ifndef WARN_MISC
+# define WARN_MISC 12
+#endif
+
+#ifndef WARN_NUMERIC
+# define WARN_NUMERIC 13
+#endif
+
+#ifndef WARN_ONCE
+# define WARN_ONCE 14
+#endif
+
+#ifndef WARN_OVERFLOW
+# define WARN_OVERFLOW 15
+#endif
+
+#ifndef WARN_PACK
+# define WARN_PACK 16
+#endif
+
+#ifndef WARN_PORTABLE
+# define WARN_PORTABLE 17
+#endif
+
+#ifndef WARN_RECURSION
+# define WARN_RECURSION 18
+#endif
+
+#ifndef WARN_REDEFINE
+# define WARN_REDEFINE 19
+#endif
+
+#ifndef WARN_REGEXP
+# define WARN_REGEXP 20
+#endif
+
+#ifndef WARN_SEVERE
+# define WARN_SEVERE 21
+#endif
+
+#ifndef WARN_DEBUGGING
+# define WARN_DEBUGGING 22
+#endif
+
+#ifndef WARN_INPLACE
+# define WARN_INPLACE 23
+#endif
+
+#ifndef WARN_INTERNAL
+# define WARN_INTERNAL 24
+#endif
+
+#ifndef WARN_MALLOC
+# define WARN_MALLOC 25
+#endif
+
+#ifndef WARN_SIGNAL
+# define WARN_SIGNAL 26
+#endif
+
+#ifndef WARN_SUBSTR
+# define WARN_SUBSTR 27
+#endif
+
+#ifndef WARN_SYNTAX
+# define WARN_SYNTAX 28
+#endif
+
+#ifndef WARN_AMBIGUOUS
+# define WARN_AMBIGUOUS 29
+#endif
+
+#ifndef WARN_BAREWORD
+# define WARN_BAREWORD 30
+#endif
+
+#ifndef WARN_DIGIT
+# define WARN_DIGIT 31
+#endif
+
+#ifndef WARN_PARENTHESIS
+# define WARN_PARENTHESIS 32
+#endif
+
+#ifndef WARN_PRECEDENCE
+# define WARN_PRECEDENCE 33
+#endif
+
+#ifndef WARN_PRINTF
+# define WARN_PRINTF 34
+#endif
+
+#ifndef WARN_PROTOTYPE
+# define WARN_PROTOTYPE 35
+#endif
+
+#ifndef WARN_QW
+# define WARN_QW 36
+#endif
+
+#ifndef WARN_RESERVED
+# define WARN_RESERVED 37
+#endif
+
+#ifndef WARN_SEMICOLON
+# define WARN_SEMICOLON 38
+#endif
+
+#ifndef WARN_TAINT
+# define WARN_TAINT 39
+#endif
+
+#ifndef WARN_THREADS
+# define WARN_THREADS 40
+#endif
+
+#ifndef WARN_UNINITIALIZED
+# define WARN_UNINITIALIZED 41
+#endif
+
+#ifndef WARN_UNPACK
+# define WARN_UNPACK 42
+#endif
+
+#ifndef WARN_UNTIE
+# define WARN_UNTIE 43
+#endif
+
+#ifndef WARN_UTF8
+# define WARN_UTF8 44
+#endif
+
+#ifndef WARN_VOID
+# define WARN_VOID 45
+#endif
+
+#ifndef WARN_ASSERTIONS
+# define WARN_ASSERTIONS 46
+#endif
+#ifndef packWARN
+# define packWARN(a) (a)
+#endif
+
+#ifndef ckWARN
+# ifdef G_WARN_ON
+# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+# else
+# define ckWARN(a) PL_dowarn
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
+#if defined(NEED_warner)
+static void DPPP_(my_warner)(U32 err, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
+#endif
+
+#define Perl_warner DPPP_(my_warner)
+
+#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
+
+void
+DPPP_(my_warner)(U32 err, const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
+
+ PERL_UNUSED_ARG(err);
+
+ va_start(args, pat);
+ sv = vnewSVpvf(pat, &args);
+ va_end(args);
+ sv_2mortal(sv);
+ warn("%s", SvPV_nolen(sv));
+}
+
+#define warner Perl_warner
+
+#define Perl_warner_nocontext Perl_warner
+
+#endif
+#endif
+
+/* concatenating with "" ensures that only literal strings are accepted as argument
+ * note that STR_WITH_LEN() can't be used as argument to macros or functions that
+ * under some configurations might be macros
+ */
+#ifndef STR_WITH_LEN
+# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
+#endif
+#ifndef newSVpvs
+# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
+#endif
+
+#ifndef newSVpvs_flags
+# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
+#endif
+
+#ifndef sv_catpvs
+# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef sv_setpvs
+# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef hv_fetchs
+# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
+#endif
+
+#ifndef hv_stores
+# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
+#endif
+#ifndef SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#endif
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
+#endif
+
+#ifndef PERL_MAGIC_overload
+# define PERL_MAGIC_overload 'A'
+#endif
+
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
+#endif
+
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
+#endif
+
+#ifndef PERL_MAGIC_bm
+# define PERL_MAGIC_bm 'B'
+#endif
+
+#ifndef PERL_MAGIC_regdata
+# define PERL_MAGIC_regdata 'D'
+#endif
+
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
+#endif
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
+#endif
+
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
+#endif
+
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
+#endif
+
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
+#endif
+
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
+#endif
+
+#ifndef PERL_MAGIC_isaelem
+# define PERL_MAGIC_isaelem 'i'
+#endif
+
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
+#endif
+
+#ifndef PERL_MAGIC_dbfile
+# define PERL_MAGIC_dbfile 'L'
+#endif
+
+#ifndef PERL_MAGIC_dbline
+# define PERL_MAGIC_dbline 'l'
+#endif
+
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
+#endif
+
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
+#endif
+
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
+#endif
+
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
+#endif
+
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
+#endif
+
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
+#endif
+
+#ifndef PERL_MAGIC_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
+#endif
+
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
+#endif
+
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
+#endif
+
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
+#endif
+
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
+#endif
+
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
+#endif
+
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
+#endif
+
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
+#endif
+
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
+#endif
+
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
+#endif
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
+#endif
+
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
+#endif
+
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
+#endif
+
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
+#endif
+
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
+#endif
+
+#ifndef PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
+#endif
+
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
+#endif
+
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
+#endif
+
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
+#endif
+
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
+#endif
+
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
+#endif
+
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
+#endif
+
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
+#endif
+
+#ifndef sv_catpv_mg
+# define sv_catpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catpvn_mg
+# define sv_catpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catsv_mg
+# define sv_catsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_catsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setnv_mg
+# define sv_setnv_mg(sv, num) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setnv(TeMpSv,num); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpv_mg
+# define sv_setpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpvn_mg
+# define sv_setpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setsv_mg
+# define sv_setsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_setsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setuv_mg
+# define sv_setuv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setuv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_usepvn_mg
+# define sv_usepvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_usepvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+#ifndef SvVSTRING_mg
+# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
+#endif
+
+/* Hint: sv_magic_portable
+ * This is a compatibility function that is only available with
+ * Devel::PPPort. It is NOT in the perl core.
+ * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
+ * it is being passed a name pointer with namlen == 0. In that
+ * case, perl 5.8.0 and later store the pointer, not a copy of it.
+ * The compatibility can be provided back to perl 5.004. With
+ * earlier versions, the code will not compile.
+ */
+
+#if (PERL_BCDVERSION < 0x5004000)
+
+ /* code that uses sv_magic_portable will not compile */
+
+#elif (PERL_BCDVERSION < 0x5008000)
+
+# define sv_magic_portable(sv, obj, how, name, namlen) \
+ STMT_START { \
+ SV *SvMp_sv = (sv); \
+ char *SvMp_name = (char *) (name); \
+ I32 SvMp_namlen = (namlen); \
+ if (SvMp_name && SvMp_namlen == 0) \
+ { \
+ MAGIC *mg; \
+ sv_magic(SvMp_sv, obj, how, 0, 0); \
+ mg = SvMAGIC(SvMp_sv); \
+ mg->mg_len = -42; /* XXX: this is the tricky part */ \
+ mg->mg_ptr = SvMp_name; \
+ } \
+ else \
+ { \
+ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+ } \
+ } STMT_END
+
+#else
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+
+#endif
+
+#ifdef USE_ITHREADS
+#ifndef CopFILE
+# define CopFILE(c) ((c)->cop_file)
+#endif
+
+#ifndef CopFILEGV
+# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) ((c)->cop_stashpv)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#endif
+
+#else
+#ifndef CopFILEGV
+# define CopFILEGV(c) ((c)->cop_filegv)
+#endif
+
+#ifndef CopFILEGV_set
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+#endif
+
+#ifndef CopFILE
+# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) ((c)->cop_stash)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
+#endif
+
+#endif /* USE_ITHREADS */
+#ifndef IN_PERL_COMPILETIME
+# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE
+# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+#ifndef IS_NUMBER_IN_UV
+# define IS_NUMBER_IN_UV 0x01
+#endif
+
+#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
+# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef IS_NUMBER_NOT_INT
+# define IS_NUMBER_NOT_INT 0x04
+#endif
+
+#ifndef IS_NUMBER_NEG
+# define IS_NUMBER_NEG 0x08
+#endif
+
+#ifndef IS_NUMBER_INFINITY
+# define IS_NUMBER_INFINITY 0x10
+#endif
+
+#ifndef IS_NUMBER_NAN
+# define IS_NUMBER_NAN 0x20
+#endif
+#ifndef GROK_NUMERIC_RADIX
+# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+#endif
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+# define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+# define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#ifndef grok_numeric_radix
+#if defined(NEED_grok_numeric_radix)
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static
+#else
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+#endif
+
+#ifdef grok_numeric_radix
+# undef grok_numeric_radix
+#endif
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
+
+#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
+bool
+DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+#ifdef PL_numeric_radix_sv
+ if (PL_numeric_radix_sv && IN_LOCALE) {
+ STRLEN len;
+ char* radix = SvPV(PL_numeric_radix_sv, len);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#else
+ /* older perls don't have PL_numeric_radix_sv so the radix
+ * must manually be requested from locale.h
+ */
+#include
+ dTHR; /* needed for older threaded perls */
+ struct lconv *lc = localeconv();
+ char *radix = lc->decimal_point;
+ if (radix && IN_LOCALE) {
+ STRLEN len = strlen(radix);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#endif
+#endif /* USE_LOCALE_NUMERIC */
+ /* always try "." if numeric radix didn't match because
+ * we may have data from different locales mixed */
+ if (*sp < send && **sp == '.') {
+ ++*sp;
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+#endif
+
+#ifndef grok_number
+#if defined(NEED_grok_number)
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static
+#else
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+#endif
+
+#ifdef grok_number
+# undef grok_number
+#endif
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
+
+#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
+int
+DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
+{
+ const char *s = pv;
+ const char *send = pv + len;
+ const UV max_div_10 = UV_MAX / 10;
+ const char max_mod_10 = UV_MAX % 10;
+ int numtype = 0;
+ int sawinf = 0;
+ int sawnan = 0;
+
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s == send) {
+ return 0;
+ } else if (*s == '-') {
+ s++;
+ numtype = IS_NUMBER_NEG;
+ }
+ else if (*s == '+')
+ s++;
+
+ if (s == send)
+ return 0;
+
+ /* next must be digit or the radix separator or beginning of infinity */
+ if (isDIGIT(*s)) {
+ /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+ overflow. */
+ UV value = *s - '0';
+ /* This construction seems to be more optimiser friendly.
+ (without it gcc does the isDIGIT test and the *s - '0' separately)
+ With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+ In theory the optimiser could deduce how far to unroll the loop
+ before checking for overflow. */
+ if (++s < send) {
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ /* Now got 9 digits, so need to check
+ each time for overflow. */
+ digit = *s - '0';
+ while (digit >= 0 && digit <= 9
+ && (value < max_div_10
+ || (value == max_div_10
+ && digit <= max_mod_10))) {
+ value = value * 10 + digit;
+ if (++s < send)
+ digit = *s - '0';
+ else
+ break;
+ }
+ if (digit >= 0 && digit <= 9
+ && (s < send)) {
+ /* value overflowed.
+ skip the remaining digits, don't
+ worry about setting *valuep. */
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ numtype |=
+ IS_NUMBER_GREATER_THAN_UV_MAX;
+ goto skip_value;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ numtype |= IS_NUMBER_IN_UV;
+ if (valuep)
+ *valuep = value;
+
+ skip_value:
+ if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT;
+ while (s < send && isDIGIT(*s)) /* optional digits after the radix */
+ s++;
+ }
+ }
+ else if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
+ /* no digits before the radix means we need digits after it */
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ if (valuep) {
+ /* integer approximation is valid - it's 0. */
+ *valuep = 0;
+ }
+ }
+ else
+ return 0;
+ } else if (*s == 'I' || *s == 'i') {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
+ s++; if (s < send && (*s == 'I' || *s == 'i')) {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
+ s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
+ s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
+ s++;
+ }
+ sawinf = 1;
+ } else if (*s == 'N' || *s == 'n') {
+ /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++;
+ sawnan = 1;
+ } else
+ return 0;
+
+ if (sawinf) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ } else if (sawnan) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ } else if (s < send) {
+ /* we can have an optional exponent part */
+ if (*s == 'e' || *s == 'E') {
+ /* The only flag we keep is sign. Blow away any "it's UV" */
+ numtype &= IS_NUMBER_NEG;
+ numtype |= IS_NUMBER_NOT_INT;
+ s++;
+ if (s < send && (*s == '-' || *s == '+'))
+ s++;
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ }
+ else
+ return 0;
+ }
+ }
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s >= send)
+ return numtype;
+ if (len == 10 && memEQ(pv, "0 but true", 10)) {
+ if (valuep)
+ *valuep = 0;
+ return IS_NUMBER_IN_UV;
+ }
+ return 0;
+}
+#endif
+#endif
+
+/*
+ * The grok_* routines have been modified to use warn() instead of
+ * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
+ * which is why the stack variable has been renamed to 'xdigit'.
+ */
+
+#ifndef grok_bin
+#if defined(NEED_grok_bin)
+static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_bin
+# undef grok_bin
+#endif
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
+
+#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
+UV
+DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_2 = UV_MAX / 2;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading b or 0b.
+ for compatibility silently suffer "b" and "0b" as valid binary
+ numbers. */
+ if (len >= 1) {
+ if (s[0] == 'b') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ char bit = *s;
+ if (bit == '0' || bit == '1') {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_bin. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_2) {
+ value = (value << 1) | (bit - '0');
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in binary number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 2.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount. */
+ value_nv += (NV)(bit - '0');
+ continue;
+ }
+ if (bit == '_' && len && allow_underscores && (bit = s[1])
+ && (bit == '0' || bit == '1'))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal binary digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Binary number > 0b11111111111111111111111111111111 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_hex
+#if defined(NEED_grok_hex)
+static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_hex
+# undef grok_hex
+#endif
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
+
+#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
+UV
+DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_16 = UV_MAX / 16;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+ const char *xdigit;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading x or 0x.
+ for compatibility silently suffer "x" and "0x" as valid hex numbers.
+ */
+ if (len >= 1) {
+ if (s[0] == 'x') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ xdigit = strchr((char *) PL_hexdigit, *s);
+ if (xdigit) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_hex. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_16) {
+ value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ warn("Integer overflow in hexadecimal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 16.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 16-tuples. */
+ value_nv += (NV)((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ if (*s == '_' && len && allow_underscores && s[1]
+ && (xdigit = strchr((char *) PL_hexdigit, s[1])))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal hexadecimal digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Hexadecimal number > 0xffffffff non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_oct
+#if defined(NEED_grok_oct)
+static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_oct
+# undef grok_oct
+#endif
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
+
+#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
+UV
+DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_8 = UV_MAX / 8;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ for (; len-- && *s; s++) {
+ /* gcc 2.95 optimiser not smart enough to figure that this subtraction
+ out front allows slicker code. */
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 7) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_8) {
+ value = (value << 3) | digit;
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in octal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 8.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 8-tuples. */
+ value_nv += (NV)digit;
+ continue;
+ }
+ if (digit == ('_' - '0') && len && allow_underscores
+ && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ /* Allow \octal to work the DWIM way (that is, stop scanning
+ * as soon as non-octal characters are seen, complain only iff
+ * someone seems to want to use the digits eight and nine). */
+ if (digit == 8 || digit == 9) {
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal octal digit '%c' ignored", *s);
+ }
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Octal number > 037777777777 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#if !defined(my_snprintf)
+#if defined(NEED_my_snprintf)
+static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+static
+#else
+extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+#endif
+
+#define my_snprintf DPPP_(my_my_snprintf)
+#define Perl_my_snprintf DPPP_(my_my_snprintf)
+
+#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
+
+int
+DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
+{
+ dTHX;
+ int retval;
+ va_list ap;
+ va_start(ap, format);
+#ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, ap);
+#else
+ retval = vsprintf(buffer, format, ap);
+#endif
+ va_end(ap);
+ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
+ Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+ return retval;
+}
+
+#endif
+#endif
+
+#if !defined(my_sprintf)
+#if defined(NEED_my_sprintf)
+static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+static
+#else
+extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+#endif
+
+#define my_sprintf DPPP_(my_my_sprintf)
+#define Perl_my_sprintf DPPP_(my_my_sprintf)
+
+#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
+
+int
+DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ vsprintf(buffer, pat, args);
+ va_end(args);
+ return strlen(buffer);
+}
+
+#endif
+#endif
+
+#ifdef NO_XSLOCKS
+# ifdef dJMPENV
+# define dXCPT dJMPENV; int rEtV = 0
+# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
+# define XCPT_TRY_END JMPENV_POP;
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW JMPENV_JUMP(rEtV)
+# else
+# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
+# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
+# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
+# endif
+#endif
+
+#if !defined(my_strlcat)
+#if defined(NEED_my_strlcat)
+static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcat DPPP_(my_my_strlcat)
+#define Perl_my_strlcat DPPP_(my_my_strlcat)
+
+#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
+{
+ Size_t used, length, copy;
+
+ used = strlen(dst);
+ length = strlen(src);
+ if (size > 0 && used < size - 1) {
+ copy = (length >= size - used) ? size - used - 1 : length;
+ memcpy(dst + used, src, copy);
+ dst[used + copy] = '\0';
+ }
+ return used + length;
+}
+#endif
+#endif
+
+#if !defined(my_strlcpy)
+#if defined(NEED_my_strlcpy)
+static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcpy DPPP_(my_my_strlcpy)
+#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
+
+#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
+{
+ Size_t length, copy;
+
+ length = strlen(src);
+ if (size > 0) {
+ copy = (length >= size) ? size - 1 : length;
+ memcpy(dst, src, copy);
+ dst[copy] = '\0';
+ }
+ return length;
+}
+
+#endif
+#endif
+#ifndef PERL_PV_ESCAPE_QUOTE
+# define PERL_PV_ESCAPE_QUOTE 0x0001
+#endif
+
+#ifndef PERL_PV_PRETTY_QUOTE
+# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_ELLIPSES
+# define PERL_PV_PRETTY_ELLIPSES 0x0002
+#endif
+
+#ifndef PERL_PV_PRETTY_LTGT
+# define PERL_PV_PRETTY_LTGT 0x0004
+#endif
+
+#ifndef PERL_PV_ESCAPE_FIRSTCHAR
+# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI
+# define PERL_PV_ESCAPE_UNI 0x0100
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI_DETECT
+# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
+#endif
+
+#ifndef PERL_PV_ESCAPE_ALL
+# define PERL_PV_ESCAPE_ALL 0x1000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOBACKSLASH
+# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOCLEAR
+# define PERL_PV_ESCAPE_NOCLEAR 0x4000
+#endif
+
+#ifndef PERL_PV_ESCAPE_RE
+# define PERL_PV_ESCAPE_RE 0x8000
+#endif
+
+#ifndef PERL_PV_PRETTY_NOCLEAR
+# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+#endif
+#ifndef PERL_PV_PRETTY_DUMP
+# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_REGPROP
+# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+#endif
+
+/* Hint: pv_escape
+ * Note that unicode functionality is only backported to
+ * those perl versions that support it. For older perl
+ * versions, the implementation will fall back to bytes.
+ */
+
+#ifndef pv_escape
+#if defined(NEED_pv_escape)
+static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+static
+#else
+extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+#endif
+
+#ifdef pv_escape
+# undef pv_escape
+#endif
+#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
+#define Perl_pv_escape DPPP_(my_pv_escape)
+
+#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
+
+char *
+DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
+ const STRLEN count, const STRLEN max,
+ STRLEN * const escaped, const U32 flags)
+{
+ const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
+ const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
+ char octbuf[32] = "%123456789ABCDF";
+ STRLEN wrote = 0;
+ STRLEN chsize = 0;
+ STRLEN readsize = 1;
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
+#endif
+ const char *pv = str;
+ const char * const end = pv + count;
+ octbuf[0] = esc;
+
+ if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
+ isuni = 1;
+#endif
+
+ for (; pv < end && (!max || wrote < max) ; pv += readsize) {
+ const UV u =
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
+#endif
+ (U8)*pv;
+ const U8 c = (U8)u & 0xFF;
+
+ if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%"UVxf, u);
+ else
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%cx{%"UVxf"}", esc, u);
+ } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
+ chsize = 1;
+ } else {
+ if (c == dq || c == esc || !isPRINT(c)) {
+ chsize = 2;
+ switch (c) {
+ case '\\' : /* fallthrough */
+ case '%' : if (c == esc)
+ octbuf[1] = esc;
+ else
+ chsize = 1;
+ break;
+ case '\v' : octbuf[1] = 'v'; break;
+ case '\t' : octbuf[1] = 't'; break;
+ case '\r' : octbuf[1] = 'r'; break;
+ case '\n' : octbuf[1] = 'n'; break;
+ case '\f' : octbuf[1] = 'f'; break;
+ case '"' : if (dq == '"')
+ octbuf[1] = '"';
+ else
+ chsize = 1;
+ break;
+ default: chsize = my_snprintf(octbuf, sizeof octbuf,
+ pv < end && isDIGIT((U8)*(pv+readsize))
+ ? "%c%03o" : "%c%o", esc, c);
+ }
+ } else {
+ chsize = 1;
+ }
+ }
+ if (max && wrote + chsize > max) {
+ break;
+ } else if (chsize > 1) {
+ sv_catpvn(dsv, octbuf, chsize);
+ wrote += chsize;
+ } else {
+ char tmp[2];
+ my_snprintf(tmp, sizeof tmp, "%c", c);
+ sv_catpvn(dsv, tmp, 1);
+ wrote++;
+ }
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ break;
+ }
+ if (escaped != NULL)
+ *escaped= pv - str;
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_pretty
+#if defined(NEED_pv_pretty)
+static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
+static
+#else
+extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
+#endif
+
+#ifdef pv_pretty
+# undef pv_pretty
+#endif
+#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
+#define Perl_pv_pretty DPPP_(my_pv_pretty)
+
+#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
+
+char *
+DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
+ const STRLEN max, char const * const start_color, char const * const end_color,
+ const U32 flags)
+{
+ const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+ STRLEN escaped;
+
+ if (!(flags & PERL_PV_PRETTY_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, "<");
+
+ if (start_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
+
+ pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
+
+ if (end_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, ">");
+
+ if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
+ sv_catpvs(dsv, "...");
+
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_display
+#if defined(NEED_pv_display)
+static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+static
+#else
+extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+#endif
+
+#ifdef pv_display
+# undef pv_display
+#endif
+#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
+#define Perl_pv_display DPPP_(my_pv_display)
+
+#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
+
+char *
+DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+{
+ pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
+ if (len > cur && pv[cur] == '\0')
+ sv_catpvs(dsv, "\\0");
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */