ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
(Generate patch)

Comparing PApp-SQL/SQL.xs (file contents):
Revision 1.15 by root, Thu Nov 7 01:57:58 2002 UTC vs.
Revision 1.30 by root, Mon Jun 24 19:24:01 2019 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.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
13static SV *sql_varchar, *sql_integer, *sql_double;
14static SV *tmp_iv;
15
16struct 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};
29typedef struct dbistate_st dbistate_t;
30
31#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */
32
33typedef U32 imp_sth;
34
35/* not strictly part of the API... */
36static imp_sth *
37sth_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 */
4 48
5#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) 49#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6# define get_sv perl_get_sv 50# define get_sv perl_get_sv
7# define call_method perl_call_method 51# define call_method perl_call_method
8# define call_sv perl_call_sv 52# define call_sv perl_call_sv
… …
10 54
11#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) 55#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6))
12# define CAN_UTF8 1 56# define CAN_UTF8 1
13#endif 57#endif
14 58
15#define MAX_CACHED_STATEMENT_SIZE 8192 59#define MAX_CACHED_STATEMENT_SIZE 2048
16 60
17static SV * 61static SV *
18sql_upgrade_utf8 (SV *sv) 62sql_upgrade_utf8 (SV *sv)
19{ 63{
20#if CAN_UTF8 64#if CAN_UTF8
21 if (SvPOK (sv)) 65 if (SvPOKp (sv))
22 sv_utf8_upgrade (sv); 66 sv_utf8_upgrade (sv);
23#endif 67#endif
24 return sv; 68 return sv;
25} 69}
26 70
27static SV * 71static SV *
28mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) 72mortalcopy_and_maybe_force_utf8(int utf8, SV *sv)
29{ 73{
30 sv = sv_mortalcopy (sv); 74 sv = sv_mortalcopy (sv);
31#if CAN_UTF8 75#if CAN_UTF8
32 if (utf8 && SvPOK (sv)) 76 if (utf8 && SvPOKp (sv))
33 SvUTF8_on (sv); 77 SvUTF8_on (sv);
34#endif 78#endif
35 return sv; 79 return sv;
36} 80}
37 81
38#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) 82#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv))
39 83
40#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) 84#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
41 85
86typedef 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
104static mc_node *first;
105
106static mc_node *
107mc_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
143static void
144mc_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
42typedef struct lru_node { 154typedef struct lru_node
155{
43 struct lru_node *next; 156 struct lru_node *next;
44 struct lru_node *prev; 157 struct lru_node *prev;
158
45 U32 hash; 159 U32 hash;
46 SV *dbh; 160 SV *dbh;
47 SV *sql; 161 SV *sql;
48 162
49 SV *sth; 163 SV *sth;
50#if 0 /* method cache */ 164 imp_sth *sth_imp;
51 GV *execute; 165
52 GV *bind_columns; 166 mc_node *mc;
53 GV *fetch;
54 GV *finish;
55#endif
56} lru_node; 167} lru_node;
57 168
58static lru_node lru_list; 169static lru_node lru_list;
59static int lru_size; 170static int lru_size;
60static int lru_maxsize; 171static int lru_maxsize;
61 172
62#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ 173#define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
63 174
64/* this is primitive, yet effective */ 175/* this is primitive, yet effective */
65/* the returned value must never be zero (or bad things will happen) */ 176/* the returned value must never be zero (or bad things will happen) */
66#define lru_hash do { \ 177static U32
67 hash = (((U32)dbh)>>2); \ 178lru_hash (SV *dbh, SV *sql)
68 hash += *statement;\ 179{
69 hash += len; \ 180 STRLEN i, l;
70} while (0) 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}
71 193
72/* fetch and "use" */ 194/* fetch and "use" */
73/* could be done using a single call (we could call prepare!) */ 195static lru_node *
74static SV *lru_fetch(SV *dbh, SV *sql) 196lru_fetch (SV *dbh, SV *sql)
75{ 197{
76 lru_node *n; 198 lru_node *n;
77
78 U32 hash; 199 U32 hash;
79 STRLEN len;
80 char *statement = SvPV (sql, len);
81 200
82 dbh = SvRV (dbh); 201 dbh = SvRV (dbh);
83 202 hash = lru_hash (dbh, sql);
84 lru_hash;
85 203
86 n = &lru_list; 204 n = &lru_list;
87 do { 205 do {
88 n = n->next; 206 n = n->next;
207
89 if (!n->hash) 208 if (!n->hash)
90 return 0; 209 return 0;
91 } while (n->hash != hash 210 } while (n->hash != hash
211 || DBI_STH_ACTIVE (n->sth_imp)
92 || !sv_eq (n->sql, sql) 212 || !sv_eq (n->sql, sql)
93 || n->dbh != dbh); 213 || n->dbh != dbh);
94 214
95 /* found, so return to the start of the list */ 215 /* found, so return to the start of the list */
96 n->prev->next = n->next; 216 n->prev->next = n->next;
… …
99 n->next = lru_list.next; 219 n->next = lru_list.next;
100 n->prev = &lru_list; 220 n->prev = &lru_list;
101 lru_list.next->prev = n; 221 lru_list.next->prev = n;
102 lru_list.next = n; 222 lru_list.next = n;
103 223
104 return n->sth; 224 return n;
105} 225}
106 226
107static void lru_nukeone(void) 227static void
228lru_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(!) */
250static void
251lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc)
108{ 252{
109 lru_node *n; 253 lru_node *n;
110 /* nuke at the end */ 254 U32 hash;
111 255
112 n = lru_list.prev; 256 if (!lru_maxsize)
113 257 return;
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 258
122 lru_size--;
123}
124
125/* store a not-yet existing entry(!) */
126static 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); 259 dbh = SvRV (dbh);
135 260 hash = lru_hash (dbh, sql);
136 lru_hash;
137 261
138 lru_size++; 262 lru_size++;
139 if (lru_size > lru_maxsize) 263 lru_trim ();
140 lru_nukeone ();
141 264
142 New (0, n, 1, lru_node); 265 New (0, n, 1, lru_node);
143 266
144 n->hash = hash; 267 n->hash = hash;
145 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ 268 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
146 n->sql = newSVsv (sql); 269 n->sql = newSVsv (sql);
147 n->sth = sth; SvREFCNT_inc (sth); 270 n->sth = sth; SvREFCNT_inc (sth);
271 n->sth_imp = sth_get_imp (sth);
272 n->mc = mc;
148 273
149 n->next = lru_list.next; 274 n->next = lru_list.next;
150 n->prev = &lru_list; 275 n->prev = &lru_list;
151 lru_list.next->prev = n; 276 lru_list.next->prev = n;
152 lru_list.next = n; 277 lru_list.next = n;
153} 278}
154 279
280static void
155static void lru_cachesize (int size) 281lru_cachesize (int size)
156{ 282{
157 if (size >= 0) 283 if (size >= 0)
158 { 284 {
159 lru_maxsize = size; 285 lru_maxsize = size;
160 while (lru_size > lru_maxsize) 286 lru_trim ();
161 lru_nukeone ();
162 } 287 }
163} 288}
164 289
165static GV *sql_exec; 290static GV *sql_exec;
166static GV *DBH; 291static GV *DBH;
167static SV *sv_prepare, *sv_execute, *sv_bind_columns,
168 *sv_fetchrow_arrayref, *sv_fetchall_arrayref,
169 *sv_finish;
170 292
171#define newconstpv(str) newSVpvn ((str), sizeof (str)) 293#define newconstpv(str) newSVpvn ((str), sizeof (str))
172 294
173MODULE = PApp::SQL PACKAGE = PApp::SQL 295MODULE = PApp::SQL PACKAGE = PApp::SQL
174 296
175PROTOTYPES: DISABLE 297PROTOTYPES: DISABLE
176 298
177BOOT: 299BOOT:
178{ 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
179 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); 309 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
180 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); 310 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
181
182 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 sv_fetchall_arrayref = newconstpv ("fetchall_arrayref");
189 sv_finish = newconstpv ("finish");
190 }
191 311
192 /* apache might BOOT: twice :( */ 312 /* apache might BOOT: twice :( */
193 if (lru_size) 313 if (lru_size)
194 lru_cachesize (0); 314 lru_cachesize (0);
195 315
196 lru_init; 316 lru_init ();
197 lru_cachesize (50); 317 lru_cachesize (100);
198} 318}
319
320void
321boot2 (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);
199 326
200int 327int
201cachesize(size = -1) 328cachesize(size = -1)
202 int size 329 int size
203 CODE: 330 CODE:
… …
208 335
209void 336void
210sql_exec(...) 337sql_exec(...)
211 ALIAS: 338 ALIAS:
212 sql_uexec = 1 339 sql_uexec = 1
213 sql_fetch = 2 340 sql_fetch = 2
214 sql_ufetch = 3 341 sql_ufetch = 3
215 sql_fetchall = 4 342 sql_fetchall = 4
216 sql_ufetchall = 5 343 sql_ufetchall = 5
217 sql_exists = 6 344 sql_exists = 6
218 sql_uexists = 7 345 sql_uexists = 7
… …
220{ 347{
221 if (items == 0) 348 if (items == 0)
222 croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); 349 croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
223 else 350 else
224 { 351 {
352 int i;
225 int arg = 0; 353 int arg = 0;
226 int bind_first, bind_last; 354 int bind_first, bind_last;
227 int count; 355 int count;
356 lru_node *lru;
228 SV *dbh = ST(0); 357 SV *dbh = ST(0);
229 SV *sth; 358 SV *sth;
230 SV *sql; 359 SV *sql;
231 SV *execute; 360 SV *execute;
361 mc_node *mc;
232 STRLEN dc, dd; /* dummy */ 362 STRLEN dc, dd; /* dummy */
363 I32 orig_stack = SP - PL_stack_base;
233 364
234 /* save our arguments against destruction through function calls */ 365 /* save our arguments against destruction through function calls */
235 SP += items; 366 SP += items;
236 367
237 /* first check wether we should use an explicit db handle */ 368 /* first check wether we should use an explicit db handle */
… …
239 { 370 {
240 /* the next line doesn't work - check why later maybe */ 371 /* the next line doesn't work - check why later maybe */
241 /* dbh = get_sv ("DBH", FALSE); 372 /* dbh = get_sv ("DBH", FALSE);
242 if (!is_dbh (dbh)) 373 if (!is_dbh (dbh))
243 {*/ 374 {*/
244 dbh = GvSV(DBH); 375 dbh = GvSV (DBH);
245 if (!is_dbh (dbh)) 376 if (!is_dbh (dbh))
246 croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); 377 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::"); 378 /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
248 }*/ 379 }*/
249 } 380 }
250 else 381 else
251 arg++; /* we consumed one argument */ 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));
252 387
253 /* count the remaining references (for bind_columns) */ 388 /* count the remaining references (for bind_columns) */
254 bind_first = arg; 389 bind_first = arg;
255 while (items > arg && SvROK (ST(arg))) 390 while (items > arg && SvROK (ST(arg)))
256 arg++; 391 arg++;
… …
273 sv_catpv (neu, " limit 1"); 408 sv_catpv (neu, " limit 1");
274 sql = neu; 409 sql = neu;
275 ix -= 4; /* sql_fetch */ 410 ix -= 4; /* sql_fetch */
276 } 411 }
277 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
278 /* check cache for existing statement handle */ 431 /* check cache for existing statement handle */
432 lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE
279 sth = lru_fetch (dbh, sql); 433 ? lru_fetch (dbh, sql)
434 : 0;
280 if (!sth) 435 if (!lru)
281 { 436 {
437 mc = mc_find (SvSTASH (SvRV (dbh)));
438
439 if (!mc->prepare)
440 mc_cache (mc, prepare);
441
282 PUSHMARK (SP); 442 PUSHMARK (SP);
283 EXTEND (SP, 2); 443 EXTEND (SP, 2);
284 PUSHs (dbh); 444 PUSHs (dbh);
285 PUSHs (sql); 445 PUSHs (sql);
286 PUTBACK; 446 PUTBACK;
287 count = call_sv (sv_prepare, G_METHOD | G_SCALAR); 447 count = call_sv (mc->prepare, G_SCALAR);
288 SPAGAIN; 448 SPAGAIN;
289 449
290 if (count != 1) 450 if (count != 1)
291 croak ("sql_exec: unable to prepare() statement '%s': %s", 451 croak ("sql_exec: unable to prepare() statement '%s': %s",
292 SvPV (sql, dc), 452 SvPV (sql, dc),
293 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 453 SvPV (get_sv ("DBI::errstr", TRUE), dd));
294 454
295 sth = POPs; 455 sth = POPs;
296 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
297 if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE) 471 if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE)
298 lru_store (dbh, sql, sth); 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.
299 } 476 */
477 SvIV_set (tmp_iv, 0);
300 478
301 PUSHMARK (SP);
302 EXTEND (SP, items - arg + 1);
303 PUSHs (sth);
304 while (items > arg) 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
305 { 514 {
306 SV *sv = ST(arg); 515 sth = sv_2mortal (SvREFCNT_inc (lru->sth));
307 /* we sv_mortalcopy magical values since DBI seems to have a memory 516 mc = lru->mc;
308 * leak when magical values are passed into execute(). 517
518 /* we have previously executed this statement, so we
519 * use the cached types and use execute with arguments.
309 */ 520 */
310 PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv)); 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);
311 arg++; 529 arg++;
530 }
312 } 531 }
313 532
314 PUTBACK; 533 PUTBACK;
315 /* { static GV *execute; 534 /* { static GV *execute;
316 if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); 535 if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
317 count = call_sv(GvCV(execute), G_SCALAR); 536 count = call_sv(GvCV(execute), G_SCALAR);
318 }*/ 537 }*/
319 count = call_sv (sv_execute, G_METHOD | G_SCALAR); 538 count = call_sv (mc->execute, G_SCALAR);
320 SPAGAIN; 539 SPAGAIN;
321 540
322 if (count != 1) 541 if (count != 1)
323 croak ("sql_exec: execute() didn't return any value ('%s'): %s", 542 croak ("sql_exec: execute() didn't return any value ('%s'): %s",
324 SvPV (sql, dc), 543 SvPV (sql, dc),
… …
329 if (!SvTRUE (execute)) 548 if (!SvTRUE (execute))
330 croak ("sql_exec: unable to execute statement '%s' (%s)", 549 croak ("sql_exec: unable to execute statement '%s' (%s)",
331 SvPV (sql, dc), 550 SvPV (sql, dc),
332 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 551 SvPV (get_sv ("DBI::errstr", TRUE), dd));
333 552
334 sv_setsv (GvSV(sql_exec), execute); 553 sv_setsv (GvSV (sql_exec), execute);
335 554
336 if (bind_first != bind_last) 555 if (bind_first != bind_last)
337 { 556 {
338 PUSHMARK (SP); 557 PUSHMARK (SP);
339 EXTEND (SP, bind_last - bind_first + 2); 558 EXTEND (SP, bind_last - bind_first + 2);
340 PUSHs (sth); 559 PUSHs (sth);
341 do { 560 do {
561#if CAN_UTF8
562 if (ix & 1)
563 SvUTF8_on (SvRV(ST(bind_first)));
564#endif
342 PUSHs (ST(bind_first)); 565 PUSHs (ST(bind_first));
343 bind_first++; 566 bind_first++;
344 } while (bind_first != bind_last); 567 } while (bind_first != bind_last);
345 568
346 PUTBACK; 569 PUTBACK;
570
571 if (!mc->bind_columns)
572 mc_cache (mc, bind_columns);
573
347 count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR); 574 count = call_sv (mc->bind_columns, G_SCALAR);
575
348 SPAGAIN; 576 SPAGAIN;
349 577
350 if (count != 1) 578 if (count != 1)
351 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", 579 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
352 SvPV (sql, dc), 580 SvPV (sql, dc),
353 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 581 SvPV (get_sv ("DBI::errstr", TRUE), dd));
354 582
355 if (!SvOK (POPs)) 583 if (!SvOK (TOPs))
356 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", 584 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
357 SvPV (sql, dc), 585 SvPV (sql, dc),
358 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 586 SvPV (get_sv ("DBI::errstr", TRUE), dd));
587
359 } 588 POPs;
360 589 }
361 /* free our arguments from the stack */
362 SP -= items;
363 590
364 if ((ix & ~1) == 2) 591 if ((ix & ~1) == 2)
365 { /* sql_fetch */ 592 { /* sql_fetch */
366 SV *row; 593 SV *row;
367 594
368 PUSHMARK (SP); 595 PUSHMARK (SP);
369 XPUSHs (sth); 596 XPUSHs (sth);
370 PUTBACK; 597 PUTBACK;
598
599 if (!mc->fetchrow_arrayref)
600 mc_cache (mc, fetchrow_arrayref);
601
371 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); 602 count = call_sv (mc->fetchrow_arrayref, G_SCALAR);
372 SPAGAIN; 603 SPAGAIN;
373 604
374 if (count != 1) 605 if (count != 1)
375 abort (); 606 abort ();
376 607
377 row = POPs; 608 row = POPs;
609
610 SP = PL_stack_base + orig_stack;
378 611
379 if (SvROK (row)) 612 if (SvROK (row))
380 { 613 {
381 AV *av; 614 AV *av;
382 615
… …
385 case G_VOID: 618 case G_VOID:
386 /* no thing */ 619 /* no thing */
387 break; 620 break;
388 case G_SCALAR: 621 case G_SCALAR:
389 /* the first element */ 622 /* the first element */
390 XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); 623 XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (row))[0]));
624 count = 1;
391 break; 625 break;
392 case G_ARRAY: 626 case G_ARRAY:
393 av = (AV *)SvRV (row); 627 av = (AV *)SvRV (row);
394 count = AvFILL (av) + 1; 628 count = AvFILL (av) + 1;
395 EXTEND (SP, count); 629 EXTEND (SP, count);
… …
407 SV *rows; 641 SV *rows;
408 642
409 PUSHMARK (SP); 643 PUSHMARK (SP);
410 XPUSHs (sth); 644 XPUSHs (sth);
411 PUTBACK; 645 PUTBACK;
646
647 if (!mc->fetchall_arrayref)
648 mc_cache (mc, fetchall_arrayref);
649
412 count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR); 650 count = call_sv (mc->fetchall_arrayref, G_SCALAR);
413 SPAGAIN; 651 SPAGAIN;
414 652
415 if (count != 1) 653 if (count != 1)
416 abort (); 654 abort ();
417 655
418 rows = POPs; 656 rows = POPs;
657
658 SP = PL_stack_base + orig_stack;
419 659
420 if (SvROK (rows)) 660 if (SvROK (rows))
421 { 661 {
422 AV *av = (AV *)SvRV (rows); 662 AV *av = (AV *)SvRV (rows);
423 count = AvFILL (av) + 1; 663 count = AvFILL (av) + 1;
… …
435 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 675 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
436 } 676 }
437 } 677 }
438 } 678 }
439 else 679 else
680 {
681 SP = PL_stack_base + orig_stack;
440 XPUSHs (sth); 682 XPUSHs (sth);
683 }
441 684
442 if (ix > 1 || GIMME_V == G_VOID) 685 if (ix > 1 || GIMME_V == G_VOID)
443 { 686 {
687 orig_stack = SP - PL_stack_base;
688
444 PUSHMARK (SP); 689 PUSHMARK (SP);
445 XPUSHs (sth); 690 XPUSHs (sth);
446 PUTBACK; 691 PUTBACK;
692
693 if (!mc->finish)
694 mc_cache (mc, finish);
695
447 (void) call_sv (sv_finish, G_METHOD | G_DISCARD); 696 call_sv (mc->finish, G_DISCARD);
448 SPAGAIN; 697 SPAGAIN;
698
699 SP = PL_stack_base + orig_stack;
449 } 700 }
450 } 701 }
451} 702}
452 703
453 704

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines