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