ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
Revision: 1.10
Committed: Mon Dec 31 03:07:57 2001 UTC (22 years, 5 months ago) by root
Branch: MAIN
Changes since 1.9: +4 -4 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6))
6 # define get_sv perl_get_sv
7 # define call_method perl_call_method
8 # define call_sv perl_call_sv
9 #endif
10
11 #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 5))
12 # define CAN_UTF8 1
13 #endif
14
15 static SV *
16 sql_upgrade_utf8 (SV *sv)
17 {
18 #if CAN_UTF8
19 if (SvPOK (sv))
20 sv_utf8_upgrade (sv);
21 #endif
22 return sv;
23 }
24
25 static SV *
26 sql_force_utf8 (SV *sv)
27 {
28 #if CAN_UTF8
29 if (SvPOK (sv))
30 SvUTF8_on (sv);
31 #endif
32 return sv;
33 }
34
35 #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
38 #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db"))
39
40 typedef struct lru_node {
41 struct lru_node *next;
42 struct lru_node *prev;
43 U32 hash;
44 SV *dbh;
45 SV *sql;
46
47 SV *sth;
48 #if 0 /* method cache */
49 GV *execute;
50 GV *bind_columns;
51 GV *fetch;
52 GV *finish;
53 #endif
54 } lru_node;
55
56 static lru_node lru_list;
57 static int lru_size;
58 static int lru_maxsize;
59
60 #define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */
61
62 /* this is primitive, yet effective */
63 /* the returned value must never be zero (or bad things will happen) */
64 #define lru_hash do { \
65 hash = (((U32)dbh)>>2); \
66 hash += *statement;\
67 hash += len; \
68 } while (0)
69
70 /* fetch and "use" */
71 /* could be done using a single call (we could call prepare!) */
72 static SV *lru_fetch(SV *dbh, SV *sql)
73 {
74 lru_node *n;
75
76 U32 hash;
77 STRLEN len;
78 char *statement = SvPV (sql, len);
79
80 dbh = SvRV (dbh);
81
82 lru_hash;
83
84 n = &lru_list;
85 do {
86 n = n->next;
87 if (!n->hash)
88 return 0;
89 } while (n->hash != hash
90 || !sv_eq (n->sql, sql)
91 || n->dbh != dbh);
92
93 /* found, so return to the start of the list */
94 n->prev->next = n->next;
95 n->next->prev = n->prev;
96
97 n->next = lru_list.next;
98 n->prev = &lru_list;
99 lru_list.next->prev = n;
100 lru_list.next = n;
101
102 return n->sth;
103 }
104
105 static void lru_nukeone(void)
106 {
107 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(!) */
124 static void lru_store(SV *dbh, SV *sql, SV *sth)
125 {
126 lru_node *n;
127
128 U32 hash;
129 STRLEN len;
130 char *statement = SvPV (sql, len);
131
132 dbh = SvRV (dbh);
133
134 lru_hash;
135
136 lru_size++;
137 if (lru_size > lru_maxsize)
138 lru_nukeone ();
139
140 New (0, n, 1, lru_node);
141
142 n->hash = hash;
143 n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */
144 n->sql = newSVsv (sql);
145 n->sth = sth; SvREFCNT_inc (sth);
146
147 n->next = lru_list.next;
148 n->prev = &lru_list;
149 lru_list.next->prev = n;
150 lru_list.next = n;
151 }
152
153 static void lru_cachesize (int size)
154 {
155 if (size >= 0)
156 {
157 lru_maxsize = size;
158 while (lru_size > lru_maxsize)
159 lru_nukeone ();
160 }
161 }
162
163 static GV *sql_exec;
164 static GV *DBH;
165 static SV *sv_prepare, *sv_execute, *sv_bind_columns,
166 *sv_fetchrow_arrayref, *sv_fetchall_arrayref,
167 *sv_finish;
168
169 #define newconstpv(str) newSVpvn ((str), sizeof (str))
170
171 MODULE = PApp::SQL PACKAGE = PApp::SQL
172
173 PROTOTYPES: DISABLE
174
175 BOOT:
176 {
177 sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
178 DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
179
180 if (!sv_prepare)
181 {
182 sv_prepare = newconstpv ("prepare");
183 sv_execute = newconstpv ("execute");
184 sv_bind_columns = newconstpv ("bind_columns");
185 sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref");
186 sv_fetchall_arrayref = newconstpv ("fetchall_arrayref");
187 sv_finish = newconstpv ("finish");
188 }
189
190 /* apache might BOOT: twice :( */
191 if (lru_size)
192 lru_cachesize (0);
193
194 lru_init;
195 lru_cachesize (50);
196 }
197
198 int
199 cachesize(size = -1)
200 int size
201 CODE:
202 RETVAL = lru_maxsize;
203 lru_cachesize (size);
204 OUTPUT:
205 RETVAL
206
207 void
208 sql_exec(...)
209 ALIAS:
210 sql_uexec = 1
211 sql_fetch = 2
212 sql_ufetch = 3
213 sql_fetchall = 4
214 sql_ufetchall = 5
215 sql_exists = 6
216 sql_uexists = 7
217 PPCODE:
218 {
219 if (items == 0)
220 croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
221 else
222 {
223 int arg = 0;
224 int bind_first, bind_last;
225 int count;
226 SV *dbh = ST(0);
227 SV *sth;
228 SV *sql;
229 SV *execute;
230 STRLEN dc, dd; /* dummy */
231
232 /* save our arguments against destruction through function calls */
233 SP += items;
234
235 /* first check wether we should use an explicit db handle */
236 if (!is_dbh (dbh))
237 {
238 dbh = get_sv ("DBH", FALSE);
239 if (!is_dbh (dbh))
240 {
241 dbh = GvSV(DBH);
242 if (!is_dbh (dbh))
243 croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
244 }
245 }
246 else
247 arg++; /* we consumed one argument */
248
249 /* count the remaining references (for bind_columns) */
250 bind_first = arg;
251 while (items > arg && SvROK (ST(arg)))
252 arg++;
253
254 bind_last = arg;
255
256 /* consume the sql-statement itself */
257 if (items <= arg)
258 croak ("sql_exec: required argument \"sql-statement\" missing");
259
260 if (!SvPOK (ST(arg)))
261 croak ("sql_exec: sql-statement must be a string");
262
263 sql = ST(arg); arg++;
264
265 if ((ix & ~1) == 6)
266 {
267 SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0));
268 sv_catsv (neu, sql);
269 sv_catpv (neu, " limit 1");
270 sql = neu;
271 ix -= 4; /* sql_fetch */
272 }
273
274 /* check cache for existing statement handle */
275 sth = lru_fetch (dbh, sql);
276 if (!sth)
277 {
278 PUSHMARK (SP);
279 EXTEND (SP, 2);
280 PUSHs (dbh);
281 PUSHs (sql);
282 PUTBACK;
283 count = call_sv (sv_prepare, G_METHOD | G_SCALAR);
284 SPAGAIN;
285
286 if (count != 1)
287 croak ("sql_exec: unable to prepare() statement '%s': %s",
288 SvPV (sql, dc),
289 SvPV (get_sv ("DBI::errstr", TRUE), dd));
290
291 sth = POPs;
292
293 lru_store (dbh, sql, sth);
294 }
295
296 PUSHMARK (SP);
297 EXTEND (SP, items - arg + 1);
298 PUSHs (sth);
299 while (items > arg)
300 {
301 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg)));
302 arg++;
303 }
304
305 PUTBACK;
306 /* { static GV *execute;
307 if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
308 count = call_sv(GvCV(execute), G_SCALAR);
309 }*/
310 count = call_sv (sv_execute, G_METHOD | G_SCALAR);
311 SPAGAIN;
312
313 if (count != 1)
314 croak ("sql_exec: execute() didn't return any value ('%s'): %s",
315 SvPV (sql, dc),
316 SvPV (get_sv ("DBI::errstr", TRUE), dd));
317
318 execute = POPs;
319
320 if (!SvTRUE (execute))
321 croak ("sql_exec: unable to execute statement '%s' (%s)",
322 SvPV (sql, dc),
323 SvPV (get_sv ("DBI::errstr", TRUE), dd));
324
325 sv_setsv (GvSV(sql_exec), execute);
326
327 if (bind_first != bind_last)
328 {
329 PUSHMARK (SP);
330 EXTEND (SP, bind_last - bind_first + 2);
331 PUSHs (sth);
332 do {
333 PUSHs (ST(bind_first));
334 bind_first++;
335 } while (bind_first != bind_last);
336
337 PUTBACK;
338 count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR);
339 SPAGAIN;
340
341 if (count != 1)
342 croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
343 SvPV (sql, dc),
344 SvPV (get_sv ("DBI::errstr", TRUE), dd));
345
346 if (!SvOK (POPs))
347 croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
348 SvPV (sql, dc),
349 SvPV (get_sv ("DBI::errstr", TRUE), dd));
350 }
351
352 /* free our arguments from the stack */
353 SP -= items;
354
355 if ((ix & ~1) == 2)
356 { /* sql_fetch */
357 SV *row;
358
359 PUSHMARK (SP);
360 XPUSHs (sth);
361 PUTBACK;
362 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR);
363 SPAGAIN;
364
365 if (count != 1)
366 abort ();
367
368 row = POPs;
369
370 if (SvROK (row))
371 {
372 AV *av;
373
374 switch (GIMME_V)
375 {
376 case G_VOID:
377 /* no thing */
378 break;
379 case G_SCALAR:
380 /* the first element */
381 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
382 break;
383 case G_ARRAY:
384 av = (AV *)SvRV (row);
385 count = AvFILL (av) + 1;
386 EXTEND (SP, count);
387 for (arg = 0; arg < count; arg++)
388 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
389
390 break;
391 default:
392 abort ();
393 }
394 }
395 }
396 else if ((ix & ~1) == 4)
397 { /* sql_fetchall */
398 SV *rows;
399
400 PUSHMARK (SP);
401 XPUSHs (sth);
402 PUTBACK;
403 count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR);
404 SPAGAIN;
405
406 if (count != 1)
407 abort ();
408
409 rows = POPs;
410
411 if (SvROK (rows))
412 {
413 AV *av = (AV *)SvRV (rows);
414 count = AvFILL (av) + 1;
415
416 if (count)
417 {
418 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */
419
420 EXTEND (SP, count);
421 if (columns == 1)
422 for (arg = 0; arg < count; arg++)
423 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
424 else
425 for (arg = 0; arg < count; arg++)
426 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
427 }
428 }
429 }
430 else
431 XPUSHs (sth);
432
433 if (ix > 1 || GIMME_V == G_VOID)
434 {
435 PUSHMARK (SP);
436 XPUSHs (sth);
437 PUTBACK;
438 (void) call_sv (sv_finish, G_METHOD | G_DISCARD);
439 SPAGAIN;
440 }
441 }
442 }
443
444
445