1 | #include "EXTERN.h" |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
3 | #include "XSUB.h" |
|
|
4 | |
|
|
5 | /* import some stuff from DBIXS.h and DBI.xs */ |
|
|
6 | #define DBIXS_VERSION 93 |
|
|
7 | #define DBI_MAGIC '~' |
|
|
8 | |
|
|
9 | #define DBISTATE_PERLNAME "DBI::_dbistate" |
|
|
10 | #define DBISTATE_ADDRSV (perl_get_sv (DBISTATE_PERLNAME, 0x05)) |
|
|
11 | #define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV)))) |
|
|
12 | |
|
|
13 | static SV *sql_varchar, *sql_integer, *sql_double; |
|
|
14 | static SV *tmp_iv; |
|
|
15 | |
|
|
16 | struct dbistate_st { |
|
|
17 | #define DBISTATE_VERSION 94 /* Must change whenever dbistate_t does */ |
|
|
18 | /* this must be the first member in structure */ |
|
|
19 | void (*check_version) _((const char *name, |
|
|
20 | int dbis_cv, int dbis_cs, int need_dbixs_cv, |
|
|
21 | int drc_s, int dbc_s, int stc_s, int fdc_s)); |
|
|
22 | |
|
|
23 | /* version and size are used to check for DBI/DBD version mis-match */ |
|
|
24 | U16 version; /* version of this structure */ |
|
|
25 | U16 size; |
|
|
26 | U16 xs_version; /* version of the overall DBIXS / DBD interface */ |
|
|
27 | U16 spare_pad; |
|
|
28 | }; |
|
|
29 | typedef struct dbistate_st dbistate_t; |
|
|
30 | |
|
|
31 | #define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */ |
|
|
32 | |
|
|
33 | typedef U32 imp_sth; |
|
|
34 | |
|
|
35 | /* not strictly part of the API... */ |
|
|
36 | static imp_sth * |
|
|
37 | sth_get_imp (SV *sth) |
|
|
38 | { |
|
|
39 | MAGIC *mg = mg_find (SvRV (sth), PERL_MAGIC_tied); |
|
|
40 | sth = mg->mg_obj; |
|
|
41 | mg = mg_find (SvRV (sth), DBI_MAGIC); |
|
|
42 | return (imp_sth *)SvPVX (mg->mg_obj); |
|
|
43 | } |
|
|
44 | |
|
|
45 | #define DBI_STH_ACTIVE(imp) (*(imp) & DBIcf_ACTIVE) |
|
|
46 | |
|
|
47 | /* end of import section */ |
4 | |
48 | |
5 | #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) |
49 | #if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) |
6 | # define get_sv perl_get_sv |
50 | # define get_sv perl_get_sv |
7 | # define call_method perl_call_method |
51 | # define call_method perl_call_method |
8 | # define call_sv perl_call_sv |
52 | # define call_sv perl_call_sv |
… | |
… | |
10 | |
54 | |
11 | #if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
55 | #if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
12 | # define CAN_UTF8 1 |
56 | # define CAN_UTF8 1 |
13 | #endif |
57 | #endif |
14 | |
58 | |
|
|
59 | #define MAX_CACHED_STATEMENT_SIZE 2048 |
|
|
60 | |
15 | static SV * |
61 | static SV * |
16 | sql_upgrade_utf8 (SV *sv) |
62 | sql_upgrade_utf8 (SV *sv) |
17 | { |
63 | { |
18 | #if CAN_UTF8 |
64 | #if CAN_UTF8 |
19 | if (SvPOK (sv)) |
65 | if (SvPOKp (sv)) |
20 | sv_utf8_upgrade (sv); |
66 | sv_utf8_upgrade (sv); |
21 | #endif |
67 | #endif |
22 | return sv; |
68 | return sv; |
23 | } |
69 | } |
24 | |
70 | |
25 | static SV * |
71 | static SV * |
26 | mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
72 | mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
27 | { |
73 | { |
28 | sv = sv_mortalcopy (sv); |
74 | sv = sv_mortalcopy (sv); |
29 | #if CAN_UTF8 |
75 | #if CAN_UTF8 |
30 | if (utf8 && SvPOK (sv)) |
76 | if (utf8 && SvPOKp (sv)) |
31 | SvUTF8_on (sv); |
77 | SvUTF8_on (sv); |
32 | #endif |
78 | #endif |
33 | return sv; |
79 | return sv; |
34 | } |
80 | } |
35 | |
81 | |
36 | #define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
82 | #define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
37 | |
83 | |
38 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
84 | #define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
39 | |
85 | |
|
|
86 | typedef struct mc_node |
|
|
87 | { |
|
|
88 | struct mc_node *next; |
|
|
89 | HV *stash; |
|
|
90 | U32 gen; |
|
|
91 | |
|
|
92 | /* DBH */ |
|
|
93 | SV *prepare; |
|
|
94 | |
|
|
95 | /* STH */ |
|
|
96 | SV *execute; |
|
|
97 | SV *bind_param; |
|
|
98 | SV *bind_columns; |
|
|
99 | SV *fetchrow_arrayref; |
|
|
100 | SV *fetchall_arrayref; |
|
|
101 | SV *finish; |
|
|
102 | } mc_node; |
|
|
103 | |
|
|
104 | static mc_node *first; |
|
|
105 | |
|
|
106 | static mc_node * |
|
|
107 | mc_find (HV *stash) |
|
|
108 | { |
|
|
109 | mc_node *mc; |
|
|
110 | U32 gen = PL_sub_generation; |
|
|
111 | |
|
|
112 | #ifdef HvMROMETA |
|
|
113 | gen += HvMROMETA (stash)->cache_gen; |
|
|
114 | #endif |
|
|
115 | |
|
|
116 | for (mc = first; mc; mc = mc->next) |
|
|
117 | if (mc->stash == stash && mc->gen == gen) |
|
|
118 | return mc; |
|
|
119 | |
|
|
120 | if (!mc) |
|
|
121 | { |
|
|
122 | Newz (0, mc, 1, mc_node); |
|
|
123 | mc->stash = stash; |
|
|
124 | |
|
|
125 | mc->next = first; |
|
|
126 | first = mc; |
|
|
127 | } |
|
|
128 | else |
|
|
129 | { |
|
|
130 | mc->execute = |
|
|
131 | mc->bind_param = |
|
|
132 | mc->bind_columns = |
|
|
133 | mc->fetchrow_arrayref = |
|
|
134 | mc->fetchall_arrayref = |
|
|
135 | mc->finish = 0; |
|
|
136 | } |
|
|
137 | |
|
|
138 | mc->gen = gen; |
|
|
139 | |
|
|
140 | return mc; |
|
|
141 | } |
|
|
142 | |
|
|
143 | static void |
|
|
144 | mc_cache (mc_node *mc, SV **method, const char *name) |
|
|
145 | { |
|
|
146 | *method = (SV *)gv_fetchmethod_autoload (mc->stash, name, 0); |
|
|
147 | |
|
|
148 | if (!method) |
|
|
149 | croak ("%s: method not found in stash, please report.", name); |
|
|
150 | } |
|
|
151 | |
|
|
152 | #define mc_cache(mc, method) mc_cache ((mc), &((mc)->method), # method) |
|
|
153 | |
40 | typedef struct lru_node { |
154 | typedef struct lru_node |
|
|
155 | { |
41 | struct lru_node *next; |
156 | struct lru_node *next; |
42 | struct lru_node *prev; |
157 | struct lru_node *prev; |
|
|
158 | |
43 | U32 hash; |
159 | U32 hash; |
44 | SV *dbh; |
160 | SV *dbh; |
45 | SV *sql; |
161 | SV *sql; |
46 | |
162 | |
47 | SV *sth; |
163 | SV *sth; |
48 | #if 0 /* method cache */ |
164 | imp_sth *sth_imp; |
49 | GV *execute; |
165 | |
50 | GV *bind_columns; |
166 | mc_node *mc; |
51 | GV *fetch; |
|
|
52 | GV *finish; |
|
|
53 | #endif |
|
|
54 | } lru_node; |
167 | } lru_node; |
55 | |
168 | |
56 | static lru_node lru_list; |
169 | static lru_node lru_list; |
57 | static int lru_size; |
170 | static int lru_size; |
58 | static int lru_maxsize; |
171 | static int lru_maxsize; |
59 | |
172 | |
60 | #define lru_init lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ |
173 | #define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ |
61 | |
174 | |
62 | /* this is primitive, yet effective */ |
175 | /* this is primitive, yet effective */ |
63 | /* the returned value must never be zero (or bad things will happen) */ |
176 | /* the returned value must never be zero (or bad things will happen) */ |
64 | #define lru_hash do { \ |
177 | static U32 |
65 | hash = (((U32)dbh)>>2); \ |
178 | lru_hash (SV *dbh, SV *sql) |
66 | hash += *statement;\ |
179 | { |
67 | hash += len; \ |
180 | /* use a variant of fnv1a */ |
68 | } while (0) |
181 | STRLEN i, l; |
|
|
182 | char *b = SvPV (sql, l); |
|
|
183 | U32 hash = 2166136261U; |
|
|
184 | |
|
|
185 | hash = (hash ^ (U32)dbh) * 16777619U; |
|
|
186 | hash = (hash ^ l) * 16777619U; |
|
|
187 | |
|
|
188 | /* start hashing at char 7, as this skips the "select " prefix */ |
|
|
189 | /* also skip more and more octets */ |
|
|
190 | for (i = 7; i < l; i += i >> 2) |
|
|
191 | hash = (hash ^ b [i]) * 16777619U; |
|
|
192 | |
|
|
193 | return hash; |
|
|
194 | } |
69 | |
195 | |
70 | /* fetch and "use" */ |
196 | /* fetch and "use" */ |
71 | /* could be done using a single call (we could call prepare!) */ |
197 | static lru_node * |
72 | static SV *lru_fetch(SV *dbh, SV *sql) |
198 | lru_fetch (SV *dbh, SV *sql) |
73 | { |
199 | { |
74 | lru_node *n; |
200 | lru_node *n; |
75 | |
|
|
76 | U32 hash; |
201 | U32 hash; |
77 | STRLEN len; |
|
|
78 | char *statement = SvPV (sql, len); |
|
|
79 | |
202 | |
80 | dbh = SvRV (dbh); |
203 | dbh = SvRV (dbh); |
81 | |
204 | hash = lru_hash (dbh, sql); |
82 | lru_hash; |
|
|
83 | |
205 | |
84 | n = &lru_list; |
206 | n = &lru_list; |
85 | do { |
207 | do { |
86 | n = n->next; |
208 | n = n->next; |
|
|
209 | |
87 | if (!n->hash) |
210 | if (!n->hash) |
88 | return 0; |
211 | return 0; |
89 | } while (n->hash != hash |
212 | } while (n->hash != hash |
|
|
213 | || DBI_STH_ACTIVE (n->sth_imp) |
90 | || !sv_eq (n->sql, sql) |
214 | || !sv_eq (n->sql, sql) |
91 | || n->dbh != dbh); |
215 | || n->dbh != dbh); |
92 | |
216 | |
93 | /* found, so return to the start of the list */ |
217 | /* found, so return to the start of the list */ |
94 | n->prev->next = n->next; |
218 | n->prev->next = n->next; |
… | |
… | |
97 | n->next = lru_list.next; |
221 | n->next = lru_list.next; |
98 | n->prev = &lru_list; |
222 | n->prev = &lru_list; |
99 | lru_list.next->prev = n; |
223 | lru_list.next->prev = n; |
100 | lru_list.next = n; |
224 | lru_list.next = n; |
101 | |
225 | |
102 | return n->sth; |
226 | return n; |
103 | } |
227 | } |
104 | |
228 | |
105 | static void lru_nukeone(void) |
229 | static void |
|
|
230 | lru_trim (void) |
|
|
231 | { |
|
|
232 | while (lru_size > lru_maxsize) |
|
|
233 | { |
|
|
234 | /* nuke at the end */ |
|
|
235 | lru_node *n = lru_list.prev; |
|
|
236 | |
|
|
237 | n = lru_list.prev; |
|
|
238 | |
|
|
239 | lru_list.prev = n->prev; |
|
|
240 | n->prev->next = &lru_list; |
|
|
241 | |
|
|
242 | SvREFCNT_dec_NN (n->dbh); |
|
|
243 | SvREFCNT_dec_NN (n->sql); |
|
|
244 | SvREFCNT_dec_NN (n->sth); |
|
|
245 | Safefree (n); |
|
|
246 | |
|
|
247 | lru_size--; |
|
|
248 | } |
|
|
249 | } |
|
|
250 | |
|
|
251 | /* store a not-yet existing entry(!) */ |
|
|
252 | static void |
|
|
253 | lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
106 | { |
254 | { |
107 | lru_node *n; |
255 | lru_node *n; |
108 | /* nuke at the end */ |
256 | U32 hash; |
109 | |
257 | |
110 | n = lru_list.prev; |
258 | if (!lru_maxsize) |
111 | |
259 | return; |
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 | |
260 | |
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); |
261 | dbh = SvRV (dbh); |
133 | |
262 | hash = lru_hash (dbh, sql); |
134 | lru_hash; |
|
|
135 | |
263 | |
136 | lru_size++; |
264 | lru_size++; |
137 | if (lru_size > lru_maxsize) |
265 | lru_trim (); |
138 | lru_nukeone (); |
|
|
139 | |
266 | |
140 | New (0, n, 1, lru_node); |
267 | New (0, n, 1, lru_node); |
141 | |
268 | |
142 | n->hash = hash; |
269 | n->hash = hash; |
143 | n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ |
270 | n->dbh = SvREFCNT_inc_NN (dbh); /* note: this is the dbi hash itself, not the reference */ |
144 | n->sql = newSVsv (sql); |
271 | n->sql = newSVsv (sql); |
145 | n->sth = sth; SvREFCNT_inc (sth); |
272 | n->sth = SvREFCNT_inc_NN (sth); |
|
|
273 | n->sth_imp = sth_get_imp (sth); |
|
|
274 | n->mc = mc; |
146 | |
275 | |
147 | n->next = lru_list.next; |
276 | n->next = lru_list.next; |
148 | n->prev = &lru_list; |
277 | n->prev = &lru_list; |
149 | lru_list.next->prev = n; |
278 | lru_list.next->prev = n; |
150 | lru_list.next = n; |
279 | lru_list.next = n; |
151 | } |
280 | } |
152 | |
281 | |
|
|
282 | static void |
153 | static void lru_cachesize (int size) |
283 | lru_cachesize (int size) |
154 | { |
284 | { |
155 | if (size >= 0) |
285 | if (size >= 0) |
156 | { |
286 | { |
157 | lru_maxsize = size; |
287 | lru_maxsize = size; |
158 | while (lru_size > lru_maxsize) |
288 | lru_trim (); |
159 | lru_nukeone (); |
|
|
160 | } |
289 | } |
161 | } |
290 | } |
162 | |
291 | |
163 | static GV *sql_exec; |
292 | static GV *sql_exec; |
164 | static GV *DBH; |
293 | static GV *DBH; |
165 | static SV *sv_prepare, *sv_execute, *sv_bind_columns, |
|
|
166 | *sv_fetchrow_arrayref, *sv_fetchall_arrayref, |
|
|
167 | *sv_finish; |
|
|
168 | |
294 | |
169 | #define newconstpv(str) newSVpvn ((str), sizeof (str)) |
295 | #define newconstpv(str) newSVpvn ((str), sizeof (str)) |
170 | |
296 | |
171 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
297 | MODULE = PApp::SQL PACKAGE = PApp::SQL |
172 | |
298 | |
173 | PROTOTYPES: DISABLE |
299 | PROTOTYPES: DISABLE |
174 | |
300 | |
175 | BOOT: |
301 | BOOT: |
176 | { |
302 | { |
|
|
303 | struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
|
|
304 | |
|
|
305 | /* this is actually wrong, we should call the check member, apparently */ |
|
|
306 | assert (dbis->version == DBISTATE_VERSION); |
|
|
307 | assert (dbis->xs_version == DBIXS_VERSION); |
|
|
308 | |
|
|
309 | tmp_iv = newSViv (0); |
|
|
310 | |
177 | sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
311 | sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
178 | DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
312 | 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 | |
313 | |
190 | /* apache might BOOT: twice :( */ |
314 | /* apache might BOOT: twice :( */ |
191 | if (lru_size) |
315 | if (lru_size) |
192 | lru_cachesize (0); |
316 | lru_cachesize (0); |
193 | |
317 | |
194 | lru_init; |
318 | lru_init (); |
195 | lru_cachesize (50); |
319 | lru_cachesize (100); |
196 | } |
320 | } |
|
|
321 | |
|
|
322 | void |
|
|
323 | boot2 (SV *t_str, SV *t_int, SV *t_dbl) |
|
|
324 | CODE: |
|
|
325 | sql_varchar = newSVsv (t_str); |
|
|
326 | sql_integer = newSVsv (t_int); |
|
|
327 | sql_double = newSVsv (t_dbl); |
197 | |
328 | |
198 | int |
329 | int |
199 | cachesize(size = -1) |
330 | cachesize(size = -1) |
200 | int size |
331 | int size |
201 | CODE: |
332 | CODE: |
… | |
… | |
206 | |
337 | |
207 | void |
338 | void |
208 | sql_exec(...) |
339 | sql_exec(...) |
209 | ALIAS: |
340 | ALIAS: |
210 | sql_uexec = 1 |
341 | sql_uexec = 1 |
211 | sql_fetch = 2 |
342 | sql_fetch = 2 |
212 | sql_ufetch = 3 |
343 | sql_ufetch = 3 |
213 | sql_fetchall = 4 |
344 | sql_fetchall = 4 |
214 | sql_ufetchall = 5 |
345 | sql_ufetchall = 5 |
215 | sql_exists = 6 |
346 | sql_exists = 6 |
216 | sql_uexists = 7 |
347 | sql_uexists = 7 |
… | |
… | |
218 | { |
349 | { |
219 | if (items == 0) |
350 | if (items == 0) |
220 | croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
351 | croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
221 | else |
352 | else |
222 | { |
353 | { |
|
|
354 | int i; |
223 | int arg = 0; |
355 | int arg = 0; |
224 | int bind_first, bind_last; |
356 | int bind_first, bind_last; |
225 | int count; |
357 | int count; |
|
|
358 | lru_node *lru; |
226 | SV *dbh = ST(0); |
359 | SV *dbh = ST(0); |
227 | SV *sth; |
360 | SV *sth; |
228 | SV *sql; |
361 | SV *sql; |
229 | SV *execute; |
362 | SV *execute; |
|
|
363 | mc_node *mc; |
230 | STRLEN dc, dd; /* dummy */ |
364 | STRLEN dc, dd; /* dummy */ |
|
|
365 | I32 orig_stack = SP - PL_stack_base; |
231 | |
366 | |
232 | /* save our arguments against destruction through function calls */ |
367 | /* save our arguments against destruction through function calls */ |
233 | SP += items; |
368 | SP += items; |
234 | |
369 | |
235 | /* first check wether we should use an explicit db handle */ |
370 | /* first check wether we should use an explicit db handle */ |
… | |
… | |
237 | { |
372 | { |
238 | /* the next line doesn't work - check why later maybe */ |
373 | /* the next line doesn't work - check why later maybe */ |
239 | /* dbh = get_sv ("DBH", FALSE); |
374 | /* dbh = get_sv ("DBH", FALSE); |
240 | if (!is_dbh (dbh)) |
375 | if (!is_dbh (dbh)) |
241 | {*/ |
376 | {*/ |
242 | dbh = GvSV(DBH); |
377 | dbh = GvSV (DBH); |
243 | if (!is_dbh (dbh)) |
378 | if (!is_dbh (dbh)) |
244 | croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
379 | croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
245 | /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
380 | /*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
246 | }*/ |
381 | }*/ |
247 | } |
382 | } |
248 | else |
383 | else |
249 | arg++; /* we consumed one argument */ |
384 | arg++; /* we consumed one argument */ |
250 | |
385 | |
|
|
386 | /* be more Coro-friendly by keeping a copy, so different threads */ |
|
|
387 | /* can replace their global handles */ |
|
|
388 | dbh = sv_2mortal (newSVsv (dbh)); |
|
|
389 | |
251 | /* count the remaining references (for bind_columns) */ |
390 | /* count the remaining references (for bind_columns) */ |
252 | bind_first = arg; |
391 | bind_first = arg; |
253 | while (items > arg && SvROK (ST(arg))) |
392 | while (items > arg && SvROK (ST(arg))) |
254 | arg++; |
393 | arg++; |
255 | |
394 | |
… | |
… | |
262 | if (!SvPOK (ST(arg))) |
401 | if (!SvPOK (ST(arg))) |
263 | croak ("sql_exec: sql-statement must be a string"); |
402 | croak ("sql_exec: sql-statement must be a string"); |
264 | |
403 | |
265 | sql = ST(arg); arg++; |
404 | sql = ST(arg); arg++; |
266 | |
405 | |
267 | if ((ix & ~1) == 6) |
406 | if ((ix & ~1) == 6) /* sql_exists */ |
268 | { |
407 | { |
269 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
408 | SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
270 | sv_catsv (neu, sql); |
409 | sv_catsv (neu, sql); |
271 | sv_catpv (neu, " limit 1"); |
410 | sv_catpv (neu, " limit 1"); |
272 | sql = neu; |
411 | sql = neu; |
273 | ix -= 4; /* sql_fetch */ |
412 | ix -= 4; /* sql_fetch */ |
274 | } |
413 | } |
275 | |
414 | |
|
|
415 | /* now prepare all parameters, by unmagicalising them and upgrading them */ |
|
|
416 | for (i = arg; i < items; ++i) |
|
|
417 | { |
|
|
418 | SV *sv = ST (i); |
|
|
419 | |
|
|
420 | /* we sv_mortalcopy magical values since DBI seems to have a memory |
|
|
421 | * leak when magical values are passed into execute(). |
|
|
422 | */ |
|
|
423 | if (SvMAGICAL (sv)) |
|
|
424 | ST (i) = sv = sv_mortalcopy (sv); |
|
|
425 | |
|
|
426 | if ((ix & 1) && SvPOKp (sv) && !SvUTF8 (sv)) |
|
|
427 | { |
|
|
428 | ST (i) = sv = sv_mortalcopy (sv); |
|
|
429 | sv_utf8_upgrade (sv); |
|
|
430 | } |
|
|
431 | } |
|
|
432 | |
276 | /* check cache for existing statement handle */ |
433 | /* check cache for existing statement handle */ |
|
|
434 | lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE |
277 | sth = lru_fetch (dbh, sql); |
435 | ? lru_fetch (dbh, sql) |
|
|
436 | : 0; |
278 | if (!sth) |
437 | if (!lru) |
279 | { |
438 | { |
|
|
439 | mc = mc_find (SvSTASH (SvRV (dbh))); |
|
|
440 | |
|
|
441 | if (!mc->prepare) |
|
|
442 | mc_cache (mc, prepare); |
|
|
443 | |
280 | PUSHMARK (SP); |
444 | PUSHMARK (SP); |
281 | EXTEND (SP, 2); |
445 | EXTEND (SP, 2); |
282 | PUSHs (dbh); |
446 | PUSHs (dbh); |
283 | PUSHs (sql); |
447 | PUSHs (sql); |
284 | PUTBACK; |
448 | PUTBACK; |
285 | count = call_sv (sv_prepare, G_METHOD | G_SCALAR); |
449 | count = call_sv (mc->prepare, G_SCALAR); |
286 | SPAGAIN; |
450 | SPAGAIN; |
287 | |
451 | |
288 | if (count != 1) |
452 | if (count != 1) |
289 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
453 | croak ("sql_exec: unable to prepare() statement '%s': %s", |
290 | SvPV (sql, dc), |
454 | SvPV (sql, dc), |
291 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
455 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
292 | |
456 | |
293 | sth = POPs; |
457 | sth = POPs; |
294 | |
458 | |
|
|
459 | if (!SvROK (sth)) |
|
|
460 | croak ("sql_exec: buggy DBD driver, prepare returned non-reference for '%s': %s", |
|
|
461 | SvPV (sql, dc), |
|
|
462 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
|
|
463 | |
|
|
464 | mc = mc_find (SvSTASH (SvRV (sth))); |
|
|
465 | |
|
|
466 | if (!mc->bind_param) |
|
|
467 | { |
|
|
468 | mc_cache (mc, bind_param); |
|
|
469 | mc_cache (mc, execute); |
|
|
470 | mc_cache (mc, finish); |
|
|
471 | } |
|
|
472 | |
|
|
473 | if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE) |
295 | lru_store (dbh, sql, sth); |
474 | lru_store (dbh, sql, sth, mc); |
|
|
475 | |
|
|
476 | /* on first execution we unfortunately need to use bind_param |
|
|
477 | * to mark any numeric parameters as such. |
|
|
478 | */ |
|
|
479 | SvIV_set (tmp_iv, 0); |
|
|
480 | |
|
|
481 | while (items > arg) |
|
|
482 | { |
|
|
483 | SV *sv = ST (arg); |
|
|
484 | /* we sv_mortalcopy magical values since DBI seems to have a memory |
|
|
485 | * leak when magical values are passed into execute(). |
|
|
486 | */ |
|
|
487 | |
|
|
488 | PUSHMARK (SP); |
|
|
489 | EXTEND (SP, 4); |
|
|
490 | PUSHs (sth); |
|
|
491 | SvIVX (tmp_iv)++; |
|
|
492 | SvIOK_only (tmp_iv); |
|
|
493 | PUSHs (tmp_iv); |
|
|
494 | PUSHs (sv); |
|
|
495 | |
|
|
496 | PUSHs ( |
|
|
497 | SvPOKp (sv) ? sql_varchar |
|
|
498 | : SvNOKp (sv) ? sql_double |
|
|
499 | : SvIOKp (sv) ? sql_integer |
|
|
500 | : sql_varchar |
|
|
501 | ); |
|
|
502 | |
|
|
503 | PUTBACK; |
|
|
504 | call_sv (mc->bind_param, G_VOID); |
|
|
505 | SPAGAIN; |
|
|
506 | |
|
|
507 | arg++; |
|
|
508 | } |
|
|
509 | |
|
|
510 | /* now use execute without any arguments */ |
|
|
511 | PUSHMARK (SP); |
|
|
512 | XPUSHs (sth); |
|
|
513 | } |
|
|
514 | else |
296 | } |
515 | { |
|
|
516 | sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
|
|
517 | mc = lru->mc; |
297 | |
518 | |
|
|
519 | /* we have previously executed this statement, so we |
|
|
520 | * use the cached types and use execute with arguments. |
|
|
521 | */ |
|
|
522 | |
298 | PUSHMARK (SP); |
523 | PUSHMARK (SP); |
299 | EXTEND (SP, items - arg + 1); |
524 | EXTEND (SP, items - arg + 1); |
300 | PUSHs (sth); |
525 | PUSHs (sth); |
301 | while (items > arg) |
526 | while (items > arg) |
302 | { |
527 | { |
303 | PUSHs (maybe_upgrade_utf8 (ix & 1, ST(arg))); |
528 | SV *sv = ST (arg); |
|
|
529 | PUSHs (sv); |
304 | arg++; |
530 | arg++; |
|
|
531 | } |
305 | } |
532 | } |
306 | |
533 | |
307 | PUTBACK; |
534 | PUTBACK; |
308 | /* { static GV *execute; |
535 | /* { static GV *execute; |
309 | if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
536 | if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
310 | count = call_sv(GvCV(execute), G_SCALAR); |
537 | count = call_sv(GvCV(execute), G_SCALAR); |
311 | }*/ |
538 | }*/ |
312 | count = call_sv (sv_execute, G_METHOD | G_SCALAR); |
539 | count = call_sv (mc->execute, G_SCALAR); |
313 | SPAGAIN; |
540 | SPAGAIN; |
314 | |
541 | |
315 | if (count != 1) |
542 | if (count != 1) |
316 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
543 | croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
317 | SvPV (sql, dc), |
544 | SvPV (sql, dc), |
… | |
… | |
322 | if (!SvTRUE (execute)) |
549 | if (!SvTRUE (execute)) |
323 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
550 | croak ("sql_exec: unable to execute statement '%s' (%s)", |
324 | SvPV (sql, dc), |
551 | SvPV (sql, dc), |
325 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
552 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
326 | |
553 | |
327 | sv_setsv (GvSV(sql_exec), execute); |
554 | sv_setsv (GvSV (sql_exec), execute); |
328 | |
555 | |
329 | if (bind_first != bind_last) |
556 | if (bind_first != bind_last) |
330 | { |
557 | { |
331 | PUSHMARK (SP); |
558 | PUSHMARK (SP); |
332 | EXTEND (SP, bind_last - bind_first + 2); |
559 | EXTEND (SP, bind_last - bind_first + 2); |
333 | PUSHs (sth); |
560 | PUSHs (sth); |
334 | do { |
561 | do { |
|
|
562 | #if CAN_UTF8 |
|
|
563 | if (ix & 1) |
|
|
564 | SvUTF8_on (SvRV(ST(bind_first))); |
|
|
565 | #endif |
335 | PUSHs (ST(bind_first)); |
566 | PUSHs (ST(bind_first)); |
336 | bind_first++; |
567 | bind_first++; |
337 | } while (bind_first != bind_last); |
568 | } while (bind_first != bind_last); |
338 | |
569 | |
339 | PUTBACK; |
570 | PUTBACK; |
|
|
571 | |
|
|
572 | if (!mc->bind_columns) |
|
|
573 | mc_cache (mc, bind_columns); |
|
|
574 | |
340 | count = call_sv (sv_bind_columns, G_METHOD | G_SCALAR); |
575 | count = call_sv (mc->bind_columns, G_SCALAR); |
|
|
576 | |
341 | SPAGAIN; |
577 | SPAGAIN; |
342 | |
578 | |
343 | if (count != 1) |
579 | if (count != 1) |
344 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
580 | croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
345 | SvPV (sql, dc), |
581 | SvPV (sql, dc), |
346 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
582 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
347 | |
583 | |
348 | if (!SvOK (POPs)) |
584 | if (!SvOK (TOPs)) |
349 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
585 | croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
350 | SvPV (sql, dc), |
586 | SvPV (sql, dc), |
351 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
587 | SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
|
|
588 | |
|
|
589 | POPs; |
|
|
590 | } |
|
|
591 | |
|
|
592 | if ((ix & ~1) == 2) /* sql_fetch */ |
352 | } |
593 | { |
353 | |
|
|
354 | /* free our arguments from the stack */ |
|
|
355 | SP -= items; |
|
|
356 | |
|
|
357 | if ((ix & ~1) == 2) |
|
|
358 | { /* sql_fetch */ |
|
|
359 | SV *row; |
594 | SV *row; |
360 | |
595 | |
361 | PUSHMARK (SP); |
596 | PUSHMARK (SP); |
362 | XPUSHs (sth); |
597 | XPUSHs (sth); |
363 | PUTBACK; |
598 | PUTBACK; |
|
|
599 | |
|
|
600 | if (!mc->fetchrow_arrayref) |
|
|
601 | mc_cache (mc, fetchrow_arrayref); |
|
|
602 | |
364 | count = call_sv (sv_fetchrow_arrayref, G_METHOD | G_SCALAR); |
603 | count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
365 | SPAGAIN; |
604 | SPAGAIN; |
366 | |
605 | |
367 | if (count != 1) |
606 | if (count != 1) |
368 | abort (); |
607 | abort (); |
369 | |
608 | |
370 | row = POPs; |
609 | row = POPs; |
|
|
610 | |
|
|
611 | SP = PL_stack_base + orig_stack; |
371 | |
612 | |
372 | if (SvROK (row)) |
613 | if (SvROK (row)) |
373 | { |
614 | { |
374 | AV *av; |
615 | AV *av; |
375 | |
616 | |
… | |
… | |
378 | case G_VOID: |
619 | case G_VOID: |
379 | /* no thing */ |
620 | /* no thing */ |
380 | break; |
621 | break; |
381 | case G_SCALAR: |
622 | case G_SCALAR: |
382 | /* the first element */ |
623 | /* the first element */ |
383 | XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
624 | XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (row))[0])); |
|
|
625 | count = 1; |
384 | break; |
626 | break; |
385 | case G_ARRAY: |
627 | case G_ARRAY: |
386 | av = (AV *)SvRV (row); |
628 | av = (AV *)SvRV (row); |
387 | count = AvFILL (av) + 1; |
629 | count = AvFILL (av) + 1; |
388 | EXTEND (SP, count); |
630 | EXTEND (SP, count); |
… | |
… | |
393 | default: |
635 | default: |
394 | abort (); |
636 | abort (); |
395 | } |
637 | } |
396 | } |
638 | } |
397 | } |
639 | } |
398 | else if ((ix & ~1) == 4) |
640 | else if ((ix & ~1) == 4) /* sql_fetchall */ |
399 | { /* sql_fetchall */ |
641 | { |
400 | SV *rows; |
642 | SV *rows; |
401 | |
643 | |
402 | PUSHMARK (SP); |
644 | PUSHMARK (SP); |
403 | XPUSHs (sth); |
645 | XPUSHs (sth); |
404 | PUTBACK; |
646 | PUTBACK; |
|
|
647 | |
|
|
648 | if (!mc->fetchall_arrayref) |
|
|
649 | mc_cache (mc, fetchall_arrayref); |
|
|
650 | |
405 | count = call_sv (sv_fetchall_arrayref, G_METHOD | G_SCALAR); |
651 | count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
406 | SPAGAIN; |
652 | SPAGAIN; |
407 | |
653 | |
408 | if (count != 1) |
654 | if (count != 1) |
409 | abort (); |
655 | abort (); |
410 | |
656 | |
411 | rows = POPs; |
657 | rows = POPs; |
|
|
658 | |
|
|
659 | SP = PL_stack_base + orig_stack; |
412 | |
660 | |
413 | if (SvROK (rows)) |
661 | if (SvROK (rows)) |
414 | { |
662 | { |
415 | AV *av = (AV *)SvRV (rows); |
663 | AV *av = (AV *)SvRV (rows); |
416 | count = AvFILL (av) + 1; |
664 | count = AvFILL (av) + 1; |
… | |
… | |
428 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
676 | PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
429 | } |
677 | } |
430 | } |
678 | } |
431 | } |
679 | } |
432 | else |
680 | else |
|
|
681 | { |
|
|
682 | SP = PL_stack_base + orig_stack; |
433 | XPUSHs (sth); |
683 | XPUSHs (sth); |
|
|
684 | } |
434 | |
685 | |
435 | if (ix > 1 || GIMME_V == G_VOID) |
686 | if (ix >= 2 || GIMME_V == G_VOID) |
436 | { |
687 | { |
|
|
688 | orig_stack = SP - PL_stack_base; |
|
|
689 | |
437 | PUSHMARK (SP); |
690 | PUSHMARK (SP); |
438 | XPUSHs (sth); |
691 | XPUSHs (sth); |
439 | PUTBACK; |
692 | PUTBACK; |
|
|
693 | |
|
|
694 | if (!mc->finish) |
|
|
695 | mc_cache (mc, finish); |
|
|
696 | |
440 | (void) call_sv (sv_finish, G_METHOD | G_DISCARD); |
697 | call_sv (mc->finish, G_DISCARD); |
441 | SPAGAIN; |
698 | SPAGAIN; |
|
|
699 | |
|
|
700 | SP = PL_stack_base + orig_stack; |
442 | } |
701 | } |
443 | } |
702 | } |
444 | } |
703 | } |
445 | |
704 | |
446 | |
705 | |