1 |
root |
1.1 |
#include "EXTERN.h" |
2 |
|
|
#include "perl.h" |
3 |
|
|
#include "XSUB.h" |
4 |
|
|
|
5 |
root |
1.22 |
/* 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 |
root |
1.24 |
#define DBISTATE_ADDRSV (perl_get_sv (DBISTATE_PERLNAME, 0x05)) |
11 |
root |
1.22 |
#define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV)))) |
12 |
|
|
|
13 |
root |
1.24 |
static SV *sql_varchar, *sql_integer, *sql_double; |
14 |
|
|
static SV *tmp_iv; |
15 |
|
|
|
16 |
root |
1.22 |
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 */ |
48 |
|
|
|
49 |
root |
1.3 |
#if (PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION <= 6)) |
50 |
root |
1.5 |
# define get_sv perl_get_sv |
51 |
root |
1.3 |
# define call_method perl_call_method |
52 |
root |
1.5 |
# define call_sv perl_call_sv |
53 |
root |
1.3 |
#endif |
54 |
|
|
|
55 |
root |
1.11 |
#if (PERL_VERSION > 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION >= 6)) |
56 |
root |
1.5 |
# define CAN_UTF8 1 |
57 |
|
|
#endif |
58 |
|
|
|
59 |
root |
1.22 |
#define MAX_CACHED_STATEMENT_SIZE 2048 |
60 |
root |
1.14 |
|
61 |
root |
1.5 |
static SV * |
62 |
|
|
sql_upgrade_utf8 (SV *sv) |
63 |
|
|
{ |
64 |
|
|
#if CAN_UTF8 |
65 |
root |
1.24 |
if (SvPOKp (sv)) |
66 |
root |
1.5 |
sv_utf8_upgrade (sv); |
67 |
|
|
#endif |
68 |
|
|
return sv; |
69 |
|
|
} |
70 |
|
|
|
71 |
|
|
static SV * |
72 |
root |
1.13 |
mortalcopy_and_maybe_force_utf8(int utf8, SV *sv) |
73 |
root |
1.5 |
{ |
74 |
root |
1.13 |
sv = sv_mortalcopy (sv); |
75 |
root |
1.5 |
#if CAN_UTF8 |
76 |
root |
1.24 |
if (utf8 && SvPOKp (sv)) |
77 |
root |
1.5 |
SvUTF8_on (sv); |
78 |
|
|
#endif |
79 |
|
|
return sv; |
80 |
|
|
} |
81 |
|
|
|
82 |
|
|
#define maybe_upgrade_utf8(utf8,sv) ((utf8) ? sql_upgrade_utf8 (sv) : (sv)) |
83 |
|
|
|
84 |
root |
1.2 |
#define is_dbh(sv) ((sv) && sv_isobject (sv) && sv_derived_from ((sv), "DBI::db")) |
85 |
root |
1.1 |
|
86 |
root |
1.24 |
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 |
root |
1.28 |
croak ("%s: method not found in stash, please report.", name); |
150 |
root |
1.24 |
} |
151 |
|
|
|
152 |
|
|
#define mc_cache(mc, method) mc_cache ((mc), &((mc)->method), # method) |
153 |
|
|
|
154 |
|
|
typedef struct lru_node |
155 |
|
|
{ |
156 |
root |
1.1 |
struct lru_node *next; |
157 |
|
|
struct lru_node *prev; |
158 |
root |
1.24 |
|
159 |
|
|
U32 hash; |
160 |
root |
1.1 |
SV *dbh; |
161 |
|
|
SV *sql; |
162 |
|
|
|
163 |
|
|
SV *sth; |
164 |
root |
1.22 |
imp_sth *sth_imp; |
165 |
root |
1.24 |
|
166 |
|
|
mc_node *mc; |
167 |
root |
1.1 |
} lru_node; |
168 |
|
|
|
169 |
|
|
static lru_node lru_list; |
170 |
|
|
static int lru_size; |
171 |
|
|
static int lru_maxsize; |
172 |
|
|
|
173 |
root |
1.22 |
#define lru_init() lru_list.next = &lru_list; lru_list.prev = &lru_list /* other fields are zero */ |
174 |
root |
1.1 |
|
175 |
|
|
/* this is primitive, yet effective */ |
176 |
|
|
/* the returned value must never be zero (or bad things will happen) */ |
177 |
root |
1.24 |
static U32 |
178 |
|
|
lru_hash (SV *dbh, SV *sql) |
179 |
|
|
{ |
180 |
root |
1.31 |
/* use a variant of fnv1a */ |
181 |
root |
1.24 |
STRLEN i, l; |
182 |
|
|
char *b = SvPV (sql, l); |
183 |
root |
1.26 |
U32 hash = 2166136261U; |
184 |
root |
1.24 |
|
185 |
|
|
hash = (hash ^ (U32)dbh) * 16777619U; |
186 |
|
|
hash = (hash ^ l) * 16777619U; |
187 |
|
|
|
188 |
root |
1.31 |
/* start hashing at char 7, as this skips the "select " prefix */ |
189 |
|
|
/* also skip more and more octets */ |
190 |
root |
1.24 |
for (i = 7; i < l; i += i >> 2) |
191 |
root |
1.31 |
hash = (hash ^ b [i]) * 16777619U; |
192 |
root |
1.24 |
|
193 |
|
|
return hash; |
194 |
|
|
} |
195 |
root |
1.1 |
|
196 |
|
|
/* fetch and "use" */ |
197 |
root |
1.24 |
static lru_node * |
198 |
root |
1.22 |
lru_fetch (SV *dbh, SV *sql) |
199 |
root |
1.1 |
{ |
200 |
|
|
lru_node *n; |
201 |
|
|
U32 hash; |
202 |
|
|
|
203 |
|
|
dbh = SvRV (dbh); |
204 |
root |
1.24 |
hash = lru_hash (dbh, sql); |
205 |
root |
1.1 |
|
206 |
|
|
n = &lru_list; |
207 |
|
|
do { |
208 |
|
|
n = n->next; |
209 |
root |
1.22 |
|
210 |
root |
1.1 |
if (!n->hash) |
211 |
|
|
return 0; |
212 |
|
|
} while (n->hash != hash |
213 |
root |
1.22 |
|| DBI_STH_ACTIVE (n->sth_imp) |
214 |
root |
1.1 |
|| !sv_eq (n->sql, sql) |
215 |
|
|
|| n->dbh != dbh); |
216 |
|
|
|
217 |
|
|
/* found, so return to the start of the list */ |
218 |
|
|
n->prev->next = n->next; |
219 |
|
|
n->next->prev = n->prev; |
220 |
|
|
|
221 |
|
|
n->next = lru_list.next; |
222 |
|
|
n->prev = &lru_list; |
223 |
|
|
lru_list.next->prev = n; |
224 |
|
|
lru_list.next = n; |
225 |
|
|
|
226 |
root |
1.24 |
return n; |
227 |
root |
1.1 |
} |
228 |
|
|
|
229 |
root |
1.22 |
static void |
230 |
|
|
lru_trim (void) |
231 |
root |
1.1 |
{ |
232 |
root |
1.22 |
while (lru_size > lru_maxsize) |
233 |
|
|
{ |
234 |
|
|
/* nuke at the end */ |
235 |
|
|
lru_node *n = lru_list.prev; |
236 |
root |
1.1 |
|
237 |
root |
1.22 |
n = lru_list.prev; |
238 |
root |
1.1 |
|
239 |
root |
1.22 |
lru_list.prev = n->prev; |
240 |
|
|
n->prev->next = &lru_list; |
241 |
root |
1.1 |
|
242 |
root |
1.32 |
SvREFCNT_dec_NN (n->dbh); |
243 |
|
|
SvREFCNT_dec_NN (n->sql); |
244 |
|
|
SvREFCNT_dec_NN (n->sth); |
245 |
root |
1.22 |
Safefree (n); |
246 |
|
|
|
247 |
|
|
lru_size--; |
248 |
|
|
} |
249 |
root |
1.1 |
} |
250 |
|
|
|
251 |
|
|
/* store a not-yet existing entry(!) */ |
252 |
root |
1.22 |
static void |
253 |
root |
1.24 |
lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
254 |
root |
1.1 |
{ |
255 |
|
|
lru_node *n; |
256 |
|
|
U32 hash; |
257 |
|
|
|
258 |
root |
1.22 |
if (!lru_maxsize) |
259 |
|
|
return; |
260 |
|
|
|
261 |
root |
1.1 |
dbh = SvRV (dbh); |
262 |
root |
1.24 |
hash = lru_hash (dbh, sql); |
263 |
root |
1.1 |
|
264 |
|
|
lru_size++; |
265 |
root |
1.22 |
lru_trim (); |
266 |
root |
1.1 |
|
267 |
|
|
New (0, n, 1, lru_node); |
268 |
|
|
|
269 |
root |
1.22 |
n->hash = hash; |
270 |
root |
1.32 |
n->dbh = SvREFCNT_inc_NN (dbh); /* note: this is the dbi hash itself, not the reference */ |
271 |
root |
1.22 |
n->sql = newSVsv (sql); |
272 |
root |
1.32 |
n->sth = SvREFCNT_inc_NN (sth); |
273 |
root |
1.22 |
n->sth_imp = sth_get_imp (sth); |
274 |
root |
1.24 |
n->mc = mc; |
275 |
root |
1.1 |
|
276 |
root |
1.22 |
n->next = lru_list.next; |
277 |
|
|
n->prev = &lru_list; |
278 |
root |
1.1 |
lru_list.next->prev = n; |
279 |
|
|
lru_list.next = n; |
280 |
|
|
} |
281 |
|
|
|
282 |
root |
1.22 |
static void |
283 |
|
|
lru_cachesize (int size) |
284 |
root |
1.1 |
{ |
285 |
|
|
if (size >= 0) |
286 |
|
|
{ |
287 |
|
|
lru_maxsize = size; |
288 |
root |
1.22 |
lru_trim (); |
289 |
root |
1.1 |
} |
290 |
|
|
} |
291 |
|
|
|
292 |
|
|
static GV *sql_exec; |
293 |
|
|
static GV *DBH; |
294 |
root |
1.5 |
|
295 |
|
|
#define newconstpv(str) newSVpvn ((str), sizeof (str)) |
296 |
root |
1.1 |
|
297 |
|
|
MODULE = PApp::SQL PACKAGE = PApp::SQL |
298 |
|
|
|
299 |
|
|
PROTOTYPES: DISABLE |
300 |
|
|
|
301 |
|
|
BOOT: |
302 |
|
|
{ |
303 |
root |
1.22 |
struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
304 |
|
|
|
305 |
root |
1.23 |
/* this is actually wrong, we should call the check member, apparently */ |
306 |
root |
1.22 |
assert (dbis->version == DBISTATE_VERSION); |
307 |
|
|
assert (dbis->xs_version == DBIXS_VERSION); |
308 |
|
|
|
309 |
root |
1.24 |
tmp_iv = newSViv (0); |
310 |
|
|
|
311 |
root |
1.1 |
sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
312 |
|
|
DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
313 |
|
|
|
314 |
|
|
/* apache might BOOT: twice :( */ |
315 |
|
|
if (lru_size) |
316 |
|
|
lru_cachesize (0); |
317 |
|
|
|
318 |
root |
1.22 |
lru_init (); |
319 |
root |
1.24 |
lru_cachesize (100); |
320 |
root |
1.1 |
} |
321 |
|
|
|
322 |
root |
1.24 |
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); |
328 |
|
|
|
329 |
root |
1.1 |
int |
330 |
|
|
cachesize(size = -1) |
331 |
|
|
int size |
332 |
|
|
CODE: |
333 |
|
|
RETVAL = lru_maxsize; |
334 |
|
|
lru_cachesize (size); |
335 |
|
|
OUTPUT: |
336 |
|
|
RETVAL |
337 |
|
|
|
338 |
|
|
void |
339 |
|
|
sql_exec(...) |
340 |
|
|
ALIAS: |
341 |
root |
1.5 |
sql_uexec = 1 |
342 |
root |
1.27 |
sql_fetch = 2 |
343 |
root |
1.5 |
sql_ufetch = 3 |
344 |
|
|
sql_fetchall = 4 |
345 |
|
|
sql_ufetchall = 5 |
346 |
|
|
sql_exists = 6 |
347 |
|
|
sql_uexists = 7 |
348 |
root |
1.1 |
PPCODE: |
349 |
|
|
{ |
350 |
|
|
if (items == 0) |
351 |
|
|
croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
352 |
|
|
else |
353 |
|
|
{ |
354 |
root |
1.24 |
int i; |
355 |
root |
1.1 |
int arg = 0; |
356 |
|
|
int bind_first, bind_last; |
357 |
|
|
int count; |
358 |
root |
1.24 |
lru_node *lru; |
359 |
root |
1.1 |
SV *dbh = ST(0); |
360 |
|
|
SV *sth; |
361 |
|
|
SV *sql; |
362 |
|
|
SV *execute; |
363 |
root |
1.24 |
mc_node *mc; |
364 |
root |
1.9 |
STRLEN dc, dd; /* dummy */ |
365 |
root |
1.24 |
I32 orig_stack = SP - PL_stack_base; |
366 |
root |
1.1 |
|
367 |
|
|
/* save our arguments against destruction through function calls */ |
368 |
|
|
SP += items; |
369 |
|
|
|
370 |
|
|
/* first check wether we should use an explicit db handle */ |
371 |
|
|
if (!is_dbh (dbh)) |
372 |
|
|
{ |
373 |
root |
1.12 |
/* the next line doesn't work - check why later maybe */ |
374 |
|
|
/* dbh = get_sv ("DBH", FALSE); |
375 |
root |
1.1 |
if (!is_dbh (dbh)) |
376 |
root |
1.12 |
{*/ |
377 |
root |
1.20 |
dbh = GvSV (DBH); |
378 |
root |
1.1 |
if (!is_dbh (dbh)) |
379 |
root |
1.12 |
croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
380 |
|
|
/*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
381 |
|
|
}*/ |
382 |
root |
1.1 |
} |
383 |
|
|
else |
384 |
|
|
arg++; /* we consumed one argument */ |
385 |
|
|
|
386 |
root |
1.20 |
/* be more Coro-friendly by keeping a copy, so different threads */ |
387 |
root |
1.21 |
/* can replace their global handles */ |
388 |
root |
1.20 |
dbh = sv_2mortal (newSVsv (dbh)); |
389 |
|
|
|
390 |
root |
1.1 |
/* count the remaining references (for bind_columns) */ |
391 |
|
|
bind_first = arg; |
392 |
|
|
while (items > arg && SvROK (ST(arg))) |
393 |
|
|
arg++; |
394 |
|
|
|
395 |
|
|
bind_last = arg; |
396 |
|
|
|
397 |
|
|
/* consume the sql-statement itself */ |
398 |
|
|
if (items <= arg) |
399 |
|
|
croak ("sql_exec: required argument \"sql-statement\" missing"); |
400 |
|
|
|
401 |
|
|
if (!SvPOK (ST(arg))) |
402 |
|
|
croak ("sql_exec: sql-statement must be a string"); |
403 |
|
|
|
404 |
|
|
sql = ST(arg); arg++; |
405 |
|
|
|
406 |
root |
1.32 |
if ((ix & ~1) == 6) /* sql_exists */ |
407 |
root |
1.1 |
{ |
408 |
|
|
SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
409 |
|
|
sv_catsv (neu, sql); |
410 |
|
|
sv_catpv (neu, " limit 1"); |
411 |
|
|
sql = neu; |
412 |
root |
1.7 |
ix -= 4; /* sql_fetch */ |
413 |
root |
1.1 |
} |
414 |
|
|
|
415 |
root |
1.24 |
/* 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 |
|
|
|
433 |
root |
1.4 |
/* check cache for existing statement handle */ |
434 |
root |
1.24 |
lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE |
435 |
|
|
? lru_fetch (dbh, sql) |
436 |
|
|
: 0; |
437 |
|
|
if (!lru) |
438 |
root |
1.1 |
{ |
439 |
root |
1.24 |
mc = mc_find (SvSTASH (SvRV (dbh))); |
440 |
|
|
|
441 |
|
|
if (!mc->prepare) |
442 |
|
|
mc_cache (mc, prepare); |
443 |
|
|
|
444 |
root |
1.1 |
PUSHMARK (SP); |
445 |
|
|
EXTEND (SP, 2); |
446 |
|
|
PUSHs (dbh); |
447 |
|
|
PUSHs (sql); |
448 |
|
|
PUTBACK; |
449 |
root |
1.24 |
count = call_sv (mc->prepare, G_SCALAR); |
450 |
root |
1.1 |
SPAGAIN; |
451 |
|
|
|
452 |
|
|
if (count != 1) |
453 |
|
|
croak ("sql_exec: unable to prepare() statement '%s': %s", |
454 |
root |
1.3 |
SvPV (sql, dc), |
455 |
root |
1.9 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
456 |
root |
1.1 |
|
457 |
|
|
sth = POPs; |
458 |
|
|
|
459 |
root |
1.25 |
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 |
root |
1.24 |
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) |
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 |
root |
1.29 |
SvIOK_only (tmp_iv); |
493 |
root |
1.24 |
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 |
root |
1.32 |
XPUSHs (sth); |
513 |
root |
1.1 |
} |
514 |
root |
1.24 |
else |
515 |
|
|
{ |
516 |
|
|
sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
517 |
|
|
mc = lru->mc; |
518 |
root |
1.1 |
|
519 |
root |
1.24 |
/* we have previously executed this statement, so we |
520 |
|
|
* use the cached types and use execute with arguments. |
521 |
root |
1.15 |
*/ |
522 |
root |
1.24 |
|
523 |
|
|
PUSHMARK (SP); |
524 |
|
|
EXTEND (SP, items - arg + 1); |
525 |
|
|
PUSHs (sth); |
526 |
|
|
while (items > arg) |
527 |
|
|
{ |
528 |
|
|
SV *sv = ST (arg); |
529 |
root |
1.27 |
PUSHs (sv); |
530 |
root |
1.24 |
arg++; |
531 |
|
|
} |
532 |
root |
1.1 |
} |
533 |
|
|
|
534 |
|
|
PUTBACK; |
535 |
|
|
/* { static GV *execute; |
536 |
|
|
if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
537 |
|
|
count = call_sv(GvCV(execute), G_SCALAR); |
538 |
|
|
}*/ |
539 |
root |
1.24 |
count = call_sv (mc->execute, G_SCALAR); |
540 |
root |
1.1 |
SPAGAIN; |
541 |
|
|
|
542 |
|
|
if (count != 1) |
543 |
|
|
croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
544 |
root |
1.3 |
SvPV (sql, dc), |
545 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
546 |
root |
1.1 |
|
547 |
|
|
execute = POPs; |
548 |
|
|
|
549 |
|
|
if (!SvTRUE (execute)) |
550 |
|
|
croak ("sql_exec: unable to execute statement '%s' (%s)", |
551 |
root |
1.3 |
SvPV (sql, dc), |
552 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
553 |
root |
1.1 |
|
554 |
root |
1.24 |
sv_setsv (GvSV (sql_exec), execute); |
555 |
root |
1.1 |
|
556 |
|
|
if (bind_first != bind_last) |
557 |
|
|
{ |
558 |
|
|
PUSHMARK (SP); |
559 |
|
|
EXTEND (SP, bind_last - bind_first + 2); |
560 |
|
|
PUSHs (sth); |
561 |
|
|
do { |
562 |
stefan |
1.16 |
#if CAN_UTF8 |
563 |
root |
1.17 |
if (ix & 1) |
564 |
|
|
SvUTF8_on (SvRV(ST(bind_first))); |
565 |
stefan |
1.16 |
#endif |
566 |
root |
1.1 |
PUSHs (ST(bind_first)); |
567 |
|
|
bind_first++; |
568 |
|
|
} while (bind_first != bind_last); |
569 |
|
|
|
570 |
|
|
PUTBACK; |
571 |
root |
1.24 |
|
572 |
|
|
if (!mc->bind_columns) |
573 |
|
|
mc_cache (mc, bind_columns); |
574 |
|
|
|
575 |
|
|
count = call_sv (mc->bind_columns, G_SCALAR); |
576 |
|
|
|
577 |
root |
1.1 |
SPAGAIN; |
578 |
|
|
|
579 |
|
|
if (count != 1) |
580 |
|
|
croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
581 |
root |
1.3 |
SvPV (sql, dc), |
582 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
583 |
root |
1.1 |
|
584 |
root |
1.19 |
if (!SvOK (TOPs)) |
585 |
root |
1.1 |
croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
586 |
root |
1.3 |
SvPV (sql, dc), |
587 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
588 |
root |
1.19 |
|
589 |
|
|
POPs; |
590 |
root |
1.1 |
} |
591 |
|
|
|
592 |
root |
1.32 |
if ((ix & ~1) == 2) /* sql_fetch */ |
593 |
|
|
{ |
594 |
root |
1.1 |
SV *row; |
595 |
|
|
|
596 |
|
|
PUSHMARK (SP); |
597 |
|
|
XPUSHs (sth); |
598 |
|
|
PUTBACK; |
599 |
root |
1.24 |
|
600 |
|
|
if (!mc->fetchrow_arrayref) |
601 |
|
|
mc_cache (mc, fetchrow_arrayref); |
602 |
|
|
|
603 |
|
|
count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
604 |
root |
1.1 |
SPAGAIN; |
605 |
|
|
|
606 |
|
|
if (count != 1) |
607 |
|
|
abort (); |
608 |
|
|
|
609 |
|
|
row = POPs; |
610 |
|
|
|
611 |
root |
1.24 |
SP = PL_stack_base + orig_stack; |
612 |
|
|
|
613 |
root |
1.1 |
if (SvROK (row)) |
614 |
|
|
{ |
615 |
|
|
AV *av; |
616 |
|
|
|
617 |
|
|
switch (GIMME_V) |
618 |
|
|
{ |
619 |
|
|
case G_VOID: |
620 |
|
|
/* no thing */ |
621 |
|
|
break; |
622 |
|
|
case G_SCALAR: |
623 |
|
|
/* the first element */ |
624 |
root |
1.29 |
XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (row))[0])); |
625 |
root |
1.24 |
count = 1; |
626 |
root |
1.1 |
break; |
627 |
|
|
case G_ARRAY: |
628 |
|
|
av = (AV *)SvRV (row); |
629 |
|
|
count = AvFILL (av) + 1; |
630 |
|
|
EXTEND (SP, count); |
631 |
|
|
for (arg = 0; arg < count; arg++) |
632 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
633 |
root |
1.1 |
|
634 |
|
|
break; |
635 |
|
|
default: |
636 |
|
|
abort (); |
637 |
|
|
} |
638 |
|
|
} |
639 |
|
|
} |
640 |
root |
1.32 |
else if ((ix & ~1) == 4) /* sql_fetchall */ |
641 |
|
|
{ |
642 |
root |
1.1 |
SV *rows; |
643 |
|
|
|
644 |
|
|
PUSHMARK (SP); |
645 |
|
|
XPUSHs (sth); |
646 |
|
|
PUTBACK; |
647 |
root |
1.24 |
|
648 |
|
|
if (!mc->fetchall_arrayref) |
649 |
|
|
mc_cache (mc, fetchall_arrayref); |
650 |
|
|
|
651 |
|
|
count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
652 |
root |
1.1 |
SPAGAIN; |
653 |
|
|
|
654 |
|
|
if (count != 1) |
655 |
|
|
abort (); |
656 |
|
|
|
657 |
|
|
rows = POPs; |
658 |
|
|
|
659 |
root |
1.24 |
SP = PL_stack_base + orig_stack; |
660 |
|
|
|
661 |
root |
1.1 |
if (SvROK (rows)) |
662 |
|
|
{ |
663 |
|
|
AV *av = (AV *)SvRV (rows); |
664 |
|
|
count = AvFILL (av) + 1; |
665 |
|
|
|
666 |
|
|
if (count) |
667 |
|
|
{ |
668 |
root |
1.6 |
int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
669 |
root |
1.1 |
|
670 |
|
|
EXTEND (SP, count); |
671 |
|
|
if (columns == 1) |
672 |
|
|
for (arg = 0; arg < count; arg++) |
673 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
674 |
root |
1.1 |
else |
675 |
|
|
for (arg = 0; arg < count; arg++) |
676 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
677 |
root |
1.1 |
} |
678 |
|
|
} |
679 |
|
|
} |
680 |
|
|
else |
681 |
root |
1.24 |
{ |
682 |
|
|
SP = PL_stack_base + orig_stack; |
683 |
|
|
XPUSHs (sth); |
684 |
|
|
} |
685 |
root |
1.1 |
|
686 |
root |
1.32 |
if (ix >= 2 || GIMME_V == G_VOID) |
687 |
root |
1.1 |
{ |
688 |
root |
1.24 |
orig_stack = SP - PL_stack_base; |
689 |
|
|
|
690 |
root |
1.1 |
PUSHMARK (SP); |
691 |
|
|
XPUSHs (sth); |
692 |
|
|
PUTBACK; |
693 |
root |
1.24 |
|
694 |
|
|
if (!mc->finish) |
695 |
|
|
mc_cache (mc, finish); |
696 |
|
|
|
697 |
|
|
call_sv (mc->finish, G_DISCARD); |
698 |
root |
1.1 |
SPAGAIN; |
699 |
root |
1.24 |
|
700 |
|
|
SP = PL_stack_base + orig_stack; |
701 |
root |
1.1 |
} |
702 |
|
|
} |
703 |
|
|
} |
704 |
|
|
|
705 |
|
|
|
706 |
|
|
|