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

Diff Legend

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