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

static SV *
sql_upgrade_utf8 (SV *sv)
{
#if CAN_UTF8
  if (SvPOK (sv))
    sv_utf8_upgrade (sv);
#endif
  return sv;
}

static SV *
sql_force_utf8 (SV *sv)
{
#if CAN_UTF8
  if (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"))

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)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 */

            /* 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;

                lru_store (dbh, sql, sth);
              }

            PUSHMARK (SP);
            EXTEND (SP, items - arg + 1);
            PUSHs (sth);
            while (items > arg)
              {
                PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg)));
                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 {
                  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 (POPs))
                  croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
                         SvPV (sql, dc),
                         SvPV (get_sv ("DBI::errstr", TRUE), dd));
              }

            /* free our arguments from the stack */
            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 (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]));

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