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

Diff Legend

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