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