PApp-SQL/SQL.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#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;
  struct lru_node *prev;
  U32 hash;
  SV *dbh;
  SV *sql;

  SV *sth;
#if 0 /* method cache */
  GV *execute;
  GV *bind_columns;
  GV *fetch;
  GV *finish;
#endif
} lru_node;

static lru_node lru_list;
static int lru_size;
static int lru_maxsize;

#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */

/* this is primitive, yet effective */
/* the returned value must never be zero (or bad things will happen) */
#define lru_hash do {   \
        hash = (((U32)(long)dbh)>>2);   \
        hash += *statement;\
        hash += len;            \
} while (0)

/* fetch and "use" */
/* could be done using a single call (we could call prepare!) */
static SV *lru_fetch(SV *dbh, SV *sql)
{
  lru_node *n;

  U32 hash;
  STRLEN len;
  char *statement = SvPV (sql, len);

  dbh = SvRV (dbh);

  lru_hash;

  n = &lru_list;
  do {
    n = n->next;
    if (!n->hash)
      return 0;
  } while (n->hash != hash
           || !sv_eq (n->sql, sql)
           || n->dbh != dbh);

  /* found, so return to the start of the list */
  n->prev->next = n->next;
  n->next->prev = n->prev;

  n->next = lru_list.next;
  n->prev = &lru_list;
  lru_list.next->prev = n;
  lru_list.next = n;

  return n->sth;
}

static void lru_nukeone(void)
{
  lru_node *n;
  /* nuke at the end */

  n = lru_list.prev;

  lru_list.prev = n->prev;
  n->prev->next = &lru_list;

  SvREFCNT_dec (n->dbh);
  SvREFCNT_dec (n->sql);
  SvREFCNT_dec (n->sth);
  Safefree (n);
  
  lru_size--;
}

/* store a not-yet existing entry(!) */
static void lru_store(SV *dbh, SV *sql, SV *sth)
{
  lru_node *n;

  U32 hash;
  STRLEN len;
  char *statement = SvPV (sql, len);

  dbh = SvRV (dbh);

  lru_hash;

  lru_size++;
  if (lru_size > lru_maxsize)
    lru_nukeone ();

  New (0, n, 1, lru_node);

  n->hash = hash;
  n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
  n->sql = newSVsv (sql);
  n->sth = sth; SvREFCNT_inc (sth);

  n->next = lru_list.next;
  n->prev = &lru_list;
  lru_list.next->prev = n;
  lru_list.next = n;
}

static void lru_cachesize (int size)
{
  if (size >= 0)
    {
      lru_maxsize = size;
      while (lru_size > lru_maxsize)
        lru_nukeone ();
    }
}

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

PROTOTYPES: DISABLE

BOOT:
{
   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);

   lru_init;
   lru_cachesize (50);
}

int
cachesize(size = -1)
        int     size
        CODE:
        RETVAL = lru_maxsize;
        lru_cachesize (size);
        OUTPUT:
        RETVAL

void
sql_exec(...)
        ALIAS:
                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)
          croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
        else
          {
            int arg = 0;
            int bind_first, bind_last;
            int count;
            SV *dbh = ST(0);
            SV *sth;
            SV *sql;
            SV *execute;
            STRLEN dc, dd; /* dummy */

            /* save our arguments against destruction through function calls */
            SP += items;
            
            /* first check wether we should use an explicit db handle */
            if (!is_dbh (dbh))
              {
                /* 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 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 */

            /* be more Coro-friendly by keeping a copy, so different threads */
            /* can replace their global handles */
            dbh = sv_2mortal (newSVsv (dbh));

            /* count the remaining references (for bind_columns) */
            bind_first = arg;
            while (items > arg && SvROK (ST(arg)))
              arg++;

            bind_last = arg;

            /* consume the sql-statement itself */
            if (items <= arg)
              croak ("sql_exec: required argument \"sql-statement\" missing");

            if (!SvPOK (ST(arg)))
              croak ("sql_exec: sql-statement must be a string");

            sql = ST(arg); arg++;

            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 -= 4; /* sql_fetch */
              }

            /* check cache for existing statement handle */
            sth = lru_fetch (dbh, sql);
            if (!sth)
              {
                PUSHMARK (SP);
                EXTEND (SP, 2);
                PUSHs (dbh);
                PUSHs (sql);
                PUTBACK;
                count = call_sv (sv_prepare, G_METHOD | G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  croak ("sql_exec: unable to prepare() statement '%s': %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dd));

                sth = POPs;

                if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE)
                  lru_store (dbh, sql, sth);
              }

            PUSHMARK (SP);
            EXTEND (SP, items - arg + 1);
            PUSHs (sth);
            while (items > 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++;
              }

            PUTBACK;
            /* { static GV *execute;
              if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
              count = call_sv(GvCV(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 (sql, 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), dd));

            sv_setsv (GvSV(sql_exec), execute);

            if (bind_first != bind_last)
              {
                PUSHMARK (SP);
                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);

                PUTBACK;
                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 (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dd));

                if (!SvOK (TOPs))
                  croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dd));

                POPs;
              }

            /* restore our arguments again */
            SP -= items;

            if ((ix & ~1) == 2)
              { /* sql_fetch */
                SV *row;

                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  abort ();

                row = POPs;

                if (SvROK (row))
                  {
                    AV *av;

                    switch (GIMME_V)
                      {
                        case G_VOID:
                          /* no thing */
                          break;
                        case G_SCALAR:
                          /* the first element */
                          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 (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));

                          break;
                        default:
                          abort ();
                      }
                 }
              }
            else if ((ix & ~1) == 4)
              { /* sql_fetchall */
                SV *rows;

                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR);
                SPAGAIN;

                if (count != 1)
                  abort ();

                rows = POPs;

                if (SvROK (rows))
                  {
                    AV *av = (AV *)SvRV (rows);
                    count = AvFILL (av) + 1;

                    if (count)
                      {
                        int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */

                        EXTEND (SP, count);
                        if (columns == 1)
                          for (arg = 0; arg < count; arg++)
                            PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
                        else
                          for (arg = 0; arg < count; arg++)
                            PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
                      }
                 }
              }
            else
              XPUSHs (sth);

            if (ix > 1 || GIMME_V == G_VOID)
              {
                PUSHMARK (SP);
                XPUSHs (sth);
                PUTBACK;
                (void) call_sv (sv_finish, G_METHOD | G_DISCARD);
                SPAGAIN;
              }
          }
}


Revision:	1.21
Committed:	Sun Jun 21 00:28:18 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_04
Changes since 1.20:	+1 -1 lines
Log Message:	1.04
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5	root	1.3	#if (PERL_VERSION < 5) \|\| ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6	root	1.5	# define get_sv perl_get_sv
7	root	1.3	# define call_method perl_call_method
8	root	1.5	# define call_sv perl_call_sv
9	root	1.3	#endif
10
11	root	1.11	#if (PERL_VERSION > 5) \|\| ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6))
12	root	1.5	# define CAN_UTF8 1
13			#endif
14
15	root	1.14	#define MAX_CACHED_STATEMENT_SIZE 8192
16
17	root	1.5	static SV *
18			sql_upgrade_utf8 (SV *sv)
19			{
20			#if CAN_UTF8
21			if (SvPOK (sv))
22			sv_utf8_upgrade (sv);
23			#endif
24			return sv;
25			}
26
27			static SV *
28	root	1.13	mortalcopy_and_maybe_force_utf8(int utf8, SV *sv)
29	root	1.5	{
30	root	1.13	sv = sv_mortalcopy (sv);
31	root	1.5	#if CAN_UTF8
32	root	1.13	if (utf8 && SvPOK (sv))
33	root	1.5	SvUTF8_on (sv);
34			#endif
35			return sv;
36			}
37
38			#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv))
39
40	root	1.2	#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
41	root	1.1
42			typedef struct lru_node {
43			struct lru_node *next;
44			struct lru_node *prev;
45			U32 hash;
46			SV *dbh;
47			SV *sql;
48
49			SV *sth;
50			#if 0 /* method cache */
51			GV *execute;
52			GV *bind_columns;
53			GV *fetch;
54	root	1.5	GV *finish;
55	root	1.1	#endif
56			} lru_node;
57
58			static lru_node lru_list;
59			static int lru_size;
60			static int lru_maxsize;
61
62			#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
63
64			/* this is primitive, yet effective */
65			/* the returned value must never be zero (or bad things will happen) */
66			#define lru_hash do { \
67	root	1.18	hash = (((U32)(long)dbh)>>2); \
68	root	1.1	hash += *statement;\
69			hash += len; \
70			} while (0)
71
72			/* fetch and "use" */
73			/* could be done using a single call (we could call prepare!) */
74			static SV lru_fetch(SV dbh, SV *sql)
75			{
76			lru_node *n;
77
78			U32 hash;
79			STRLEN len;
80			char *statement = SvPV (sql, len);
81
82			dbh = SvRV (dbh);
83
84			lru_hash;
85
86			n = &lru_list;
87			do {
88			n = n->next;
89			if (!n->hash)
90			return 0;
91			} while (n->hash != hash
92			\|\| !sv_eq (n->sql, sql)
93			\|\| n->dbh != dbh);
94
95			/* found, so return to the start of the list */
96			n->prev->next = n->next;
97			n->next->prev = n->prev;
98
99			n->next = lru_list.next;
100			n->prev = &lru_list;
101			lru_list.next->prev = n;
102			lru_list.next = n;
103
104			return n->sth;
105			}
106
107			static void lru_nukeone(void)
108			{
109			lru_node *n;
110			/* nuke at the end */
111
112			n = lru_list.prev;
113
114			lru_list.prev = n->prev;
115			n->prev->next = &lru_list;
116
117			SvREFCNT_dec (n->dbh);
118			SvREFCNT_dec (n->sql);
119			SvREFCNT_dec (n->sth);
120			Safefree (n);
121
122			lru_size--;
123			}
124
125			/* store a not-yet existing entry(!) */
126			static void lru_store(SV dbh, SV sql, SV *sth)
127			{
128			lru_node *n;
129
130			U32 hash;
131			STRLEN len;
132			char *statement = SvPV (sql, len);
133
134			dbh = SvRV (dbh);
135
136			lru_hash;
137
138			lru_size++;
139			if (lru_size > lru_maxsize)
140			lru_nukeone ();
141
142			New (0, n, 1, lru_node);
143
144			n->hash = hash;
145			n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
146			n->sql = newSVsv (sql);
147			n->sth = sth; SvREFCNT_inc (sth);
148
149			n->next = lru_list.next;
150			n->prev = &lru_list;
151			lru_list.next->prev = n;
152			lru_list.next = n;
153			}
154
155			static void lru_cachesize (int size)
156			{
157			if (size >= 0)
158			{
159			lru_maxsize = size;
160			while (lru_size > lru_maxsize)
161			lru_nukeone ();
162			}
163			}
164
165			static GV *sql_exec;
166			static GV *DBH;
167	root	1.6	static SV sv_prepare, sv_execute, *sv_bind_columns,
168			sv_fetchrow_arrayref, sv_fetchall_arrayref,
169			*sv_finish;
170	root	1.5
171			#define newconstpv(str) newSVpvn ((str), sizeof (str))
172	root	1.1
173			MODULE = PApp::SQL PACKAGE = PApp::SQL
174
175			PROTOTYPES: DISABLE
176
177			BOOT:
178			{
179			sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
180			DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
181
182	root	1.5	if (!sv_prepare)
183			{
184			sv_prepare = newconstpv ("prepare");
185			sv_execute = newconstpv ("execute");
186			sv_bind_columns = newconstpv ("bind_columns");
187			sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref");
188	root	1.6	sv_fetchall_arrayref = newconstpv ("fetchall_arrayref");
189	root	1.5	sv_finish = newconstpv ("finish");
190			}
191
192	root	1.1	/* apache might BOOT: twice :( */
193			if (lru_size)
194			lru_cachesize (0);
195
196			lru_init;
197			lru_cachesize (50);
198			}
199
200			int
201			cachesize(size = -1)
202			int size
203			CODE:
204			RETVAL = lru_maxsize;
205			lru_cachesize (size);
206			OUTPUT:
207			RETVAL
208
209			void
210			sql_exec(...)
211			ALIAS:
212	root	1.5	sql_uexec = 1
213			sql_fetch = 2
214			sql_ufetch = 3
215			sql_fetchall = 4
216			sql_ufetchall = 5
217			sql_exists = 6
218			sql_uexists = 7
219	root	1.1	PPCODE:
220			{
221			if (items == 0)
222			croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
223			else
224			{
225			int arg = 0;
226			int bind_first, bind_last;
227			int count;
228			SV *dbh = ST(0);
229			SV *sth;
230			SV *sql;
231			SV *execute;
232	root	1.9	STRLEN dc, dd; /* dummy */
233	root	1.1
234			/* save our arguments against destruction through function calls */
235			SP += items;
236
237			/* first check wether we should use an explicit db handle */
238			if (!is_dbh (dbh))
239			{
240	root	1.12	/* the next line doesn't work - check why later maybe */
241			/* dbh = get_sv ("DBH", FALSE);
242	root	1.1	if (!is_dbh (dbh))
243	root	1.12	{*/
244	root	1.20	dbh = GvSV (DBH);
245	root	1.1	if (!is_dbh (dbh))
246	root	1.12	croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH");
247			/*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
248			}*/
249	root	1.1	}
250			else
251			arg++; /* we consumed one argument */
252
253	root	1.20	/* be more Coro-friendly by keeping a copy, so different threads */
254	root	1.21	/* can replace their global handles */
255	root	1.20	dbh = sv_2mortal (newSVsv (dbh));
256
257	root	1.1	/* count the remaining references (for bind_columns) */
258			bind_first = arg;
259			while (items > arg && SvROK (ST(arg)))
260			arg++;
261
262			bind_last = arg;
263
264			/* consume the sql-statement itself */
265			if (items <= arg)
266			croak ("sql_exec: required argument \"sql-statement\" missing");
267
268			if (!SvPOK (ST(arg)))
269			croak ("sql_exec: sql-statement must be a string");
270
271			sql = ST(arg); arg++;
272
273	root	1.5	if ((ix & ~1) == 6)
274	root	1.1	{
275			SV neu = sv_2mortal (newSVpv ("select count() > 0 from ", 0));
276			sv_catsv (neu, sql);
277			sv_catpv (neu, " limit 1");
278			sql = neu;
279	root	1.7	ix -= 4; /* sql_fetch */
280	root	1.1	}
281
282	root	1.4	/* check cache for existing statement handle */
283	root	1.1	sth = lru_fetch (dbh, sql);
284			if (!sth)
285			{
286			PUSHMARK (SP);
287			EXTEND (SP, 2);
288			PUSHs (dbh);
289			PUSHs (sql);
290			PUTBACK;
291	root	1.5	count = call_sv (sv_prepare, G_METHOD \| G_SCALAR);
292	root	1.1	SPAGAIN;
293
294			if (count != 1)
295			croak ("sql_exec: unable to prepare() statement '%s': %s",
296	root	1.3	SvPV (sql, dc),
297	root	1.9	SvPV (get_sv ("DBI::errstr", TRUE), dd));
298	root	1.1
299			sth = POPs;
300
301	root	1.14	if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE)
302			lru_store (dbh, sql, sth);
303	root	1.1	}
304
305			PUSHMARK (SP);
306			EXTEND (SP, items - arg + 1);
307			PUSHs (sth);
308			while (items > arg)
309			{
310	root	1.15	SV *sv = ST(arg);
311			/* we sv_mortalcopy magical values since DBI seems to have a memory
312			* leak when magical values are passed into execute().
313			*/
314			PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv));
315	root	1.1	arg++;
316			}
317
318			PUTBACK;
319			/* { static GV *execute;
320			if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
321			count = call_sv(GvCV(execute), G_SCALAR);
322			}*/
323	root	1.5	count = call_sv (sv_execute, G_METHOD \| G_SCALAR);
324	root	1.1	SPAGAIN;
325
326			if (count != 1)
327			croak ("sql_exec: execute() didn't return any value ('%s'): %s",
328	root	1.3	SvPV (sql, dc),
329	root	1.10	SvPV (get_sv ("DBI::errstr", TRUE), dd));
330	root	1.1
331			execute = POPs;
332
333			if (!SvTRUE (execute))
334			croak ("sql_exec: unable to execute statement '%s' (%s)",
335	root	1.3	SvPV (sql, dc),
336	root	1.10	SvPV (get_sv ("DBI::errstr", TRUE), dd));
337	root	1.1
338			sv_setsv (GvSV(sql_exec), execute);
339
340			if (bind_first != bind_last)
341			{
342			PUSHMARK (SP);
343			EXTEND (SP, bind_last - bind_first + 2);
344			PUSHs (sth);
345			do {
346	stefan	1.16	#if CAN_UTF8
347	root	1.17	if (ix & 1)
348			SvUTF8_on (SvRV(ST(bind_first)));
349	stefan	1.16	#endif
350	root	1.1	PUSHs (ST(bind_first));
351			bind_first++;
352			} while (bind_first != bind_last);
353
354			PUTBACK;
355	root	1.5	count = call_sv (sv_bind_columns, G_METHOD \| G_SCALAR);
356	root	1.1	SPAGAIN;
357
358			if (count != 1)
359			croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
360	root	1.3	SvPV (sql, dc),
361	root	1.10	SvPV (get_sv ("DBI::errstr", TRUE), dd));
362	root	1.1
363	root	1.19	if (!SvOK (TOPs))
364	root	1.1	croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
365	root	1.3	SvPV (sql, dc),
366	root	1.10	SvPV (get_sv ("DBI::errstr", TRUE), dd));
367	root	1.19
368			POPs;
369	root	1.1	}
370
371	root	1.19	/* restore our arguments again */
372	root	1.1	SP -= items;
373
374	root	1.5	if ((ix & ~1) == 2)
375	root	1.1	{ /* sql_fetch */
376			SV *row;
377
378			PUSHMARK (SP);
379			XPUSHs (sth);
380			PUTBACK;
381	root	1.5	count = call_sv (sv_fetchrow_arrayref, G_METHOD \| G_SCALAR);
382	root	1.1	SPAGAIN;
383
384			if (count != 1)
385			abort ();
386
387			row = POPs;
388
389			if (SvROK (row))
390			{
391			AV *av;
392
393			switch (GIMME_V)
394			{
395			case G_VOID:
396			/* no thing */
397			break;
398			case G_SCALAR:
399			/* the first element */
400	root	1.13	XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, av_fetch ((AV )SvRV (row), 0, 1)));
401	root	1.1	break;
402			case G_ARRAY:
403			av = (AV *)SvRV (row);
404			count = AvFILL (av) + 1;
405			EXTEND (SP, count);
406			for (arg = 0; arg < count; arg++)
407	root	1.13	PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
408	root	1.1
409			break;
410			default:
411			abort ();
412			}
413			}
414			}
415	root	1.5	else if ((ix & ~1) == 4)
416	root	1.1	{ /* sql_fetchall */
417			SV *rows;
418
419			PUSHMARK (SP);
420			XPUSHs (sth);
421			PUTBACK;
422	root	1.6	count = call_sv (sv_fetchall_arrayref, G_METHOD \| G_SCALAR);
423	root	1.1	SPAGAIN;
424
425			if (count != 1)
426			abort ();
427
428			rows = POPs;
429
430			if (SvROK (rows))
431			{
432			AV av = (AV )SvRV (rows);
433			count = AvFILL (av) + 1;
434
435			if (count)
436			{
437	root	1.6	int columns = AvFILL ((AV ) SvRV (AvARRAY (av)[0])) + 1; / columns? */
438	root	1.1
439			EXTEND (SP, count);
440			if (columns == 1)
441			for (arg = 0; arg < count; arg++)
442	root	1.13	PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
443	root	1.1	else
444			for (arg = 0; arg < count; arg++)
445	root	1.13	PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
446	root	1.1	}
447			}
448			}
449			else
450			XPUSHs (sth);
451
452	root	1.5	if (ix > 1 \|\| GIMME_V == G_VOID)
453	root	1.1	{
454			PUSHMARK (SP);
455			XPUSHs (sth);
456			PUTBACK;
457	root	1.5	(void) call_sv (sv_finish, G_METHOD \| G_DISCARD);
458	root	1.1	SPAGAIN;
459			}
460			}
461			}
462
463
464