--- PApp-SQL/SQL.xs 2001/12/31 03:05:03 1.9 +++ PApp-SQL/SQL.xs 2008/01/19 07:38:52 1.19 @@ -8,10 +8,12 @@ # define call_sv perl_call_sv #endif -#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 5)) +#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) # define CAN_UTF8 1 #endif +#define MAX_CACHED_STATEMENT_SIZE 8192 + static SV * sql_upgrade_utf8 (SV *sv) { @@ -23,17 +25,17 @@ } static SV * -sql_force_utf8 (SV *sv) +mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) { + sv = sv_mortalcopy (sv); #if CAN_UTF8 - if (SvPOK (sv)) + if (utf8 && SvPOK (sv)) SvUTF8_on (sv); #endif return sv; } #define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) -#define maybe_force_utf8(utf8,sv) ((utf8) ? sql_force_utf8 (sv) : (sv)) #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) @@ -62,7 +64,7 @@ /* this is primitive, yet effective */ /* the returned value must never be zero (or bad things will happen) */ #define lru_hash do { \ - hash = (((U32)dbh)>>2); \ + hash = (((U32)(long)dbh)>>2); \ hash += *statement;\ hash += len; \ } while (0) @@ -235,13 +237,15 @@ /* first check wether we should use an explicit db handle */ if (!is_dbh (dbh)) { - dbh = get_sv ("DBH", FALSE); + /* the next line doesn't work - check why later maybe */ + /* dbh = get_sv ("DBH", FALSE); if (!is_dbh (dbh)) - { + {*/ dbh = GvSV(DBH); if (!is_dbh (dbh)) - croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); - } + croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); + /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); + }*/ } else arg++; /* we consumed one argument */ @@ -290,7 +294,8 @@ sth = POPs; - lru_store (dbh, sql, sth); + if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE) + lru_store (dbh, sql, sth); } PUSHMARK (SP); @@ -298,7 +303,11 @@ PUSHs (sth); while (items > arg) { - PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg))); + SV *sv = ST(arg); + /* we sv_mortalcopy magical values since DBI seems to have a memory + * leak when magical values are passed into execute(). + */ + PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv)); arg++; } @@ -313,14 +322,14 @@ if (count != 1) croak ("sql_exec: execute() didn't return any value ('%s'): %s", SvPV (sql, dc), - SvPV (get_sv ("DBI::errstr", TRUE), dc)); + SvPV (get_sv ("DBI::errstr", TRUE), dd)); execute = POPs; if (!SvTRUE (execute)) croak ("sql_exec: unable to execute statement '%s' (%s)", SvPV (sql, dc), - SvPV (get_sv ("DBI::errstr", TRUE), dc)); + SvPV (get_sv ("DBI::errstr", TRUE), dd)); sv_setsv (GvSV(sql_exec), execute); @@ -330,6 +339,10 @@ EXTEND (SP, bind_last - bind_first + 2); PUSHs (sth); do { +#if CAN_UTF8 + if (ix & 1) + SvUTF8_on (SvRV(ST(bind_first))); +#endif PUSHs (ST(bind_first)); bind_first++; } while (bind_first != bind_last); @@ -341,15 +354,17 @@ if (count != 1) croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", SvPV (sql, dc), - SvPV (get_sv ("DBI::errstr", TRUE), dc)); + SvPV (get_sv ("DBI::errstr", TRUE), dd)); - if (!SvOK (POPs)) + if (!SvOK (TOPs)) croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", SvPV (sql, dc), - SvPV (get_sv ("DBI::errstr", TRUE), dc)); + SvPV (get_sv ("DBI::errstr", TRUE), dd)); + + POPs; } - /* free our arguments from the stack */ + /* restore our arguments again */ SP -= items; if ((ix & ~1) == 2) @@ -378,14 +393,14 @@ break; case G_SCALAR: /* the first element */ - XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); + XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); break; case G_ARRAY: av = (AV *)SvRV (row); count = AvFILL (av) + 1; EXTEND (SP, count); for (arg = 0; arg < count; arg++) - PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); + PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); break; default: @@ -420,10 +435,10 @@ EXTEND (SP, count); if (columns == 1) for (arg = 0; arg < count; arg++) - PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); + PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); else for (arg = 0; arg < count; arg++) - PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); + PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); } } }