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, pelase 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 = 2166136261; |
183 |
|
184 |
hash = (hash ^ (U32)dbh) * 16777619U; |
185 |
hash = (hash ^ l) * 16777619U; |
186 |
|
187 |
for (i = 7; i < l; i += i >> 2) |
188 |
hash = (hash ^ b [i]) * 16777619U; |
189 |
|
190 |
return hash; |
191 |
} |
192 |
|
193 |
/* fetch and "use" */ |
194 |
static lru_node * |
195 |
lru_fetch (SV *dbh, SV *sql) |
196 |
{ |
197 |
lru_node *n; |
198 |
U32 hash; |
199 |
|
200 |
dbh = SvRV (dbh); |
201 |
hash = lru_hash (dbh, sql); |
202 |
|
203 |
n = &lru_list; |
204 |
do { |
205 |
n = n->next; |
206 |
|
207 |
if (!n->hash) |
208 |
return 0; |
209 |
} while (n->hash != hash |
210 |
|| DBI_STH_ACTIVE (n->sth_imp) |
211 |
|| !sv_eq (n->sql, sql) |
212 |
|| n->dbh != dbh); |
213 |
|
214 |
/* found, so return to the start of the list */ |
215 |
n->prev->next = n->next; |
216 |
n->next->prev = n->prev; |
217 |
|
218 |
n->next = lru_list.next; |
219 |
n->prev = &lru_list; |
220 |
lru_list.next->prev = n; |
221 |
lru_list.next = n; |
222 |
|
223 |
return n; |
224 |
} |
225 |
|
226 |
static void |
227 |
lru_trim (void) |
228 |
{ |
229 |
while (lru_size > lru_maxsize) |
230 |
{ |
231 |
/* nuke at the end */ |
232 |
lru_node *n = lru_list.prev; |
233 |
|
234 |
n = lru_list.prev; |
235 |
|
236 |
lru_list.prev = n->prev; |
237 |
n->prev->next = &lru_list; |
238 |
|
239 |
SvREFCNT_dec (n->dbh); |
240 |
SvREFCNT_dec (n->sql); |
241 |
SvREFCNT_dec (n->sth); |
242 |
Safefree (n); |
243 |
|
244 |
lru_size--; |
245 |
} |
246 |
} |
247 |
|
248 |
/* store a not-yet existing entry(!) */ |
249 |
static void |
250 |
lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
251 |
{ |
252 |
lru_node *n; |
253 |
U32 hash; |
254 |
|
255 |
if (!lru_maxsize) |
256 |
return; |
257 |
|
258 |
dbh = SvRV (dbh); |
259 |
hash = lru_hash (dbh, sql); |
260 |
|
261 |
lru_size++; |
262 |
lru_trim (); |
263 |
|
264 |
New (0, n, 1, lru_node); |
265 |
|
266 |
n->hash = hash; |
267 |
n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ |
268 |
n->sql = newSVsv (sql); |
269 |
n->sth = sth; SvREFCNT_inc (sth); |
270 |
n->sth_imp = sth_get_imp (sth); |
271 |
n->mc = mc; |
272 |
|
273 |
n->next = lru_list.next; |
274 |
n->prev = &lru_list; |
275 |
lru_list.next->prev = n; |
276 |
lru_list.next = n; |
277 |
} |
278 |
|
279 |
static void |
280 |
lru_cachesize (int size) |
281 |
{ |
282 |
if (size >= 0) |
283 |
{ |
284 |
lru_maxsize = size; |
285 |
lru_trim (); |
286 |
} |
287 |
} |
288 |
|
289 |
static GV *sql_exec; |
290 |
static GV *DBH; |
291 |
|
292 |
#define newconstpv(str) newSVpvn ((str), sizeof (str)) |
293 |
|
294 |
MODULE = PApp::SQL PACKAGE = PApp::SQL |
295 |
|
296 |
PROTOTYPES: DISABLE |
297 |
|
298 |
BOOT: |
299 |
{ |
300 |
struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
301 |
|
302 |
/* this is actually wrong, we should call the check member, apparently */ |
303 |
assert (dbis->version == DBISTATE_VERSION); |
304 |
assert (dbis->xs_version == DBIXS_VERSION); |
305 |
|
306 |
tmp_iv = newSViv (0); |
307 |
|
308 |
sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
309 |
DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
310 |
|
311 |
/* apache might BOOT: twice :( */ |
312 |
if (lru_size) |
313 |
lru_cachesize (0); |
314 |
|
315 |
lru_init (); |
316 |
lru_cachesize (100); |
317 |
} |
318 |
|
319 |
void |
320 |
boot2 (SV *t_str, SV *t_int, SV *t_dbl) |
321 |
CODE: |
322 |
sql_varchar = newSVsv (t_str); |
323 |
sql_integer = newSVsv (t_int); |
324 |
sql_double = newSVsv (t_dbl); |
325 |
|
326 |
int |
327 |
cachesize(size = -1) |
328 |
int size |
329 |
CODE: |
330 |
RETVAL = lru_maxsize; |
331 |
lru_cachesize (size); |
332 |
OUTPUT: |
333 |
RETVAL |
334 |
|
335 |
void |
336 |
sql_exec(...) |
337 |
ALIAS: |
338 |
sql_uexec = 1 |
339 |
sql_fetch = 2 |
340 |
sql_ufetch = 3 |
341 |
sql_fetchall = 4 |
342 |
sql_ufetchall = 5 |
343 |
sql_exists = 6 |
344 |
sql_uexists = 7 |
345 |
PPCODE: |
346 |
{ |
347 |
if (items == 0) |
348 |
croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
349 |
else |
350 |
{ |
351 |
int i; |
352 |
int arg = 0; |
353 |
int first_execution = 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 |
mc = mc_find (SvSTASH (SvRV (sth))); |
458 |
|
459 |
if (!mc->bind_param) |
460 |
{ |
461 |
mc_cache (mc, bind_param); |
462 |
mc_cache (mc, execute); |
463 |
mc_cache (mc, finish); |
464 |
} |
465 |
|
466 |
if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE) |
467 |
lru_store (dbh, sql, sth, mc); |
468 |
|
469 |
/* on first execution we unfortunately need to use bind_param |
470 |
* to mark any numeric parameters as such. |
471 |
*/ |
472 |
SvIV_set (tmp_iv, 0); |
473 |
|
474 |
while (items > arg) |
475 |
{ |
476 |
SV *sv = ST (arg); |
477 |
/* we sv_mortalcopy magical values since DBI seems to have a memory |
478 |
* leak when magical values are passed into execute(). |
479 |
*/ |
480 |
|
481 |
PUSHMARK (SP); |
482 |
EXTEND (SP, 4); |
483 |
PUSHs (sth); |
484 |
SvIVX (tmp_iv)++; |
485 |
PUSHs (tmp_iv); |
486 |
PUSHs (sv); |
487 |
|
488 |
PUSHs ( |
489 |
SvPOKp (sv) ? sql_varchar |
490 |
: SvNOKp (sv) ? sql_double |
491 |
: SvIOKp (sv) ? sql_integer |
492 |
: sql_varchar |
493 |
); |
494 |
|
495 |
PUTBACK; |
496 |
call_sv (mc->bind_param, G_VOID); |
497 |
SPAGAIN; |
498 |
|
499 |
arg++; |
500 |
} |
501 |
|
502 |
/* now use execute without any arguments */ |
503 |
PUSHMARK (SP); |
504 |
EXTEND (SP, 1); |
505 |
PUSHs (sth); |
506 |
} |
507 |
else |
508 |
{ |
509 |
sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
510 |
mc = lru->mc; |
511 |
|
512 |
/* we have previously executed this statement, so we |
513 |
* use the cached types and use execute with arguments. |
514 |
*/ |
515 |
|
516 |
PUSHMARK (SP); |
517 |
EXTEND (SP, items - arg + 1); |
518 |
PUSHs (sth); |
519 |
while (items > arg) |
520 |
{ |
521 |
SV *sv = ST (arg); |
522 |
PUSHs (ST (arg)); |
523 |
arg++; |
524 |
} |
525 |
} |
526 |
|
527 |
PUTBACK; |
528 |
/* { static GV *execute; |
529 |
if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
530 |
count = call_sv(GvCV(execute), G_SCALAR); |
531 |
}*/ |
532 |
count = call_sv (mc->execute, G_SCALAR); |
533 |
SPAGAIN; |
534 |
|
535 |
if (count != 1) |
536 |
croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
537 |
SvPV (sql, dc), |
538 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
539 |
|
540 |
execute = POPs; |
541 |
|
542 |
if (!SvTRUE (execute)) |
543 |
croak ("sql_exec: unable to execute statement '%s' (%s)", |
544 |
SvPV (sql, dc), |
545 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
546 |
|
547 |
sv_setsv (GvSV (sql_exec), execute); |
548 |
|
549 |
if (bind_first != bind_last) |
550 |
{ |
551 |
PUSHMARK (SP); |
552 |
EXTEND (SP, bind_last - bind_first + 2); |
553 |
PUSHs (sth); |
554 |
do { |
555 |
#if CAN_UTF8 |
556 |
if (ix & 1) |
557 |
SvUTF8_on (SvRV(ST(bind_first))); |
558 |
#endif |
559 |
PUSHs (ST(bind_first)); |
560 |
bind_first++; |
561 |
} while (bind_first != bind_last); |
562 |
|
563 |
PUTBACK; |
564 |
|
565 |
if (!mc->bind_columns) |
566 |
mc_cache (mc, bind_columns); |
567 |
|
568 |
count = call_sv (mc->bind_columns, G_SCALAR); |
569 |
|
570 |
SPAGAIN; |
571 |
|
572 |
if (count != 1) |
573 |
croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
574 |
SvPV (sql, dc), |
575 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
576 |
|
577 |
if (!SvOK (TOPs)) |
578 |
croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
579 |
SvPV (sql, dc), |
580 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
581 |
|
582 |
POPs; |
583 |
} |
584 |
|
585 |
if ((ix & ~1) == 2) |
586 |
{ /* sql_fetch */ |
587 |
SV *row; |
588 |
|
589 |
PUSHMARK (SP); |
590 |
XPUSHs (sth); |
591 |
PUTBACK; |
592 |
|
593 |
if (!mc->fetchrow_arrayref) |
594 |
mc_cache (mc, fetchrow_arrayref); |
595 |
|
596 |
count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
597 |
SPAGAIN; |
598 |
|
599 |
if (count != 1) |
600 |
abort (); |
601 |
|
602 |
row = POPs; |
603 |
|
604 |
SP = PL_stack_base + orig_stack; |
605 |
|
606 |
if (SvROK (row)) |
607 |
{ |
608 |
AV *av; |
609 |
|
610 |
switch (GIMME_V) |
611 |
{ |
612 |
case G_VOID: |
613 |
/* no thing */ |
614 |
break; |
615 |
case G_SCALAR: |
616 |
/* the first element */ |
617 |
XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
618 |
count = 1; |
619 |
break; |
620 |
case G_ARRAY: |
621 |
av = (AV *)SvRV (row); |
622 |
count = AvFILL (av) + 1; |
623 |
EXTEND (SP, count); |
624 |
for (arg = 0; arg < count; arg++) |
625 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
626 |
|
627 |
break; |
628 |
default: |
629 |
abort (); |
630 |
} |
631 |
} |
632 |
} |
633 |
else if ((ix & ~1) == 4) |
634 |
{ /* sql_fetchall */ |
635 |
SV *rows; |
636 |
|
637 |
PUSHMARK (SP); |
638 |
XPUSHs (sth); |
639 |
PUTBACK; |
640 |
|
641 |
if (!mc->fetchall_arrayref) |
642 |
mc_cache (mc, fetchall_arrayref); |
643 |
|
644 |
count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
645 |
SPAGAIN; |
646 |
|
647 |
if (count != 1) |
648 |
abort (); |
649 |
|
650 |
rows = POPs; |
651 |
|
652 |
SP = PL_stack_base + orig_stack; |
653 |
|
654 |
if (SvROK (rows)) |
655 |
{ |
656 |
AV *av = (AV *)SvRV (rows); |
657 |
count = AvFILL (av) + 1; |
658 |
|
659 |
if (count) |
660 |
{ |
661 |
int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
662 |
|
663 |
EXTEND (SP, count); |
664 |
if (columns == 1) |
665 |
for (arg = 0; arg < count; arg++) |
666 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
667 |
else |
668 |
for (arg = 0; arg < count; arg++) |
669 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
670 |
} |
671 |
} |
672 |
} |
673 |
else |
674 |
{ |
675 |
SP = PL_stack_base + orig_stack; |
676 |
XPUSHs (sth); |
677 |
} |
678 |
|
679 |
if (ix > 1 || GIMME_V == G_VOID) |
680 |
{ |
681 |
orig_stack = SP - PL_stack_base; |
682 |
|
683 |
PUSHMARK (SP); |
684 |
XPUSHs (sth); |
685 |
PUTBACK; |
686 |
|
687 |
if (!mc->finish) |
688 |
mc_cache (mc, finish); |
689 |
|
690 |
call_sv (mc->finish, G_DISCARD); |
691 |
SPAGAIN; |
692 |
|
693 |
SP = PL_stack_base + orig_stack; |
694 |
} |
695 |
} |
696 |
} |
697 |
|
698 |
|
699 |
|