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.22 by root, Sun Jun 21 03:30:00 2009 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
5/* import some stuff from DBIXS.h and DBI.xs */
6#define DBIXS_VERSION 93
7#define DBI_MAGIC '~'
8
9#define DBISTATE_PERLNAME "DBI::_dbistate"
10#define DBISTATE_ADDRSV (perl_get_sv(DBISTATE_PERLNAME, 0x05))
11#define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV))))
12
13struct dbistate_st {
14#define DBISTATE_VERSION 94 /* Must change whenever dbistate_t does */
15 /* this must be the first member in structure */
16 void (*check_version) _((const char *name,
17 int dbis_cv, int dbis_cs, int need_dbixs_cv,
18 int drc_s, int dbc_s, int stc_s, int fdc_s));
19
20 /* version and size are used to check for DBI/DBD version mis-match */
21 U16 version; /* version of this structure */
22 U16 size;
23 U16 xs_version; /* version of the overall DBIXS / DBD interface */
24 U16 spare_pad;
25};
26typedef struct dbistate_st dbistate_t;
27
28#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */
29
30typedef U32 imp_sth;
31
32/* not strictly part of the API... */
33static imp_sth *
34sth_get_imp (SV *sth)
35{
36 MAGIC *mg = mg_find (SvRV (sth), PERL_MAGIC_tied);
37 sth = mg->mg_obj;
38 mg = mg_find (SvRV (sth), DBI_MAGIC);
39 return (imp_sth *)SvPVX (mg->mg_obj);
40}
41
42#define DBI_STH_ACTIVE(imp) (*(imp) & DBIcf_ACTIVE)
43
44/* end of import section */
4 45
5#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) 46#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6# define get_sv perl_get_sv 47# define get_sv perl_get_sv
7# define call_method perl_call_method 48# define call_method perl_call_method
8# define call_sv perl_call_sv 49# define call_sv perl_call_sv
9#endif 50#endif
10 51
11#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 5)) 52#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6))
12# define CAN_UTF8 1 53# define CAN_UTF8 1
13#endif 54#endif
55
56#define MAX_CACHED_STATEMENT_SIZE 2048
14 57
15static SV * 58static SV *
16sql_upgrade_utf8 (SV *sv) 59sql_upgrade_utf8 (SV *sv)
17{ 60{
18#if CAN_UTF8 61#if CAN_UTF8
… …
21#endif 64#endif
22 return sv; 65 return sv;
23} 66}
24 67
25static SV * 68static SV *
26sql_force_utf8 (SV *sv) 69mortalcopy_and_maybe_force_utf8(int utf8, SV *sv)
27{ 70{
71 sv = sv_mortalcopy (sv);
28#if CAN_UTF8 72#if CAN_UTF8
29 if (SvPOK (sv)) 73 if (utf8 && SvPOK (sv))
30 SvUTF8_on (sv); 74 SvUTF8_on (sv);
31#endif 75#endif
32 return sv; 76 return sv;
33} 77}
34 78
35#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) 79#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 80
38#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) 81#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
39 82
40typedef struct lru_node { 83typedef struct lru_node {
41 struct lru_node *next; 84 struct lru_node *next;
42 struct lru_node *prev; 85 struct lru_node *prev;
43 U32 hash; 86 U32 hash; /* bit 31 is used to mark active nodes */
44 SV *dbh; 87 SV *dbh;
45 SV *sql; 88 SV *sql;
46 89
47 SV *sth; 90 SV *sth;
91 imp_sth *sth_imp;
48#if 0 /* method cache */ 92#if 0 /* method cache */
49 GV *execute; 93 GV *execute;
50 GV *bind_columns; 94 GV *bind_columns;
51 GV *fetch; 95 GV *fetch;
52 GV *finish; 96 GV *finish;
… …
55 99
56static lru_node lru_list; 100static lru_node lru_list;
57static int lru_size; 101static int lru_size;
58static int lru_maxsize; 102static int lru_maxsize;
59 103
60#define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ 104#define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
61 105
62/* this is primitive, yet effective */ 106/* this is primitive, yet effective */
63/* the returned value must never be zero (or bad things will happen) */ 107/* the returned value must never be zero (or bad things will happen) */
64#define lru_hash do { \ 108#define lru_hash \
109 do { \
65 hash = (((U32)dbh)>>2); \ 110 hash = (((U32)(long)dbh)>>4); \
66 hash += *statement;\ 111 hash += *statement; \
67 hash += len; \ 112 hash += len; \
68} while (0) 113 } while (0)
69 114
70/* fetch and "use" */ 115/* fetch and "use" */
71/* could be done using a single call (we could call prepare!) */ 116/* could be done using a single call (we could call prepare!) */
117static SV *
72static SV *lru_fetch(SV *dbh, SV *sql) 118lru_fetch (SV *dbh, SV *sql)
73{ 119{
74 lru_node *n; 120 lru_node *n;
75 121
76 U32 hash; 122 U32 hash;
77 STRLEN len; 123 STRLEN len;
… …
82 lru_hash; 128 lru_hash;
83 129
84 n = &lru_list; 130 n = &lru_list;
85 do { 131 do {
86 n = n->next; 132 n = n->next;
133
87 if (!n->hash) 134 if (!n->hash)
88 return 0; 135 return 0;
89 } while (n->hash != hash 136 } while (n->hash != hash
137 || DBI_STH_ACTIVE (n->sth_imp)
90 || !sv_eq (n->sql, sql) 138 || !sv_eq (n->sql, sql)
91 || n->dbh != dbh); 139 || n->dbh != dbh);
92 140
93 /* found, so return to the start of the list */ 141 /* found, so return to the start of the list */
94 n->prev->next = n->next; 142 n->prev->next = n->next;
… …
97 n->next = lru_list.next; 145 n->next = lru_list.next;
98 n->prev = &lru_list; 146 n->prev = &lru_list;
99 lru_list.next->prev = n; 147 lru_list.next->prev = n;
100 lru_list.next = n; 148 lru_list.next = n;
101 149
102 return n->sth; 150 return sv_2mortal (SvREFCNT_inc (n->sth));
103} 151}
104 152
105static void lru_nukeone(void) 153static void
154lru_trim (void)
155{
156 while (lru_size > lru_maxsize)
157 {
158 /* nuke at the end */
159 lru_node *n = lru_list.prev;
160
161 n = lru_list.prev;
162
163 lru_list.prev = n->prev;
164 n->prev->next = &lru_list;
165
166 SvREFCNT_dec (n->dbh);
167 SvREFCNT_dec (n->sql);
168 SvREFCNT_dec (n->sth);
169 Safefree (n);
170
171 lru_size--;
172 }
173}
174
175/* store a not-yet existing entry(!) */
176static void
177lru_store (SV *dbh, SV *sql, SV *sth)
106{ 178{
107 lru_node *n; 179 lru_node *n;
108 /* nuke at the end */
109
110 n = lru_list.prev;
111
112 lru_list.prev = n->prev;
113 n->prev->next = &lru_list;
114
115 SvREFCNT_dec (n->dbh);
116 SvREFCNT_dec (n->sql);
117 SvREFCNT_dec (n->sth);
118 Safefree (n);
119
120 lru_size--;
121}
122
123/* store a not-yet existing entry(!) */
124static void lru_store(SV *dbh, SV *sql, SV *sth)
125{
126 lru_node *n;
127
128 U32 hash; 180 U32 hash;
129 STRLEN len; 181 STRLEN len;
182 char *statement;
183
184 if (!lru_maxsize)
185 return;
186
130 char *statement = SvPV (sql, len); 187 statement = SvPV (sql, len);
131
132 dbh = SvRV (dbh); 188 dbh = SvRV (dbh);
133 189
134 lru_hash; 190 lru_hash;
135 191
136 lru_size++; 192 lru_size++;
137 if (lru_size > lru_maxsize) 193 lru_trim ();
138 lru_nukeone ();
139 194
140 New (0, n, 1, lru_node); 195 New (0, n, 1, lru_node);
141 196
142 n->hash = hash; 197 n->hash = hash;
143 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ 198 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
144 n->sql = newSVsv (sql); 199 n->sql = newSVsv (sql);
145 n->sth = sth; SvREFCNT_inc (sth); 200 n->sth = sth; SvREFCNT_inc (sth);
201 n->sth_imp = sth_get_imp (sth);
146 202
147 n->next = lru_list.next; 203 n->next = lru_list.next;
148 n->prev = &lru_list; 204 n->prev = &lru_list;
149 lru_list.next->prev = n; 205 lru_list.next->prev = n;
150 lru_list.next = n; 206 lru_list.next = n;
151} 207}
152 208
209static void
153static void lru_cachesize (int size) 210lru_cachesize (int size)
154{ 211{
155 if (size >= 0) 212 if (size >= 0)
156 { 213 {
157 lru_maxsize = size; 214 lru_maxsize = size;
158 while (lru_size > lru_maxsize) 215 lru_trim ();
159 lru_nukeone ();
160 } 216 }
161} 217}
162 218
163static GV *sql_exec; 219static GV *sql_exec;
164static GV *DBH; 220static GV *DBH;
… …
172 228
173PROTOTYPES: DISABLE 229PROTOTYPES: DISABLE
174 230
175BOOT: 231BOOT:
176{ 232{
233 struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE;
234
235 /* this is atcually wrong, we should call the check member, apparently */
236 assert (dbis->version == DBISTATE_VERSION);
237 assert (dbis->xs_version == DBIXS_VERSION);
238
177 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); 239 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
178 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); 240 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
179 241
180 if (!sv_prepare) 242 if (!sv_prepare)
181 { 243 {
… …
189 251
190 /* apache might BOOT: twice :( */ 252 /* apache might BOOT: twice :( */
191 if (lru_size) 253 if (lru_size)
192 lru_cachesize (0); 254 lru_cachesize (0);
193 255
194 lru_init; 256 lru_init ();
195 lru_cachesize (50); 257 lru_cachesize (50);
196} 258}
197 259
198int 260int
199cachesize(size = -1) 261cachesize(size = -1)
… …
233 SP += items; 295 SP += items;
234 296
235 /* first check wether we should use an explicit db handle */ 297 /* first check wether we should use an explicit db handle */
236 if (!is_dbh (dbh)) 298 if (!is_dbh (dbh))
237 { 299 {
300 /* the next line doesn't work - check why later maybe */
238 dbh = get_sv ("DBH", FALSE); 301 /* dbh = get_sv ("DBH", FALSE);
239 if (!is_dbh (dbh)) 302 if (!is_dbh (dbh))
240 { 303 {*/
241 dbh = GvSV(DBH); 304 dbh = GvSV (DBH);
242 if (!is_dbh (dbh)) 305 if (!is_dbh (dbh))
306 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::"); 307 /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
244 } 308 }*/
245 } 309 }
246 else 310 else
247 arg++; /* we consumed one argument */ 311 arg++; /* we consumed one argument */
312
313 /* be more Coro-friendly by keeping a copy, so different threads */
314 /* can replace their global handles */
315 dbh = sv_2mortal (newSVsv (dbh));
248 316
249 /* count the remaining references (for bind_columns) */ 317 /* count the remaining references (for bind_columns) */
250 bind_first = arg; 318 bind_first = arg;
251 while (items > arg && SvROK (ST(arg))) 319 while (items > arg && SvROK (ST(arg)))
252 arg++; 320 arg++;
… …
288 SvPV (sql, dc), 356 SvPV (sql, dc),
289 SvPV (get_sv ("DBI::errstr", TRUE), dd)); 357 SvPV (get_sv ("DBI::errstr", TRUE), dd));
290 358
291 sth = POPs; 359 sth = POPs;
292 360
361 if (SvLEN (sql) < MAX_CACHED_STATEMENT_SIZE)
293 lru_store (dbh, sql, sth); 362 lru_store (dbh, sql, sth);
294 } 363 }
295 364
296 PUSHMARK (SP); 365 PUSHMARK (SP);
297 EXTEND (SP, items - arg + 1); 366 EXTEND (SP, items - arg + 1);
298 PUSHs (sth); 367 PUSHs (sth);
299 while (items > arg) 368 while (items > arg)
300 { 369 {
370 SV *sv = ST(arg);
371 /* we sv_mortalcopy magical values since DBI seems to have a memory
372 * leak when magical values are passed into execute().
373 */
301 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg))); 374 PUSHs (maybe_upgrade_utf8 (ix & 1, SvMAGICAL(sv) ? sv_mortalcopy(sv) : sv));
302 arg++; 375 arg++;
303 } 376 }
304 377
305 PUTBACK; 378 PUTBACK;
306 /* { static GV *execute; 379 /* { static GV *execute;
… …
311 SPAGAIN; 384 SPAGAIN;
312 385
313 if (count != 1) 386 if (count != 1)
314 croak ("sql_exec: execute() didn't return any value ('%s'): %s", 387 croak ("sql_exec: execute() didn't return any value ('%s'): %s",
315 SvPV (sql, dc), 388 SvPV (sql, dc),
316 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 389 SvPV (get_sv ("DBI::errstr", TRUE), dd));
317 390
318 execute = POPs; 391 execute = POPs;
319 392
320 if (!SvTRUE (execute)) 393 if (!SvTRUE (execute))
321 croak ("sql_exec: unable to execute statement '%s' (%s)", 394 croak ("sql_exec: unable to execute statement '%s' (%s)",
322 SvPV (sql, dc), 395 SvPV (sql, dc),
323 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 396 SvPV (get_sv ("DBI::errstr", TRUE), dd));
324 397
325 sv_setsv (GvSV(sql_exec), execute); 398 sv_setsv (GvSV(sql_exec), execute);
326 399
327 if (bind_first != bind_last) 400 if (bind_first != bind_last)
328 { 401 {
329 PUSHMARK (SP); 402 PUSHMARK (SP);
330 EXTEND (SP, bind_last - bind_first + 2); 403 EXTEND (SP, bind_last - bind_first + 2);
331 PUSHs (sth); 404 PUSHs (sth);
332 do { 405 do {
406#if CAN_UTF8
407 if (ix & 1)
408 SvUTF8_on (SvRV(ST(bind_first)));
409#endif
333 PUSHs (ST(bind_first)); 410 PUSHs (ST(bind_first));
334 bind_first++; 411 bind_first++;
335 } while (bind_first != bind_last); 412 } while (bind_first != bind_last);
336 413
337 PUTBACK; 414 PUTBACK;
… …
339 SPAGAIN; 416 SPAGAIN;
340 417
341 if (count != 1) 418 if (count != 1)
342 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", 419 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
343 SvPV (sql, dc), 420 SvPV (sql, dc),
344 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 421 SvPV (get_sv ("DBI::errstr", TRUE), dd));
345 422
346 if (!SvOK (POPs)) 423 if (!SvOK (TOPs))
347 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", 424 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
348 SvPV (sql, dc), 425 SvPV (sql, dc),
349 SvPV (get_sv ("DBI::errstr", TRUE), dc)); 426 SvPV (get_sv ("DBI::errstr", TRUE), dd));
427
350 } 428 POPs;
429 }
351 430
352 /* free our arguments from the stack */ 431 /* restore our arguments again */
353 SP -= items; 432 SP -= items;
354 433
355 if ((ix & ~1) == 2) 434 if ((ix & ~1) == 2)
356 { /* sql_fetch */ 435 { /* sql_fetch */
357 SV *row; 436 SV *row;
… …
376 case G_VOID: 455 case G_VOID:
377 /* no thing */ 456 /* no thing */
378 break; 457 break;
379 case G_SCALAR: 458 case G_SCALAR:
380 /* the first element */ 459 /* the first element */
381 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); 460 XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
382 break; 461 break;
383 case G_ARRAY: 462 case G_ARRAY:
384 av = (AV *)SvRV (row); 463 av = (AV *)SvRV (row);
385 count = AvFILL (av) + 1; 464 count = AvFILL (av) + 1;
386 EXTEND (SP, count); 465 EXTEND (SP, count);
387 for (arg = 0; arg < count; arg++) 466 for (arg = 0; arg < count; arg++)
388 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 467 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
389 468
390 break; 469 break;
391 default: 470 default:
392 abort (); 471 abort ();
393 } 472 }
… …
418 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ 497 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */
419 498
420 EXTEND (SP, count); 499 EXTEND (SP, count);
421 if (columns == 1) 500 if (columns == 1)
422 for (arg = 0; arg < count; arg++) 501 for (arg = 0; arg < count; arg++)
423 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); 502 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
424 else 503 else
425 for (arg = 0; arg < count; arg++) 504 for (arg = 0; arg < count; arg++)
426 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); 505 PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
427 } 506 }
428 } 507 }
429 } 508 }
430 else 509 else
431 XPUSHs (sth); 510 XPUSHs (sth);

Diff Legend

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