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

Diff Legend

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