1 |
#include "EXTERN.h" |
2 |
#include "perl.h" |
3 |
#include "XSUB.h" |
4 |
|
5 |
/* import some stuff from DBIXS.h and DBI.xs */ |
6 |
#define DBIXS_VERSION 93 |
7 |
#define DBI_MAGIC '~' |
8 |
|
9 |
#define DBISTATE_PERLNAME "DBI::_dbistate" |
10 |
#define DBISTATE_ADDRSV (perl_get_sv (DBISTATE_PERLNAME, 0x05)) |
11 |
#define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV)))) |
12 |
|
13 |
static SV *sql_varchar, *sql_integer, *sql_double; |
14 |
static SV *tmp_iv; |
15 |
|
16 |
struct dbistate_st { |
17 |
#define DBISTATE_VERSION 94 /* Must change whenever dbistate_t does */ |
18 |
/* this must be the first member in structure */ |
19 |
void (*check_version) _((const char *name, |
20 |
int dbis_cv, int dbis_cs, int need_dbixs_cv, |
21 |
int drc_s, int dbc_s, int stc_s, int fdc_s)); |
22 |
|
23 |
/* version and size are used to check for DBI/DBD version mis-match */ |
24 |
U16 version; /* version of this structure */ |
25 |
U16 size; |
26 |
U16 xs_version; /* version of the overall DBIXS / DBD interface */ |
27 |
U16 spare_pad; |
28 |
}; |
29 |
typedef struct dbistate_st dbistate_t; |
30 |
|
31 |
#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */ |
32 |
|
33 |
typedef U32 imp_sth; |
34 |
|
35 |
/* not strictly part of the API... */ |
36 |
static imp_sth * |
37 |
sth_get_imp (SV *sth) |
38 |
{ |
39 |
MAGIC *mg = mg_find (SvRV (sth), PERL_MAGIC_tied); |
40 |
sth = mg->mg_obj; |
41 |
mg = mg_find (SvRV (sth), DBI_MAGIC); |
42 |
return (imp_sth *)SvPVX (mg->mg_obj); |
43 |
} |
44 |
|
45 |
#define DBI_STH_ACTIVE(imp) (*(imp) & DBIcf_ACTIVE) |
46 |
|
47 |
/* end of import section */ |
48 |
|
49 |
#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) |
50 |
# define get_sv perl_get_sv |
51 |
# define call_method perl_call_method |
52 |
# define call_sv perl_call_sv |
53 |
#endif |
54 |
|
55 |
#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
56 |
# define CAN_UTF8 1 |
57 |
#endif |
58 |
|
59 |
#define MAX_CACHED_STATEMENT_SIZE 2048 |
60 |
|
61 |
static SV * |
62 |
sql_upgrade_utf8 (SV *sv) |
63 |
{ |
64 |
#if CAN_UTF8 |
65 |
if (SvPOKp (sv)) |
66 |
sv_utf8_upgrade (sv); |
67 |
#endif |
68 |
return sv; |
69 |
} |
70 |
|
71 |
static SV * |
72 |
mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
73 |
{ |
74 |
sv = sv_mortalcopy (sv); |
75 |
#if CAN_UTF8 |
76 |
if (utf8 && SvPOKp (sv)) |
77 |
SvUTF8_on (sv); |
78 |
#endif |
79 |
return sv; |
80 |
} |
81 |
|
82 |
#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
83 |
|
84 |
#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
85 |
|
86 |
typedef struct mc_node |
87 |
{ |
88 |
struct mc_node *next; |
89 |
HV *stash; |
90 |
U32 gen; |
91 |
|
92 |
/* DBH */ |
93 |
SV *prepare; |
94 |
|
95 |
/* STH */ |
96 |
SV *execute; |
97 |
SV *bind_param; |
98 |
SV *bind_columns; |
99 |
SV *fetchrow_arrayref; |
100 |
SV *fetchall_arrayref; |
101 |
SV *finish; |
102 |
} mc_node; |
103 |
|
104 |
static mc_node *first; |
105 |
|
106 |
static mc_node * |
107 |
mc_find (HV *stash) |
108 |
{ |
109 |
mc_node *mc; |
110 |
U32 gen = PL_sub_generation; |
111 |
|
112 |
#ifdef HvMROMETA |
113 |
gen += HvMROMETA (stash)->cache_gen; |
114 |
#endif |
115 |
|
116 |
for (mc = first; mc; mc = mc->next) |
117 |
if (mc->stash == stash && mc->gen == gen) |
118 |
return mc; |
119 |
|
120 |
if (!mc) |
121 |
{ |
122 |
Newz (0, mc, 1, mc_node); |
123 |
mc->stash = stash; |
124 |
|
125 |
mc->next = first; |
126 |
first = mc; |
127 |
} |
128 |
else |
129 |
{ |
130 |
mc->execute = |
131 |
mc->bind_param = |
132 |
mc->bind_columns = |
133 |
mc->fetchrow_arrayref = |
134 |
mc->fetchall_arrayref = |
135 |
mc->finish = 0; |
136 |
} |
137 |
|
138 |
mc->gen = gen; |
139 |
|
140 |
return mc; |
141 |
} |
142 |
|
143 |
static void |
144 |
mc_cache (mc_node *mc, SV **method, const char *name) |
145 |
{ |
146 |
*method = (SV *)gv_fetchmethod_autoload (mc->stash, name, 0); |
147 |
|
148 |
if (!method) |
149 |
croak ("%s: method not found in stash, please report.", name); |
150 |
} |
151 |
|
152 |
#define mc_cache(mc, method) mc_cache ((mc), &((mc)->method), # method) |
153 |
|
154 |
typedef struct lru_node |
155 |
{ |
156 |
struct lru_node *next; |
157 |
struct lru_node *prev; |
158 |
|
159 |
U32 hash; |
160 |
SV *dbh; |
161 |
SV *sql; |
162 |
|
163 |
SV *sth; |
164 |
imp_sth *sth_imp; |
165 |
|
166 |
mc_node *mc; |
167 |
} lru_node; |
168 |
|
169 |
static lru_node lru_list; |
170 |
static int lru_size; |
171 |
static int lru_maxsize; |
172 |
|
173 |
#define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ |
174 |
|
175 |
/* this is primitive, yet effective */ |
176 |
/* the returned value must never be zero (or bad things will happen) */ |
177 |
static U32 |
178 |
lru_hash (SV *dbh, SV *sql) |
179 |
{ |
180 |
/* use a variant of fnv1a */ |
181 |
STRLEN i, l; |
182 |
char *b = SvPV (sql, l); |
183 |
U32 hash = 2166136261U; |
184 |
|
185 |
hash = (hash ^ (U32)dbh) * 16777619U; |
186 |
hash = (hash ^ l) * 16777619U; |
187 |
|
188 |
/* start hashing at char 7, as this skips the "select " prefix */ |
189 |
/* also skip more and more octets */ |
190 |
for (i = 7; i < l; i += i >> 2) |
191 |
hash = (hash ^ b [i]) * 16777619U; |
192 |
|
193 |
return hash; |
194 |
} |
195 |
|
196 |
/* fetch and "use" */ |
197 |
static lru_node * |
198 |
lru_fetch (SV *dbh, SV *sql) |
199 |
{ |
200 |
lru_node *n; |
201 |
U32 hash; |
202 |
|
203 |
dbh = SvRV (dbh); |
204 |
hash = lru_hash (dbh, sql); |
205 |
|
206 |
n = &lru_list; |
207 |
do { |
208 |
n = n->next; |
209 |
|
210 |
if (!n->hash) |
211 |
return 0; |
212 |
} while (n->hash != hash |
213 |
|| DBI_STH_ACTIVE (n->sth_imp) |
214 |
|| !sv_eq (n->sql, sql) |
215 |
|| n->dbh != dbh); |
216 |
|
217 |
/* found, so return to the start of the list */ |
218 |
n->prev->next = n->next; |
219 |
n->next->prev = n->prev; |
220 |
|
221 |
n->next = lru_list.next; |
222 |
n->prev = &lru_list; |
223 |
lru_list.next->prev = n; |
224 |
lru_list.next = n; |
225 |
|
226 |
return n; |
227 |
} |
228 |
|
229 |
static void |
230 |
lru_trim (void) |
231 |
{ |
232 |
while (lru_size > lru_maxsize) |
233 |
{ |
234 |
/* nuke at the end */ |
235 |
lru_node *n = lru_list.prev; |
236 |
|
237 |
n = lru_list.prev; |
238 |
|
239 |
lru_list.prev = n->prev; |
240 |
n->prev->next = &lru_list; |
241 |
|
242 |
SvREFCNT_dec_NN (n->dbh); |
243 |
SvREFCNT_dec_NN (n->sql); |
244 |
SvREFCNT_dec_NN (n->sth); |
245 |
Safefree (n); |
246 |
|
247 |
lru_size--; |
248 |
} |
249 |
} |
250 |
|
251 |
/* store a not-yet existing entry(!) */ |
252 |
static void |
253 |
lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
254 |
{ |
255 |
lru_node *n; |
256 |
U32 hash; |
257 |
|
258 |
if (!lru_maxsize) |
259 |
return; |
260 |
|
261 |
dbh = SvRV (dbh); |
262 |
hash = lru_hash (dbh, sql); |
263 |
|
264 |
lru_size++; |
265 |
lru_trim (); |
266 |
|
267 |
New (0, n, 1, lru_node); |
268 |
|
269 |
n->hash = hash; |
270 |
n->dbh = SvREFCNT_inc_NN (dbh); /* note: this is the dbi hash itself, not the reference */ |
271 |
n->sql = newSVsv (sql); |
272 |
n->sth = SvREFCNT_inc_NN (sth); |
273 |
n->sth_imp = sth_get_imp (sth); |
274 |
n->mc = mc; |
275 |
|
276 |
n->next = lru_list.next; |
277 |
n->prev = &lru_list; |
278 |
lru_list.next->prev = n; |
279 |
lru_list.next = n; |
280 |
} |
281 |
|
282 |
static void |
283 |
lru_cachesize (int size) |
284 |
{ |
285 |
if (size >= 0) |
286 |
{ |
287 |
lru_maxsize = size; |
288 |
lru_trim (); |
289 |
} |
290 |
} |
291 |
|
292 |
static GV *sql_exec; |
293 |
static GV *DBH; |
294 |
|
295 |
#define newconstpv(str) newSVpvn ((str), sizeof (str)) |
296 |
|
297 |
MODULE = PApp::SQL PACKAGE = PApp::SQL |
298 |
|
299 |
PROTOTYPES: DISABLE |
300 |
|
301 |
BOOT: |
302 |
{ |
303 |
struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
304 |
|
305 |
/* this is actually wrong, we should call the check member, apparently */ |
306 |
assert (dbis->version == DBISTATE_VERSION); |
307 |
assert (dbis->xs_version == DBIXS_VERSION); |
308 |
|
309 |
tmp_iv = newSViv (0); |
310 |
|
311 |
sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
312 |
DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
313 |
|
314 |
/* apache might BOOT: twice :( */ |
315 |
if (lru_size) |
316 |
lru_cachesize (0); |
317 |
|
318 |
lru_init (); |
319 |
lru_cachesize (100); |
320 |
} |
321 |
|
322 |
void |
323 |
boot2 (SV *t_str, SV *t_int, SV *t_dbl) |
324 |
CODE: |
325 |
sql_varchar = newSVsv (t_str); |
326 |
sql_integer = newSVsv (t_int); |
327 |
sql_double = newSVsv (t_dbl); |
328 |
|
329 |
int |
330 |
cachesize(size = -1) |
331 |
int size |
332 |
CODE: |
333 |
RETVAL = lru_maxsize; |
334 |
lru_cachesize (size); |
335 |
OUTPUT: |
336 |
RETVAL |
337 |
|
338 |
void |
339 |
sql_exec(...) |
340 |
ALIAS: |
341 |
sql_uexec = 1 |
342 |
sql_fetch = 2 |
343 |
sql_ufetch = 3 |
344 |
sql_fetchall = 4 |
345 |
sql_ufetchall = 5 |
346 |
sql_exists = 6 |
347 |
sql_uexists = 7 |
348 |
PPCODE: |
349 |
{ |
350 |
if (items == 0) |
351 |
croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
352 |
else |
353 |
{ |
354 |
int i; |
355 |
int arg = 0; |
356 |
int bind_first, bind_last; |
357 |
int count; |
358 |
lru_node *lru; |
359 |
SV *dbh = ST(0); |
360 |
SV *sth; |
361 |
SV *sql; |
362 |
SV *execute; |
363 |
mc_node *mc; |
364 |
STRLEN dc, dd; /* dummy */ |
365 |
I32 orig_stack = SP - PL_stack_base; |
366 |
|
367 |
/* save our arguments against destruction through function calls */ |
368 |
SP += items; |
369 |
|
370 |
/* first check wether we should use an explicit db handle */ |
371 |
if (!is_dbh (dbh)) |
372 |
{ |
373 |
/* the next line doesn't work - check why later maybe */ |
374 |
/* dbh = get_sv ("DBH", FALSE); |
375 |
if (!is_dbh (dbh)) |
376 |
{*/ |
377 |
dbh = GvSV (DBH); |
378 |
if (!is_dbh (dbh)) |
379 |
croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
380 |
/*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
381 |
}*/ |
382 |
} |
383 |
else |
384 |
arg++; /* we consumed one argument */ |
385 |
|
386 |
/* be more Coro-friendly by keeping a copy, so different threads */ |
387 |
/* can replace their global handles */ |
388 |
dbh = sv_2mortal (newSVsv (dbh)); |
389 |
|
390 |
/* count the remaining references (for bind_columns) */ |
391 |
bind_first = arg; |
392 |
while (items > arg && SvROK (ST(arg))) |
393 |
arg++; |
394 |
|
395 |
bind_last = arg; |
396 |
|
397 |
/* consume the sql-statement itself */ |
398 |
if (items <= arg) |
399 |
croak ("sql_exec: required argument \"sql-statement\" missing"); |
400 |
|
401 |
if (!SvPOK (ST(arg))) |
402 |
croak ("sql_exec: sql-statement must be a string"); |
403 |
|
404 |
sql = ST(arg); arg++; |
405 |
|
406 |
if ((ix & ~1) == 6) /* sql_exists */ |
407 |
{ |
408 |
SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
409 |
sv_catsv (neu, sql); |
410 |
sv_catpv (neu, " limit 1"); |
411 |
sql = neu; |
412 |
ix -= 4; /* sql_fetch */ |
413 |
} |
414 |
|
415 |
/* now prepare all parameters, by unmagicalising them and upgrading them */ |
416 |
for (i = arg; i < items; ++i) |
417 |
{ |
418 |
SV *sv = ST (i); |
419 |
|
420 |
/* we sv_mortalcopy magical values since DBI seems to have a memory |
421 |
* leak when magical values are passed into execute(). |
422 |
*/ |
423 |
if (SvMAGICAL (sv)) |
424 |
ST (i) = sv = sv_mortalcopy (sv); |
425 |
|
426 |
if ((ix & 1) && SvPOKp (sv) && !SvUTF8 (sv)) |
427 |
{ |
428 |
ST (i) = sv = sv_mortalcopy (sv); |
429 |
sv_utf8_upgrade (sv); |
430 |
} |
431 |
} |
432 |
|
433 |
/* check cache for existing statement handle */ |
434 |
lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE |
435 |
? lru_fetch (dbh, sql) |
436 |
: 0; |
437 |
if (!lru) |
438 |
{ |
439 |
mc = mc_find (SvSTASH (SvRV (dbh))); |
440 |
|
441 |
if (!mc->prepare) |
442 |
mc_cache (mc, prepare); |
443 |
|
444 |
PUSHMARK (SP); |
445 |
EXTEND (SP, 2); |
446 |
PUSHs (dbh); |
447 |
PUSHs (sql); |
448 |
PUTBACK; |
449 |
count = call_sv (mc->prepare, G_SCALAR); |
450 |
SPAGAIN; |
451 |
|
452 |
if (count != 1) |
453 |
croak ("sql_exec: unable to prepare() statement '%s': %s", |
454 |
SvPV (sql, dc), |
455 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
456 |
|
457 |
sth = POPs; |
458 |
|
459 |
if (!SvROK (sth)) |
460 |
croak ("sql_exec: buggy DBD driver, prepare returned non-reference for '%s': %s", |
461 |
SvPV (sql, dc), |
462 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
463 |
|
464 |
mc = mc_find (SvSTASH (SvRV (sth))); |
465 |
|
466 |
if (!mc->bind_param) |
467 |
{ |
468 |
mc_cache (mc, bind_param); |
469 |
mc_cache (mc, execute); |
470 |
mc_cache (mc, finish); |
471 |
} |
472 |
|
473 |
if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE) |
474 |
lru_store (dbh, sql, sth, mc); |
475 |
|
476 |
/* on first execution we unfortunately need to use bind_param |
477 |
* to mark any numeric parameters as such. |
478 |
*/ |
479 |
SvIV_set (tmp_iv, 0); |
480 |
|
481 |
while (items > arg) |
482 |
{ |
483 |
SV *sv = ST (arg); |
484 |
/* we sv_mortalcopy magical values since DBI seems to have a memory |
485 |
* leak when magical values are passed into execute(). |
486 |
*/ |
487 |
|
488 |
PUSHMARK (SP); |
489 |
EXTEND (SP, 4); |
490 |
PUSHs (sth); |
491 |
SvIVX (tmp_iv)++; |
492 |
SvIOK_only (tmp_iv); |
493 |
PUSHs (tmp_iv); |
494 |
PUSHs (sv); |
495 |
|
496 |
PUSHs ( |
497 |
SvPOKp (sv) ? sql_varchar |
498 |
: SvNOKp (sv) ? sql_double |
499 |
: SvIOKp (sv) ? sql_integer |
500 |
: sql_varchar |
501 |
); |
502 |
|
503 |
PUTBACK; |
504 |
call_sv (mc->bind_param, G_VOID); |
505 |
SPAGAIN; |
506 |
|
507 |
arg++; |
508 |
} |
509 |
|
510 |
/* now use execute without any arguments */ |
511 |
PUSHMARK (SP); |
512 |
XPUSHs (sth); |
513 |
} |
514 |
else |
515 |
{ |
516 |
sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
517 |
mc = lru->mc; |
518 |
|
519 |
/* we have previously executed this statement, so we |
520 |
* use the cached types and use execute with arguments. |
521 |
*/ |
522 |
|
523 |
PUSHMARK (SP); |
524 |
EXTEND (SP, items - arg + 1); |
525 |
PUSHs (sth); |
526 |
while (items > arg) |
527 |
{ |
528 |
SV *sv = ST (arg); |
529 |
PUSHs (sv); |
530 |
arg++; |
531 |
} |
532 |
} |
533 |
|
534 |
PUTBACK; |
535 |
/* { static GV *execute; |
536 |
if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
537 |
count = call_sv(GvCV(execute), G_SCALAR); |
538 |
}*/ |
539 |
count = call_sv (mc->execute, G_SCALAR); |
540 |
SPAGAIN; |
541 |
|
542 |
if (count != 1) |
543 |
croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
544 |
SvPV (sql, dc), |
545 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
546 |
|
547 |
execute = POPs; |
548 |
|
549 |
if (!SvTRUE (execute)) |
550 |
croak ("sql_exec: unable to execute statement '%s' (%s)", |
551 |
SvPV (sql, dc), |
552 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
553 |
|
554 |
sv_setsv (GvSV (sql_exec), execute); |
555 |
|
556 |
if (bind_first != bind_last) |
557 |
{ |
558 |
PUSHMARK (SP); |
559 |
EXTEND (SP, bind_last - bind_first + 2); |
560 |
PUSHs (sth); |
561 |
do { |
562 |
#if CAN_UTF8 |
563 |
if (ix & 1) |
564 |
SvUTF8_on (SvRV(ST(bind_first))); |
565 |
#endif |
566 |
PUSHs (ST(bind_first)); |
567 |
bind_first++; |
568 |
} while (bind_first != bind_last); |
569 |
|
570 |
PUTBACK; |
571 |
|
572 |
if (!mc->bind_columns) |
573 |
mc_cache (mc, bind_columns); |
574 |
|
575 |
count = call_sv (mc->bind_columns, G_SCALAR); |
576 |
|
577 |
SPAGAIN; |
578 |
|
579 |
if (count != 1) |
580 |
croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
581 |
SvPV (sql, dc), |
582 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
583 |
|
584 |
if (!SvOK (TOPs)) |
585 |
croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
586 |
SvPV (sql, dc), |
587 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
588 |
|
589 |
POPs; |
590 |
} |
591 |
|
592 |
if ((ix & ~1) == 2) /* sql_fetch */ |
593 |
{ |
594 |
SV *row; |
595 |
|
596 |
PUSHMARK (SP); |
597 |
XPUSHs (sth); |
598 |
PUTBACK; |
599 |
|
600 |
if (!mc->fetchrow_arrayref) |
601 |
mc_cache (mc, fetchrow_arrayref); |
602 |
|
603 |
count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
604 |
SPAGAIN; |
605 |
|
606 |
if (count != 1) |
607 |
abort (); |
608 |
|
609 |
row = POPs; |
610 |
|
611 |
SP = PL_stack_base + orig_stack; |
612 |
|
613 |
if (SvROK (row)) |
614 |
{ |
615 |
AV *av; |
616 |
|
617 |
switch (GIMME_V) |
618 |
{ |
619 |
case G_VOID: |
620 |
/* no thing */ |
621 |
break; |
622 |
case G_SCALAR: |
623 |
/* the first element */ |
624 |
XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (row))[0])); |
625 |
count = 1; |
626 |
break; |
627 |
case G_ARRAY: |
628 |
av = (AV *)SvRV (row); |
629 |
count = AvFILL (av) + 1; |
630 |
EXTEND (SP, count); |
631 |
for (arg = 0; arg < count; arg++) |
632 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
633 |
|
634 |
break; |
635 |
default: |
636 |
abort (); |
637 |
} |
638 |
} |
639 |
} |
640 |
else if ((ix & ~1) == 4) /* sql_fetchall */ |
641 |
{ |
642 |
SV *rows; |
643 |
|
644 |
PUSHMARK (SP); |
645 |
XPUSHs (sth); |
646 |
PUTBACK; |
647 |
|
648 |
if (!mc->fetchall_arrayref) |
649 |
mc_cache (mc, fetchall_arrayref); |
650 |
|
651 |
count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
652 |
SPAGAIN; |
653 |
|
654 |
if (count != 1) |
655 |
abort (); |
656 |
|
657 |
rows = POPs; |
658 |
|
659 |
SP = PL_stack_base + orig_stack; |
660 |
|
661 |
if (SvROK (rows)) |
662 |
{ |
663 |
AV *av = (AV *)SvRV (rows); |
664 |
count = AvFILL (av) + 1; |
665 |
|
666 |
if (count) |
667 |
{ |
668 |
int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
669 |
|
670 |
EXTEND (SP, count); |
671 |
if (columns == 1) |
672 |
for (arg = 0; arg < count; arg++) |
673 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
674 |
else |
675 |
for (arg = 0; arg < count; arg++) |
676 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
677 |
} |
678 |
} |
679 |
} |
680 |
else |
681 |
{ |
682 |
SP = PL_stack_base + orig_stack; |
683 |
XPUSHs (sth); |
684 |
} |
685 |
|
686 |
if (ix >= 2 || GIMME_V == G_VOID) |
687 |
{ |
688 |
orig_stack = SP - PL_stack_base; |
689 |
|
690 |
PUSHMARK (SP); |
691 |
XPUSHs (sth); |
692 |
PUTBACK; |
693 |
|
694 |
if (!mc->finish) |
695 |
mc_cache (mc, finish); |
696 |
|
697 |
call_sv (mc->finish, G_DISCARD); |
698 |
SPAGAIN; |
699 |
|
700 |
SP = PL_stack_base + orig_stack; |
701 |
} |
702 |
} |
703 |
} |
704 |
|
705 |
|
706 |
|