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 |
STRLEN i, l; |
181 |
char *b = SvPV (sql, l); |
182 |
U32 hash = 2166136261U; |
183 |
|
184 |
hash = (hash ^ (U32)dbh) * 16777619U; |
185 |
hash = (hash ^ l) * 16777619U; |
186 |
|
187 |
/* start hashing at char 8, as this skips the "select " prefix */ |
188 |
for (i = 7; i < l; i += i >> 2) |
189 |
hash = (hash ^ b [i]) * 16777619U; |
190 |
|
191 |
return hash; |
192 |
} |
193 |
|
194 |
/* fetch and "use" */ |
195 |
static lru_node * |
196 |
lru_fetch (SV *dbh, SV *sql) |
197 |
{ |
198 |
lru_node *n; |
199 |
U32 hash; |
200 |
|
201 |
dbh = SvRV (dbh); |
202 |
hash = lru_hash (dbh, sql); |
203 |
|
204 |
n = &lru_list; |
205 |
do { |
206 |
n = n->next; |
207 |
|
208 |
if (!n->hash) |
209 |
return 0; |
210 |
} while (n->hash != hash |
211 |
|| DBI_STH_ACTIVE (n->sth_imp) |
212 |
|| !sv_eq (n->sql, sql) |
213 |
|| n->dbh != dbh); |
214 |
|
215 |
/* found, so return to the start of the list */ |
216 |
n->prev->next = n->next; |
217 |
n->next->prev = n->prev; |
218 |
|
219 |
n->next = lru_list.next; |
220 |
n->prev = &lru_list; |
221 |
lru_list.next->prev = n; |
222 |
lru_list.next = n; |
223 |
|
224 |
return n; |
225 |
} |
226 |
|
227 |
static void |
228 |
lru_trim (void) |
229 |
{ |
230 |
while (lru_size > lru_maxsize) |
231 |
{ |
232 |
/* nuke at the end */ |
233 |
lru_node *n = lru_list.prev; |
234 |
|
235 |
n = lru_list.prev; |
236 |
|
237 |
lru_list.prev = n->prev; |
238 |
n->prev->next = &lru_list; |
239 |
|
240 |
SvREFCNT_dec (n->dbh); |
241 |
SvREFCNT_dec (n->sql); |
242 |
SvREFCNT_dec (n->sth); |
243 |
Safefree (n); |
244 |
|
245 |
lru_size--; |
246 |
} |
247 |
} |
248 |
|
249 |
/* store a not-yet existing entry(!) */ |
250 |
static void |
251 |
lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
252 |
{ |
253 |
lru_node *n; |
254 |
U32 hash; |
255 |
|
256 |
if (!lru_maxsize) |
257 |
return; |
258 |
|
259 |
dbh = SvRV (dbh); |
260 |
hash = lru_hash (dbh, sql); |
261 |
|
262 |
lru_size++; |
263 |
lru_trim (); |
264 |
|
265 |
New (0, n, 1, lru_node); |
266 |
|
267 |
n->hash = hash; |
268 |
n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ |
269 |
n->sql = newSVsv (sql); |
270 |
n->sth = sth; SvREFCNT_inc (sth); |
271 |
n->sth_imp = sth_get_imp (sth); |
272 |
n->mc = mc; |
273 |
|
274 |
n->next = lru_list.next; |
275 |
n->prev = &lru_list; |
276 |
lru_list.next->prev = n; |
277 |
lru_list.next = n; |
278 |
} |
279 |
|
280 |
static void |
281 |
lru_cachesize (int size) |
282 |
{ |
283 |
if (size >= 0) |
284 |
{ |
285 |
lru_maxsize = size; |
286 |
lru_trim (); |
287 |
} |
288 |
} |
289 |
|
290 |
static GV *sql_exec; |
291 |
static GV *DBH; |
292 |
|
293 |
#define newconstpv(str) newSVpvn ((str), sizeof (str)) |
294 |
|
295 |
MODULE = PApp::SQL PACKAGE = PApp::SQL |
296 |
|
297 |
PROTOTYPES: DISABLE |
298 |
|
299 |
BOOT: |
300 |
{ |
301 |
struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
302 |
|
303 |
/* this is actually wrong, we should call the check member, apparently */ |
304 |
assert (dbis->version == DBISTATE_VERSION); |
305 |
assert (dbis->xs_version == DBIXS_VERSION); |
306 |
|
307 |
tmp_iv = newSViv (0); |
308 |
|
309 |
sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
310 |
DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
311 |
|
312 |
/* apache might BOOT: twice :( */ |
313 |
if (lru_size) |
314 |
lru_cachesize (0); |
315 |
|
316 |
lru_init (); |
317 |
lru_cachesize (100); |
318 |
} |
319 |
|
320 |
void |
321 |
boot2 (SV *t_str, SV *t_int, SV *t_dbl) |
322 |
CODE: |
323 |
sql_varchar = newSVsv (t_str); |
324 |
sql_integer = newSVsv (t_int); |
325 |
sql_double = newSVsv (t_dbl); |
326 |
|
327 |
int |
328 |
cachesize(size = -1) |
329 |
int size |
330 |
CODE: |
331 |
RETVAL = lru_maxsize; |
332 |
lru_cachesize (size); |
333 |
OUTPUT: |
334 |
RETVAL |
335 |
|
336 |
void |
337 |
sql_exec(...) |
338 |
ALIAS: |
339 |
sql_uexec = 1 |
340 |
sql_fetch = 2 |
341 |
sql_ufetch = 3 |
342 |
sql_fetchall = 4 |
343 |
sql_ufetchall = 5 |
344 |
sql_exists = 6 |
345 |
sql_uexists = 7 |
346 |
PPCODE: |
347 |
{ |
348 |
if (items == 0) |
349 |
croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
350 |
else |
351 |
{ |
352 |
int i; |
353 |
int arg = 0; |
354 |
int bind_first, bind_last; |
355 |
int count; |
356 |
lru_node *lru; |
357 |
SV *dbh = ST(0); |
358 |
SV *sth; |
359 |
SV *sql; |
360 |
SV *execute; |
361 |
mc_node *mc; |
362 |
STRLEN dc, dd; /* dummy */ |
363 |
I32 orig_stack = SP - PL_stack_base; |
364 |
|
365 |
/* save our arguments against destruction through function calls */ |
366 |
SP += items; |
367 |
|
368 |
/* first check wether we should use an explicit db handle */ |
369 |
if (!is_dbh (dbh)) |
370 |
{ |
371 |
/* the next line doesn't work - check why later maybe */ |
372 |
/* dbh = get_sv ("DBH", FALSE); |
373 |
if (!is_dbh (dbh)) |
374 |
{*/ |
375 |
dbh = GvSV (DBH); |
376 |
if (!is_dbh (dbh)) |
377 |
croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
378 |
/*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
379 |
}*/ |
380 |
} |
381 |
else |
382 |
arg++; /* we consumed one argument */ |
383 |
|
384 |
/* be more Coro-friendly by keeping a copy, so different threads */ |
385 |
/* can replace their global handles */ |
386 |
dbh = sv_2mortal (newSVsv (dbh)); |
387 |
|
388 |
/* count the remaining references (for bind_columns) */ |
389 |
bind_first = arg; |
390 |
while (items > arg && SvROK (ST(arg))) |
391 |
arg++; |
392 |
|
393 |
bind_last = arg; |
394 |
|
395 |
/* consume the sql-statement itself */ |
396 |
if (items <= arg) |
397 |
croak ("sql_exec: required argument \"sql-statement\" missing"); |
398 |
|
399 |
if (!SvPOK (ST(arg))) |
400 |
croak ("sql_exec: sql-statement must be a string"); |
401 |
|
402 |
sql = ST(arg); arg++; |
403 |
|
404 |
if ((ix & ~1) == 6) |
405 |
{ |
406 |
SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
407 |
sv_catsv (neu, sql); |
408 |
sv_catpv (neu, " limit 1"); |
409 |
sql = neu; |
410 |
ix -= 4; /* sql_fetch */ |
411 |
} |
412 |
|
413 |
/* now prepare all parameters, by unmagicalising them and upgrading them */ |
414 |
for (i = arg; i < items; ++i) |
415 |
{ |
416 |
SV *sv = ST (i); |
417 |
|
418 |
/* we sv_mortalcopy magical values since DBI seems to have a memory |
419 |
* leak when magical values are passed into execute(). |
420 |
*/ |
421 |
if (SvMAGICAL (sv)) |
422 |
ST (i) = sv = sv_mortalcopy (sv); |
423 |
|
424 |
if ((ix & 1) && SvPOKp (sv) && !SvUTF8 (sv)) |
425 |
{ |
426 |
ST (i) = sv = sv_mortalcopy (sv); |
427 |
sv_utf8_upgrade (sv); |
428 |
} |
429 |
} |
430 |
|
431 |
/* check cache for existing statement handle */ |
432 |
lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE |
433 |
? lru_fetch (dbh, sql) |
434 |
: 0; |
435 |
if (!lru) |
436 |
{ |
437 |
mc = mc_find (SvSTASH (SvRV (dbh))); |
438 |
|
439 |
if (!mc->prepare) |
440 |
mc_cache (mc, prepare); |
441 |
|
442 |
PUSHMARK (SP); |
443 |
EXTEND (SP, 2); |
444 |
PUSHs (dbh); |
445 |
PUSHs (sql); |
446 |
PUTBACK; |
447 |
count = call_sv (mc->prepare, G_SCALAR); |
448 |
SPAGAIN; |
449 |
|
450 |
if (count != 1) |
451 |
croak ("sql_exec: unable to prepare() statement '%s': %s", |
452 |
SvPV (sql, dc), |
453 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
454 |
|
455 |
sth = POPs; |
456 |
|
457 |
if (!SvROK (sth)) |
458 |
croak ("sql_exec: buggy DBD driver, prepare returned non-reference for '%s': %s", |
459 |
SvPV (sql, dc), |
460 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
461 |
|
462 |
mc = mc_find (SvSTASH (SvRV (sth))); |
463 |
|
464 |
if (!mc->bind_param) |
465 |
{ |
466 |
mc_cache (mc, bind_param); |
467 |
mc_cache (mc, execute); |
468 |
mc_cache (mc, finish); |
469 |
} |
470 |
|
471 |
if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE) |
472 |
lru_store (dbh, sql, sth, mc); |
473 |
|
474 |
/* on first execution we unfortunately need to use bind_param |
475 |
* to mark any numeric parameters as such. |
476 |
*/ |
477 |
SvIV_set (tmp_iv, 0); |
478 |
|
479 |
while (items > arg) |
480 |
{ |
481 |
SV *sv = ST (arg); |
482 |
/* we sv_mortalcopy magical values since DBI seems to have a memory |
483 |
* leak when magical values are passed into execute(). |
484 |
*/ |
485 |
|
486 |
PUSHMARK (SP); |
487 |
EXTEND (SP, 4); |
488 |
PUSHs (sth); |
489 |
SvIVX (tmp_iv)++; |
490 |
SvIOK_only (tmp_iv); |
491 |
PUSHs (tmp_iv); |
492 |
PUSHs (sv); |
493 |
|
494 |
PUSHs ( |
495 |
SvPOKp (sv) ? sql_varchar |
496 |
: SvNOKp (sv) ? sql_double |
497 |
: SvIOKp (sv) ? sql_integer |
498 |
: sql_varchar |
499 |
); |
500 |
|
501 |
PUTBACK; |
502 |
call_sv (mc->bind_param, G_VOID); |
503 |
SPAGAIN; |
504 |
|
505 |
arg++; |
506 |
} |
507 |
|
508 |
/* now use execute without any arguments */ |
509 |
PUSHMARK (SP); |
510 |
EXTEND (SP, 1); |
511 |
PUSHs (sth); |
512 |
} |
513 |
else |
514 |
{ |
515 |
sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
516 |
mc = lru->mc; |
517 |
|
518 |
/* we have previously executed this statement, so we |
519 |
* use the cached types and use execute with arguments. |
520 |
*/ |
521 |
|
522 |
PUSHMARK (SP); |
523 |
EXTEND (SP, items - arg + 1); |
524 |
PUSHs (sth); |
525 |
while (items > arg) |
526 |
{ |
527 |
SV *sv = ST (arg); |
528 |
PUSHs (sv); |
529 |
arg++; |
530 |
} |
531 |
} |
532 |
|
533 |
PUTBACK; |
534 |
/* { static GV *execute; |
535 |
if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
536 |
count = call_sv(GvCV(execute), G_SCALAR); |
537 |
}*/ |
538 |
count = call_sv (mc->execute, G_SCALAR); |
539 |
SPAGAIN; |
540 |
|
541 |
if (count != 1) |
542 |
croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
543 |
SvPV (sql, dc), |
544 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
545 |
|
546 |
execute = POPs; |
547 |
|
548 |
if (!SvTRUE (execute)) |
549 |
croak ("sql_exec: unable to execute statement '%s' (%s)", |
550 |
SvPV (sql, dc), |
551 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
552 |
|
553 |
sv_setsv (GvSV (sql_exec), execute); |
554 |
|
555 |
if (bind_first != bind_last) |
556 |
{ |
557 |
PUSHMARK (SP); |
558 |
EXTEND (SP, bind_last - bind_first + 2); |
559 |
PUSHs (sth); |
560 |
do { |
561 |
#if CAN_UTF8 |
562 |
if (ix & 1) |
563 |
SvUTF8_on (SvRV(ST(bind_first))); |
564 |
#endif |
565 |
PUSHs (ST(bind_first)); |
566 |
bind_first++; |
567 |
} while (bind_first != bind_last); |
568 |
|
569 |
PUTBACK; |
570 |
|
571 |
if (!mc->bind_columns) |
572 |
mc_cache (mc, bind_columns); |
573 |
|
574 |
count = call_sv (mc->bind_columns, G_SCALAR); |
575 |
|
576 |
SPAGAIN; |
577 |
|
578 |
if (count != 1) |
579 |
croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
580 |
SvPV (sql, dc), |
581 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
582 |
|
583 |
if (!SvOK (TOPs)) |
584 |
croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
585 |
SvPV (sql, dc), |
586 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
587 |
|
588 |
POPs; |
589 |
} |
590 |
|
591 |
if ((ix & ~1) == 2) |
592 |
{ /* sql_fetch */ |
593 |
SV *row; |
594 |
|
595 |
PUSHMARK (SP); |
596 |
XPUSHs (sth); |
597 |
PUTBACK; |
598 |
|
599 |
if (!mc->fetchrow_arrayref) |
600 |
mc_cache (mc, fetchrow_arrayref); |
601 |
|
602 |
count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
603 |
SPAGAIN; |
604 |
|
605 |
if (count != 1) |
606 |
abort (); |
607 |
|
608 |
row = POPs; |
609 |
|
610 |
SP = PL_stack_base + orig_stack; |
611 |
|
612 |
if (SvROK (row)) |
613 |
{ |
614 |
AV *av; |
615 |
|
616 |
switch (GIMME_V) |
617 |
{ |
618 |
case G_VOID: |
619 |
/* no thing */ |
620 |
break; |
621 |
case G_SCALAR: |
622 |
/* the first element */ |
623 |
XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (row))[0])); |
624 |
count = 1; |
625 |
break; |
626 |
case G_ARRAY: |
627 |
av = (AV *)SvRV (row); |
628 |
count = AvFILL (av) + 1; |
629 |
EXTEND (SP, count); |
630 |
for (arg = 0; arg < count; arg++) |
631 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
632 |
|
633 |
break; |
634 |
default: |
635 |
abort (); |
636 |
} |
637 |
} |
638 |
} |
639 |
else if ((ix & ~1) == 4) |
640 |
{ /* sql_fetchall */ |
641 |
SV *rows; |
642 |
|
643 |
PUSHMARK (SP); |
644 |
XPUSHs (sth); |
645 |
PUTBACK; |
646 |
|
647 |
if (!mc->fetchall_arrayref) |
648 |
mc_cache (mc, fetchall_arrayref); |
649 |
|
650 |
count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
651 |
SPAGAIN; |
652 |
|
653 |
if (count != 1) |
654 |
abort (); |
655 |
|
656 |
rows = POPs; |
657 |
|
658 |
SP = PL_stack_base + orig_stack; |
659 |
|
660 |
if (SvROK (rows)) |
661 |
{ |
662 |
AV *av = (AV *)SvRV (rows); |
663 |
count = AvFILL (av) + 1; |
664 |
|
665 |
if (count) |
666 |
{ |
667 |
int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
668 |
|
669 |
EXTEND (SP, count); |
670 |
if (columns == 1) |
671 |
for (arg = 0; arg < count; arg++) |
672 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
673 |
else |
674 |
for (arg = 0; arg < count; arg++) |
675 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
676 |
} |
677 |
} |
678 |
} |
679 |
else |
680 |
{ |
681 |
SP = PL_stack_base + orig_stack; |
682 |
XPUSHs (sth); |
683 |
} |
684 |
|
685 |
if (ix > 1 || GIMME_V == G_VOID) |
686 |
{ |
687 |
orig_stack = SP - PL_stack_base; |
688 |
|
689 |
PUSHMARK (SP); |
690 |
XPUSHs (sth); |
691 |
PUTBACK; |
692 |
|
693 |
if (!mc->finish) |
694 |
mc_cache (mc, finish); |
695 |
|
696 |
call_sv (mc->finish, G_DISCARD); |
697 |
SPAGAIN; |
698 |
|
699 |
SP = PL_stack_base + orig_stack; |
700 |
} |
701 |
} |
702 |
} |
703 |
|
704 |
|
705 |
|