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.20 by root, Sat Jun 20 21:29:29 2009 UTC

… …
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
15#define MAX_CACHED_STATEMENT_SIZE 8192
14 16
15static SV * 17static SV *
16sql_upgrade_utf8 (SV *sv) 18sql_upgrade_utf8 (SV *sv)
17{ 19{
18#if CAN_UTF8 20#if CAN_UTF8
… …
21#endif 23#endif
22 return sv; 24 return sv;
23} 25}
24 26
25static SV * 27static SV *
26sql_force_utf8 (SV *sv) 28mortalcopy_and_maybe_force_utf8(int utf8, SV *sv)
27{ 29{
30 sv = sv_mortalcopy (sv);
28#if CAN_UTF8 31#if CAN_UTF8
29 if (SvPOK (sv)) 32 if (utf8 && SvPOK (sv))
30 SvUTF8_on (sv); 33 SvUTF8_on (sv);
31#endif 34#endif
32 return sv; 35 return sv;
33} 36}
34 37
35#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) 38#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 39
38#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"))
39 41
40typedef struct lru_node { 42typedef struct lru_node {
41 struct lru_node *next; 43 struct lru_node *next;
… …
60#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ 62#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
61 63
62/* this is primitive, yet effective */ 64/* this is primitive, yet effective */
63/* the returned value must never be zero (or bad things will happen) */ 65/* the returned value must never be zero (or bad things will happen) */
64#define lru_hash do { \ 66#define lru_hash do { \
65 hash = (((U32)dbh)>>2); \ 67 hash = (((U32)(long)dbh)>>2); \
66 hash += *statement;\ 68 hash += *statement;\
67 hash += len; \ 69 hash += len; \
68} while (0) 70} while (0)
69 71
70/* fetch and "use" */ 72/* fetch and "use" */
… …
233 SP += items; 235 SP += items;
234 236
235 /* first check wether we should use an explicit db handle */ 237 /* first check wether we should use an explicit db handle */
236 if (!is_dbh (dbh)) 238 if (!is_dbh (dbh))
237 { 239 {
240 /* the next line doesn't work - check why later maybe */
238 dbh = get_sv ("DBH", FALSE); 241 /* dbh = get_sv ("DBH", FALSE);
239 if (!is_dbh (dbh)) 242 if (!is_dbh (dbh))
240 { 243 {*/
241 dbh = GvSV(DBH); 244 dbh = GvSV (DBH);
242 if (!is_dbh (dbh)) 245 if (!is_dbh (dbh))
246 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::"); 247 /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
244 } 248 }*/
245 } 249 }
246 else 250 else
247 arg++; /* we consumed one argument */ 251 arg++; /* we consumed one argument */
252
253 /* be more Coro-friendly by keeping a copy, so different threads */
254 /* can multitask easier */
255 dbh = sv_2mortal (newSVsv (dbh));
248 256
249 /* count the remaining references (for bind_columns) */ 257 /* count the remaining references (for bind_columns) */
250 bind_first = arg; 258 bind_first = arg;
251 while (items > arg && SvROK (ST(arg))) 259 while (items > arg && SvROK (ST(arg)))
252 arg++; 260 arg++;
… …
288 SvPV (sql, dc), 296 SvPV (sql, dc),
289 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 297 SvPV (get_sv ("DBI::errstr", TRUE), dd));
290 298
291 sth = POPs; 299 sth = POPs;
292 300
301 if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE)
293 lru_store (dbh, sql, sth); 302 lru_store (dbh, sql, sth);
294 } 303 }
295 304
296 PUSHMARK (SP); 305 PUSHMARK (SP);
297 EXTEND (SP, items - arg + 1); 306 EXTEND (SP, items - arg + 1);
298 PUSHs (sth); 307 PUSHs (sth);
299 while (items > arg) 308 while (items > arg)
300 { 309 {
310 SV *sv = ST(arg);
311 /* we sv_mortalcopy magical values since DBI seems to have a memory
312 * leak when magical values are passed into execute().
313 */
301 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg))); 314 PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv));
302 arg++; 315 arg++;
303 } 316 }
304 317
305 PUTBACK; 318 PUTBACK;
306 /* { static GV *execute; 319 /* { static GV *execute;
… …
311 SPAGAIN; 324 SPAGAIN;
312 325
313 if (count != 1) 326 if (count != 1)
314 croak ("sql_exec: execute() didn't return any value ('%s'): %s", 327 croak ("sql_exec: execute() didn't return any value ('%s'): %s",
315 SvPV (sql, dc), 328 SvPV (sql, dc),
316 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 329 SvPV (get_sv ("DBI::errstr", TRUE), dd));
317 330
318 execute = POPs; 331 execute = POPs;
319 332
320 if (!SvTRUE (execute)) 333 if (!SvTRUE (execute))
321 croak ("sql_exec: unable to execute statement '%s' (%s)", 334 croak ("sql_exec: unable to execute statement '%s' (%s)",
322 SvPV (sql, dc), 335 SvPV (sql, dc),
323 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 336 SvPV (get_sv ("DBI::errstr", TRUE), dd));
324 337
325 sv_setsv (GvSV(sql_exec), execute); 338 sv_setsv (GvSV(sql_exec), execute);
326 339
327 if (bind_first != bind_last) 340 if (bind_first != bind_last)
328 { 341 {
329 PUSHMARK (SP); 342 PUSHMARK (SP);
330 EXTEND (SP, bind_last - bind_first + 2); 343 EXTEND (SP, bind_last - bind_first + 2);
331 PUSHs (sth); 344 PUSHs (sth);
332 do { 345 do {
346#if CAN_UTF8
347 if (ix & 1)
348 SvUTF8_on (SvRV(ST(bind_first)));
349#endif
333 PUSHs (ST(bind_first)); 350 PUSHs (ST(bind_first));
334 bind_first++; 351 bind_first++;
335 } while (bind_first != bind_last); 352 } while (bind_first != bind_last);
336 353
337 PUTBACK; 354 PUTBACK;
… …
339 SPAGAIN; 356 SPAGAIN;
340 357
341 if (count != 1) 358 if (count != 1)
342 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", 359 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
343 SvPV (sql, dc), 360 SvPV (sql, dc),
344 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 361 SvPV (get_sv ("DBI::errstr", TRUE), dd));
345 362
346 if (!SvOK (POPs)) 363 if (!SvOK (TOPs))
347 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", 364 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
348 SvPV (sql, dc), 365 SvPV (sql, dc),
349 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 366 SvPV (get_sv ("DBI::errstr", TRUE), dd));
367
350 } 368 POPs;
369 }
351 370
352 /* free our arguments from the stack */ 371 /* restore our arguments again */
353 SP -= items; 372 SP -= items;
354 373
355 if ((ix & ~1) == 2) 374 if ((ix & ~1) == 2)
356 { /* sql_fetch */ 375 { /* sql_fetch */
357 SV *row; 376 SV *row;
… …
376 case G_VOID: 395 case G_VOID:
377 /* no thing */ 396 /* no thing */
378 break; 397 break;
379 case G_SCALAR: 398 case G_SCALAR:
380 /* the first element */ 399 /* the first element */
381 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); 400 XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
382 break; 401 break;
383 case G_ARRAY: 402 case G_ARRAY:
384 av = (AV *)SvRV (row); 403 av = (AV *)SvRV (row);
385 count = AvFILL (av) + 1; 404 count = AvFILL (av) + 1;
386 EXTEND (SP, count); 405 EXTEND (SP, count);
387 for (arg = 0; arg < count; arg++) 406 for (arg = 0; arg < count; arg++)
388 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 407 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
389 408
390 break; 409 break;
391 default: 410 default:
392 abort (); 411 abort ();
393 } 412 }
… …
418 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ 437 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */
419 438
420 EXTEND (SP, count); 439 EXTEND (SP, count);
421 if (columns == 1) 440 if (columns == 1)
422 for (arg = 0; arg < count; arg++) 441 for (arg = 0; arg < count; arg++)
423 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); 442 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
424 else 443 else
425 for (arg = 0; arg < count; arg++) 444 for (arg = 0; arg < count; arg++)
426 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 445 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
427 } 446 }
428 } 447 }
429 } 448 }
430 else 449 else
431 XPUSHs (sth); 450 XPUSHs (sth);

Diff Legend

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