ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.xs
Revision: 1.8
Committed: Sat Aug 11 02:46:16 2001 UTC (22 years, 10 months ago) by root
Branch: MAIN
Changes since 1.7: +0 -6 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     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 root 1.6 static SV *sv_prepare, *sv_execute, *sv_bind_columns,
166     *sv_fetchrow_arrayref, *sv_fetchall_arrayref,
167     *sv_finish;
168 root 1.5
169     #define newconstpv(str) newSVpvn ((str), sizeof (str))
170 root 1.1
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 root 1.5 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 root 1.6 sv_fetchall_arrayref = newconstpv ("fetchall_arrayref");
187 root 1.5 sv_finish = newconstpv ("finish");
188     }
189    
190 root 1.1 /* 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 root 1.5 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 root 1.1 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 root 1.3 STRLEN dc;
231 root 1.1
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 root 1.5 if ((ix & ~1) == 6)
266 root 1.1 {
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 root 1.7 ix -= 4; /* sql_fetch */
272 root 1.1 }
273    
274 root 1.4 /* check cache for existing statement handle */
275 root 1.1 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 root 1.5 count = call_sv (sv_prepare, G_METHOD | G_SCALAR);
284 root 1.1 SPAGAIN;
285    
286     if (count != 1)
287     croak ("sql_exec: unable to prepare() statement '%s': %s",
288 root 1.3 SvPV (sql, dc),
289     SvPV (get_sv ("DBI::errstr", TRUE), dc));
290 root 1.1
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 root 1.5 PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg)));
302 root 1.1 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 root 1.5 count = call_sv (sv_execute, G_METHOD | G_SCALAR);
311 root 1.1 SPAGAIN;
312    
313     if (count != 1)
314     croak ("sql_exec: execute() didn't return any value ('%s'): %s",
315 root 1.3 SvPV (sql, dc),
316     SvPV (get_sv ("DBI::errstr", TRUE), dc));
317 root 1.1
318     execute = POPs;
319    
320     if (!SvTRUE (execute))
321     croak ("sql_exec: unable to execute statement '%s' (%s)",
322 root 1.3 SvPV (sql, dc),
323     SvPV (get_sv ("DBI::errstr", TRUE), dc));
324 root 1.1
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 root 1.5 count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR);
339 root 1.1 SPAGAIN;
340    
341     if (count != 1)
342     croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s",
343 root 1.3 SvPV (sql, dc),
344     SvPV (get_sv ("DBI::errstr", TRUE), dc));
345 root 1.1
346     if (!SvOK (POPs))
347     croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s",
348 root 1.3 SvPV (sql, dc),
349     SvPV (get_sv ("DBI::errstr", TRUE), dc));
350 root 1.1 }
351    
352     /* free our arguments from the stack */
353     SP -= items;
354    
355 root 1.5 if ((ix & ~1) == 2)
356 root 1.1 { /* sql_fetch */
357     SV *row;
358    
359     PUSHMARK (SP);
360     XPUSHs (sth);
361     PUTBACK;
362 root 1.5 count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR);
363 root 1.1 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 root 1.5 XPUSHs (maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1)));
382 root 1.1 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 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
389 root 1.1
390     break;
391     default:
392     abort ();
393     }
394     }
395     }
396 root 1.5 else if ((ix & ~1) == 4)
397 root 1.1 { /* sql_fetchall */
398     SV *rows;
399    
400     PUSHMARK (SP);
401     XPUSHs (sth);
402     PUTBACK;
403 root 1.6 count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR);
404 root 1.1 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 root 1.6 int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */
419 root 1.1
420     EXTEND (SP, count);
421     if (columns == 1)
422     for (arg = 0; arg < count; arg++)
423 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0]));
424 root 1.1 else
425     for (arg = 0; arg < count; arg++)
426 root 1.5 PUSHs (maybe_force_utf8 (ix & 1, AvARRAY (av)[arg]));
427 root 1.1 }
428     }
429     }
430     else
431     XPUSHs (sth);
432    
433 root 1.5 if (ix > 1 || GIMME_V == G_VOID)
434 root 1.1 {
435     PUSHMARK (SP);
436     XPUSHs (sth);
437     PUTBACK;
438 root 1.5 (void) call_sv (sv_finish, G_METHOD | G_DISCARD);
439 root 1.1 SPAGAIN;
440     }
441     }
442     }
443    
444    
445