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 |
|
|
croak ("%s: method not found in stash, pelase report.", name); |
150 |
|
|
} |
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 |
|
|
STRLEN i, l; |
181 |
|
|
char *b = SvPV (sql, l); |
182 |
root |
1.26 |
U32 hash = 2166136261U; |
183 |
root |
1.24 |
|
184 |
|
|
hash = (hash ^ (U32)dbh) * 16777619U; |
185 |
|
|
hash = (hash ^ l) * 16777619U; |
186 |
|
|
|
187 |
|
|
for (i = 7; i < l; i += i >> 2) |
188 |
|
|
hash = (hash ^ b [i]) * 16777619U; |
189 |
|
|
|
190 |
|
|
return hash; |
191 |
|
|
} |
192 |
root |
1.1 |
|
193 |
|
|
/* fetch and "use" */ |
194 |
root |
1.24 |
static lru_node * |
195 |
root |
1.22 |
lru_fetch (SV *dbh, SV *sql) |
196 |
root |
1.1 |
{ |
197 |
|
|
lru_node *n; |
198 |
|
|
U32 hash; |
199 |
|
|
|
200 |
|
|
dbh = SvRV (dbh); |
201 |
root |
1.24 |
hash = lru_hash (dbh, sql); |
202 |
root |
1.1 |
|
203 |
|
|
n = &lru_list; |
204 |
|
|
do { |
205 |
|
|
n = n->next; |
206 |
root |
1.22 |
|
207 |
root |
1.1 |
if (!n->hash) |
208 |
|
|
return 0; |
209 |
|
|
} while (n->hash != hash |
210 |
root |
1.22 |
|| DBI_STH_ACTIVE (n->sth_imp) |
211 |
root |
1.1 |
|| !sv_eq (n->sql, sql) |
212 |
|
|
|| n->dbh != dbh); |
213 |
|
|
|
214 |
|
|
/* found, so return to the start of the list */ |
215 |
|
|
n->prev->next = n->next; |
216 |
|
|
n->next->prev = n->prev; |
217 |
|
|
|
218 |
|
|
n->next = lru_list.next; |
219 |
|
|
n->prev = &lru_list; |
220 |
|
|
lru_list.next->prev = n; |
221 |
|
|
lru_list.next = n; |
222 |
|
|
|
223 |
root |
1.24 |
return n; |
224 |
root |
1.1 |
} |
225 |
|
|
|
226 |
root |
1.22 |
static void |
227 |
|
|
lru_trim (void) |
228 |
root |
1.1 |
{ |
229 |
root |
1.22 |
while (lru_size > lru_maxsize) |
230 |
|
|
{ |
231 |
|
|
/* nuke at the end */ |
232 |
|
|
lru_node *n = lru_list.prev; |
233 |
root |
1.1 |
|
234 |
root |
1.22 |
n = lru_list.prev; |
235 |
root |
1.1 |
|
236 |
root |
1.22 |
lru_list.prev = n->prev; |
237 |
|
|
n->prev->next = &lru_list; |
238 |
root |
1.1 |
|
239 |
root |
1.22 |
SvREFCNT_dec (n->dbh); |
240 |
|
|
SvREFCNT_dec (n->sql); |
241 |
|
|
SvREFCNT_dec (n->sth); |
242 |
|
|
Safefree (n); |
243 |
|
|
|
244 |
|
|
lru_size--; |
245 |
|
|
} |
246 |
root |
1.1 |
} |
247 |
|
|
|
248 |
|
|
/* store a not-yet existing entry(!) */ |
249 |
root |
1.22 |
static void |
250 |
root |
1.24 |
lru_store (SV *dbh, SV *sql, SV *sth, mc_node *mc) |
251 |
root |
1.1 |
{ |
252 |
|
|
lru_node *n; |
253 |
|
|
U32 hash; |
254 |
|
|
|
255 |
root |
1.22 |
if (!lru_maxsize) |
256 |
|
|
return; |
257 |
|
|
|
258 |
root |
1.1 |
dbh = SvRV (dbh); |
259 |
root |
1.24 |
hash = lru_hash (dbh, sql); |
260 |
root |
1.1 |
|
261 |
|
|
lru_size++; |
262 |
root |
1.22 |
lru_trim (); |
263 |
root |
1.1 |
|
264 |
|
|
New (0, n, 1, lru_node); |
265 |
|
|
|
266 |
root |
1.22 |
n->hash = hash; |
267 |
|
|
n->dbh = dbh; SvREFCNT_inc (dbh); /* note: this is the dbi hash itself, not the reference */ |
268 |
|
|
n->sql = newSVsv (sql); |
269 |
|
|
n->sth = sth; SvREFCNT_inc (sth); |
270 |
|
|
n->sth_imp = sth_get_imp (sth); |
271 |
root |
1.24 |
n->mc = mc; |
272 |
root |
1.1 |
|
273 |
root |
1.22 |
n->next = lru_list.next; |
274 |
|
|
n->prev = &lru_list; |
275 |
root |
1.1 |
lru_list.next->prev = n; |
276 |
|
|
lru_list.next = n; |
277 |
|
|
} |
278 |
|
|
|
279 |
root |
1.22 |
static void |
280 |
|
|
lru_cachesize (int size) |
281 |
root |
1.1 |
{ |
282 |
|
|
if (size >= 0) |
283 |
|
|
{ |
284 |
|
|
lru_maxsize = size; |
285 |
root |
1.22 |
lru_trim (); |
286 |
root |
1.1 |
} |
287 |
|
|
} |
288 |
|
|
|
289 |
|
|
static GV *sql_exec; |
290 |
|
|
static GV *DBH; |
291 |
root |
1.5 |
|
292 |
|
|
#define newconstpv(str) newSVpvn ((str), sizeof (str)) |
293 |
root |
1.1 |
|
294 |
|
|
MODULE = PApp::SQL PACKAGE = PApp::SQL |
295 |
|
|
|
296 |
|
|
PROTOTYPES: DISABLE |
297 |
|
|
|
298 |
|
|
BOOT: |
299 |
|
|
{ |
300 |
root |
1.22 |
struct dbistate_st *dbis = DBIS_PUBLISHED_LVALUE; |
301 |
|
|
|
302 |
root |
1.23 |
/* this is actually wrong, we should call the check member, apparently */ |
303 |
root |
1.22 |
assert (dbis->version == DBISTATE_VERSION); |
304 |
|
|
assert (dbis->xs_version == DBIXS_VERSION); |
305 |
|
|
|
306 |
root |
1.24 |
tmp_iv = newSViv (0); |
307 |
|
|
|
308 |
root |
1.1 |
sql_exec = gv_fetchpv ("PApp::SQL::sql_exec", TRUE, SVt_PV); |
309 |
|
|
DBH = gv_fetchpv ("PApp::SQL::DBH" , TRUE, SVt_PV); |
310 |
|
|
|
311 |
|
|
/* apache might BOOT: twice :( */ |
312 |
|
|
if (lru_size) |
313 |
|
|
lru_cachesize (0); |
314 |
|
|
|
315 |
root |
1.22 |
lru_init (); |
316 |
root |
1.24 |
lru_cachesize (100); |
317 |
root |
1.1 |
} |
318 |
|
|
|
319 |
root |
1.24 |
void |
320 |
|
|
boot2 (SV *t_str, SV *t_int, SV *t_dbl) |
321 |
|
|
CODE: |
322 |
|
|
sql_varchar = newSVsv (t_str); |
323 |
|
|
sql_integer = newSVsv (t_int); |
324 |
|
|
sql_double = newSVsv (t_dbl); |
325 |
|
|
|
326 |
root |
1.1 |
int |
327 |
|
|
cachesize(size = -1) |
328 |
|
|
int size |
329 |
|
|
CODE: |
330 |
|
|
RETVAL = lru_maxsize; |
331 |
|
|
lru_cachesize (size); |
332 |
|
|
OUTPUT: |
333 |
|
|
RETVAL |
334 |
|
|
|
335 |
|
|
void |
336 |
|
|
sql_exec(...) |
337 |
|
|
ALIAS: |
338 |
root |
1.5 |
sql_uexec = 1 |
339 |
|
|
sql_fetch = 2 |
340 |
|
|
sql_ufetch = 3 |
341 |
|
|
sql_fetchall = 4 |
342 |
|
|
sql_ufetchall = 5 |
343 |
|
|
sql_exists = 6 |
344 |
|
|
sql_uexists = 7 |
345 |
root |
1.1 |
PPCODE: |
346 |
|
|
{ |
347 |
|
|
if (items == 0) |
348 |
|
|
croak ("Usage: sql_exec [database-handle,] [bind-var-refs,... ] \"sql-statement\", [arguments, ...]"); |
349 |
|
|
else |
350 |
|
|
{ |
351 |
root |
1.24 |
int i; |
352 |
root |
1.1 |
int arg = 0; |
353 |
root |
1.24 |
int first_execution = 0; |
354 |
root |
1.1 |
int bind_first, bind_last; |
355 |
|
|
int count; |
356 |
root |
1.24 |
lru_node *lru; |
357 |
root |
1.1 |
SV *dbh = ST(0); |
358 |
|
|
SV *sth; |
359 |
|
|
SV *sql; |
360 |
|
|
SV *execute; |
361 |
root |
1.24 |
mc_node *mc; |
362 |
root |
1.9 |
STRLEN dc, dd; /* dummy */ |
363 |
root |
1.24 |
I32 orig_stack = SP - PL_stack_base; |
364 |
root |
1.1 |
|
365 |
|
|
/* save our arguments against destruction through function calls */ |
366 |
|
|
SP += items; |
367 |
|
|
|
368 |
|
|
/* first check wether we should use an explicit db handle */ |
369 |
|
|
if (!is_dbh (dbh)) |
370 |
|
|
{ |
371 |
root |
1.12 |
/* the next line doesn't work - check why later maybe */ |
372 |
|
|
/* dbh = get_sv ("DBH", FALSE); |
373 |
root |
1.1 |
if (!is_dbh (dbh)) |
374 |
root |
1.12 |
{*/ |
375 |
root |
1.20 |
dbh = GvSV (DBH); |
376 |
root |
1.1 |
if (!is_dbh (dbh)) |
377 |
root |
1.12 |
croak ("sql_exec: no $DBH argument and no fallback in $PApp::SQL::DBH"); |
378 |
|
|
/*croak ("sql_exec: no $DBH found in current package or in PApp::SQL::"); |
379 |
|
|
}*/ |
380 |
root |
1.1 |
} |
381 |
|
|
else |
382 |
|
|
arg++; /* we consumed one argument */ |
383 |
|
|
|
384 |
root |
1.20 |
/* be more Coro-friendly by keeping a copy, so different threads */ |
385 |
root |
1.21 |
/* can replace their global handles */ |
386 |
root |
1.20 |
dbh = sv_2mortal (newSVsv (dbh)); |
387 |
|
|
|
388 |
root |
1.1 |
/* count the remaining references (for bind_columns) */ |
389 |
|
|
bind_first = arg; |
390 |
|
|
while (items > arg && SvROK (ST(arg))) |
391 |
|
|
arg++; |
392 |
|
|
|
393 |
|
|
bind_last = arg; |
394 |
|
|
|
395 |
|
|
/* consume the sql-statement itself */ |
396 |
|
|
if (items <= arg) |
397 |
|
|
croak ("sql_exec: required argument \"sql-statement\" missing"); |
398 |
|
|
|
399 |
|
|
if (!SvPOK (ST(arg))) |
400 |
|
|
croak ("sql_exec: sql-statement must be a string"); |
401 |
|
|
|
402 |
|
|
sql = ST(arg); arg++; |
403 |
|
|
|
404 |
root |
1.5 |
if ((ix & ~1) == 6) |
405 |
root |
1.1 |
{ |
406 |
|
|
SV *neu = sv_2mortal (newSVpv ("select count(*) > 0 from ", 0)); |
407 |
|
|
sv_catsv (neu, sql); |
408 |
|
|
sv_catpv (neu, " limit 1"); |
409 |
|
|
sql = neu; |
410 |
root |
1.7 |
ix -= 4; /* sql_fetch */ |
411 |
root |
1.1 |
} |
412 |
|
|
|
413 |
root |
1.24 |
/* now prepare all parameters, by unmagicalising them and upgrading them */ |
414 |
|
|
for (i = arg; i < items; ++i) |
415 |
|
|
{ |
416 |
|
|
SV *sv = ST (i); |
417 |
|
|
|
418 |
|
|
/* we sv_mortalcopy magical values since DBI seems to have a memory |
419 |
|
|
* leak when magical values are passed into execute(). |
420 |
|
|
*/ |
421 |
|
|
if (SvMAGICAL (sv)) |
422 |
|
|
ST (i) = sv = sv_mortalcopy (sv); |
423 |
|
|
|
424 |
|
|
if ((ix & 1) && SvPOKp (sv) && !SvUTF8 (sv)) |
425 |
|
|
{ |
426 |
|
|
ST (i) = sv = sv_mortalcopy (sv); |
427 |
|
|
sv_utf8_upgrade (sv); |
428 |
|
|
} |
429 |
|
|
} |
430 |
|
|
|
431 |
root |
1.4 |
/* check cache for existing statement handle */ |
432 |
root |
1.24 |
lru = SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE |
433 |
|
|
? lru_fetch (dbh, sql) |
434 |
|
|
: 0; |
435 |
|
|
if (!lru) |
436 |
root |
1.1 |
{ |
437 |
root |
1.24 |
mc = mc_find (SvSTASH (SvRV (dbh))); |
438 |
|
|
|
439 |
|
|
if (!mc->prepare) |
440 |
|
|
mc_cache (mc, prepare); |
441 |
|
|
|
442 |
root |
1.1 |
PUSHMARK (SP); |
443 |
|
|
EXTEND (SP, 2); |
444 |
|
|
PUSHs (dbh); |
445 |
|
|
PUSHs (sql); |
446 |
|
|
PUTBACK; |
447 |
root |
1.24 |
count = call_sv (mc->prepare, G_SCALAR); |
448 |
root |
1.1 |
SPAGAIN; |
449 |
|
|
|
450 |
|
|
if (count != 1) |
451 |
|
|
croak ("sql_exec: unable to prepare() statement '%s': %s", |
452 |
root |
1.3 |
SvPV (sql, dc), |
453 |
root |
1.9 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
454 |
root |
1.1 |
|
455 |
|
|
sth = POPs; |
456 |
|
|
|
457 |
root |
1.25 |
if (!SvROK (sth)) |
458 |
|
|
croak ("sql_exec: buggy DBD driver, prepare returned non-reference for '%s': %s", |
459 |
|
|
SvPV (sql, dc), |
460 |
|
|
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
461 |
|
|
|
462 |
root |
1.24 |
mc = mc_find (SvSTASH (SvRV (sth))); |
463 |
|
|
|
464 |
|
|
if (!mc->bind_param) |
465 |
|
|
{ |
466 |
|
|
mc_cache (mc, bind_param); |
467 |
|
|
mc_cache (mc, execute); |
468 |
|
|
mc_cache (mc, finish); |
469 |
|
|
} |
470 |
|
|
|
471 |
|
|
if (SvCUR (sql) <= MAX_CACHED_STATEMENT_SIZE) |
472 |
|
|
lru_store (dbh, sql, sth, mc); |
473 |
|
|
|
474 |
|
|
/* on first execution we unfortunately need to use bind_param |
475 |
|
|
* to mark any numeric parameters as such. |
476 |
|
|
*/ |
477 |
|
|
SvIV_set (tmp_iv, 0); |
478 |
|
|
|
479 |
|
|
while (items > arg) |
480 |
|
|
{ |
481 |
|
|
SV *sv = ST (arg); |
482 |
|
|
/* we sv_mortalcopy magical values since DBI seems to have a memory |
483 |
|
|
* leak when magical values are passed into execute(). |
484 |
|
|
*/ |
485 |
|
|
|
486 |
|
|
PUSHMARK (SP); |
487 |
|
|
EXTEND (SP, 4); |
488 |
|
|
PUSHs (sth); |
489 |
|
|
SvIVX (tmp_iv)++; |
490 |
|
|
PUSHs (tmp_iv); |
491 |
|
|
PUSHs (sv); |
492 |
|
|
|
493 |
|
|
PUSHs ( |
494 |
|
|
SvPOKp (sv) ? sql_varchar |
495 |
|
|
: SvNOKp (sv) ? sql_double |
496 |
|
|
: SvIOKp (sv) ? sql_integer |
497 |
|
|
: sql_varchar |
498 |
|
|
); |
499 |
|
|
|
500 |
|
|
PUTBACK; |
501 |
|
|
call_sv (mc->bind_param, G_VOID); |
502 |
|
|
SPAGAIN; |
503 |
|
|
|
504 |
|
|
arg++; |
505 |
|
|
} |
506 |
|
|
|
507 |
|
|
/* now use execute without any arguments */ |
508 |
|
|
PUSHMARK (SP); |
509 |
|
|
EXTEND (SP, 1); |
510 |
|
|
PUSHs (sth); |
511 |
root |
1.1 |
} |
512 |
root |
1.24 |
else |
513 |
|
|
{ |
514 |
|
|
sth = sv_2mortal (SvREFCNT_inc (lru->sth)); |
515 |
|
|
mc = lru->mc; |
516 |
root |
1.1 |
|
517 |
root |
1.24 |
/* we have previously executed this statement, so we |
518 |
|
|
* use the cached types and use execute with arguments. |
519 |
root |
1.15 |
*/ |
520 |
root |
1.24 |
|
521 |
|
|
PUSHMARK (SP); |
522 |
|
|
EXTEND (SP, items - arg + 1); |
523 |
|
|
PUSHs (sth); |
524 |
|
|
while (items > arg) |
525 |
|
|
{ |
526 |
|
|
SV *sv = ST (arg); |
527 |
|
|
PUSHs (ST (arg)); |
528 |
|
|
arg++; |
529 |
|
|
} |
530 |
root |
1.1 |
} |
531 |
|
|
|
532 |
|
|
PUTBACK; |
533 |
|
|
/* { static GV *execute; |
534 |
|
|
if (!execute) execute = gv_fetchmethod_autoload(SvSTASH(SvRV(sth)), "execute", 0); |
535 |
|
|
count = call_sv(GvCV(execute), G_SCALAR); |
536 |
|
|
}*/ |
537 |
root |
1.24 |
count = call_sv (mc->execute, G_SCALAR); |
538 |
root |
1.1 |
SPAGAIN; |
539 |
|
|
|
540 |
|
|
if (count != 1) |
541 |
|
|
croak ("sql_exec: execute() didn't return any value ('%s'): %s", |
542 |
root |
1.3 |
SvPV (sql, dc), |
543 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
544 |
root |
1.1 |
|
545 |
|
|
execute = POPs; |
546 |
|
|
|
547 |
|
|
if (!SvTRUE (execute)) |
548 |
|
|
croak ("sql_exec: unable to execute statement '%s' (%s)", |
549 |
root |
1.3 |
SvPV (sql, dc), |
550 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
551 |
root |
1.1 |
|
552 |
root |
1.24 |
sv_setsv (GvSV (sql_exec), execute); |
553 |
root |
1.1 |
|
554 |
|
|
if (bind_first != bind_last) |
555 |
|
|
{ |
556 |
|
|
PUSHMARK (SP); |
557 |
|
|
EXTEND (SP, bind_last - bind_first + 2); |
558 |
|
|
PUSHs (sth); |
559 |
|
|
do { |
560 |
stefan |
1.16 |
#if CAN_UTF8 |
561 |
root |
1.17 |
if (ix & 1) |
562 |
|
|
SvUTF8_on (SvRV(ST(bind_first))); |
563 |
stefan |
1.16 |
#endif |
564 |
root |
1.1 |
PUSHs (ST(bind_first)); |
565 |
|
|
bind_first++; |
566 |
|
|
} while (bind_first != bind_last); |
567 |
|
|
|
568 |
|
|
PUTBACK; |
569 |
root |
1.24 |
|
570 |
|
|
if (!mc->bind_columns) |
571 |
|
|
mc_cache (mc, bind_columns); |
572 |
|
|
|
573 |
|
|
count = call_sv (mc->bind_columns, G_SCALAR); |
574 |
|
|
|
575 |
root |
1.1 |
SPAGAIN; |
576 |
|
|
|
577 |
|
|
if (count != 1) |
578 |
|
|
croak ("sql_exec: bind_columns() didn't return any value ('%s'): %s", |
579 |
root |
1.3 |
SvPV (sql, dc), |
580 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
581 |
root |
1.1 |
|
582 |
root |
1.19 |
if (!SvOK (TOPs)) |
583 |
root |
1.1 |
croak ("sql_exec: bind_columns() didn't return a true ('%s'): %s", |
584 |
root |
1.3 |
SvPV (sql, dc), |
585 |
root |
1.10 |
SvPV (get_sv ("DBI::errstr", TRUE), dd)); |
586 |
root |
1.19 |
|
587 |
|
|
POPs; |
588 |
root |
1.1 |
} |
589 |
|
|
|
590 |
root |
1.5 |
if ((ix & ~1) == 2) |
591 |
root |
1.1 |
{ /* sql_fetch */ |
592 |
|
|
SV *row; |
593 |
|
|
|
594 |
|
|
PUSHMARK (SP); |
595 |
|
|
XPUSHs (sth); |
596 |
|
|
PUTBACK; |
597 |
root |
1.24 |
|
598 |
|
|
if (!mc->fetchrow_arrayref) |
599 |
|
|
mc_cache (mc, fetchrow_arrayref); |
600 |
|
|
|
601 |
|
|
count = call_sv (mc->fetchrow_arrayref, G_SCALAR); |
602 |
root |
1.1 |
SPAGAIN; |
603 |
|
|
|
604 |
|
|
if (count != 1) |
605 |
|
|
abort (); |
606 |
|
|
|
607 |
|
|
row = POPs; |
608 |
|
|
|
609 |
root |
1.24 |
SP = PL_stack_base + orig_stack; |
610 |
|
|
|
611 |
root |
1.1 |
if (SvROK (row)) |
612 |
|
|
{ |
613 |
|
|
AV *av; |
614 |
|
|
|
615 |
|
|
switch (GIMME_V) |
616 |
|
|
{ |
617 |
|
|
case G_VOID: |
618 |
|
|
/* no thing */ |
619 |
|
|
break; |
620 |
|
|
case G_SCALAR: |
621 |
|
|
/* the first element */ |
622 |
root |
1.13 |
XPUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, *av_fetch ((AV *)SvRV (row), 0, 1))); |
623 |
root |
1.24 |
count = 1; |
624 |
root |
1.1 |
break; |
625 |
|
|
case G_ARRAY: |
626 |
|
|
av = (AV *)SvRV (row); |
627 |
|
|
count = AvFILL (av) + 1; |
628 |
|
|
EXTEND (SP, count); |
629 |
|
|
for (arg = 0; arg < count; arg++) |
630 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
631 |
root |
1.1 |
|
632 |
|
|
break; |
633 |
|
|
default: |
634 |
|
|
abort (); |
635 |
|
|
} |
636 |
|
|
} |
637 |
|
|
} |
638 |
root |
1.5 |
else if ((ix & ~1) == 4) |
639 |
root |
1.1 |
{ /* sql_fetchall */ |
640 |
|
|
SV *rows; |
641 |
|
|
|
642 |
|
|
PUSHMARK (SP); |
643 |
|
|
XPUSHs (sth); |
644 |
|
|
PUTBACK; |
645 |
root |
1.24 |
|
646 |
|
|
if (!mc->fetchall_arrayref) |
647 |
|
|
mc_cache (mc, fetchall_arrayref); |
648 |
|
|
|
649 |
|
|
count = call_sv (mc->fetchall_arrayref, G_SCALAR); |
650 |
root |
1.1 |
SPAGAIN; |
651 |
|
|
|
652 |
|
|
if (count != 1) |
653 |
|
|
abort (); |
654 |
|
|
|
655 |
|
|
rows = POPs; |
656 |
|
|
|
657 |
root |
1.24 |
SP = PL_stack_base + orig_stack; |
658 |
|
|
|
659 |
root |
1.1 |
if (SvROK (rows)) |
660 |
|
|
{ |
661 |
|
|
AV *av = (AV *)SvRV (rows); |
662 |
|
|
count = AvFILL (av) + 1; |
663 |
|
|
|
664 |
|
|
if (count) |
665 |
|
|
{ |
666 |
root |
1.6 |
int columns = AvFILL ((AV *) SvRV (AvARRAY (av)[0])) + 1; /* columns? */ |
667 |
root |
1.1 |
|
668 |
|
|
EXTEND (SP, count); |
669 |
|
|
if (columns == 1) |
670 |
|
|
for (arg = 0; arg < count; arg++) |
671 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY ((AV *)SvRV (AvARRAY (av)[arg]))[0])); |
672 |
root |
1.1 |
else |
673 |
|
|
for (arg = 0; arg < count; arg++) |
674 |
root |
1.13 |
PUSHs (mortalcopy_and_maybe_force_utf8 (ix & 1, AvARRAY (av)[arg])); |
675 |
root |
1.1 |
} |
676 |
|
|
} |
677 |
|
|
} |
678 |
|
|
else |
679 |
root |
1.24 |
{ |
680 |
|
|
SP = PL_stack_base + orig_stack; |
681 |
|
|
XPUSHs (sth); |
682 |
|
|
} |
683 |
root |
1.1 |
|
684 |
root |
1.5 |
if (ix > 1 || GIMME_V == G_VOID) |
685 |
root |
1.1 |
{ |
686 |
root |
1.24 |
orig_stack = SP - PL_stack_base; |
687 |
|
|
|
688 |
root |
1.1 |
PUSHMARK (SP); |
689 |
|
|
XPUSHs (sth); |
690 |
|
|
PUTBACK; |
691 |
root |
1.24 |
|
692 |
|
|
if (!mc->finish) |
693 |
|
|
mc_cache (mc, finish); |
694 |
|
|
|
695 |
|
|
call_sv (mc->finish, G_DISCARD); |
696 |
root |
1.1 |
SPAGAIN; |
697 |
root |
1.24 |
|
698 |
|
|
SP = PL_stack_base + orig_stack; |
699 |
root |
1.1 |
} |
700 |
|
|
} |
701 |
|
|
} |
702 |
|
|
|
703 |
|
|
|
704 |
|
|
|