… | |
… | |
6 | # define get_sv perl_get_sv |
6 | # define get_sv perl_get_sv |
7 | # define call_method perl_call_method |
7 | # define call_method perl_call_method |
8 | # define call_sv perl_call_sv |
8 | # define call_sv perl_call_sv |
9 | #endif |
9 | #endif |
10 | |
10 | |
11 | #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 5)) |
11 | #if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
12 | # define CAN_UTF8 1 |
12 | # define CAN_UTF8 1 |
13 | #endif |
13 | #endif |
14 | |
14 | |
15 | static SV * |
15 | static SV * |
16 | sql_upgrade_utf8 (SV *sv) |
16 | sql_upgrade_utf8 (SV *sv) |
… | |
… | |
21 | #endif |
21 | #endif |
22 | return sv; |
22 | return sv; |
23 | } |
23 | } |
24 | |
24 | |
25 | static SV * |
25 | static SV * |
26 | sql_force_utf8 (SV *sv) |
26 | mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
27 | { |
27 | { |
|
|
28 | sv = sv_mortalcopy (sv); |
28 | #if CAN_UTF8 |
29 | #if CAN_UTF8 |
29 | if (SvPOK (sv)) |
30 | if (utf8 && SvPOK (sv)) |
30 | SvUTF8_on (sv); |
31 | SvUTF8_on (sv); |
31 | #endif |
32 | #endif |
32 | return sv; |
33 | return sv; |
33 | } |
34 | } |
34 | |
35 | |
35 | #define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
36 | #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 | |
37 | |
38 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
38 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
39 | |
39 | |
40 | typedef struct lru_node { |
40 | typedef struct lru_node { |
41 | struct lru_node *next; |
41 | struct lru_node *next; |
… | |
… | |
79 | |
79 | |
80 | dbh = SvRV (dbh); |
80 | dbh = SvRV (dbh); |
81 | |
81 | |
82 | lru_hash; |
82 | lru_hash; |
83 | |
83 | |
84 | /*fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ |
|
|
85 | |
|
|
86 | n = &lru_list; |
84 | n = &lru_list; |
87 | do { |
85 | do { |
88 | n = n->next; |
86 | n = n->next; |
89 | if (!n->hash) |
87 | if (!n->hash) |
90 | return 0; |
88 | return 0; |
… | |
… | |
112 | n = lru_list.prev; |
110 | n = lru_list.prev; |
113 | |
111 | |
114 | lru_list.prev = n->prev; |
112 | lru_list.prev = n->prev; |
115 | n->prev->next = &lru_list; |
113 | n->prev->next = &lru_list; |
116 | |
114 | |
117 | /*fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/*D*/ |
|
|
118 | |
|
|
119 | SvREFCNT_dec (n->dbh); |
115 | SvREFCNT_dec (n->dbh); |
120 | SvREFCNT_dec (n->sql); |
116 | SvREFCNT_dec (n->sql); |
121 | SvREFCNT_dec (n->sth); |
117 | SvREFCNT_dec (n->sth); |
122 | Safefree (n); |
118 | Safefree (n); |
123 | |
119 | |
… | |
… | |
135 | |
131 | |
136 | dbh = SvRV (dbh); |
132 | dbh = SvRV (dbh); |
137 | |
133 | |
138 | lru_hash; |
134 | lru_hash; |
139 | |
135 | |
140 | /*fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/ |
|
|
141 | |
|
|
142 | lru_size++; |
136 | lru_size++; |
143 | if (lru_size > lru_maxsize) |
137 | if (lru_size > lru_maxsize) |
144 | lru_nukeone (); |
138 | lru_nukeone (); |
145 | |
139 | |
146 | New (0, n, 1, lru_node); |
140 | New (0, n, 1, lru_node); |
… | |
… | |
166 | } |
160 | } |
167 | } |
161 | } |
168 | |
162 | |
169 | static GV *sql_exec; |
163 | static GV *sql_exec; |
170 | static GV *DBH; |
164 | static GV *DBH; |
171 | static SV *sv_prepare, *sv_execute, *sv_bind_columns, *sv_fetchrow_arrayref, *sv_finish; |
165 | static SV *sv_prepare, *sv_execute, *sv_bind_columns, |
|
|
166 | *sv_fetchrow_arrayref, *sv_fetchall_arrayref, |
|
|
167 | *sv_finish; |
172 | |
168 | |
173 | #define newconstpv(str) newSVpvn ((str), sizeof (str)) |
169 | #define newconstpv(str) newSVpvn ((str), sizeof (str)) |
174 | |
170 | |
175 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
171 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
176 | |
172 | |
… | |
… | |
185 | { |
181 | { |
186 | sv_prepare = newconstpv ("prepare"); |
182 | sv_prepare = newconstpv ("prepare"); |
187 | sv_execute = newconstpv ("execute"); |
183 | sv_execute = newconstpv ("execute"); |
188 | sv_bind_columns = newconstpv ("bind_columns"); |
184 | sv_bind_columns = newconstpv ("bind_columns"); |
189 | sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref"); |
185 | sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref"); |
|
|
186 | sv_fetchall_arrayref = newconstpv ("fetchall_arrayref"); |
190 | sv_finish = newconstpv ("finish"); |
187 | sv_finish = newconstpv ("finish"); |
191 | } |
188 | } |
192 | |
189 | |
193 | /* apache might BOOT: twice :( */ |
190 | /* apache might BOOT: twice :( */ |
194 | if (lru_size) |
191 | if (lru_size) |
… | |
… | |
228 | int count; |
225 | int count; |
229 | SV *dbh = ST(0); |
226 | SV *dbh = ST(0); |
230 | SV *sth; |
227 | SV *sth; |
231 | SV *sql; |
228 | SV *sql; |
232 | SV *execute; |
229 | SV *execute; |
233 | STRLEN dc; |
230 | STRLEN dc, dd; /* dummy */ |
234 | |
231 | |
235 | /* save our arguments against destruction through function calls */ |
232 | /* save our arguments against destruction through function calls */ |
236 | SP += items; |
233 | SP += items; |
237 | |
234 | |
238 | /* first check wether we should use an explicit db handle */ |
235 | /* first check wether we should use an explicit db handle */ |
239 | if (!is_dbh (dbh)) |
236 | if (!is_dbh (dbh)) |
240 | { |
237 | { |
|
|
238 | /* the next line doesn't work - check why later maybe */ |
241 | dbh = get_sv ("DBH", FALSE); |
239 | /* dbh = get_sv ("DBH", FALSE); |
242 | if (!is_dbh (dbh)) |
240 | if (!is_dbh (dbh)) |
243 | { |
241 | {*/ |
244 | dbh = GvSV(DBH); |
242 | dbh = GvSV(DBH); |
245 | if (!is_dbh (dbh)) |
243 | if (!is_dbh (dbh)) |
|
|
244 | croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
246 | croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
245 | /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
247 | } |
246 | }*/ |
248 | } |
247 | } |
249 | else |
248 | else |
250 | arg++; /* we consumed one argument */ |
249 | arg++; /* we consumed one argument */ |
251 | |
250 | |
252 | /* count the remaining references (for bind_columns) */ |
251 | /* count the remaining references (for bind_columns) */ |
… | |
… | |
269 | { |
268 | { |
270 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
269 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
271 | sv_catsv (neu, sql); |
270 | sv_catsv (neu, sql); |
272 | sv_catpv (neu, " limit 1"); |
271 | sv_catpv (neu, " limit 1"); |
273 | sql = neu; |
272 | sql = neu; |
274 | ix -= 6; /* sql_fetch */ |
273 | ix -= 4; /* sql_fetch */ |
275 | } |
274 | } |
276 | |
275 | |
277 | /* check cache for existing statement handle */ |
276 | /* check cache for existing statement handle */ |
278 | sth = lru_fetch (dbh, sql); |
277 | sth = lru_fetch (dbh, sql); |
279 | if (!sth) |
278 | if (!sth) |
… | |
… | |
287 | SPAGAIN; |
286 | SPAGAIN; |
288 | |
287 | |
289 | if (count != 1) |
288 | if (count != 1) |
290 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
289 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
291 | SvPV (sql, dc), |
290 | SvPV (sql, dc), |
292 | SvPV (get_sv ("DBI::errstr", TRUE), dc)); |
291 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
293 | |
292 | |
294 | sth = POPs; |
293 | sth = POPs; |
295 | |
294 | |
296 | lru_store (dbh, sql, sth); |
295 | lru_store (dbh, sql, sth); |
297 | } |
296 | } |
… | |
… | |
314 | SPAGAIN; |
313 | SPAGAIN; |
315 | |
314 | |
316 | if (count != 1) |
315 | if (count != 1) |
317 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
316 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
318 | SvPV (sql, dc), |
317 | SvPV (sql, dc), |
319 | SvPV (get_sv ("DBI::errstr", TRUE), dc)); |
318 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
320 | |
319 | |
321 | execute = POPs; |
320 | execute = POPs; |
322 | |
321 | |
323 | if (!SvTRUE (execute)) |
322 | if (!SvTRUE (execute)) |
324 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
323 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
325 | SvPV (sql, dc), |
324 | SvPV (sql, dc), |
326 | SvPV (get_sv ("DBI::errstr", TRUE), dc)); |
325 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
327 | |
326 | |
328 | sv_setsv (GvSV(sql_exec), execute); |
327 | sv_setsv (GvSV(sql_exec), execute); |
329 | |
328 | |
330 | if (bind_first != bind_last) |
329 | if (bind_first != bind_last) |
331 | { |
330 | { |
… | |
… | |
342 | SPAGAIN; |
341 | SPAGAIN; |
343 | |
342 | |
344 | if (count != 1) |
343 | if (count != 1) |
345 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
344 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
346 | SvPV (sql, dc), |
345 | SvPV (sql, dc), |
347 | SvPV (get_sv ("DBI::errstr", TRUE), dc)); |
346 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
348 | |
347 | |
349 | if (!SvOK (POPs)) |
348 | if (!SvOK (POPs)) |
350 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
349 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
351 | SvPV (sql, dc), |
350 | SvPV (sql, dc), |
352 | SvPV (get_sv ("DBI::errstr", TRUE), dc)); |
351 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
353 | } |
352 | } |
354 | |
353 | |
355 | /* free our arguments from the stack */ |
354 | /* free our arguments from the stack */ |
356 | SP -= items; |
355 | SP -= items; |
357 | |
356 | |
… | |
… | |
379 | case G_VOID: |
378 | case G_VOID: |
380 | /* no thing */ |
379 | /* no thing */ |
381 | break; |
380 | break; |
382 | case G_SCALAR: |
381 | case G_SCALAR: |
383 | /* the first element */ |
382 | /* the first element */ |
384 | XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
383 | XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
385 | break; |
384 | break; |
386 | case G_ARRAY: |
385 | case G_ARRAY: |
387 | av = (AV *)SvRV (row); |
386 | av = (AV *)SvRV (row); |
388 | count = AvFILL (av) + 1; |
387 | count = AvFILL (av) + 1; |
389 | EXTEND (SP, count); |
388 | EXTEND (SP, count); |
390 | for (arg = 0; arg < count; arg++) |
389 | for (arg = 0; arg < count; arg++) |
391 | PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
390 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
392 | |
391 | |
393 | break; |
392 | break; |
394 | default: |
393 | default: |
395 | abort (); |
394 | abort (); |
396 | } |
395 | } |
… | |
… | |
401 | SV *rows; |
400 | SV *rows; |
402 | |
401 | |
403 | PUSHMARK (SP); |
402 | PUSHMARK (SP); |
404 | XPUSHs (sth); |
403 | XPUSHs (sth); |
405 | PUTBACK; |
404 | PUTBACK; |
406 | count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); |
405 | count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR); |
407 | SPAGAIN; |
406 | SPAGAIN; |
408 | |
407 | |
409 | if (count != 1) |
408 | if (count != 1) |
410 | abort (); |
409 | abort (); |
411 | |
410 | |
… | |
… | |
416 | AV *av = (AV *)SvRV (rows); |
415 | AV *av = (AV *)SvRV (rows); |
417 | count = AvFILL (av) + 1; |
416 | count = AvFILL (av) + 1; |
418 | |
417 | |
419 | if (count) |
418 | if (count) |
420 | { |
419 | { |
421 | int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */ |
420 | int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
422 | |
421 | |
423 | EXTEND (SP, count); |
422 | EXTEND (SP, count); |
424 | if (columns == 1) |
423 | if (columns == 1) |
425 | for (arg = 0; arg < count; arg++) |
424 | for (arg = 0; arg < count; arg++) |
426 | PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
425 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
427 | else |
426 | else |
428 | for (arg = 0; arg < count; arg++) |
427 | for (arg = 0; arg < count; arg++) |
429 | PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
428 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
430 | } |
429 | } |
431 | } |
430 | } |
432 | } |
431 | } |
433 | else |
432 | else |
434 | XPUSHs (sth); |
433 | XPUSHs (sth); |