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 | #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) |
|
|
6 | # define get_sv perl_get_sv |
|
|
7 | # define call_method perl_call_method |
|
|
8 | # define call_sv perl_call_sv |
|
|
9 | #endif |
|
|
10 | |
|
|
11 | #if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
|
|
12 | # define CAN_UTF8 1 |
|
|
13 | #endif |
|
|
14 | |
|
|
15 | #define MAX_CACHED_STATEMENT_SIZE 8192 |
|
|
16 | |
|
|
17 | static SV * |
|
|
18 | sql_upgrade_utf8 (SV *sv) |
|
|
19 | { |
|
|
20 | #if CAN_UTF8 |
|
|
21 | if (SvPOK (sv)) |
|
|
22 | sv_utf8_upgrade (sv); |
|
|
23 | #endif |
|
|
24 | return sv; |
|
|
25 | } |
|
|
26 | |
|
|
27 | static SV * |
|
|
28 | mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
|
|
29 | { |
|
|
30 | sv = sv_mortalcopy (sv); |
|
|
31 | #if CAN_UTF8 |
|
|
32 | if (utf8 && SvPOK (sv)) |
|
|
33 | SvUTF8_on (sv); |
|
|
34 | #endif |
|
|
35 | return sv; |
|
|
36 | } |
|
|
37 | |
|
|
38 | #define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
4 | |
39 | |
5 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
40 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
6 | |
41 | |
7 | typedef struct lru_node { |
42 | typedef struct lru_node { |
8 | struct lru_node *next; |
43 | struct lru_node *next; |
… | |
… | |
14 | SV *sth; |
49 | SV *sth; |
15 | #if 0 /* method cache */ |
50 | #if 0 /* method cache */ |
16 | GV *execute; |
51 | GV *execute; |
17 | GV *bind_columns; |
52 | GV *bind_columns; |
18 | GV *fetch; |
53 | GV *fetch; |
|
|
54 | GV *finish; |
19 | #endif |
55 | #endif |
20 | } lru_node; |
56 | } lru_node; |
21 | |
57 | |
22 | static lru_node lru_list; |
58 | static lru_node lru_list; |
23 | static int lru_size; |
59 | static int lru_size; |
… | |
… | |
44 | char *statement = SvPV (sql, len); |
80 | char *statement = SvPV (sql, len); |
45 | |
81 | |
46 | dbh = SvRV (dbh); |
82 | dbh = SvRV (dbh); |
47 | |
83 | |
48 | lru_hash; |
84 | lru_hash; |
49 | |
|
|
50 | /*fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ |
|
|
51 | |
85 | |
52 | n = &lru_list; |
86 | n = &lru_list; |
53 | do { |
87 | do { |
54 | n = n->next; |
88 | n = n->next; |
55 | if (!n->hash) |
89 | if (!n->hash) |
… | |
… | |
78 | n = lru_list.prev; |
112 | n = lru_list.prev; |
79 | |
113 | |
80 | lru_list.prev = n->prev; |
114 | lru_list.prev = n->prev; |
81 | n->prev->next = &lru_list; |
115 | n->prev->next = &lru_list; |
82 | |
116 | |
83 | /*fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/*D*/ |
|
|
84 | |
|
|
85 | SvREFCNT_dec (n->dbh); |
117 | SvREFCNT_dec (n->dbh); |
86 | SvREFCNT_dec (n->sql); |
118 | SvREFCNT_dec (n->sql); |
87 | SvREFCNT_dec (n->sth); |
119 | SvREFCNT_dec (n->sth); |
88 | Safefree (n); |
120 | Safefree (n); |
89 | |
121 | |
… | |
… | |
101 | |
133 | |
102 | dbh = SvRV (dbh); |
134 | dbh = SvRV (dbh); |
103 | |
135 | |
104 | lru_hash; |
136 | lru_hash; |
105 | |
137 | |
106 | /*fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ |
|
|
107 | |
|
|
108 | lru_size++; |
138 | lru_size++; |
109 | if (lru_size > lru_maxsize) |
139 | if (lru_size > lru_maxsize) |
110 | lru_nukeone (); |
140 | lru_nukeone (); |
111 | |
141 | |
112 | New (0, n, 1, lru_node); |
142 | New (0, n, 1, lru_node); |
… | |
… | |
132 | } |
162 | } |
133 | } |
163 | } |
134 | |
164 | |
135 | static GV *sql_exec; |
165 | static GV *sql_exec; |
136 | static GV *DBH; |
166 | static GV *DBH; |
|
|
167 | static SV *sv_prepare, *sv_execute, *sv_bind_columns, |
|
|
168 | *sv_fetchrow_arrayref, *sv_fetchall_arrayref, |
|
|
169 | *sv_finish; |
|
|
170 | |
|
|
171 | #define newconstpv(str) newSVpvn ((str), sizeof (str)) |
137 | |
172 | |
138 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
173 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
139 | |
174 | |
140 | PROTOTYPES: DISABLE |
175 | PROTOTYPES: DISABLE |
141 | |
176 | |
142 | BOOT: |
177 | BOOT: |
143 | { |
178 | { |
144 | sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
179 | sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
145 | DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
180 | 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 | } |
146 | |
191 | |
147 | /* apache might BOOT: twice :( */ |
192 | /* apache might BOOT: twice :( */ |
148 | if (lru_size) |
193 | if (lru_size) |
149 | lru_cachesize (0); |
194 | lru_cachesize (0); |
150 | |
195 | |
… | |
… | |
162 | RETVAL |
207 | RETVAL |
163 | |
208 | |
164 | void |
209 | void |
165 | sql_exec(...) |
210 | sql_exec(...) |
166 | ALIAS: |
211 | ALIAS: |
|
|
212 | sql_uexec = 1 |
167 | sql_fetch = 1 |
213 | sql_fetch = 2 |
|
|
214 | sql_ufetch = 3 |
168 | sql_fetchall = 2 |
215 | sql_fetchall = 4 |
|
|
216 | sql_ufetchall = 5 |
169 | sql_exists = 4 |
217 | sql_exists = 6 |
|
|
218 | sql_uexists = 7 |
170 | PPCODE: |
219 | PPCODE: |
171 | { |
220 | { |
172 | if (items == 0) |
221 | if (items == 0) |
173 | croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
222 | croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
174 | else |
223 | else |
… | |
… | |
178 | int count; |
227 | int count; |
179 | SV *dbh = ST(0); |
228 | SV *dbh = ST(0); |
180 | SV *sth; |
229 | SV *sth; |
181 | SV *sql; |
230 | SV *sql; |
182 | SV *execute; |
231 | SV *execute; |
|
|
232 | STRLEN dc, dd; /* dummy */ |
183 | |
233 | |
184 | /* save our arguments against destruction through function calls */ |
234 | /* save our arguments against destruction through function calls */ |
185 | SP += items; |
235 | SP += items; |
186 | |
236 | |
187 | /* first check wether we should use an explicit db handle */ |
237 | /* first check wether we should use an explicit db handle */ |
188 | if (!is_dbh (dbh)) |
238 | if (!is_dbh (dbh)) |
189 | { |
239 | { |
|
|
240 | /* the next line doesn't work - check why later maybe */ |
190 | dbh = get_sv ("DBH", FALSE); |
241 | /* dbh = get_sv ("DBH", FALSE); |
191 | if (!is_dbh (dbh)) |
242 | if (!is_dbh (dbh)) |
192 | { |
243 | {*/ |
193 | dbh = GvSV(DBH); |
244 | dbh = GvSV(DBH); |
194 | if (!is_dbh (dbh)) |
245 | if (!is_dbh (dbh)) |
|
|
246 | croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
195 | croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
247 | /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
196 | } |
248 | }*/ |
197 | } |
249 | } |
198 | else |
250 | else |
199 | arg++; /* we consumed one argument */ |
251 | arg++; /* we consumed one argument */ |
200 | |
252 | |
201 | /* count the remaining references (for bind_columns) */ |
253 | /* count the remaining references (for bind_columns) */ |
… | |
… | |
212 | if (!SvPOK (ST(arg))) |
264 | if (!SvPOK (ST(arg))) |
213 | croak ("sql_exec: sql-statement must be a string"); |
265 | croak ("sql_exec: sql-statement must be a string"); |
214 | |
266 | |
215 | sql = ST(arg); arg++; |
267 | sql = ST(arg); arg++; |
216 | |
268 | |
217 | if (ix == 4) |
269 | if ((ix & ~1) == 6) |
218 | { |
270 | { |
219 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
271 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
220 | sv_catsv (neu, sql); |
272 | sv_catsv (neu, sql); |
221 | sv_catpv (neu, " limit 1"); |
273 | sv_catpv (neu, " limit 1"); |
222 | sql = neu; |
274 | sql = neu; |
223 | ix = 1; /* sql_fetch */ |
275 | ix -= 4; /* sql_fetch */ |
224 | } |
276 | } |
225 | |
277 | |
226 | /* check cache for existing statement handle (NYI) */ |
278 | /* check cache for existing statement handle */ |
227 | sth = lru_fetch (dbh, sql); |
279 | sth = lru_fetch (dbh, sql); |
228 | if (!sth) |
280 | if (!sth) |
229 | { |
281 | { |
230 | PUSHMARK (SP); |
282 | PUSHMARK (SP); |
231 | EXTEND (SP, 2); |
283 | EXTEND (SP, 2); |
232 | PUSHs (dbh); |
284 | PUSHs (dbh); |
233 | PUSHs (sql); |
285 | PUSHs (sql); |
234 | PUTBACK; |
286 | PUTBACK; |
235 | count = call_method ("prepare", G_SCALAR); |
287 | count = call_sv (sv_prepare, G_METHOD | G_SCALAR); |
236 | SPAGAIN; |
288 | SPAGAIN; |
237 | |
289 | |
238 | if (count != 1) |
290 | if (count != 1) |
239 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
291 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
240 | SvPV_nolen (sql), |
292 | SvPV (sql, dc), |
241 | SvPV_nolen (get_sv ("DBI::errstr", TRUE))); |
293 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
242 | |
294 | |
243 | sth = POPs; |
295 | sth = POPs; |
244 | |
296 | |
|
|
297 | if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE) |
245 | lru_store (dbh, sql, sth); |
298 | lru_store (dbh, sql, sth); |
246 | } |
299 | } |
247 | |
300 | |
248 | PUSHMARK (SP); |
301 | PUSHMARK (SP); |
249 | EXTEND (SP, items - arg + 1); |
302 | EXTEND (SP, items - arg + 1); |
250 | PUSHs (sth); |
303 | PUSHs (sth); |
251 | while (items > arg) |
304 | while (items > arg) |
252 | { |
305 | { |
253 | PUSHs (ST(arg)); |
306 | SV *sv = ST(arg); |
|
|
307 | /* we sv_mortalcopy magical values since DBI seems to have a memory |
|
|
308 | * leak when magical values are passed into execute(). |
|
|
309 | */ |
|
|
310 | PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv)); |
254 | arg++; |
311 | arg++; |
255 | } |
312 | } |
256 | |
313 | |
257 | PUTBACK; |
314 | PUTBACK; |
258 | /* { static GV *execute; |
315 | /* { static GV *execute; |
259 | if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
316 | if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
260 | count = call_sv(GvCV(execute), G_SCALAR); |
317 | count = call_sv(GvCV(execute), G_SCALAR); |
261 | }*/ |
318 | }*/ |
262 | count = call_method ("execute", G_SCALAR); |
319 | count = call_sv (sv_execute, G_METHOD | G_SCALAR); |
263 | SPAGAIN; |
320 | SPAGAIN; |
264 | |
321 | |
265 | if (count != 1) |
322 | if (count != 1) |
266 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
323 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
267 | SvPV_nolen (sql), |
324 | SvPV (sql, dc), |
268 | SvPV_nolen (get_sv ("DBI::errstr", TRUE))); |
325 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
269 | |
326 | |
270 | execute = POPs; |
327 | execute = POPs; |
271 | |
328 | |
272 | if (!SvTRUE (execute)) |
329 | if (!SvTRUE (execute)) |
273 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
330 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
274 | SvPV_nolen (sql), |
331 | SvPV (sql, dc), |
275 | SvPV_nolen (get_sv ("DBI::errstr", TRUE))); |
332 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
276 | |
333 | |
277 | sv_setsv (GvSV(sql_exec), execute); |
334 | sv_setsv (GvSV(sql_exec), execute); |
278 | |
335 | |
279 | if (bind_first != bind_last) |
336 | if (bind_first != bind_last) |
280 | { |
337 | { |
… | |
… | |
285 | PUSHs (ST(bind_first)); |
342 | PUSHs (ST(bind_first)); |
286 | bind_first++; |
343 | bind_first++; |
287 | } while (bind_first != bind_last); |
344 | } while (bind_first != bind_last); |
288 | |
345 | |
289 | PUTBACK; |
346 | PUTBACK; |
290 | count = call_method ("bind_columns", G_SCALAR); |
347 | count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR); |
291 | SPAGAIN; |
348 | SPAGAIN; |
292 | |
349 | |
293 | if (count != 1) |
350 | if (count != 1) |
294 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
351 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
295 | SvPV_nolen (sql), |
352 | SvPV (sql, dc), |
296 | SvPV_nolen (get_sv ("DBI::errstr", TRUE))); |
353 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
297 | |
354 | |
298 | if (!SvOK (POPs)) |
355 | if (!SvOK (POPs)) |
299 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
356 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
300 | SvPV_nolen (sql), |
357 | SvPV (sql, dc), |
301 | SvPV_nolen (get_sv ("DBI::errstr", TRUE))); |
358 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
302 | } |
359 | } |
303 | |
360 | |
304 | /* free our arguments from the stack */ |
361 | /* free our arguments from the stack */ |
305 | SP -= items; |
362 | SP -= items; |
306 | |
363 | |
307 | if (ix == 1) |
364 | if ((ix & ~1) == 2) |
308 | { /* sql_fetch */ |
365 | { /* sql_fetch */ |
309 | SV *row; |
366 | SV *row; |
310 | |
367 | |
311 | PUSHMARK (SP); |
368 | PUSHMARK (SP); |
312 | XPUSHs (sth); |
369 | XPUSHs (sth); |
313 | PUTBACK; |
370 | PUTBACK; |
314 | count = call_method ("fetchrow_arrayref", G_SCALAR); |
371 | count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); |
315 | SPAGAIN; |
372 | SPAGAIN; |
316 | |
373 | |
317 | if (count != 1) |
374 | if (count != 1) |
318 | abort (); |
375 | abort (); |
319 | |
376 | |
… | |
… | |
328 | case G_VOID: |
385 | case G_VOID: |
329 | /* no thing */ |
386 | /* no thing */ |
330 | break; |
387 | break; |
331 | case G_SCALAR: |
388 | case G_SCALAR: |
332 | /* the first element */ |
389 | /* the first element */ |
333 | XPUSHs (*av_fetch ((AV *)SvRV (row), 0, 1)); |
390 | XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
334 | break; |
391 | break; |
335 | case G_ARRAY: |
392 | case G_ARRAY: |
336 | av = (AV *)SvRV (row); |
393 | av = (AV *)SvRV (row); |
337 | count = AvFILL (av) + 1; |
394 | count = AvFILL (av) + 1; |
338 | EXTEND (SP, count); |
395 | EXTEND (SP, count); |
339 | for (arg = 0; arg < count; arg++) |
396 | for (arg = 0; arg < count; arg++) |
340 | PUSHs (AvARRAY (av)[arg]); |
397 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
341 | |
398 | |
342 | break; |
399 | break; |
343 | default: |
400 | default: |
344 | abort (); |
401 | abort (); |
345 | } |
402 | } |
346 | } |
403 | } |
347 | } |
404 | } |
348 | else if (ix == 2) |
405 | else if ((ix & ~1) == 4) |
349 | { /* sql_fetchall */ |
406 | { /* sql_fetchall */ |
350 | SV *rows; |
407 | SV *rows; |
351 | |
408 | |
352 | PUSHMARK (SP); |
409 | PUSHMARK (SP); |
353 | XPUSHs (sth); |
410 | XPUSHs (sth); |
354 | PUTBACK; |
411 | PUTBACK; |
355 | count = call_method ("fetchall_arrayref", G_SCALAR); |
412 | count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR); |
356 | SPAGAIN; |
413 | SPAGAIN; |
357 | |
414 | |
358 | if (count != 1) |
415 | if (count != 1) |
359 | abort (); |
416 | abort (); |
360 | |
417 | |
… | |
… | |
365 | AV *av = (AV *)SvRV (rows); |
422 | AV *av = (AV *)SvRV (rows); |
366 | count = AvFILL (av) + 1; |
423 | count = AvFILL (av) + 1; |
367 | |
424 | |
368 | if (count) |
425 | if (count) |
369 | { |
426 | { |
370 | int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */ |
427 | int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
371 | |
428 | |
372 | EXTEND (SP, count); |
429 | EXTEND (SP, count); |
373 | if (columns == 1) |
430 | if (columns == 1) |
374 | for (arg = 0; arg < count; arg++) |
431 | for (arg = 0; arg < count; arg++) |
375 | PUSHs (AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]); |
432 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
376 | else |
433 | else |
377 | for (arg = 0; arg < count; arg++) |
434 | for (arg = 0; arg < count; arg++) |
378 | PUSHs (AvARRAY (av)[arg]); |
435 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
379 | } |
436 | } |
380 | } |
437 | } |
381 | } |
438 | } |
382 | else |
439 | else |
383 | XPUSHs (sth); |
440 | XPUSHs (sth); |
384 | |
441 | |
385 | if (ix || GIMME_V == G_VOID) |
442 | if (ix > 1 || GIMME_V == G_VOID) |
386 | { |
443 | { |
387 | PUSHMARK (SP); |
444 | PUSHMARK (SP); |
388 | XPUSHs (sth); |
445 | XPUSHs (sth); |
389 | PUTBACK; |
446 | PUTBACK; |
390 | (void) call_method ("finish", G_DISCARD); |
447 | (void) call_sv (sv_finish, G_METHOD | G_DISCARD); |
391 | SPAGAIN; |
448 | SPAGAIN; |
392 | } |
449 | } |
393 | } |
450 | } |
394 | } |
451 | } |
395 | |
452 | |