--- PApp-SQL/SQL.xs 2000/10/21 19:00:53 1.1 +++ PApp-SQL/SQL.xs 2002/11/07 01:57:58 1.15 @@ -2,7 +2,42 @@ #include "perl.h" #include "XSUB.h" -#define is_dbh(sv) (sv && SvROK (sv) && sv_derived_from (sv, "DBI::db")) +#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) +# define get_sv perl_get_sv +# define call_method perl_call_method +# define call_sv perl_call_sv +#endif + +#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) +{ +#if CAN_UTF8 + if (SvPOK (sv)) + sv_utf8_upgrade (sv); +#endif + return sv; +} + +static SV * +mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) +{ + sv = sv_mortalcopy (sv); +#if CAN_UTF8 + if (utf8 && SvPOK (sv)) + SvUTF8_on (sv); +#endif + return sv; +} + +#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) + +#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) typedef struct lru_node { struct lru_node *next; @@ -16,6 +51,7 @@ GV *execute; GV *bind_columns; GV *fetch; + GV *finish; #endif } lru_node; @@ -47,8 +83,6 @@ lru_hash; - /*fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ - n = &lru_list; do { n = n->next; @@ -80,8 +114,6 @@ lru_list.prev = n->prev; n->prev->next = &lru_list; - /*fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/*D*/ - SvREFCNT_dec (n->dbh); SvREFCNT_dec (n->sql); SvREFCNT_dec (n->sth); @@ -103,8 +135,6 @@ lru_hash; - /*fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ - lru_size++; if (lru_size > lru_maxsize) lru_nukeone (); @@ -134,6 +164,11 @@ static GV *sql_exec; static GV *DBH; +static SV *sv_prepare, *sv_execute, *sv_bind_columns, + *sv_fetchrow_arrayref, *sv_fetchall_arrayref, + *sv_finish; + +#define newconstpv(str) newSVpvn ((str), sizeof (str)) MODULE = PApp::SQL PACKAGE = PApp::SQL @@ -144,6 +179,16 @@ sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); + if (!sv_prepare) + { + sv_prepare = newconstpv ("prepare"); + sv_execute = newconstpv ("execute"); + sv_bind_columns = newconstpv ("bind_columns"); + sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref"); + sv_fetchall_arrayref = newconstpv ("fetchall_arrayref"); + sv_finish = newconstpv ("finish"); + } + /* apache might BOOT: twice :( */ if (lru_size) lru_cachesize (0); @@ -164,9 +209,13 @@ void sql_exec(...) ALIAS: - sql_fetch = 1 - sql_fetchall = 2 - sql_exists = 4 + sql_uexec = 1 + sql_fetch = 2 + sql_ufetch = 3 + sql_fetchall = 4 + sql_ufetchall = 5 + sql_exists = 6 + sql_uexists = 7 PPCODE: { if (items == 0) @@ -180,6 +229,7 @@ SV *sth; SV *sql; SV *execute; + STRLEN dc, dd; /* dummy */ /* save our arguments against destruction through function calls */ SP += items; @@ -187,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 */ @@ -214,16 +266,16 @@ sql = ST(arg); arg++; - if (ix == 4) + if ((ix & ~1) == 6) { SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); sv_catsv (neu, sql); sv_catpv (neu, " limit 1"); sql = neu; - ix = 1; /* sql_fetch */ + ix -= 4; /* sql_fetch */ } - /* check cache for existing statement handle (NYI) */ + /* check cache for existing statement handle */ sth = lru_fetch (dbh, sql); if (!sth) { @@ -232,17 +284,18 @@ PUSHs (dbh); PUSHs (sql); PUTBACK; - count = call_method ("prepare", G_SCALAR); + count = call_sv (sv_prepare, G_METHOD | G_SCALAR); SPAGAIN; if (count != 1) croak ("sql_exec: unable to prepare() statement '%s': %s", - SvPV_nolen (sql), - SvPV_nolen (get_sv ("DBI::errstr", TRUE))); + SvPV (sql, dc), + SvPV (get_sv ("DBI::errstr", TRUE), dd)); sth = POPs; - lru_store (dbh, sql, sth); + if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE) + lru_store (dbh, sql, sth); } PUSHMARK (SP); @@ -250,7 +303,11 @@ PUSHs (sth); while (items > arg) { - PUSHs (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++; } @@ -259,20 +316,20 @@ if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); count = call_sv(GvCV(execute), G_SCALAR); }*/ - count = call_method ("execute", G_SCALAR); + count = call_sv (sv_execute, G_METHOD | G_SCALAR); SPAGAIN; if (count != 1) croak ("sql_exec: execute() didn't return any value ('%s'): %s", - SvPV_nolen (sql), - SvPV_nolen (get_sv ("DBI::errstr", TRUE))); + SvPV (sql, dc), + SvPV (get_sv ("DBI::errstr", TRUE), dd)); execute = POPs; if (!SvTRUE (execute)) croak ("sql_exec: unable to execute statement '%s' (%s)", - SvPV_nolen (sql), - SvPV_nolen (get_sv ("DBI::errstr", TRUE))); + SvPV (sql, dc), + SvPV (get_sv ("DBI::errstr", TRUE), dd)); sv_setsv (GvSV(sql_exec), execute); @@ -287,31 +344,31 @@ } while (bind_first != bind_last); PUTBACK; - count = call_method ("bind_columns", G_SCALAR); + count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR); SPAGAIN; if (count != 1) croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", - SvPV_nolen (sql), - SvPV_nolen (get_sv ("DBI::errstr", TRUE))); + SvPV (sql, dc), + SvPV (get_sv ("DBI::errstr", TRUE), dd)); if (!SvOK (POPs)) croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", - SvPV_nolen (sql), - SvPV_nolen (get_sv ("DBI::errstr", TRUE))); + SvPV (sql, dc), + SvPV (get_sv ("DBI::errstr", TRUE), dd)); } /* free our arguments from the stack */ SP -= items; - if (ix == 1) + if ((ix & ~1) == 2) { /* sql_fetch */ SV *row; PUSHMARK (SP); XPUSHs (sth); PUTBACK; - count = call_method ("fetchrow_arrayref", G_SCALAR); + count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); SPAGAIN; if (count != 1) @@ -330,14 +387,14 @@ break; case G_SCALAR: /* the first element */ - XPUSHs (*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 (AvARRAY (av)[arg]); + PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); break; default: @@ -345,14 +402,14 @@ } } } - else if (ix == 2) + else if ((ix & ~1) == 4) { /* sql_fetchall */ SV *rows; PUSHMARK (SP); XPUSHs (sth); PUTBACK; - count = call_method ("fetchall_arrayref", G_SCALAR); + count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR); SPAGAIN; if (count != 1) @@ -367,27 +424,27 @@ if (count) { - int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */ + int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ EXTEND (SP, count); if (columns == 1) for (arg = 0; arg < count; arg++) - PUSHs (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 (AvARRAY (av)[arg]); + PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); } } } else XPUSHs (sth); - if (ix || GIMME_V == G_VOID) + if (ix > 1 || GIMME_V == G_VOID) { PUSHMARK (SP); XPUSHs (sth); PUTBACK; - (void) call_method ("finish", G_DISCARD); + (void) call_sv (sv_finish, G_METHOD | G_DISCARD); SPAGAIN; } }