ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
Revision: 1.6
Committed: Sun Apr 22 17:03:28 2001 UTC (23 years, 1 month ago) by root
Branch: MAIN
Changes since 1.5: +6 -3 lines
Log Message:
*** empty log message ***

File Contents

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