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.5 by root, Sun Apr 22 14:38:28 2001 UTC vs.
Revision 1.17 by root, Wed Jan 28 19:55:39 2004 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;
… …
78 char *statement = SvPV (sql, len); 80 char *statement = SvPV (sql, len);
79 81
80 dbh = SvRV (dbh); 82 dbh = SvRV (dbh);
81 83
82 lru_hash; 84 lru_hash;
83
84 /*fprintf (stderr, "F: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/
85 85
86 n = &lru_list; 86 n = &lru_list;
87 do { 87 do {
88 n = n->next; 88 n = n->next;
89 if (!n->hash) 89 if (!n->hash)
… …
112 n = lru_list.prev; 112 n = lru_list.prev;
113 113
114 lru_list.prev = n->prev; 114 lru_list.prev = n->prev;
115 n->prev->next = &lru_list; 115 n->prev->next = &lru_list;
116 116
117 /*fprintf (stderr, "N: %s\n", SvPV_nolen (n->sql));/*D*/
118
119 SvREFCNT_dec (n->dbh); 117 SvREFCNT_dec (n->dbh);
120 SvREFCNT_dec (n->sql); 118 SvREFCNT_dec (n->sql);
121 SvREFCNT_dec (n->sth); 119 SvREFCNT_dec (n->sth);
122 Safefree (n); 120 Safefree (n);
123 121
… …
135 133
136 dbh = SvRV (dbh); 134 dbh = SvRV (dbh);
137 135
138 lru_hash; 136 lru_hash;
139 137
140 /*fprintf (stderr, "S: %08lx %s\n", hash, SvPV_nolen (sql));/*D*/
141
142 lru_size++; 138 lru_size++;
143 if (lru_size > lru_maxsize) 139 if (lru_size > lru_maxsize)
144 lru_nukeone (); 140 lru_nukeone ();
145 141
146 New (0, n, 1, lru_node); 142 New (0, n, 1, lru_node);
… …
166 } 162 }
167} 163}
168 164
169static GV *sql_exec; 165static GV *sql_exec;
170static GV *DBH; 166static GV *DBH;
171static SV *sv_prepare, *sv_execute, *sv_bind_columns, *sv_fetchrow_arrayref, *sv_finish; 167static SV *sv_prepare, *sv_execute, *sv_bind_columns,
168 *sv_fetchrow_arrayref, *sv_fetchall_arrayref,
169 *sv_finish;
172 170
173#define newconstpv(str) newSVpvn ((str), sizeof (str)) 171#define newconstpv(str) newSVpvn ((str), sizeof (str))
174 172
175MODULE = PApp::SQL PACKAGE = PApp::SQL 173MODULE = PApp::SQL PACKAGE = PApp::SQL
176 174
… …
185 { 183 {
186 sv_prepare = newconstpv ("prepare"); 184 sv_prepare = newconstpv ("prepare");
187 sv_execute = newconstpv ("execute"); 185 sv_execute = newconstpv ("execute");
188 sv_bind_columns = newconstpv ("bind_columns"); 186 sv_bind_columns = newconstpv ("bind_columns");
189 sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref"); 187 sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref");
188 sv_fetchall_arrayref = newconstpv ("fetchall_arrayref");
190 sv_finish = newconstpv ("finish"); 189 sv_finish = newconstpv ("finish");
191 } 190 }
192 191
193 /* apache might BOOT: twice :( */ 192 /* apache might BOOT: twice :( */
194 if (lru_size) 193 if (lru_size)
… …
228 int count; 227 int count;
229 SV *dbh = ST(0); 228 SV *dbh = ST(0);
230 SV *sth; 229 SV *sth;
231 SV *sql; 230 SV *sql;
232 SV *execute; 231 SV *execute;
233 STRLEN dc; 232 STRLEN dc, dd; /* dummy */
234 233
235 /* save our arguments against destruction through function calls */ 234 /* save our arguments against destruction through function calls */
236 SP += items; 235 SP += items;
237 236
238 /* first check wether we should use an explicit db handle */ 237 /* first check wether we should use an explicit db handle */
239 if (!is_dbh (dbh)) 238 if (!is_dbh (dbh))
240 { 239 {
240 /* the next line doesn't work - check why later maybe */
241 dbh = get_sv ("DBH", FALSE); 241 /* dbh = get_sv ("DBH", FALSE);
242 if (!is_dbh (dbh)) 242 if (!is_dbh (dbh))
243 { 243 {*/
244 dbh = GvSV(DBH); 244 dbh = GvSV(DBH);
245 if (!is_dbh (dbh)) 245 if (!is_dbh (dbh))
246 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::"); 247 /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
247 } 248 }*/
248 } 249 }
249 else 250 else
250 arg++; /* we consumed one argument */ 251 arg++; /* we consumed one argument */
251 252
252 /* count the remaining references (for bind_columns) */ 253 /* count the remaining references (for bind_columns) */
… …
269 { 270 {
270 SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); 271 SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0));
271 sv_catsv (neu, sql); 272 sv_catsv (neu, sql);
272 sv_catpv (neu, " limit 1"); 273 sv_catpv (neu, " limit 1");
273 sql = neu; 274 sql = neu;
274 ix -= 6; /* sql_fetch */ 275 ix -= 4; /* sql_fetch */
275 } 276 }
276 277
277 /* check cache for existing statement handle */ 278 /* check cache for existing statement handle */
278 sth = lru_fetch (dbh, sql); 279 sth = lru_fetch (dbh, sql);
279 if (!sth) 280 if (!sth)
… …
287 SPAGAIN; 288 SPAGAIN;
288 289
289 if (count != 1) 290 if (count != 1)
290 croak ("sql_exec: unable to prepare() statement '%s': %s", 291 croak ("sql_exec: unable to prepare() statement '%s': %s",
291 SvPV (sql, dc), 292 SvPV (sql, dc),
292 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 293 SvPV (get_sv ("DBI::errstr", TRUE), dd));
293 294
294 sth = POPs; 295 sth = POPs;
295 296
297 if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE)
296 lru_store (dbh, sql, sth); 298 lru_store (dbh, sql, sth);
297 } 299 }
298 300
299 PUSHMARK (SP); 301 PUSHMARK (SP);
300 EXTEND (SP, items - arg + 1); 302 EXTEND (SP, items - arg + 1);
301 PUSHs (sth); 303 PUSHs (sth);
302 while (items > arg) 304 while (items > arg)
303 { 305 {
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 */
304 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg))); 310 PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv));
305 arg++; 311 arg++;
306 } 312 }
307 313
308 PUTBACK; 314 PUTBACK;
309 /* { static GV *execute; 315 /* { static GV *execute;
… …
314 SPAGAIN; 320 SPAGAIN;
315 321
316 if (count != 1) 322 if (count != 1)
317 croak ("sql_exec: execute() didn't return any value ('%s'): %s", 323 croak ("sql_exec: execute() didn't return any value ('%s'): %s",
318 SvPV (sql, dc), 324 SvPV (sql, dc),
319 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 325 SvPV (get_sv ("DBI::errstr", TRUE), dd));
320 326
321 execute = POPs; 327 execute = POPs;
322 328
323 if (!SvTRUE (execute)) 329 if (!SvTRUE (execute))
324 croak ("sql_exec: unable to execute statement '%s' (%s)", 330 croak ("sql_exec: unable to execute statement '%s' (%s)",
325 SvPV (sql, dc), 331 SvPV (sql, dc),
326 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 332 SvPV (get_sv ("DBI::errstr", TRUE), dd));
327 333
328 sv_setsv (GvSV(sql_exec), execute); 334 sv_setsv (GvSV(sql_exec), execute);
329 335
330 if (bind_first != bind_last) 336 if (bind_first != bind_last)
331 { 337 {
332 PUSHMARK (SP); 338 PUSHMARK (SP);
333 EXTEND (SP, bind_last - bind_first + 2); 339 EXTEND (SP, bind_last - bind_first + 2);
334 PUSHs (sth); 340 PUSHs (sth);
335 do { 341 do {
342#if CAN_UTF8
343 if (ix & 1)
344 SvUTF8_on (SvRV(ST(bind_first)));
345#endif
336 PUSHs (ST(bind_first)); 346 PUSHs (ST(bind_first));
337 bind_first++; 347 bind_first++;
338 } while (bind_first != bind_last); 348 } while (bind_first != bind_last);
339 349
340 PUTBACK; 350 PUTBACK;
… …
342 SPAGAIN; 352 SPAGAIN;
343 353
344 if (count != 1) 354 if (count != 1)
345 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", 355 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
346 SvPV (sql, dc), 356 SvPV (sql, dc),
347 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 357 SvPV (get_sv ("DBI::errstr", TRUE), dd));
348 358
349 if (!SvOK (POPs)) 359 if (!SvOK (POPs))
350 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", 360 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
351 SvPV (sql, dc), 361 SvPV (sql, dc),
352 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 362 SvPV (get_sv ("DBI::errstr", TRUE), dd));
353 } 363 }
354 364
355 /* free our arguments from the stack */ 365 /* free our arguments from the stack */
356 SP -= items; 366 SP -= items;
357 367
… …
379 case G_VOID: 389 case G_VOID:
380 /* no thing */ 390 /* no thing */
381 break; 391 break;
382 case G_SCALAR: 392 case G_SCALAR:
383 /* the first element */ 393 /* the first element */
384 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); 394 XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
385 break; 395 break;
386 case G_ARRAY: 396 case G_ARRAY:
387 av = (AV *)SvRV (row); 397 av = (AV *)SvRV (row);
388 count = AvFILL (av) + 1; 398 count = AvFILL (av) + 1;
389 EXTEND (SP, count); 399 EXTEND (SP, count);
390 for (arg = 0; arg < count; arg++) 400 for (arg = 0; arg < count; arg++)
391 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 401 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
392 402
393 break; 403 break;
394 default: 404 default:
395 abort (); 405 abort ();
396 } 406 }
… …
401 SV *rows; 411 SV *rows;
402 412
403 PUSHMARK (SP); 413 PUSHMARK (SP);
404 XPUSHs (sth); 414 XPUSHs (sth);
405 PUTBACK; 415 PUTBACK;
406 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); 416 count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR);
407 SPAGAIN; 417 SPAGAIN;
408 418
409 if (count != 1) 419 if (count != 1)
410 abort (); 420 abort ();
411 421
… …
416 AV *av = (AV *)SvRV (rows); 426 AV *av = (AV *)SvRV (rows);
417 count = AvFILL (av) + 1; 427 count = AvFILL (av) + 1;
418 428
419 if (count) 429 if (count)
420 { 430 {
421 int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */ 431 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */
422 432
423 EXTEND (SP, count); 433 EXTEND (SP, count);
424 if (columns == 1) 434 if (columns == 1)
425 for (arg = 0; arg < count; arg++) 435 for (arg = 0; arg < count; arg++)
426 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); 436 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
427 else 437 else
428 for (arg = 0; arg < count; arg++) 438 for (arg = 0; arg < count; arg++)
429 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 439 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
430 } 440 }
431 } 441 }
432 } 442 }
433 else 443 else
434 XPUSHs (sth); 444 XPUSHs (sth);

Diff Legend

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