ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
Revision: 1.5
Committed: Sun Apr 22 14:38:28 2001 UTC (23 years, 1 month ago) by root
Branch: MAIN
Changes since 1.4: +65 -20 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.5 static SV *sv_prepare, *sv_execute, *sv_bind_columns, *sv_fetchrow_arrayref, *sv_finish;
172    
173     #define newconstpv(str) newSVpvn ((str), sizeof (str))
174 root 1.1
175     MODULE = PApp::SQL PACKAGE = PApp::SQL
176    
177     PROTOTYPES: DISABLE
178    
179     BOOT:
180     {
181     sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV);
182     DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV);
183    
184 root 1.5 if (!sv_prepare)
185     {
186     sv_prepare = newconstpv ("prepare");
187     sv_execute = newconstpv ("execute");
188     sv_bind_columns = newconstpv ("bind_columns");
189     sv_fetchrow_arrayref = newconstpv ("fetchrow_arrayref");
190     sv_finish = newconstpv ("finish");
191     }
192    
193 root 1.1 /* apache might BOOT: twice :( */
194     if (lru_size)
195     lru_cachesize (0);
196    
197     lru_init;
198     lru_cachesize (50);
199     }
200    
201     int
202     cachesize(size = -1)
203     int size
204     CODE:
205     RETVAL = lru_maxsize;
206     lru_cachesize (size);
207     OUTPUT:
208     RETVAL
209    
210     void
211     sql_exec(...)
212     ALIAS:
213 root 1.5 sql_uexec = 1
214     sql_fetch = 2
215     sql_ufetch = 3
216     sql_fetchall = 4
217     sql_ufetchall = 5
218     sql_exists = 6
219     sql_uexists = 7
220 root 1.1 PPCODE:
221     {
222     if (items == 0)
223     croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]");
224     else
225     {
226     int arg = 0;
227     int bind_first, bind_last;
228     int count;
229     SV *dbh = ST(0);
230     SV *sth;
231     SV *sql;
232     SV *execute;
233 root 1.3 STRLEN dc;
234 root 1.1
235     /* save our arguments against destruction through function calls */
236     SP += items;
237    
238     /* first check wether we should use an explicit db handle */
239     if (!is_dbh (dbh))
240     {
241     dbh = get_sv ("DBH", FALSE);
242     if (!is_dbh (dbh))
243     {
244     dbh = GvSV(DBH);
245     if (!is_dbh (dbh))
246     croak ("sql_exec: no $DBH found in current package or in PApp::SQL::");
247     }
248     }
249     else
250     arg++; /* we consumed one argument */
251    
252     /* count the remaining references (for bind_columns) */
253     bind_first = arg;
254     while (items > arg && SvROK (ST(arg)))
255     arg++;
256    
257     bind_last = arg;
258    
259     /* consume the sql-statement itself */
260     if (items <= arg)
261     croak ("sql_exec: required argument \"sql-statement\" missing");
262    
263     if (!SvPOK (ST(arg)))
264     croak ("sql_exec: sql-statement must be a string");
265    
266     sql = ST(arg); arg++;
267    
268 root 1.5 if ((ix & ~1) == 6)
269 root 1.1 {
270     SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0));
271     sv_catsv (neu, sql);
272     sv_catpv (neu, " limit 1");
273     sql = neu;
274 root 1.5 ix -= 6; /* sql_fetch */
275 root 1.1 }
276    
277 root 1.4 /* check cache for existing statement handle */
278 root 1.1 sth = lru_fetch (dbh, sql);
279     if (!sth)
280     {
281     PUSHMARK (SP);
282     EXTEND (SP, 2);
283     PUSHs (dbh);
284     PUSHs (sql);
285     PUTBACK;
286 root 1.5 count = call_sv (sv_prepare, G_METHOD | G_SCALAR);
287 root 1.1 SPAGAIN;
288    
289     if (count != 1)
290     croak ("sql_exec: unable to prepare() statement '%s': %s",
291 root 1.3 SvPV (sql, dc),
292     SvPV (get_sv ("DBI::errstr", TRUE), dc));
293 root 1.1
294     sth = POPs;
295    
296     lru_store (dbh, sql, sth);
297     }
298    
299     PUSHMARK (SP);
300     EXTEND (SP, items - arg + 1);
301     PUSHs (sth);
302     while (items > arg)
303     {
304 root 1.5 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg)));
305 root 1.1 arg++;
306     }
307    
308     PUTBACK;
309     /* { static GV *execute;
310     if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0);
311     count = call_sv(GvCV(execute), G_SCALAR);
312     }*/
313 root 1.5 count = call_sv (sv_execute, G_METHOD | G_SCALAR);
314 root 1.1 SPAGAIN;
315    
316     if (count != 1)
317     croak ("sql_exec: execute() didn't return any value ('%s'): %s",
318 root 1.3 SvPV (sql, dc),
319     SvPV (get_sv ("DBI::errstr", TRUE), dc));
320 root 1.1
321     execute = POPs;
322    
323     if (!SvTRUE (execute))
324     croak ("sql_exec: unable to execute statement '%s' (%s)",
325 root 1.3 SvPV (sql, dc),
326     SvPV (get_sv ("DBI::errstr", TRUE), dc));
327 root 1.1
328     sv_setsv (GvSV(sql_exec), execute);
329    
330     if (bind_first != bind_last)
331     {
332     PUSHMARK (SP);
333     EXTEND (SP, bind_last - bind_first + 2);
334     PUSHs (sth);
335     do {
336     PUSHs (ST(bind_first));
337     bind_first++;
338     } while (bind_first != bind_last);
339    
340     PUTBACK;
341 root 1.5 count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR);
342 root 1.1 SPAGAIN;
343    
344     if (count != 1)
345     croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
346 root 1.3 SvPV (sql, dc),
347     SvPV (get_sv ("DBI::errstr", TRUE), dc));
348 root 1.1
349     if (!SvOK (POPs))
350     croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
351 root 1.3 SvPV (sql, dc),
352     SvPV (get_sv ("DBI::errstr", TRUE), dc));
353 root 1.1 }
354    
355     /* free our arguments from the stack */
356     SP -= items;
357    
358 root 1.5 if ((ix & ~1) == 2)
359 root 1.1 { /* sql_fetch */
360     SV *row;
361    
362     PUSHMARK (SP);
363     XPUSHs (sth);
364     PUTBACK;
365 root 1.5 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR);
366 root 1.1 SPAGAIN;
367    
368     if (count != 1)
369     abort ();
370    
371     row = POPs;
372    
373     if (SvROK (row))
374     {
375     AV *av;
376    
377     switch (GIMME_V)
378     {
379     case G_VOID:
380     /* no thing */
381     break;
382     case G_SCALAR:
383     /* the first element */
384 root 1.5 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
385 root 1.1 break;
386     case G_ARRAY:
387     av = (AV *)SvRV (row);
388     count = AvFILL (av) + 1;
389     EXTEND (SP, count);
390     for (arg = 0; arg < count; arg++)
391 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
392 root 1.1
393     break;
394     default:
395     abort ();
396     }
397     }
398     }
399 root 1.5 else if ((ix & ~1) == 4)
400 root 1.1 { /* sql_fetchall */
401     SV *rows;
402    
403     PUSHMARK (SP);
404     XPUSHs (sth);
405     PUTBACK;
406 root 1.5 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR);
407 root 1.1 SPAGAIN;
408    
409     if (count != 1)
410     abort ();
411    
412     rows = POPs;
413    
414     if (SvROK (rows))
415     {
416     AV *av = (AV *)SvRV (rows);
417     count = AvFILL (av) + 1;
418    
419     if (count)
420     {
421     int columns = AvFILL ((AV *)SvRV (AvARRAY(av)[0])) + 1; /* columns? */
422    
423     EXTEND (SP, count);
424     if (columns == 1)
425     for (arg = 0; arg < count; arg++)
426 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
427 root 1.1 else
428     for (arg = 0; arg < count; arg++)
429 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
430 root 1.1 }
431     }
432     }
433     else
434     XPUSHs (sth);
435    
436 root 1.5 if (ix > 1 || GIMME_V == G_VOID)
437 root 1.1 {
438     PUSHMARK (SP);
439     XPUSHs (sth);
440     PUTBACK;
441 root 1.5 (void) call_sv (sv_finish, G_METHOD | G_DISCARD);
442 root 1.1 SPAGAIN;
443     }
444     }
445     }
446    
447    
448