line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
/* vim: ts=8:sw=4:expandtab |
2
|
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
|
* $Id$ |
4
|
|
|
|
|
|
|
* |
5
|
|
|
|
|
|
|
* Copyright (c) 1994-2012 Tim Bunce Ireland. |
6
|
|
|
|
|
|
|
* |
7
|
|
|
|
|
|
|
* See COPYRIGHT section in DBI.pm for usage and distribution rights. |
8
|
|
|
|
|
|
|
*/ |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#define IN_DBI_XS 1 /* see DBIXS.h */ |
11
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#include "DBIXS.h" /* DBI public interface for DBD's written in C */ |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# if (defined(_WIN32) && (! defined(HAS_GETTIMEOFDAY))) |
16
|
|
|
|
|
|
|
#include |
17
|
|
|
|
|
|
|
# endif |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
/* The XS dispatcher code can optimize calls to XS driver methods, |
20
|
|
|
|
|
|
|
* bypassing the usual call_sv() and argument handling overheads. |
21
|
|
|
|
|
|
|
* Just-in-case it causes problems there's an (undocumented) way |
22
|
|
|
|
|
|
|
* to disable it by setting an env var. |
23
|
|
|
|
|
|
|
*/ |
24
|
|
|
|
|
|
|
static int use_xsbypass = 1; /* set in dbi_bootinit() */ |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#ifndef CvISXSUB |
27
|
|
|
|
|
|
|
#define CvISXSUB(sv) CvXSUB(sv) |
28
|
|
|
|
|
|
|
#endif |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#define DBI_MAGIC '~' |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
/* HvMROMETA introduced in 5.9.5, but mro_meta_init not exported in 5.10.0 */ |
33
|
|
|
|
|
|
|
#if (PERL_VERSION < 10) |
34
|
|
|
|
|
|
|
# define MY_cache_gen(stash) 0 |
35
|
|
|
|
|
|
|
#else |
36
|
|
|
|
|
|
|
# if ((PERL_VERSION == 10) && (PERL_SUBVERSION == 0)) |
37
|
|
|
|
|
|
|
# define MY_cache_gen(stash) \ |
38
|
|
|
|
|
|
|
(HvAUX(stash)->xhv_mro_meta \ |
39
|
|
|
|
|
|
|
? HvAUX(stash)->xhv_mro_meta->cache_gen \ |
40
|
|
|
|
|
|
|
: 0) |
41
|
|
|
|
|
|
|
# else |
42
|
|
|
|
|
|
|
# define MY_cache_gen(stash) HvMROMETA(stash)->cache_gen |
43
|
|
|
|
|
|
|
# endif |
44
|
|
|
|
|
|
|
#endif |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
/* If the tests fail with errors about 'setlinebuf' then try */ |
47
|
|
|
|
|
|
|
/* deleting the lines in the block below except the setvbuf one */ |
48
|
|
|
|
|
|
|
#ifndef PerlIO_setlinebuf |
49
|
|
|
|
|
|
|
#ifdef HAS_SETLINEBUF |
50
|
|
|
|
|
|
|
#define PerlIO_setlinebuf(f) setlinebuf(f) |
51
|
|
|
|
|
|
|
#else |
52
|
|
|
|
|
|
|
#ifndef USE_PERLIO |
53
|
|
|
|
|
|
|
#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0) |
54
|
|
|
|
|
|
|
#endif |
55
|
|
|
|
|
|
|
#endif |
56
|
|
|
|
|
|
|
#endif |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
#ifndef CopFILEGV |
59
|
|
|
|
|
|
|
# define CopFILEGV(cop) cop->cop_filegv |
60
|
|
|
|
|
|
|
# define CopLINE(cop) cop->cop_line |
61
|
|
|
|
|
|
|
# define CopSTASH(cop) cop->cop_stash |
62
|
|
|
|
|
|
|
# define CopSTASHPV(cop) (CopSTASH(cop) ? HvNAME(CopSTASH(cop)) : Nullch) |
63
|
|
|
|
|
|
|
#endif |
64
|
|
|
|
|
|
|
#ifndef PERL_GET_THX |
65
|
|
|
|
|
|
|
#define PERL_GET_THX ((void*)0) |
66
|
|
|
|
|
|
|
#endif |
67
|
|
|
|
|
|
|
#ifndef PerlProc_getpid |
68
|
|
|
|
|
|
|
#define PerlProc_getpid() getpid() |
69
|
|
|
|
|
|
|
extern Pid_t getpid (void); |
70
|
|
|
|
|
|
|
#endif |
71
|
|
|
|
|
|
|
#ifndef aTHXo_ |
72
|
|
|
|
|
|
|
#define aTHXo_ |
73
|
|
|
|
|
|
|
#endif |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
#if (PERL_VERSION < 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION == 0)) |
76
|
|
|
|
|
|
|
#define DBI_save_hv_fetch_ent |
77
|
|
|
|
|
|
|
#endif |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
/* prior to 5.8.9: when a CV is duped, the mg dup method is called, |
80
|
|
|
|
|
|
|
* then *afterwards*, any_ptr is copied from the old CV to the new CV. |
81
|
|
|
|
|
|
|
* This wipes out anything which the dup method did to any_ptr. |
82
|
|
|
|
|
|
|
* This needs working around */ |
83
|
|
|
|
|
|
|
#if defined(USE_ITHREADS) && (PERL_VERSION == 8) && (PERL_SUBVERSION < 9) |
84
|
|
|
|
|
|
|
# define BROKEN_DUP_ANY_PTR |
85
|
|
|
|
|
|
|
#endif |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
#ifndef warn_sv |
88
|
|
|
|
|
|
|
static void warn_sv(SV *sv) { dTHX; warn("%" SVf, SVfARG(sv)); } |
89
|
|
|
|
|
|
|
#endif |
90
|
|
|
|
|
|
|
#ifndef croak_sv |
91
|
|
|
|
|
|
|
static void croak_sv(SV *sv) { dTHX; sv_setsv(ERRSV, sv); croak(NULL); } |
92
|
|
|
|
|
|
|
#endif |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
/* types of method name */ |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
typedef enum { |
97
|
|
|
|
|
|
|
methtype_ordinary, /* nothing special about this method name */ |
98
|
|
|
|
|
|
|
methtype_DESTROY, |
99
|
|
|
|
|
|
|
methtype_FETCH, |
100
|
|
|
|
|
|
|
methtype_can, |
101
|
|
|
|
|
|
|
methtype_fetch_star, /* fetch*, i.e. fetch() or fetch_...() */ |
102
|
|
|
|
|
|
|
methtype_set_err |
103
|
|
|
|
|
|
|
} meth_types; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
static imp_xxh_t *dbih_getcom _((SV *h)); |
107
|
|
|
|
|
|
|
static imp_xxh_t *dbih_getcom2 _((pTHX_ SV *h, MAGIC **mgp)); |
108
|
|
|
|
|
|
|
static void dbih_clearcom _((imp_xxh_t *imp_xxh)); |
109
|
|
|
|
|
|
|
static int dbih_logmsg _((imp_xxh_t *imp_xxh, const char *fmt, ...)); |
110
|
|
|
|
|
|
|
static SV *dbih_make_com _((SV *parent_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV *copy)); |
111
|
|
|
|
|
|
|
static SV *dbih_make_fdsv _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name)); |
112
|
|
|
|
|
|
|
static AV *dbih_get_fbav _((imp_sth_t *imp_sth)); |
113
|
|
|
|
|
|
|
static SV *dbih_event _((SV *h, const char *name, SV*, SV*)); |
114
|
|
|
|
|
|
|
static int dbih_set_attr_k _((SV *h, SV *keysv, int dbikey, SV *valuesv)); |
115
|
|
|
|
|
|
|
static SV *dbih_get_attr_k _((SV *h, SV *keysv, int dbikey)); |
116
|
|
|
|
|
|
|
static int dbih_sth_bind_col _((SV *sth, SV *col, SV *ref, SV *attribs)); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
static int set_err_char _((SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method)); |
119
|
|
|
|
|
|
|
static int set_err_sv _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method)); |
120
|
|
|
|
|
|
|
static int quote_type _((int sql_type, int p, int s, int *base_type, void *v)); |
121
|
|
|
|
|
|
|
static int sql_type_cast_svpv _((pTHX_ SV *sv, int sql_type, U32 flags, void *v)); |
122
|
|
|
|
|
|
|
static I32 dbi_hash _((const char *string, long i)); |
123
|
|
|
|
|
|
|
static void dbih_dumphandle _((pTHX_ SV *h, const char *msg, int level)); |
124
|
|
|
|
|
|
|
static int dbih_dumpcom _((pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level)); |
125
|
|
|
|
|
|
|
static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg); |
126
|
|
|
|
|
|
|
#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR) |
127
|
|
|
|
|
|
|
static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param); |
128
|
|
|
|
|
|
|
#endif |
129
|
|
|
|
|
|
|
char *neatsvpv _((SV *sv, STRLEN maxlen)); |
130
|
|
|
|
|
|
|
SV * preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo); |
131
|
|
|
|
|
|
|
static meth_types get_meth_type(const char * const name); |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
struct imp_drh_st { dbih_drc_t com; }; |
134
|
|
|
|
|
|
|
struct imp_dbh_st { dbih_dbc_t com; }; |
135
|
|
|
|
|
|
|
struct imp_sth_st { dbih_stc_t com; }; |
136
|
|
|
|
|
|
|
struct imp_fdh_st { dbih_fdc_t com; }; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
/* identify the type of a method name for dispatch behaviour */ |
139
|
|
|
|
|
|
|
/* (should probably be folded into the IMA flags mechanism) */ |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
static meth_types |
142
|
35038
|
|
|
|
|
|
get_meth_type(const char * const name) |
143
|
|
|
|
|
|
|
{ |
144
|
35038
|
|
|
|
|
|
switch (name[0]) { |
145
|
|
|
|
|
|
|
case 'D': |
146
|
584
|
100
|
|
|
|
|
if strEQ(name,"DESTROY") |
147
|
292
|
|
|
|
|
|
return methtype_DESTROY; |
148
|
292
|
|
|
|
|
|
break; |
149
|
|
|
|
|
|
|
case 'F': |
150
|
876
|
100
|
|
|
|
|
if strEQ(name,"FETCH") |
151
|
292
|
|
|
|
|
|
return methtype_FETCH; |
152
|
584
|
|
|
|
|
|
break; |
153
|
|
|
|
|
|
|
case 'c': |
154
|
2336
|
100
|
|
|
|
|
if strEQ(name,"can") |
155
|
292
|
|
|
|
|
|
return methtype_can; |
156
|
2044
|
|
|
|
|
|
break; |
157
|
|
|
|
|
|
|
case 'f': |
158
|
2969
|
100
|
|
|
|
|
if strnEQ(name,"fetch", 5) /* fetch* */ |
159
|
2044
|
|
|
|
|
|
return methtype_fetch_star; |
160
|
925
|
|
|
|
|
|
break; |
161
|
|
|
|
|
|
|
case 's': |
162
|
4041
|
100
|
|
|
|
|
if strEQ(name,"set_err") |
163
|
292
|
|
|
|
|
|
return methtype_set_err; |
164
|
3749
|
|
|
|
|
|
break; |
165
|
|
|
|
|
|
|
} |
166
|
31826
|
|
|
|
|
|
return methtype_ordinary; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
/* Internal Method Attributes (attached to dispatch methods when installed) */ |
171
|
|
|
|
|
|
|
/* NOTE: when adding SVs to dbi_ima_t, update dbi_ima_dup() dbi_ima_free() |
172
|
|
|
|
|
|
|
* to ensure that they are duped and correctly ref-counted */ |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
typedef struct dbi_ima_st { |
175
|
|
|
|
|
|
|
U8 minargs; |
176
|
|
|
|
|
|
|
U8 maxargs; |
177
|
|
|
|
|
|
|
IV hidearg; |
178
|
|
|
|
|
|
|
/* method_trace controls tracing of method calls in the dispatcher: |
179
|
|
|
|
|
|
|
- if the current trace flags include a trace flag in method_trace |
180
|
|
|
|
|
|
|
then set trace_level to min(2,trace_level) for duration of the call. |
181
|
|
|
|
|
|
|
- else, if trace_level < (method_trace & DBIc_TRACE_LEVEL_MASK) |
182
|
|
|
|
|
|
|
then don't trace the call |
183
|
|
|
|
|
|
|
*/ |
184
|
|
|
|
|
|
|
U32 method_trace; |
185
|
|
|
|
|
|
|
const char *usage_msg; |
186
|
|
|
|
|
|
|
U32 flags; |
187
|
|
|
|
|
|
|
meth_types meth_type; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
/* cached outer to inner method mapping */ |
190
|
|
|
|
|
|
|
HV *stash; /* the stash we found the GV in */ |
191
|
|
|
|
|
|
|
GV *gv; /* the GV containing the inner sub */ |
192
|
|
|
|
|
|
|
U32 generation; /* cache invalidation */ |
193
|
|
|
|
|
|
|
#ifdef BROKEN_DUP_ANY_PTR |
194
|
|
|
|
|
|
|
PerlInterpreter *my_perl; /* who owns this struct */ |
195
|
|
|
|
|
|
|
#endif |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
} dbi_ima_t; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
/* These values are embedded in the data passed to install_method */ |
200
|
|
|
|
|
|
|
#define IMA_HAS_USAGE 0x00000001 /* check parameter usage */ |
201
|
|
|
|
|
|
|
#define IMA_FUNC_REDIRECT 0x00000002 /* is $h->func(..., "method") */ |
202
|
|
|
|
|
|
|
#define IMA_KEEP_ERR 0x00000004 /* don't reset err & errstr */ |
203
|
|
|
|
|
|
|
#define IMA_KEEP_ERR_SUB 0x00000008 /* '' if in a nested call */ |
204
|
|
|
|
|
|
|
#define IMA_NO_TAINT_IN 0x00000010 /* don't check for PL_tainted args */ |
205
|
|
|
|
|
|
|
#define IMA_NO_TAINT_OUT 0x00000020 /* don't taint results */ |
206
|
|
|
|
|
|
|
#define IMA_COPY_UP_STMT 0x00000040 /* copy sth Statement to dbh */ |
207
|
|
|
|
|
|
|
#define IMA_END_WORK 0x00000080 /* method is commit or rollback */ |
208
|
|
|
|
|
|
|
#define IMA_STUB 0x00000100 /* donothing eg $dbh->connected */ |
209
|
|
|
|
|
|
|
#define IMA_CLEAR_STMT 0x00000200 /* clear Statement before call */ |
210
|
|
|
|
|
|
|
#define IMA_UNRELATED_TO_STMT 0x00000400 /* profile as empty Statement */ |
211
|
|
|
|
|
|
|
#define IMA_NOT_FOUND_OKAY 0x00000800 /* no error if not found */ |
212
|
|
|
|
|
|
|
#define IMA_EXECUTE 0x00001000 /* do/execute: DBIcf_Executed */ |
213
|
|
|
|
|
|
|
#define IMA_SHOW_ERR_STMT 0x00002000 /* dbh meth relates to Statement*/ |
214
|
|
|
|
|
|
|
#define IMA_HIDE_ERR_PARAMVALUES 0x00004000 /* ParamValues are not relevant */ |
215
|
|
|
|
|
|
|
#define IMA_IS_FACTORY 0x00008000 /* new h ie connect and prepare */ |
216
|
|
|
|
|
|
|
#define IMA_CLEAR_CACHED_KIDS 0x00010000 /* clear CachedKids before call */ |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
#define DBIc_STATE_adjust(imp_xxh, state) \ |
219
|
|
|
|
|
|
|
(SvOK(state) /* SQLSTATE is implemented by driver */ \ |
220
|
|
|
|
|
|
|
? (strEQ(SvPV_nolen(state),"00000") ? &PL_sv_no : sv_mortalcopy(state))\ |
221
|
|
|
|
|
|
|
: (SvTRUE(DBIc_ERR(imp_xxh)) \ |
222
|
|
|
|
|
|
|
? sv_2mortal(newSVpv("S1000",5)) /* General error */ \ |
223
|
|
|
|
|
|
|
: &PL_sv_no) /* Success ("00000") */ \ |
224
|
|
|
|
|
|
|
) |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#define DBI_LAST_HANDLE g_dbi_last_h /* special fake inner handle */ |
227
|
|
|
|
|
|
|
#define DBI_IS_LAST_HANDLE(h) ((DBI_LAST_HANDLE) == SvRV(h)) |
228
|
|
|
|
|
|
|
#define DBI_SET_LAST_HANDLE(h) ((DBI_LAST_HANDLE) = SvRV(h)) |
229
|
|
|
|
|
|
|
#define DBI_UNSET_LAST_HANDLE ((DBI_LAST_HANDLE) = &PL_sv_undef) |
230
|
|
|
|
|
|
|
#define DBI_LAST_HANDLE_OK ((DBI_LAST_HANDLE) != &PL_sv_undef) |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#define DBIS_TRACE_LEVEL (DBIS->debug & DBIc_TRACE_LEVEL_MASK) |
233
|
|
|
|
|
|
|
#define DBIS_TRACE_FLAGS (DBIS->debug) /* includes level */ |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
#ifdef PERL_LONG_MAX |
236
|
|
|
|
|
|
|
#define MAX_LongReadLen PERL_LONG_MAX |
237
|
|
|
|
|
|
|
#else |
238
|
|
|
|
|
|
|
#define MAX_LongReadLen 2147483647L |
239
|
|
|
|
|
|
|
#endif |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
242
|
|
|
|
|
|
|
static char *dbi_build_opt = "-ithread"; |
243
|
|
|
|
|
|
|
#else |
244
|
|
|
|
|
|
|
static char *dbi_build_opt = "-nothread"; |
245
|
|
|
|
|
|
|
#endif |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
/* 32 bit magic FNV-0 and FNV-1 prime */ |
248
|
|
|
|
|
|
|
#define FNV_32_PRIME ((UV)0x01000193) |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
/* perl doesn't know anything about the dbi_ima_t struct attached to the |
252
|
|
|
|
|
|
|
* CvXSUBANY(cv).any_ptr slot, so add some magic to the CV to handle |
253
|
|
|
|
|
|
|
* duping and freeing. |
254
|
|
|
|
|
|
|
*/ |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
static MGVTBL dbi_ima_vtbl = { 0, 0, 0, 0, dbi_ima_free, |
257
|
|
|
|
|
|
|
0, |
258
|
|
|
|
|
|
|
#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR) |
259
|
|
|
|
|
|
|
dbi_ima_dup |
260
|
|
|
|
|
|
|
#else |
261
|
|
|
|
|
|
|
0 |
262
|
|
|
|
|
|
|
#endif |
263
|
|
|
|
|
|
|
#if (PERL_VERSION > 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION >= 9)) |
264
|
|
|
|
|
|
|
, 0 |
265
|
|
|
|
|
|
|
#endif |
266
|
|
|
|
|
|
|
}; |
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
|
static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg) |
269
|
|
|
|
|
|
|
{ |
270
|
0
|
|
|
|
|
|
dbi_ima_t *ima = (dbi_ima_t *)(CvXSUBANY((CV*)sv).any_ptr); |
271
|
|
|
|
|
|
|
#ifdef BROKEN_DUP_ANY_PTR |
272
|
|
|
|
|
|
|
if (ima->my_perl != my_perl) |
273
|
|
|
|
|
|
|
return 0; |
274
|
|
|
|
|
|
|
#endif |
275
|
0
|
|
|
|
|
|
SvREFCNT_dec(ima->stash); |
276
|
0
|
|
|
|
|
|
SvREFCNT_dec(ima->gv); |
277
|
0
|
|
|
|
|
|
Safefree(ima); |
278
|
0
|
|
|
|
|
|
return 0; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR) |
282
|
|
|
|
|
|
|
static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param) |
283
|
|
|
|
|
|
|
{ |
284
|
|
|
|
|
|
|
dbi_ima_t *ima, *nima; |
285
|
|
|
|
|
|
|
CV *cv = (CV*) mg->mg_ptr; |
286
|
|
|
|
|
|
|
CV *ncv = (CV*)ptr_table_fetch(PL_ptr_table, (cv)); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
PERL_UNUSED_VAR(param); |
289
|
|
|
|
|
|
|
mg->mg_ptr = (char *)ncv; |
290
|
|
|
|
|
|
|
ima = (dbi_ima_t*) CvXSUBANY(cv).any_ptr; |
291
|
|
|
|
|
|
|
Newx(nima, 1, dbi_ima_t); |
292
|
|
|
|
|
|
|
*nima = *ima; /* structure copy */ |
293
|
|
|
|
|
|
|
CvXSUBANY(ncv).any_ptr = nima; |
294
|
|
|
|
|
|
|
nima->stash = NULL; |
295
|
|
|
|
|
|
|
nima->gv = NULL; |
296
|
|
|
|
|
|
|
return 0; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
#endif |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
/* --- make DBI safe for multiple perl interpreters --- */ |
303
|
|
|
|
|
|
|
/* Originally contributed by Murray Nesbitt of ActiveState, */ |
304
|
|
|
|
|
|
|
/* but later updated to use MY_CTX */ |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#define MY_CXT_KEY "DBI::_guts" XS_VERSION |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
typedef struct { |
309
|
|
|
|
|
|
|
SV *dbi_last_h; /* maybe better moved into dbistate_t? */ |
310
|
|
|
|
|
|
|
dbistate_t* dbi_state; |
311
|
|
|
|
|
|
|
} my_cxt_t; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
START_MY_CXT |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
#undef DBIS |
316
|
|
|
|
|
|
|
#define DBIS (MY_CXT.dbi_state) |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
#define g_dbi_last_h (MY_CXT.dbi_last_h) |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
/* allow the 'static' dbi_state struct to be accessed from other files */ |
321
|
|
|
|
|
|
|
dbistate_t** |
322
|
0
|
|
|
|
|
|
_dbi_state_lval(pTHX) |
323
|
|
|
|
|
|
|
{ |
324
|
|
|
|
|
|
|
dMY_CXT; |
325
|
0
|
|
|
|
|
|
return &(MY_CXT.dbi_state); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
/* --- */ |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
static void * |
332
|
15476
|
|
|
|
|
|
malloc_using_sv(STRLEN len) |
333
|
|
|
|
|
|
|
{ |
334
|
|
|
|
|
|
|
dTHX; |
335
|
15476
|
|
|
|
|
|
SV *sv = newSV(len); |
336
|
15476
|
|
|
|
|
|
void *p = SvPVX(sv); |
337
|
15476
|
|
|
|
|
|
memzero(p, len); |
338
|
15476
|
|
|
|
|
|
return p; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
static char * |
342
|
15184
|
|
|
|
|
|
savepv_using_sv(char *str) |
343
|
|
|
|
|
|
|
{ |
344
|
15184
|
|
|
|
|
|
char *buf = malloc_using_sv(strlen(str)); |
345
|
15184
|
|
|
|
|
|
strcpy(buf, str); |
346
|
15184
|
|
|
|
|
|
return buf; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
/* --- support functions for concat_hash_sorted --- */ |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
typedef struct str_uv_sort_pair_st { |
353
|
|
|
|
|
|
|
char *key; |
354
|
|
|
|
|
|
|
UV numeric; |
355
|
|
|
|
|
|
|
} str_uv_sort_pair_t; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
static int |
358
|
36230
|
|
|
|
|
|
_cmp_number(const void *val1, const void *val2) |
359
|
|
|
|
|
|
|
{ |
360
|
36230
|
|
|
|
|
|
UV first = ((str_uv_sort_pair_t *)val1)->numeric; |
361
|
36230
|
|
|
|
|
|
UV second = ((str_uv_sort_pair_t *)val2)->numeric; |
362
|
|
|
|
|
|
|
|
363
|
36230
|
100
|
|
|
|
|
if (first > second) |
364
|
18383
|
|
|
|
|
|
return 1; |
365
|
17847
|
100
|
|
|
|
|
if (first < second) |
366
|
17791
|
|
|
|
|
|
return -1; |
367
|
|
|
|
|
|
|
/* only likely to reach here if numeric sort forced for non-numeric keys */ |
368
|
|
|
|
|
|
|
/* fallback to comparing the key strings */ |
369
|
56
|
|
|
|
|
|
return strcmp( |
370
|
56
|
|
|
|
|
|
((str_uv_sort_pair_t *)val1)->key, |
371
|
56
|
|
|
|
|
|
((str_uv_sort_pair_t *)val2)->key |
372
|
|
|
|
|
|
|
); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
static int |
376
|
55233
|
|
|
|
|
|
_cmp_str (const void *val1, const void *val2) |
377
|
|
|
|
|
|
|
{ |
378
|
55233
|
|
|
|
|
|
return strcmp( *(char **)val1, *(char **)val2); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
static char ** |
382
|
3317
|
|
|
|
|
|
_sort_hash_keys (HV *hash, int num_sort, STRLEN *total_length) |
383
|
|
|
|
|
|
|
{ |
384
|
|
|
|
|
|
|
dTHX; |
385
|
|
|
|
|
|
|
I32 hv_len, key_len; |
386
|
|
|
|
|
|
|
HE *entry; |
387
|
|
|
|
|
|
|
char **keys; |
388
|
3317
|
|
|
|
|
|
unsigned int idx = 0; |
389
|
3317
|
|
|
|
|
|
STRLEN tot_len = 0; |
390
|
3317
|
|
|
|
|
|
bool has_non_numerics = 0; |
391
|
|
|
|
|
|
|
str_uv_sort_pair_t *numbers; |
392
|
|
|
|
|
|
|
|
393
|
3317
|
|
|
|
|
|
hv_len = hv_iterinit(hash); |
394
|
3317
|
100
|
|
|
|
|
if (!hv_len) |
395
|
8
|
|
|
|
|
|
return 0; |
396
|
|
|
|
|
|
|
|
397
|
3309
|
50
|
|
|
|
|
Newz(0, keys, hv_len, char *); |
398
|
3309
|
50
|
|
|
|
|
Newz(0, numbers, hv_len, str_uv_sort_pair_t); |
399
|
|
|
|
|
|
|
|
400
|
34237
|
100
|
|
|
|
|
while ((entry = hv_iternext(hash))) { |
401
|
30928
|
|
|
|
|
|
*(keys+idx) = hv_iterkey(entry, &key_len); |
402
|
30928
|
|
|
|
|
|
tot_len += key_len; |
403
|
|
|
|
|
|
|
|
404
|
30928
|
100
|
|
|
|
|
if (grok_number(*(keys+idx), key_len, &(numbers+idx)->numeric) != IS_NUMBER_IN_UV) { |
405
|
26512
|
|
|
|
|
|
has_non_numerics = 1; |
406
|
26512
|
|
|
|
|
|
(numbers+idx)->numeric = 0; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
30928
|
|
|
|
|
|
(numbers+idx)->key = *(keys+idx); |
410
|
30928
|
|
|
|
|
|
++idx; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
3309
|
50
|
|
|
|
|
if (total_length) |
414
|
3309
|
|
|
|
|
|
*total_length = tot_len; |
415
|
|
|
|
|
|
|
|
416
|
3309
|
100
|
|
|
|
|
if (num_sort < 0) |
417
|
42
|
100
|
|
|
|
|
num_sort = (has_non_numerics) ? 0 : 1; |
418
|
|
|
|
|
|
|
|
419
|
3309
|
100
|
|
|
|
|
if (!num_sort) { |
420
|
3267
|
|
|
|
|
|
qsort(keys, hv_len, sizeof(char*), _cmp_str); |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
else { |
423
|
42
|
|
|
|
|
|
qsort(numbers, hv_len, sizeof(str_uv_sort_pair_t), _cmp_number); |
424
|
4430
|
100
|
|
|
|
|
for (idx = 0; idx < hv_len; ++idx) |
425
|
4388
|
|
|
|
|
|
*(keys+idx) = (numbers+idx)->key; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
3309
|
|
|
|
|
|
Safefree(numbers); |
429
|
3317
|
|
|
|
|
|
return keys; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
static SV * |
434
|
3317
|
|
|
|
|
|
_join_hash_sorted(HV *hash, char *kv_sep, STRLEN kv_sep_len, char *pair_sep, STRLEN pair_sep_len, int use_neat, int num_sort) |
435
|
|
|
|
|
|
|
{ |
436
|
|
|
|
|
|
|
dTHX; |
437
|
|
|
|
|
|
|
I32 hv_len; |
438
|
3317
|
|
|
|
|
|
STRLEN total_len = 0; |
439
|
|
|
|
|
|
|
char **keys; |
440
|
3317
|
|
|
|
|
|
unsigned int i = 0; |
441
|
|
|
|
|
|
|
SV *return_sv; |
442
|
|
|
|
|
|
|
|
443
|
3317
|
|
|
|
|
|
keys = _sort_hash_keys(hash, num_sort, &total_len); |
444
|
3317
|
100
|
|
|
|
|
if (!keys) |
445
|
8
|
|
|
|
|
|
return newSVpv("", 0); |
446
|
|
|
|
|
|
|
|
447
|
3309
|
50
|
|
|
|
|
if (!kv_sep_len) |
448
|
0
|
|
|
|
|
|
kv_sep_len = strlen(kv_sep); |
449
|
3309
|
50
|
|
|
|
|
if (!pair_sep_len) |
450
|
0
|
|
|
|
|
|
pair_sep_len = strlen(pair_sep); |
451
|
|
|
|
|
|
|
|
452
|
3309
|
|
|
|
|
|
hv_len = hv_iterinit(hash); |
453
|
|
|
|
|
|
|
/* total_len += Separators + quotes + term null */ |
454
|
3309
|
|
|
|
|
|
total_len += kv_sep_len*hv_len + pair_sep_len*hv_len+2*hv_len+1; |
455
|
3309
|
|
|
|
|
|
return_sv = newSV(total_len); |
456
|
3309
|
|
|
|
|
|
sv_setpv(return_sv, ""); /* quell undef warnings */ |
457
|
|
|
|
|
|
|
|
458
|
34237
|
100
|
|
|
|
|
for (i=0; i
|
459
|
30928
|
|
|
|
|
|
SV **hash_svp = hv_fetch(hash, keys[i], strlen(keys[i]), 0); |
460
|
|
|
|
|
|
|
|
461
|
30928
|
|
|
|
|
|
sv_catpv(return_sv, keys[i]); /* XXX keys can't contain nul chars */ |
462
|
30928
|
|
|
|
|
|
sv_catpvn(return_sv, kv_sep, kv_sep_len); |
463
|
|
|
|
|
|
|
|
464
|
30928
|
50
|
|
|
|
|
if (!hash_svp) { /* should never happen */ |
465
|
0
|
|
|
|
|
|
warn("No hash entry with key '%s'", keys[i]); |
466
|
0
|
|
|
|
|
|
sv_catpvn(return_sv, "???", 3); |
467
|
0
|
|
|
|
|
|
continue; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
30928
|
100
|
|
|
|
|
if (use_neat) { |
471
|
4412
|
|
|
|
|
|
sv_catpv(return_sv, neatsvpv(*hash_svp,0)); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
else { |
474
|
46273
|
100
|
|
|
|
|
if (SvOK(*hash_svp)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
475
|
|
|
|
|
|
|
STRLEN hv_val_len; |
476
|
19757
|
100
|
|
|
|
|
char *hv_val = SvPV(*hash_svp, hv_val_len); |
477
|
19757
|
|
|
|
|
|
sv_catpvn(return_sv, "'", 1); |
478
|
19757
|
|
|
|
|
|
sv_catpvn(return_sv, hv_val, hv_val_len); |
479
|
19757
|
|
|
|
|
|
sv_catpvn(return_sv, "'", 1); |
480
|
|
|
|
|
|
|
} |
481
|
6759
|
|
|
|
|
|
else sv_catpvn(return_sv, "undef", 5); |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
30928
|
100
|
|
|
|
|
if (i < hv_len-1) |
485
|
27619
|
|
|
|
|
|
sv_catpvn(return_sv, pair_sep, pair_sep_len); |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
3309
|
|
|
|
|
|
Safefree(keys); |
489
|
|
|
|
|
|
|
|
490
|
3317
|
|
|
|
|
|
return return_sv; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
/* handy for embedding into condition expression for debugging */ |
496
|
|
|
|
|
|
|
/* |
497
|
|
|
|
|
|
|
static int warn1(char *s) { warn("%s", s); return 1; } |
498
|
|
|
|
|
|
|
static int dump1(SV *sv) { dTHX; sv_dump(sv); return 1; } |
499
|
|
|
|
|
|
|
*/ |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
/* --- */ |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
static void |
505
|
0
|
|
|
|
|
|
check_version(const char *name, int dbis_cv, int dbis_cs, int need_dbixs_cv, int drc_s, |
506
|
|
|
|
|
|
|
int dbc_s, int stc_s, int fdc_s) |
507
|
|
|
|
|
|
|
{ |
508
|
|
|
|
|
|
|
dTHX; |
509
|
|
|
|
|
|
|
dMY_CXT; |
510
|
|
|
|
|
|
|
static const char msg[] = "you probably need to rebuild the DBD driver (or possibly the DBI)"; |
511
|
|
|
|
|
|
|
(void)need_dbixs_cv; |
512
|
0
|
0
|
|
|
|
|
if (dbis_cv != DBISTATE_VERSION || dbis_cs != sizeof(*DBIS)) |
|
|
0
|
|
|
|
|
|
513
|
0
|
|
|
|
|
|
croak("DBI/DBD internal version mismatch (DBI is v%d/s%lu, DBD %s expected v%d/s%d) %s.\n", |
514
|
|
|
|
|
|
|
DBISTATE_VERSION, (long unsigned int)sizeof(*DBIS), name, dbis_cv, dbis_cs, msg); |
515
|
|
|
|
|
|
|
/* Catch structure size changes - We should probably force a recompile if the DBI */ |
516
|
|
|
|
|
|
|
/* runtime version is different from the build time. That would be harsh but safe. */ |
517
|
0
|
0
|
|
|
|
|
if (drc_s != sizeof(dbih_drc_t) || dbc_s != sizeof(dbih_dbc_t) || |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
|
stc_s != sizeof(dbih_stc_t) || fdc_s != sizeof(dbih_fdc_t) ) |
519
|
0
|
|
|
|
|
|
croak("%s (dr:%d/%ld, db:%d/%ld, st:%d/%ld, fd:%d/%ld), %s.\n", |
520
|
|
|
|
|
|
|
"DBI/DBD internal structure mismatch", |
521
|
|
|
|
|
|
|
drc_s, (long)sizeof(dbih_drc_t), dbc_s, (long)sizeof(dbih_dbc_t), |
522
|
|
|
|
|
|
|
stc_s, (long)sizeof(dbih_stc_t), fdc_s, (long)sizeof(dbih_fdc_t), msg); |
523
|
0
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
static void |
526
|
292
|
|
|
|
|
|
dbi_bootinit(dbistate_t * parent_dbis) |
527
|
|
|
|
|
|
|
{ |
528
|
|
|
|
|
|
|
dTHX; |
529
|
|
|
|
|
|
|
dMY_CXT; |
530
|
|
|
|
|
|
|
dbistate_t* DBISx; |
531
|
|
|
|
|
|
|
|
532
|
292
|
|
|
|
|
|
DBISx = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st)); |
533
|
292
|
|
|
|
|
|
DBIS = DBISx; |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
/* make DBIS available to DBD modules the "old" (<= 1.618) way, |
536
|
|
|
|
|
|
|
* so that unrecompiled DBD's will still work against a newer DBI */ |
537
|
292
|
|
|
|
|
|
sv_setiv(get_sv("DBI::_dbistate", GV_ADDMULTI), |
538
|
|
|
|
|
|
|
PTR2IV(MY_CXT.dbi_state)); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
/* store version and size so we can spot DBI/DBD version mismatch */ |
541
|
292
|
|
|
|
|
|
DBIS->check_version = check_version; |
542
|
292
|
|
|
|
|
|
DBIS->version = DBISTATE_VERSION; |
543
|
292
|
|
|
|
|
|
DBIS->size = sizeof(*DBIS); |
544
|
292
|
|
|
|
|
|
DBIS->xs_version = DBIXS_VERSION; |
545
|
|
|
|
|
|
|
|
546
|
292
|
|
|
|
|
|
DBIS->logmsg = dbih_logmsg; |
547
|
292
|
|
|
|
|
|
DBIS->logfp = PerlIO_stderr(); |
548
|
876
|
50
|
|
|
|
|
DBIS->debug = (parent_dbis) ? parent_dbis->debug |
|
|
50
|
|
|
|
|
|
549
|
584
|
|
|
|
|
|
: SvIV(get_sv("DBI::dbi_debug",0x5)); |
550
|
584
|
|
|
|
|
|
DBIS->neatsvpvlen = (parent_dbis) ? parent_dbis->neatsvpvlen |
551
|
292
|
50
|
|
|
|
|
: get_sv("DBI::neat_maxlen", GV_ADDMULTI); |
552
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
553
|
|
|
|
|
|
|
DBIS->thr_owner = PERL_GET_THX; |
554
|
|
|
|
|
|
|
#endif |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
/* store some function pointers so DBD's can call our functions */ |
557
|
292
|
|
|
|
|
|
DBIS->getcom = dbih_getcom; |
558
|
292
|
|
|
|
|
|
DBIS->clearcom = dbih_clearcom; |
559
|
292
|
|
|
|
|
|
DBIS->event = dbih_event; |
560
|
292
|
|
|
|
|
|
DBIS->set_attr_k = dbih_set_attr_k; |
561
|
292
|
|
|
|
|
|
DBIS->get_attr_k = dbih_get_attr_k; |
562
|
292
|
|
|
|
|
|
DBIS->get_fbav = dbih_get_fbav; |
563
|
292
|
|
|
|
|
|
DBIS->make_fdsv = dbih_make_fdsv; |
564
|
292
|
|
|
|
|
|
DBIS->neat_svpv = neatsvpv; |
565
|
292
|
|
|
|
|
|
DBIS->bind_as_num = quote_type; /* XXX deprecated */ |
566
|
292
|
|
|
|
|
|
DBIS->hash = dbi_hash; |
567
|
292
|
|
|
|
|
|
DBIS->set_err_sv = set_err_sv; |
568
|
292
|
|
|
|
|
|
DBIS->set_err_char= set_err_char; |
569
|
292
|
|
|
|
|
|
DBIS->bind_col = dbih_sth_bind_col; |
570
|
292
|
|
|
|
|
|
DBIS->sql_type_cast_svpv = sql_type_cast_svpv; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
/* Remember the last handle used. BEWARE! Sneaky stuff here! */ |
574
|
|
|
|
|
|
|
/* We want a handle reference but we don't want to increment */ |
575
|
|
|
|
|
|
|
/* the handle's reference count and we don't want perl to try */ |
576
|
|
|
|
|
|
|
/* to destroy it during global destruction. Take care! */ |
577
|
292
|
|
|
|
|
|
DBI_UNSET_LAST_HANDLE; /* ensure setup the correct way */ |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
/* trick to avoid 'possible typo' warnings */ |
580
|
292
|
|
|
|
|
|
gv_fetchpv("DBI::state", GV_ADDMULTI, SVt_PV); |
581
|
292
|
|
|
|
|
|
gv_fetchpv("DBI::err", GV_ADDMULTI, SVt_PV); |
582
|
292
|
|
|
|
|
|
gv_fetchpv("DBI::errstr", GV_ADDMULTI, SVt_PV); |
583
|
292
|
|
|
|
|
|
gv_fetchpv("DBI::lasth", GV_ADDMULTI, SVt_PV); |
584
|
292
|
|
|
|
|
|
gv_fetchpv("DBI::rows", GV_ADDMULTI, SVt_PV); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
/* we only need to check the env var on the initial boot |
587
|
|
|
|
|
|
|
* which is handy because it can core dump during CLONE on windows |
588
|
|
|
|
|
|
|
*/ |
589
|
292
|
50
|
|
|
|
|
if (!parent_dbis && getenv("PERL_DBI_XSBYPASS")) |
|
|
50
|
|
|
|
|
|
590
|
0
|
|
|
|
|
|
use_xsbypass = atoi(getenv("PERL_DBI_XSBYPASS")); |
591
|
292
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
/* ----------------------------------------------------------------- */ |
595
|
|
|
|
|
|
|
/* Utility functions */ |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
static char * |
599
|
60
|
|
|
|
|
|
dbih_htype_name(int htype) |
600
|
|
|
|
|
|
|
{ |
601
|
60
|
|
|
|
|
|
switch(htype) { |
602
|
3
|
|
|
|
|
|
case DBIt_DR: return "dr"; |
603
|
11
|
|
|
|
|
|
case DBIt_DB: return "db"; |
604
|
46
|
|
|
|
|
|
case DBIt_ST: return "st"; |
605
|
0
|
|
|
|
|
|
case DBIt_FD: return "fd"; |
606
|
0
|
|
|
|
|
|
default: return "??"; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
char * |
612
|
6005
|
|
|
|
|
|
neatsvpv(SV *sv, STRLEN maxlen) /* return a tidy ascii value, for debugging only */ |
613
|
|
|
|
|
|
|
{ |
614
|
|
|
|
|
|
|
dTHX; |
615
|
|
|
|
|
|
|
dMY_CXT; |
616
|
|
|
|
|
|
|
STRLEN len; |
617
|
6005
|
|
|
|
|
|
SV *nsv = Nullsv; |
618
|
6005
|
|
|
|
|
|
SV *infosv = Nullsv; |
619
|
|
|
|
|
|
|
char *v, *quote; |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
/* We take care not to alter the supplied sv in any way at all. */ |
622
|
|
|
|
|
|
|
/* (but if it is SvGMAGICAL we have to call mg_get and that can */ |
623
|
|
|
|
|
|
|
/* have side effects, especially as it may be called twice overall.) */ |
624
|
|
|
|
|
|
|
|
625
|
6005
|
100
|
|
|
|
|
if (!sv) |
626
|
3
|
|
|
|
|
|
return "Null!"; /* should never happen */ |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
/* try to do the right thing with magical values */ |
629
|
6002
|
100
|
|
|
|
|
if (SvMAGICAL(sv)) { |
630
|
96
|
100
|
|
|
|
|
if (DBIS_TRACE_LEVEL >= 5) { /* add magic details to help debugging */ |
631
|
|
|
|
|
|
|
MAGIC* mg; |
632
|
33
|
|
|
|
|
|
infosv = sv_2mortal(newSVpv(" (magic-",0)); |
633
|
33
|
50
|
|
|
|
|
if (SvSMAGICAL(sv)) sv_catpvn(infosv,"s",1); |
634
|
33
|
50
|
|
|
|
|
if (SvGMAGICAL(sv)) sv_catpvn(infosv,"g",1); |
635
|
33
|
50
|
|
|
|
|
if (SvRMAGICAL(sv)) sv_catpvn(infosv,"r",1); |
636
|
33
|
|
|
|
|
|
sv_catpvn(infosv,":",1); |
637
|
66
|
100
|
|
|
|
|
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) |
638
|
33
|
|
|
|
|
|
sv_catpvn(infosv, &mg->mg_type, 1); |
639
|
33
|
|
|
|
|
|
sv_catpvn(infosv, ")", 1); |
640
|
|
|
|
|
|
|
} |
641
|
96
|
100
|
|
|
|
|
if (SvGMAGICAL(sv) && !PL_dirty) |
|
|
50
|
|
|
|
|
|
642
|
36
|
|
|
|
|
|
mg_get(sv); /* trigger magic to FETCH the value */ |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
6002
|
100
|
|
|
|
|
if (!SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
646
|
4463
|
100
|
|
|
|
|
if (SvTYPE(sv) >= SVt_PVAV) |
647
|
12
|
|
|
|
|
|
return (char *)sv_reftype(sv,0); /* raw AV/HV etc, not via a ref */ |
648
|
4451
|
100
|
|
|
|
|
if (!infosv) |
649
|
4442
|
|
|
|
|
|
return "undef"; |
650
|
9
|
|
|
|
|
|
sv_insert(infosv, 0,0, "undef",5); |
651
|
9
|
|
|
|
|
|
return SvPVX(infosv); |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
1539
|
100
|
|
|
|
|
if (SvNIOK(sv)) { /* is a numeric value - so no surrounding quotes */ |
655
|
365
|
100
|
|
|
|
|
if (SvPOK(sv)) { /* already has string version of the value, so use it */ |
656
|
150
|
50
|
|
|
|
|
v = SvPV(sv,len); |
657
|
150
|
100
|
|
|
|
|
if (len == 0) { v="''"; len=2; } /* catch &sv_no style special case */ |
658
|
150
|
50
|
|
|
|
|
if (!infosv) |
659
|
150
|
|
|
|
|
|
return v; |
660
|
0
|
|
|
|
|
|
sv_insert(infosv, 0,0, v, len); |
661
|
0
|
|
|
|
|
|
return SvPVX(infosv); |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
/* we don't use SvPV here since we don't want to alter sv in _any_ way */ |
664
|
215
|
50
|
|
|
|
|
if (SvUOK(sv)) |
665
|
0
|
|
|
|
|
|
nsv = newSVpvf("%"UVuf, SvUVX(sv)); |
666
|
215
|
100
|
|
|
|
|
else if (SvIOK(sv)) |
667
|
202
|
|
|
|
|
|
nsv = newSVpvf("%"IVdf, SvIVX(sv)); |
668
|
13
|
|
|
|
|
|
else nsv = newSVpvf("%"NVgf, SvNVX(sv)); |
669
|
215
|
100
|
|
|
|
|
if (infosv) |
670
|
6
|
|
|
|
|
|
sv_catsv(nsv, infosv); |
671
|
215
|
|
|
|
|
|
return SvPVX(sv_2mortal(nsv)); |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
1174
|
|
|
|
|
|
nsv = sv_newmortal(); |
675
|
1174
|
|
|
|
|
|
sv_upgrade(nsv, SVt_PV); |
676
|
|
|
|
|
|
|
|
677
|
1174
|
100
|
|
|
|
|
if (SvROK(sv)) { |
678
|
439
|
50
|
|
|
|
|
if (!SvAMAGIC(sv)) /* (un-amagic'd) refs get no special treatment */ |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
679
|
438
|
50
|
|
|
|
|
v = SvPV(sv,len); |
680
|
|
|
|
|
|
|
else { |
681
|
|
|
|
|
|
|
/* handle Overload magic refs */ |
682
|
1
|
|
|
|
|
|
(void)SvAMAGIC_off(sv); /* should really be done via local scoping */ |
683
|
1
|
50
|
|
|
|
|
v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */ |
684
|
1
|
|
|
|
|
|
SvAMAGIC_on(sv); |
685
|
|
|
|
|
|
|
} |
686
|
439
|
|
|
|
|
|
sv_setpvn(nsv, v, len); |
687
|
439
|
100
|
|
|
|
|
if (infosv) |
688
|
3
|
|
|
|
|
|
sv_catsv(nsv, infosv); |
689
|
439
|
50
|
|
|
|
|
return SvPV(nsv, len); |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
735
|
50
|
|
|
|
|
if (SvPOK(sv)) /* usual simple string case */ |
693
|
735
|
50
|
|
|
|
|
v = SvPV(sv,len); |
694
|
|
|
|
|
|
|
else /* handles all else via sv_2pv() */ |
695
|
0
|
0
|
|
|
|
|
v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */ |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
/* for strings we limit the length and translate codes */ |
698
|
735
|
100
|
|
|
|
|
if (maxlen == 0) |
699
|
632
|
50
|
|
|
|
|
maxlen = SvIV(DBIS->neatsvpvlen); |
700
|
735
|
50
|
|
|
|
|
if (maxlen < 6) /* handle daft values */ |
701
|
0
|
|
|
|
|
|
maxlen = 6; |
702
|
735
|
|
|
|
|
|
maxlen -= 2; /* account for quotes */ |
703
|
|
|
|
|
|
|
|
704
|
735
|
50
|
|
|
|
|
quote = (SvUTF8(sv)) ? "\"" : "'"; |
705
|
735
|
100
|
|
|
|
|
if (len > maxlen) { |
706
|
6
|
50
|
|
|
|
|
SvGROW(nsv, (1+maxlen+1+1)); |
|
|
50
|
|
|
|
|
|
707
|
6
|
|
|
|
|
|
sv_setpvn(nsv, quote, 1); |
708
|
6
|
|
|
|
|
|
sv_catpvn(nsv, v, maxlen-3); /* account for three dots */ |
709
|
6
|
|
|
|
|
|
sv_catpvn(nsv, "...", 3); |
710
|
|
|
|
|
|
|
} else { |
711
|
729
|
50
|
|
|
|
|
SvGROW(nsv, (1+len+1+1)); |
|
|
50
|
|
|
|
|
|
712
|
729
|
|
|
|
|
|
sv_setpvn(nsv, quote, 1); |
713
|
729
|
|
|
|
|
|
sv_catpvn(nsv, v, len); |
714
|
|
|
|
|
|
|
} |
715
|
735
|
|
|
|
|
|
sv_catpvn(nsv, quote, 1); |
716
|
735
|
100
|
|
|
|
|
if (infosv) |
717
|
6
|
|
|
|
|
|
sv_catsv(nsv, infosv); |
718
|
735
|
50
|
|
|
|
|
v = SvPV(nsv, len); |
719
|
735
|
50
|
|
|
|
|
if (!SvUTF8(sv)) { |
720
|
8785
|
100
|
|
|
|
|
while(len-- > 0) { /* cleanup string (map control chars to ascii etc) */ |
721
|
8050
|
|
|
|
|
|
const char c = v[len] & 0x7F; /* ignore top bit for multinational chars */ |
722
|
8050
|
100
|
|
|
|
|
if (!isPRINT(c) && !isSPACE(c)) |
|
|
100
|
|
|
|
|
|
723
|
2
|
|
|
|
|
|
v[len] = '.'; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
6005
|
|
|
|
|
|
return v; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
static void |
731
|
11319
|
|
|
|
|
|
copy_statement_to_parent(pTHX_ SV *h, imp_xxh_t *imp_xxh) |
732
|
|
|
|
|
|
|
{ |
733
|
|
|
|
|
|
|
SV *parent; |
734
|
11319
|
50
|
|
|
|
|
if (PL_dirty) |
735
|
0
|
|
|
|
|
|
return; |
736
|
11319
|
|
|
|
|
|
parent = DBIc_PARENT_H(imp_xxh); |
737
|
11319
|
50
|
|
|
|
|
if (parent && SvROK(parent)) { |
|
|
100
|
|
|
|
|
|
738
|
11285
|
|
|
|
|
|
SV *tmp_sv = *hv_fetch((HV*)SvRV(h), "Statement", 9, 1); |
739
|
11285
|
100
|
|
|
|
|
if (SvOK(tmp_sv)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
740
|
9730
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(tmp_sv), 0); |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
static int |
746
|
16
|
|
|
|
|
|
set_err_char(SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method) |
747
|
|
|
|
|
|
|
{ |
748
|
|
|
|
|
|
|
dTHX; |
749
|
|
|
|
|
|
|
char err_buf[28]; |
750
|
|
|
|
|
|
|
SV *err_sv, *errstr_sv, *state_sv, *method_sv; |
751
|
16
|
50
|
|
|
|
|
if (!err_c) { |
752
|
0
|
|
|
|
|
|
sprintf(err_buf, "%ld", (long)err_i); |
753
|
0
|
|
|
|
|
|
err_c = &err_buf[0]; |
754
|
|
|
|
|
|
|
} |
755
|
16
|
50
|
|
|
|
|
err_sv = (strEQ(err_c,"1")) ? &PL_sv_yes : sv_2mortal(newSVpvn(err_c, strlen(err_c))); |
756
|
16
|
|
|
|
|
|
errstr_sv = sv_2mortal(newSVpvn(errstr, strlen(errstr))); |
757
|
16
|
50
|
|
|
|
|
state_sv = (state && *state) ? sv_2mortal(newSVpvn(state, strlen(state))) : &PL_sv_undef; |
|
|
0
|
|
|
|
|
|
758
|
16
|
100
|
|
|
|
|
method_sv = (method && *method) ? sv_2mortal(newSVpvn(method, strlen(method))) : &PL_sv_undef; |
|
|
50
|
|
|
|
|
|
759
|
16
|
|
|
|
|
|
return set_err_sv(h, imp_xxh, err_sv, errstr_sv, state_sv, method_sv); |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
static int |
764
|
9381
|
|
|
|
|
|
set_err_sv(SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method) |
765
|
|
|
|
|
|
|
{ |
766
|
|
|
|
|
|
|
dTHX; |
767
|
|
|
|
|
|
|
SV *h_err; |
768
|
|
|
|
|
|
|
SV *h_errstr; |
769
|
|
|
|
|
|
|
SV *h_state; |
770
|
|
|
|
|
|
|
SV **hook_svp; |
771
|
9381
|
|
|
|
|
|
int err_changed = 0; |
772
|
|
|
|
|
|
|
|
773
|
9381
|
100
|
|
|
|
|
if ( DBIc_has(imp_xxh, DBIcf_HandleSetErr) |
774
|
38
|
50
|
|
|
|
|
&& (hook_svp = hv_fetch((HV*)SvRV(h),"HandleSetErr",12,0)) |
775
|
38
|
50
|
|
|
|
|
&& hook_svp |
776
|
38
|
50
|
|
|
|
|
&& ((void)(SvGMAGICAL(*hook_svp) && mg_get(*hook_svp)), SvOK(*hook_svp)) |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
777
|
36
|
|
|
|
|
|
) { |
778
|
38
|
|
|
|
|
|
dSP; |
779
|
|
|
|
|
|
|
IV items; |
780
|
|
|
|
|
|
|
SV *response_sv; |
781
|
38
|
100
|
|
|
|
|
if (SvREADONLY(err)) err = sv_mortalcopy(err); |
782
|
38
|
100
|
|
|
|
|
if (SvREADONLY(errstr)) errstr = sv_mortalcopy(errstr); |
783
|
38
|
50
|
|
|
|
|
if (SvREADONLY(state)) state = sv_mortalcopy(state); |
784
|
38
|
50
|
|
|
|
|
if (SvREADONLY(method)) method = sv_mortalcopy(method); |
785
|
38
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) |
786
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -> HandleSetErr(%s, err=%s, errstr=%s, state=%s, %s)\n", |
787
|
|
|
|
|
|
|
neatsvpv(h,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0), |
788
|
|
|
|
|
|
|
neatsvpv(method,0) |
789
|
|
|
|
|
|
|
); |
790
|
38
|
50
|
|
|
|
|
PUSHMARK(SP); |
791
|
38
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh)))); |
792
|
38
|
50
|
|
|
|
|
XPUSHs(err); |
793
|
38
|
50
|
|
|
|
|
XPUSHs(errstr); |
794
|
38
|
50
|
|
|
|
|
XPUSHs(state); |
795
|
38
|
50
|
|
|
|
|
XPUSHs(method); |
796
|
38
|
|
|
|
|
|
PUTBACK; |
797
|
38
|
|
|
|
|
|
items = call_sv(*hook_svp, G_SCALAR); |
798
|
38
|
|
|
|
|
|
SPAGAIN; |
799
|
38
|
50
|
|
|
|
|
response_sv = (items) ? POPs : &PL_sv_undef; |
800
|
38
|
|
|
|
|
|
PUTBACK; |
801
|
38
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 1) |
802
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," <- HandleSetErr= %s (err=%s, errstr=%s, state=%s, %s)\n", |
803
|
|
|
|
|
|
|
neatsvpv(response_sv,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0), |
804
|
|
|
|
|
|
|
neatsvpv(method,0) |
805
|
|
|
|
|
|
|
); |
806
|
38
|
50
|
|
|
|
|
if (SvTRUE(response_sv)) /* handler says it has handled it, so... */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
807
|
2
|
|
|
|
|
|
return 0; |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
else { |
810
|
9343
|
100
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) |
811
|
4
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -- HandleSetErr err=%s, errstr=%s, state=%s, %s\n", |
812
|
|
|
|
|
|
|
neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0), neatsvpv(method,0) |
813
|
|
|
|
|
|
|
); |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
|
816
|
9379
|
100
|
|
|
|
|
if (!SvOK(err)) { /* clear err / errstr / state */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
817
|
6048
|
50
|
|
|
|
|
DBIh_CLEAR_ERROR(imp_xxh); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
818
|
6048
|
|
|
|
|
|
return 1; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
/* fetch these after calling HandleSetErr */ |
822
|
3331
|
|
|
|
|
|
h_err = DBIc_ERR(imp_xxh); |
823
|
3331
|
|
|
|
|
|
h_errstr = DBIc_ERRSTR(imp_xxh); |
824
|
3331
|
|
|
|
|
|
h_state = DBIc_STATE(imp_xxh); |
825
|
|
|
|
|
|
|
|
826
|
3331
|
50
|
|
|
|
|
if (SvTRUE(h_errstr)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
827
|
|
|
|
|
|
|
/* append current err, if any, to errstr if it's going to change */ |
828
|
27
|
50
|
|
|
|
|
if (SvTRUE(h_err) && SvTRUE(err) && strNE(SvPV_nolen(h_err), SvPV_nolen(err))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
829
|
10
|
50
|
|
|
|
|
sv_catpvf(h_errstr, " [err was %s now %s]", SvPV_nolen(h_err), SvPV_nolen(err)); |
|
|
50
|
|
|
|
|
|
830
|
27
|
50
|
|
|
|
|
if (SvTRUE(h_state) && SvTRUE(state) && strNE(SvPV_nolen(h_state), SvPV_nolen(state))) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
831
|
4
|
50
|
|
|
|
|
sv_catpvf(h_errstr, " [state was %s now %s]", SvPV_nolen(h_state), SvPV_nolen(state)); |
|
|
50
|
|
|
|
|
|
832
|
52
|
50
|
|
|
|
|
if (strNE(SvPV_nolen(h_errstr), SvPV_nolen(errstr))) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
833
|
25
|
|
|
|
|
|
sv_catpvn(h_errstr, "\n", 1); |
834
|
25
|
|
|
|
|
|
sv_catsv(h_errstr, errstr); |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
else |
838
|
3304
|
|
|
|
|
|
sv_setsv(h_errstr, errstr); |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
/* SvTRUE(err) > "0" > "" > undef */ |
841
|
3331
|
50
|
|
|
|
|
if (SvTRUE(err) /* new error: so assign */ |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
842
|
21
|
100
|
|
|
|
|
|| !SvOK(h_err) /* no existing warn/info: so assign */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
843
|
|
|
|
|
|
|
/* new warn ("0" len 1) > info ("" len 0): so assign */ |
844
|
12
|
50
|
|
|
|
|
|| (SvOK(err) && strlen(SvPV_nolen(err)) > strlen(SvPV_nolen(h_err))) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
845
|
|
|
|
|
|
|
) { |
846
|
3322
|
|
|
|
|
|
sv_setsv(h_err, err); |
847
|
3322
|
|
|
|
|
|
err_changed = 1; |
848
|
3322
|
50
|
|
|
|
|
if (SvTRUE(h_err)) /* new error */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
849
|
3310
|
|
|
|
|
|
++DBIc_ErrCount(imp_xxh); |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
3331
|
100
|
|
|
|
|
if (err_changed) { |
853
|
3322
|
50
|
|
|
|
|
if (SvTRUE(state)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
854
|
2996
|
50
|
|
|
|
|
if (strlen(SvPV_nolen(state)) != 5) { |
|
|
50
|
|
|
|
|
|
855
|
0
|
|
|
|
|
|
warn("set_err: state (%s) is not a 5 character string, using 'S1000' instead", neatsvpv(state,0)); |
856
|
0
|
|
|
|
|
|
sv_setpv(h_state, "S1000"); |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
else |
859
|
1498
|
|
|
|
|
|
sv_setsv(h_state, state); |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
else |
862
|
1824
|
50
|
|
|
|
|
(void)SvOK_off(h_state); /* see DBIc_STATE_adjust */ |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
/* ensure that the parent's Statement attribute reflects the latest error */ |
865
|
|
|
|
|
|
|
/* so that ShowErrorStatement is reliable */ |
866
|
3322
|
|
|
|
|
|
copy_statement_to_parent(aTHX_ h, imp_xxh); |
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
|
869
|
3331
|
|
|
|
|
|
return 1; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
/* err_hash returns a U32 'hash' value representing the current err 'level' |
874
|
|
|
|
|
|
|
* (err/warn/info) and errstr. It's used by the dispatcher as a way to detect |
875
|
|
|
|
|
|
|
* a new or changed warning during a 'keep err' method like STORE. Always returns >0. |
876
|
|
|
|
|
|
|
* The value is 1 for no err/warn/info and guarantees that err > warn > info. |
877
|
|
|
|
|
|
|
* (It's a bit of a hack but the original approach in 70fe6bd76 using a new |
878
|
|
|
|
|
|
|
* ErrChangeCount attribute would break binary compatibility with drivers.) |
879
|
|
|
|
|
|
|
* The chance that two realistic errstr values would hash the same, even with |
880
|
|
|
|
|
|
|
* only 30 bits, is deemed to small to even bother documenting. |
881
|
|
|
|
|
|
|
*/ |
882
|
|
|
|
|
|
|
static U32 |
883
|
512953
|
|
|
|
|
|
err_hash(pTHX_ imp_xxh_t *imp_xxh) |
884
|
|
|
|
|
|
|
{ |
885
|
512953
|
|
|
|
|
|
SV *err_sv = DBIc_ERR(imp_xxh); |
886
|
|
|
|
|
|
|
SV *errstr_sv; |
887
|
512953
|
|
|
|
|
|
I32 hash = 1; |
888
|
512953
|
100
|
|
|
|
|
if (SvOK(err_sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
889
|
4506
|
|
|
|
|
|
errstr_sv = DBIc_ERRSTR(imp_xxh); |
890
|
4506
|
50
|
|
|
|
|
if (SvOK(errstr_sv)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
891
|
4506
|
50
|
|
|
|
|
hash = -dbi_hash(SvPV_nolen(errstr_sv), 0); /* make positive */ |
892
|
0
|
|
|
|
|
|
else hash = 0; |
893
|
4506
|
|
|
|
|
|
hash >>= 1; /* free up extra bit (top bit is already free) */ |
894
|
9012
|
0
|
|
|
|
|
hash |= (SvTRUE(err_sv)) ? 0x80000000 /* err */ |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
895
|
9012
|
50
|
|
|
|
|
: (SvPOK(err_sv) && !SvCUR(err_sv)) ? 0x20000000 /* '' = info */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
896
|
|
|
|
|
|
|
: 0x40000000;/* 0 or '0' = warn */ |
897
|
|
|
|
|
|
|
} |
898
|
512953
|
|
|
|
|
|
return hash; |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
static char * |
903
|
29563
|
|
|
|
|
|
mkvname(pTHX_ HV *stash, const char *item, int uplevel) /* construct a variable name */ |
904
|
|
|
|
|
|
|
{ |
905
|
29563
|
|
|
|
|
|
SV *sv = sv_newmortal(); |
906
|
29563
|
50
|
|
|
|
|
sv_setpv(sv, HvNAME(stash)); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
907
|
29563
|
50
|
|
|
|
|
if(uplevel) { |
908
|
0
|
0
|
|
|
|
|
while(SvCUR(sv) && *SvEND(sv)!=':') |
|
|
0
|
|
|
|
|
|
909
|
0
|
|
|
|
|
|
--SvCUR(sv); |
910
|
0
|
0
|
|
|
|
|
if (SvCUR(sv)) |
911
|
0
|
|
|
|
|
|
--SvCUR(sv); |
912
|
|
|
|
|
|
|
} |
913
|
29563
|
|
|
|
|
|
sv_catpv(sv, "::"); |
914
|
29563
|
|
|
|
|
|
sv_catpv(sv, item); |
915
|
29563
|
50
|
|
|
|
|
return SvPV_nolen(sv); |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
/* 32 bit magic FNV-0 and FNV-1 prime */ |
919
|
|
|
|
|
|
|
#define FNV_32_PRIME ((UV)0x01000193) |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
static I32 |
922
|
4516
|
|
|
|
|
|
dbi_hash(const char *key, long type) |
923
|
|
|
|
|
|
|
{ |
924
|
4516
|
100
|
|
|
|
|
if (type == 0) { |
925
|
4512
|
|
|
|
|
|
STRLEN klen = strlen(key); |
926
|
4512
|
|
|
|
|
|
U32 hash = 0; |
927
|
354468
|
100
|
|
|
|
|
while (klen--) |
928
|
349956
|
|
|
|
|
|
hash = hash * 33 + *key++; |
929
|
4512
|
|
|
|
|
|
hash &= 0x7FFFFFFF; /* limit to 31 bits */ |
930
|
4512
|
|
|
|
|
|
hash |= 0x40000000; /* set bit 31 */ |
931
|
4512
|
|
|
|
|
|
return -(I32)hash; /* return negative int */ |
932
|
|
|
|
|
|
|
} |
933
|
4
|
50
|
|
|
|
|
else if (type == 1) { /* Fowler/Noll/Vo hash */ |
934
|
|
|
|
|
|
|
/* see http://www.isthe.com/chongo/tech/comp/fnv/ */ |
935
|
4
|
|
|
|
|
|
U32 hash = 0x811c9dc5; |
936
|
4
|
|
|
|
|
|
const unsigned char *s = (unsigned char *)key; /* unsigned string */ |
937
|
20
|
100
|
|
|
|
|
while (*s) { |
938
|
|
|
|
|
|
|
/* multiply by the 32 bit FNV magic prime mod 2^32 */ |
939
|
16
|
|
|
|
|
|
hash *= FNV_32_PRIME; |
940
|
|
|
|
|
|
|
/* xor the bottom with the current octet */ |
941
|
16
|
|
|
|
|
|
hash ^= (U32)*s++; |
942
|
|
|
|
|
|
|
} |
943
|
4
|
|
|
|
|
|
return hash; |
944
|
|
|
|
|
|
|
} |
945
|
0
|
|
|
|
|
|
croak("DBI::hash(%ld): invalid type", type); |
946
|
|
|
|
|
|
|
return 0; /* NOT REACHED */ |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
static int |
951
|
0
|
|
|
|
|
|
dbih_logmsg(imp_xxh_t *imp_xxh, const char *fmt, ...) |
952
|
|
|
|
|
|
|
{ |
953
|
|
|
|
|
|
|
dTHX; |
954
|
|
|
|
|
|
|
va_list args; |
955
|
|
|
|
|
|
|
#ifdef I_STDARG |
956
|
0
|
|
|
|
|
|
va_start(args, fmt); |
957
|
|
|
|
|
|
|
#else |
958
|
|
|
|
|
|
|
va_start(args); |
959
|
|
|
|
|
|
|
#endif |
960
|
0
|
|
|
|
|
|
(void) PerlIO_vprintf(DBIc_DBISTATE(imp_xxh)->logfp, fmt, args); |
961
|
0
|
|
|
|
|
|
va_end(args); |
962
|
|
|
|
|
|
|
(void)imp_xxh; |
963
|
0
|
|
|
|
|
|
return 1; |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
static void |
967
|
38
|
|
|
|
|
|
close_trace_file(pTHX) |
968
|
|
|
|
|
|
|
{ |
969
|
|
|
|
|
|
|
dMY_CXT; |
970
|
38
|
100
|
|
|
|
|
if (DBILOGFP == PerlIO_stderr() || DBILOGFP == PerlIO_stdout()) |
|
|
100
|
|
|
|
|
|
971
|
20
|
|
|
|
|
|
return; |
972
|
|
|
|
|
|
|
|
973
|
18
|
100
|
|
|
|
|
if (DBIS->logfp_ref == NULL) |
974
|
8
|
|
|
|
|
|
PerlIO_close(DBILOGFP); |
975
|
|
|
|
|
|
|
else { |
976
|
|
|
|
|
|
|
/* DAA dec refcount and discard */ |
977
|
10
|
|
|
|
|
|
SvREFCNT_dec(DBIS->logfp_ref); |
978
|
10
|
|
|
|
|
|
DBIS->logfp_ref = NULL; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
static int |
983
|
190
|
|
|
|
|
|
set_trace_file(SV *file) |
984
|
|
|
|
|
|
|
{ |
985
|
|
|
|
|
|
|
dTHX; |
986
|
|
|
|
|
|
|
dMY_CXT; |
987
|
|
|
|
|
|
|
const char *filename; |
988
|
190
|
|
|
|
|
|
PerlIO *fp = Nullfp; |
989
|
|
|
|
|
|
|
IO *io; |
990
|
|
|
|
|
|
|
|
991
|
190
|
100
|
|
|
|
|
if (!file) /* no arg == no change */ |
992
|
152
|
|
|
|
|
|
return 0; |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
/* DAA check for a filehandle */ |
995
|
38
|
100
|
|
|
|
|
if (SvROK(file)) { |
996
|
8
|
|
|
|
|
|
io = sv_2io(file); |
997
|
8
|
50
|
|
|
|
|
if (!io || !(fp = IoOFP(io))) { |
|
|
50
|
|
|
|
|
|
998
|
0
|
|
|
|
|
|
warn("DBI trace filehandle is not valid"); |
999
|
0
|
|
|
|
|
|
return 0; |
1000
|
|
|
|
|
|
|
} |
1001
|
8
|
|
|
|
|
|
close_trace_file(aTHX); |
1002
|
8
|
|
|
|
|
|
(void)SvREFCNT_inc(io); |
1003
|
8
|
|
|
|
|
|
DBIS->logfp_ref = io; |
1004
|
|
|
|
|
|
|
} |
1005
|
30
|
100
|
|
|
|
|
else if (isGV_with_GP(file)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1006
|
4
|
50
|
|
|
|
|
io = GvIO(file); |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1007
|
4
|
50
|
|
|
|
|
if (!io || !(fp = IoOFP(io))) { |
|
|
50
|
|
|
|
|
|
1008
|
0
|
|
|
|
|
|
warn("DBI trace filehandle from GLOB is not valid"); |
1009
|
0
|
|
|
|
|
|
return 0; |
1010
|
|
|
|
|
|
|
} |
1011
|
4
|
|
|
|
|
|
close_trace_file(aTHX); |
1012
|
4
|
|
|
|
|
|
(void)SvREFCNT_inc(io); |
1013
|
4
|
|
|
|
|
|
DBIS->logfp_ref = io; |
1014
|
|
|
|
|
|
|
} |
1015
|
|
|
|
|
|
|
else { |
1016
|
26
|
100
|
|
|
|
|
filename = (SvOK(file)) ? SvPV_nolen(file) : Nullch; |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
/* undef arg == reset back to stderr */ |
1018
|
26
|
100
|
|
|
|
|
if (!filename || strEQ(filename,"STDERR") |
|
|
100
|
|
|
|
|
|
1019
|
20
|
50
|
|
|
|
|
|| strEQ(filename,"*main::STDERR")) { |
1020
|
6
|
|
|
|
|
|
close_trace_file(aTHX); |
1021
|
6
|
|
|
|
|
|
DBILOGFP = PerlIO_stderr(); |
1022
|
6
|
|
|
|
|
|
return 1; |
1023
|
|
|
|
|
|
|
} |
1024
|
20
|
100
|
|
|
|
|
if (strEQ(filename,"STDOUT")) { |
1025
|
12
|
|
|
|
|
|
close_trace_file(aTHX); |
1026
|
12
|
|
|
|
|
|
DBILOGFP = PerlIO_stdout(); |
1027
|
12
|
|
|
|
|
|
return 1; |
1028
|
|
|
|
|
|
|
} |
1029
|
8
|
|
|
|
|
|
fp = PerlIO_open(filename, "a+"); |
1030
|
8
|
50
|
|
|
|
|
if (fp == Nullfp) { |
1031
|
0
|
|
|
|
|
|
warn("Can't open trace file %s: %s", filename, Strerror(errno)); |
1032
|
0
|
|
|
|
|
|
return 0; |
1033
|
|
|
|
|
|
|
} |
1034
|
8
|
|
|
|
|
|
close_trace_file(aTHX); |
1035
|
|
|
|
|
|
|
} |
1036
|
20
|
|
|
|
|
|
DBILOGFP = fp; |
1037
|
|
|
|
|
|
|
/* if this line causes your compiler or linker to choke */ |
1038
|
|
|
|
|
|
|
/* then just comment it out, it's not essential. */ |
1039
|
20
|
|
|
|
|
|
PerlIO_setlinebuf(fp); /* force line buffered output */ |
1040
|
20
|
|
|
|
|
|
return 1; |
1041
|
|
|
|
|
|
|
} |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
static IV |
1044
|
190
|
|
|
|
|
|
parse_trace_flags(SV *h, SV *level_sv, IV old_level) |
1045
|
|
|
|
|
|
|
{ |
1046
|
|
|
|
|
|
|
dTHX; |
1047
|
|
|
|
|
|
|
IV level; |
1048
|
190
|
50
|
|
|
|
|
if (!level_sv || !SvOK(level_sv)) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1049
|
46
|
|
|
|
|
|
level = old_level; /* undef: no change */ |
1050
|
|
|
|
|
|
|
else |
1051
|
144
|
50
|
|
|
|
|
if (SvTRUE(level_sv)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1052
|
168
|
100
|
|
|
|
|
if (looks_like_number(level_sv)) |
1053
|
58
|
50
|
|
|
|
|
level = SvIV(level_sv); /* number: number */ |
1054
|
|
|
|
|
|
|
else { /* string: parse it */ |
1055
|
26
|
|
|
|
|
|
dSP; |
1056
|
26
|
50
|
|
|
|
|
PUSHMARK(sp); |
1057
|
26
|
50
|
|
|
|
|
XPUSHs(h); |
1058
|
26
|
50
|
|
|
|
|
XPUSHs(level_sv); |
1059
|
26
|
|
|
|
|
|
PUTBACK; |
1060
|
26
|
50
|
|
|
|
|
if (call_method("parse_trace_flags", G_SCALAR) != 1) |
1061
|
0
|
|
|
|
|
|
croak("panic: parse_trace_flags");/* should never happen */ |
1062
|
26
|
|
|
|
|
|
SPAGAIN; |
1063
|
26
|
50
|
|
|
|
|
level = POPi; |
1064
|
26
|
|
|
|
|
|
PUTBACK; |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
else /* defined but false: 0 */ |
1068
|
60
|
|
|
|
|
|
level = 0; |
1069
|
190
|
|
|
|
|
|
return level; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
static int |
1074
|
166
|
|
|
|
|
|
set_trace(SV *h, SV *level_sv, SV *file) |
1075
|
|
|
|
|
|
|
{ |
1076
|
|
|
|
|
|
|
dTHX; |
1077
|
166
|
|
|
|
|
|
D_imp_xxh(h); |
1078
|
166
|
|
|
|
|
|
int RETVAL = DBIc_DBISTATE(imp_xxh)->debug; /* Return trace level in effect now */ |
1079
|
166
|
|
|
|
|
|
IV level = parse_trace_flags(h, level_sv, RETVAL); |
1080
|
166
|
|
|
|
|
|
set_trace_file(file); |
1081
|
166
|
100
|
|
|
|
|
if (level != RETVAL) { /* set value */ |
1082
|
80
|
100
|
|
|
|
|
if ((level & DBIc_TRACE_LEVEL_MASK) > 0) { |
1083
|
8
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh), |
1084
|
|
|
|
|
|
|
" %s trace level set to 0x%lx/%ld (DBI @ 0x%lx/%ld) in DBI %s%s (pid %d)\n", |
1085
|
|
|
|
|
|
|
neatsvpv(h,0), |
1086
|
|
|
|
|
|
|
(long)(level & DBIc_TRACE_FLAGS_MASK), |
1087
|
|
|
|
|
|
|
(long)(level & DBIc_TRACE_LEVEL_MASK), |
1088
|
16
|
|
|
|
|
|
(long)DBIc_TRACE_FLAGS(imp_xxh), (long)DBIc_TRACE_LEVEL(imp_xxh), |
1089
|
8
|
|
|
|
|
|
XS_VERSION, dbi_build_opt, (int)PerlProc_getpid()); |
1090
|
8
|
50
|
|
|
|
|
if (!PL_dowarn) |
1091
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," Note: perl is running without the recommended perl -w option\n"); |
1092
|
8
|
|
|
|
|
|
PerlIO_flush(DBIc_LOGPIO(imp_xxh)); |
1093
|
|
|
|
|
|
|
} |
1094
|
80
|
|
|
|
|
|
sv_setiv(DBIc_DEBUG(imp_xxh), level); |
1095
|
|
|
|
|
|
|
} |
1096
|
166
|
|
|
|
|
|
return RETVAL; |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
static SV * |
1101
|
108399
|
|
|
|
|
|
dbih_inner(pTHX_ SV *orv, const char *what) |
1102
|
|
|
|
|
|
|
{ /* convert outer to inner handle else croak(what) if what is not NULL */ |
1103
|
|
|
|
|
|
|
/* if what is NULL then return NULL for invalid handles */ |
1104
|
|
|
|
|
|
|
MAGIC *mg; |
1105
|
|
|
|
|
|
|
SV *ohv; /* outer HV after derefing the RV */ |
1106
|
|
|
|
|
|
|
SV *hrv; /* dbi inner handle RV-to-HV */ |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
/* enable a raw HV (not ref-to-HV) to be passed in, eg DBIc_MY_H */ |
1109
|
108399
|
100
|
|
|
|
|
ohv = SvROK(orv) ? SvRV(orv) : orv; |
1110
|
|
|
|
|
|
|
|
1111
|
108399
|
50
|
|
|
|
|
if (!ohv || SvTYPE(ohv) != SVt_PVHV) { |
|
|
100
|
|
|
|
|
|
1112
|
330
|
50
|
|
|
|
|
if (!what) |
1113
|
330
|
|
|
|
|
|
return NULL; |
1114
|
|
|
|
|
|
|
if (1) { |
1115
|
|
|
|
|
|
|
dMY_CXT; |
1116
|
0
|
0
|
|
|
|
|
if (DBIS_TRACE_LEVEL) |
1117
|
0
|
|
|
|
|
|
sv_dump(orv); |
1118
|
|
|
|
|
|
|
} |
1119
|
0
|
0
|
|
|
|
|
if (!SvOK(orv)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
|
croak("%s given an undefined handle %s", |
1121
|
|
|
|
|
|
|
what, "(perhaps returned from a previous call which failed)"); |
1122
|
0
|
|
|
|
|
|
croak("%s handle %s is not a DBI handle", what, neatsvpv(orv,0)); |
1123
|
|
|
|
|
|
|
} |
1124
|
108069
|
100
|
|
|
|
|
if (!SvMAGICAL(ohv)) { |
1125
|
2
|
50
|
|
|
|
|
if (!what) |
1126
|
2
|
|
|
|
|
|
return NULL; |
1127
|
0
|
|
|
|
|
|
sv_dump(orv); |
1128
|
0
|
|
|
|
|
|
croak("%s handle %s is not a DBI handle (has no magic)", |
1129
|
|
|
|
|
|
|
what, neatsvpv(orv,0)); |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
108067
|
100
|
|
|
|
|
if ( (mg=mg_find(ohv,'P')) == NULL) { /* hash tie magic */ |
1133
|
|
|
|
|
|
|
/* not tied, maybe it's already an inner handle... */ |
1134
|
45990
|
50
|
|
|
|
|
if (mg_find(ohv, DBI_MAGIC) == NULL) { |
1135
|
0
|
0
|
|
|
|
|
if (!what) |
1136
|
0
|
|
|
|
|
|
return NULL; |
1137
|
0
|
|
|
|
|
|
sv_dump(orv); |
1138
|
0
|
|
|
|
|
|
croak("%s handle %s is not a valid DBI handle", |
1139
|
|
|
|
|
|
|
what, neatsvpv(orv,0)); |
1140
|
|
|
|
|
|
|
} |
1141
|
45990
|
|
|
|
|
|
hrv = orv; /* was already a DBI handle inner hash */ |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
else { |
1144
|
62077
|
|
|
|
|
|
hrv = mg->mg_obj; /* inner hash of tie */ |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
|
1147
|
108067
|
|
|
|
|
|
return hrv; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
/* -------------------------------------------------------------------- */ |
1153
|
|
|
|
|
|
|
/* Functions to manage a DBI handle (magic and attributes etc). */ |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
static imp_xxh_t * |
1156
|
0
|
|
|
|
|
|
dbih_getcom(SV *hrv) /* used by drivers via DBIS func ptr */ |
1157
|
|
|
|
|
|
|
{ |
1158
|
|
|
|
|
|
|
MAGIC *mg; |
1159
|
|
|
|
|
|
|
SV *sv; |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
/* short-cut common case */ |
1162
|
0
|
0
|
|
|
|
|
if ( SvROK(hrv) |
1163
|
0
|
0
|
|
|
|
|
&& (sv = SvRV(hrv)) |
1164
|
0
|
0
|
|
|
|
|
&& SvRMAGICAL(sv) |
1165
|
0
|
0
|
|
|
|
|
&& (mg = SvMAGIC(sv)) |
1166
|
0
|
0
|
|
|
|
|
&& mg->mg_type == DBI_MAGIC |
1167
|
0
|
0
|
|
|
|
|
&& mg->mg_ptr |
1168
|
|
|
|
|
|
|
) |
1169
|
0
|
|
|
|
|
|
return (imp_xxh_t *) mg->mg_ptr; |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
{ |
1172
|
|
|
|
|
|
|
dTHX; |
1173
|
0
|
|
|
|
|
|
imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ hrv, 0); |
1174
|
0
|
0
|
|
|
|
|
if (!imp_xxh) /* eg after take_imp_data */ |
1175
|
0
|
|
|
|
|
|
croak("Invalid DBI handle %s, has no dbi_imp_data", neatsvpv(hrv,0)); |
1176
|
0
|
|
|
|
|
|
return imp_xxh; |
1177
|
|
|
|
|
|
|
} |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
static imp_xxh_t * |
1181
|
1015393
|
|
|
|
|
|
dbih_getcom2(pTHX_ SV *hrv, MAGIC **mgp) /* Get com struct for handle. Must be fast. */ |
1182
|
|
|
|
|
|
|
{ |
1183
|
|
|
|
|
|
|
MAGIC *mg; |
1184
|
|
|
|
|
|
|
SV *sv; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
/* important and quick sanity check (esp non-'safe' Oraperl) */ |
1187
|
1015393
|
100
|
|
|
|
|
if (SvROK(hrv)) /* must at least be a ref */ |
1188
|
995890
|
|
|
|
|
|
sv = SvRV(hrv); |
1189
|
|
|
|
|
|
|
else { |
1190
|
|
|
|
|
|
|
dMY_CXT; |
1191
|
19503
|
100
|
|
|
|
|
if (hrv == DBI_LAST_HANDLE) /* special for var::FETCH */ |
1192
|
19497
|
|
|
|
|
|
sv = DBI_LAST_HANDLE; |
1193
|
6
|
50
|
|
|
|
|
else if (sv_derived_from(hrv, "DBI::common")) { |
1194
|
|
|
|
|
|
|
/* probably a class name, if ref($h)->foo() */ |
1195
|
6
|
|
|
|
|
|
return 0; |
1196
|
|
|
|
|
|
|
} |
1197
|
|
|
|
|
|
|
else { |
1198
|
0
|
|
|
|
|
|
sv_dump(hrv); |
1199
|
0
|
|
|
|
|
|
croak("Invalid DBI handle %s", neatsvpv(hrv,0)); |
1200
|
|
|
|
|
|
|
sv = &PL_sv_undef; /* avoid "might be used uninitialized" warning */ |
1201
|
|
|
|
|
|
|
} |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
/* Short cut for common case. We assume that a magic var always */ |
1205
|
|
|
|
|
|
|
/* has magic and that DBI_MAGIC, if present, will be the first. */ |
1206
|
1015387
|
50
|
|
|
|
|
if (SvRMAGICAL(sv) && (mg=SvMAGIC(sv))->mg_type == DBI_MAGIC) { |
|
|
100
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
/* nothing to do here */ |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
else { |
1210
|
|
|
|
|
|
|
/* Validate handle (convert outer to inner if required) */ |
1211
|
32450
|
|
|
|
|
|
hrv = dbih_inner(aTHX_ hrv, "dbih_getcom"); |
1212
|
32450
|
|
|
|
|
|
mg = mg_find(SvRV(hrv), DBI_MAGIC); |
1213
|
|
|
|
|
|
|
} |
1214
|
1015387
|
100
|
|
|
|
|
if (mgp) /* let caller pickup magic struct for this handle */ |
1215
|
1
|
|
|
|
|
|
*mgp = mg; |
1216
|
|
|
|
|
|
|
|
1217
|
1015387
|
50
|
|
|
|
|
if (!mg) /* may happen during global destruction */ |
1218
|
0
|
|
|
|
|
|
return (imp_xxh_t *) 0; |
1219
|
|
|
|
|
|
|
|
1220
|
1015387
|
|
|
|
|
|
return (imp_xxh_t *) mg->mg_ptr; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
static SV * |
1225
|
264747
|
|
|
|
|
|
dbih_setup_attrib(pTHX_ SV *h, imp_xxh_t *imp_xxh, char *attrib, SV *parent, int read_only, int optional) |
1226
|
|
|
|
|
|
|
{ |
1227
|
264747
|
|
|
|
|
|
STRLEN len = strlen(attrib); |
1228
|
|
|
|
|
|
|
SV **asvp; |
1229
|
|
|
|
|
|
|
|
1230
|
264747
|
100
|
|
|
|
|
asvp = hv_fetch((HV*)SvRV(h), attrib, len, !optional); |
1231
|
|
|
|
|
|
|
/* we assume that we won't have any existing 'undef' attributes here */ |
1232
|
|
|
|
|
|
|
/* (or, alternately, we take undef to mean 'copy from parent') */ |
1233
|
264747
|
100
|
|
|
|
|
if (!(asvp && SvOK(*asvp))) { /* attribute doesn't already exists (the common case) */ |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
SV **psvp; |
1235
|
253197
|
50
|
|
|
|
|
if ((!parent || !SvROK(parent)) && !optional) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1236
|
0
|
|
|
|
|
|
croak("dbih_setup_attrib(%s): %s not set and no parent supplied", |
1237
|
|
|
|
|
|
|
neatsvpv(h,0), attrib); |
1238
|
|
|
|
|
|
|
} |
1239
|
253197
|
|
|
|
|
|
psvp = hv_fetch((HV*)SvRV(parent), attrib, len, 0); |
1240
|
253197
|
100
|
|
|
|
|
if (psvp) { |
1241
|
136950
|
100
|
|
|
|
|
if (!asvp) |
1242
|
685
|
|
|
|
|
|
asvp = hv_fetch((HV*)SvRV(h), attrib, len, 1); |
1243
|
136950
|
|
|
|
|
|
sv_setsv(*asvp, *psvp); /* copy attribute from parent to handle */ |
1244
|
|
|
|
|
|
|
} |
1245
|
|
|
|
|
|
|
else { |
1246
|
116247
|
50
|
|
|
|
|
if (!optional) |
1247
|
0
|
|
|
|
|
|
croak("dbih_setup_attrib(%s): %s not set and not in parent", |
1248
|
|
|
|
|
|
|
neatsvpv(h,0), attrib); |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
} |
1251
|
264747
|
100
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 5) { |
1252
|
27
|
|
|
|
|
|
PerlIO *logfp = DBIc_LOGPIO(imp_xxh); |
1253
|
27
|
|
|
|
|
|
PerlIO_printf(logfp," dbih_setup_attrib(%s, %s, %s)", |
1254
|
|
|
|
|
|
|
neatsvpv(h,0), attrib, neatsvpv(parent,0)); |
1255
|
27
|
100
|
|
|
|
|
if (!asvp) |
1256
|
12
|
|
|
|
|
|
PerlIO_printf(logfp," undef (not defined)\n"); |
1257
|
|
|
|
|
|
|
else |
1258
|
15
|
50
|
|
|
|
|
if (SvOK(*asvp)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1259
|
15
|
|
|
|
|
|
PerlIO_printf(logfp," %s (already defined)\n", neatsvpv(*asvp,0)); |
1260
|
0
|
|
|
|
|
|
else PerlIO_printf(logfp," %s (copied from parent)\n", neatsvpv(*asvp,0)); |
1261
|
|
|
|
|
|
|
} |
1262
|
264747
|
100
|
|
|
|
|
if (read_only && asvp) |
|
|
50
|
|
|
|
|
|
1263
|
88689
|
|
|
|
|
|
SvREADONLY_on(*asvp); |
1264
|
264747
|
100
|
|
|
|
|
return asvp ? *asvp : &PL_sv_undef; |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
static SV * |
1269
|
0
|
|
|
|
|
|
dbih_make_fdsv(SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name) |
1270
|
|
|
|
|
|
|
{ |
1271
|
|
|
|
|
|
|
dTHX; |
1272
|
0
|
|
|
|
|
|
D_imp_sth(sth); |
1273
|
0
|
|
|
|
|
|
const STRLEN cn_len = strlen(col_name); |
1274
|
|
|
|
|
|
|
imp_fdh_t *imp_fdh; |
1275
|
|
|
|
|
|
|
SV *fdsv; |
1276
|
0
|
0
|
|
|
|
|
if (imp_size < sizeof(imp_fdh_t) || cn_len<10 || strNE("::fd",&col_name[cn_len-4])) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1277
|
0
|
|
|
|
|
|
croak("panic: dbih_makefdsv %s '%s' imp_size %ld invalid", |
1278
|
|
|
|
|
|
|
imp_class, col_name, (long)imp_size); |
1279
|
0
|
0
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 5) |
1280
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_make_fdsv(%s, %s, %ld, '%s')\n", |
1281
|
|
|
|
|
|
|
neatsvpv(sth,0), imp_class, (long)imp_size, col_name); |
1282
|
0
|
|
|
|
|
|
fdsv = dbih_make_com(sth, (imp_xxh_t*)imp_sth, imp_class, imp_size, cn_len+2, 0); |
1283
|
0
|
|
|
|
|
|
imp_fdh = (imp_fdh_t*)(void*)SvPVX(fdsv); |
1284
|
0
|
|
|
|
|
|
imp_fdh->com.col_name = ((char*)imp_fdh) + imp_size; |
1285
|
0
|
|
|
|
|
|
strcpy(imp_fdh->com.col_name, col_name); |
1286
|
0
|
|
|
|
|
|
return fdsv; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
static SV * |
1291
|
29563
|
|
|
|
|
|
dbih_make_com(SV *p_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV* imp_templ) |
1292
|
|
|
|
|
|
|
{ |
1293
|
|
|
|
|
|
|
dTHX; |
1294
|
|
|
|
|
|
|
static const char *errmsg = "Can't make DBI com handle for %s: %s"; |
1295
|
|
|
|
|
|
|
HV *imp_stash; |
1296
|
|
|
|
|
|
|
SV *dbih_imp_sv; |
1297
|
|
|
|
|
|
|
imp_xxh_t *imp; |
1298
|
|
|
|
|
|
|
int trace_level; |
1299
|
|
|
|
|
|
|
PERL_UNUSED_VAR(extra); |
1300
|
|
|
|
|
|
|
|
1301
|
29563
|
50
|
|
|
|
|
if ( (imp_stash = gv_stashpv(imp_class, FALSE)) == NULL) |
1302
|
0
|
|
|
|
|
|
croak(errmsg, imp_class, "unknown package"); |
1303
|
|
|
|
|
|
|
|
1304
|
29563
|
50
|
|
|
|
|
if (imp_size == 0) { |
1305
|
|
|
|
|
|
|
/* get size of structure to allocate for common and imp specific data */ |
1306
|
29563
|
|
|
|
|
|
const char *imp_size_name = mkvname(aTHX_ imp_stash, "imp_data_size", 0); |
1307
|
29563
|
50
|
|
|
|
|
imp_size = SvIV(get_sv(imp_size_name, 0x05)); |
1308
|
29563
|
50
|
|
|
|
|
if (imp_size == 0) { |
1309
|
29563
|
|
|
|
|
|
imp_size = sizeof(imp_sth_t); |
1310
|
29563
|
50
|
|
|
|
|
if (sizeof(imp_dbh_t) > imp_size) |
1311
|
0
|
|
|
|
|
|
imp_size = sizeof(imp_dbh_t); |
1312
|
29563
|
50
|
|
|
|
|
if (sizeof(imp_drh_t) > imp_size) |
1313
|
0
|
|
|
|
|
|
imp_size = sizeof(imp_drh_t); |
1314
|
29563
|
|
|
|
|
|
imp_size += 4; |
1315
|
|
|
|
|
|
|
} |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
|
1318
|
29563
|
100
|
|
|
|
|
if (p_imp_xxh) { |
1319
|
29233
|
|
|
|
|
|
trace_level = DBIc_TRACE_LEVEL(p_imp_xxh); |
1320
|
|
|
|
|
|
|
} |
1321
|
|
|
|
|
|
|
else { |
1322
|
|
|
|
|
|
|
dMY_CXT; |
1323
|
330
|
|
|
|
|
|
trace_level = DBIS_TRACE_LEVEL; |
1324
|
|
|
|
|
|
|
} |
1325
|
29563
|
100
|
|
|
|
|
if (trace_level >= 5) { |
1326
|
|
|
|
|
|
|
dMY_CXT; |
1327
|
3
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," dbih_make_com(%s, %p, %s, %ld, %p) thr#%p\n", |
1328
|
|
|
|
|
|
|
neatsvpv(p_h,0), (void*)p_imp_xxh, imp_class, (long)imp_size, (void*)imp_templ, (void*)PERL_GET_THX); |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
|
1331
|
29563
|
50
|
|
|
|
|
if (imp_templ && SvOK(imp_templ)) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
U32 imp_templ_flags; |
1333
|
|
|
|
|
|
|
/* validate the supplied dbi_imp_data looks reasonable, */ |
1334
|
0
|
0
|
|
|
|
|
if (SvCUR(imp_templ) != imp_size) |
1335
|
0
|
|
|
|
|
|
croak("Can't use dbi_imp_data of wrong size (%ld not %ld)", |
1336
|
0
|
|
|
|
|
|
(long)SvCUR(imp_templ), (long)imp_size); |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
/* copy the whole template */ |
1339
|
0
|
|
|
|
|
|
dbih_imp_sv = newSVsv(imp_templ); |
1340
|
0
|
|
|
|
|
|
imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv); |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
/* sanity checks on the supplied imp_data */ |
1343
|
0
|
0
|
|
|
|
|
if (DBIc_TYPE(imp) != ((p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 :1) ) |
|
|
0
|
|
|
|
|
|
1344
|
0
|
|
|
|
|
|
croak("Can't use dbi_imp_data from different type of handle"); |
1345
|
0
|
0
|
|
|
|
|
if (!DBIc_has(imp, DBIcf_IMPSET)) |
1346
|
0
|
|
|
|
|
|
croak("Can't use dbi_imp_data that not from a setup handle"); |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
/* copy flags, zero out our imp_xxh struct, restore some flags */ |
1349
|
0
|
|
|
|
|
|
imp_templ_flags = DBIc_FLAGS(imp); |
1350
|
0
|
0
|
|
|
|
|
switch ( (p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 : DBIt_DR ) { |
1351
|
0
|
|
|
|
|
|
case DBIt_DR: memzero((char*)imp, sizeof(imp_drh_t)); break; |
1352
|
0
|
|
|
|
|
|
case DBIt_DB: memzero((char*)imp, sizeof(imp_dbh_t)); break; |
1353
|
0
|
|
|
|
|
|
case DBIt_ST: memzero((char*)imp, sizeof(imp_sth_t)); break; |
1354
|
0
|
|
|
|
|
|
default: croak("dbih_make_com dbi_imp_data bad h type"); |
1355
|
|
|
|
|
|
|
} |
1356
|
|
|
|
|
|
|
/* Only pass on DBIcf_IMPSET to indicate to driver that the imp */ |
1357
|
|
|
|
|
|
|
/* structure has been copied and it doesn't need to reconnect. */ |
1358
|
|
|
|
|
|
|
/* Similarly DBIcf_ACTIVE is also passed along but isn't key. */ |
1359
|
0
|
|
|
|
|
|
DBIc_FLAGS(imp) = imp_templ_flags & (DBIcf_IMPSET|DBIcf_ACTIVE); |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
else { |
1362
|
29563
|
|
|
|
|
|
dbih_imp_sv = newSV(imp_size); /* is grown to at least imp_size+1 */ |
1363
|
29563
|
|
|
|
|
|
imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv); |
1364
|
29563
|
|
|
|
|
|
memzero((char*)imp, imp_size); |
1365
|
|
|
|
|
|
|
/* set up SV with SvCUR set ready for take_imp_data */ |
1366
|
29563
|
|
|
|
|
|
SvCUR_set(dbih_imp_sv, imp_size); |
1367
|
29563
|
|
|
|
|
|
*SvEND(dbih_imp_sv) = '\0'; |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
29563
|
100
|
|
|
|
|
if (p_imp_xxh) { |
1371
|
29233
|
|
|
|
|
|
DBIc_DBISTATE(imp) = DBIc_DBISTATE(p_imp_xxh); |
1372
|
|
|
|
|
|
|
} |
1373
|
|
|
|
|
|
|
else { |
1374
|
|
|
|
|
|
|
dMY_CXT; |
1375
|
330
|
|
|
|
|
|
DBIc_DBISTATE(imp) = DBIS; |
1376
|
|
|
|
|
|
|
} |
1377
|
29563
|
|
|
|
|
|
DBIc_IMP_STASH(imp) = imp_stash; |
1378
|
|
|
|
|
|
|
|
1379
|
29563
|
100
|
|
|
|
|
if (!p_h) { /* only a driver (drh) has no parent */ |
1380
|
330
|
|
|
|
|
|
DBIc_PARENT_H(imp) = &PL_sv_undef; |
1381
|
330
|
|
|
|
|
|
DBIc_PARENT_COM(imp) = NULL; |
1382
|
330
|
|
|
|
|
|
DBIc_TYPE(imp) = DBIt_DR; |
1383
|
330
|
|
|
|
|
|
DBIc_on(imp,DBIcf_WARN /* set only here, children inherit */ |
1384
|
|
|
|
|
|
|
|DBIcf_ACTIVE /* drivers are 'Active' by default */ |
1385
|
|
|
|
|
|
|
|DBIcf_AutoCommit /* advisory, driver must manage this */ |
1386
|
|
|
|
|
|
|
); |
1387
|
330
|
|
|
|
|
|
DBIc_set(imp, DBIcf_PrintWarn, 1); |
1388
|
|
|
|
|
|
|
} |
1389
|
|
|
|
|
|
|
else { |
1390
|
29233
|
|
|
|
|
|
DBIc_PARENT_H(imp) = (SV*)SvREFCNT_inc(p_h); /* ensure it lives */ |
1391
|
29233
|
|
|
|
|
|
DBIc_PARENT_COM(imp) = p_imp_xxh; /* shortcut for speed */ |
1392
|
29233
|
|
|
|
|
|
DBIc_TYPE(imp) = DBIc_TYPE(p_imp_xxh) + 1; |
1393
|
|
|
|
|
|
|
/* inherit some flags from parent and carry forward some from template */ |
1394
|
58466
|
|
|
|
|
|
DBIc_FLAGS(imp) = (DBIc_FLAGS(p_imp_xxh) & ~DBIcf_INHERITMASK) |
1395
|
29233
|
|
|
|
|
|
| (DBIc_FLAGS(imp) & (DBIcf_IMPSET|DBIcf_ACTIVE)); |
1396
|
29233
|
|
|
|
|
|
++DBIc_KIDS(p_imp_xxh); |
1397
|
|
|
|
|
|
|
} |
1398
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
1399
|
|
|
|
|
|
|
DBIc_THR_USER(imp) = PERL_GET_THX ; |
1400
|
|
|
|
|
|
|
#endif |
1401
|
|
|
|
|
|
|
|
1402
|
29563
|
100
|
|
|
|
|
if (DBIc_TYPE(imp) == DBIt_ST) { |
1403
|
25933
|
|
|
|
|
|
imp_sth_t *imp_sth = (imp_sth_t*)imp; |
1404
|
25933
|
|
|
|
|
|
DBIc_ROW_COUNT(imp_sth) = -1; |
1405
|
|
|
|
|
|
|
} |
1406
|
|
|
|
|
|
|
|
1407
|
29563
|
|
|
|
|
|
DBIc_COMSET_on(imp); /* common data now set up */ |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
/* The implementor should DBIc_IMPSET_on(imp) when setting up */ |
1410
|
|
|
|
|
|
|
/* any private data which will need clearing/freeing later. */ |
1411
|
|
|
|
|
|
|
|
1412
|
29563
|
|
|
|
|
|
return dbih_imp_sv; |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
static void |
1417
|
29563
|
|
|
|
|
|
dbih_setup_handle(pTHX_ SV *orv, char *imp_class, SV *parent, SV *imp_datasv) |
1418
|
|
|
|
|
|
|
{ |
1419
|
|
|
|
|
|
|
SV *h; |
1420
|
29563
|
|
|
|
|
|
char *errmsg = "Can't setup DBI handle of %s to %s: %s"; |
1421
|
|
|
|
|
|
|
SV *dbih_imp_sv; |
1422
|
|
|
|
|
|
|
SV *dbih_imp_rv; |
1423
|
29563
|
|
|
|
|
|
SV *dbi_imp_data = Nullsv; |
1424
|
|
|
|
|
|
|
SV **svp; |
1425
|
|
|
|
|
|
|
char imp_mem_name[300]; |
1426
|
|
|
|
|
|
|
HV *imp_mem_stash; |
1427
|
|
|
|
|
|
|
imp_xxh_t *imp; |
1428
|
|
|
|
|
|
|
imp_xxh_t *parent_imp; |
1429
|
|
|
|
|
|
|
int trace_level; |
1430
|
|
|
|
|
|
|
|
1431
|
29563
|
|
|
|
|
|
h = dbih_inner(aTHX_ orv, "dbih_setup_handle"); |
1432
|
29563
|
|
|
|
|
|
parent = dbih_inner(aTHX_ parent, NULL); /* check parent valid (& inner) */ |
1433
|
29563
|
100
|
|
|
|
|
if (parent) { |
1434
|
29233
|
|
|
|
|
|
parent_imp = DBIh_COM(parent); |
1435
|
29233
|
|
|
|
|
|
trace_level = DBIc_TRACE_LEVEL(parent_imp); |
1436
|
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
|
else { |
1438
|
|
|
|
|
|
|
dMY_CXT; |
1439
|
330
|
|
|
|
|
|
parent_imp = NULL; |
1440
|
330
|
|
|
|
|
|
trace_level = DBIS_TRACE_LEVEL; |
1441
|
|
|
|
|
|
|
} |
1442
|
|
|
|
|
|
|
|
1443
|
29563
|
100
|
|
|
|
|
if (trace_level >= 5) { |
1444
|
|
|
|
|
|
|
dMY_CXT; |
1445
|
3
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," dbih_setup_handle(%s=>%s, %s, %lx, %s)\n", |
1446
|
|
|
|
|
|
|
neatsvpv(orv,0), neatsvpv(h,0), imp_class, (long)parent, neatsvpv(imp_datasv,0)); |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
|
1449
|
29563
|
50
|
|
|
|
|
if (mg_find(SvRV(h), DBI_MAGIC) != NULL) |
1450
|
0
|
|
|
|
|
|
croak(errmsg, neatsvpv(orv,0), imp_class, "already a DBI (or ~magic) handle"); |
1451
|
|
|
|
|
|
|
|
1452
|
29563
|
|
|
|
|
|
strcpy(imp_mem_name, imp_class); |
1453
|
29563
|
|
|
|
|
|
strcat(imp_mem_name, "_mem"); |
1454
|
29563
|
50
|
|
|
|
|
if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL) |
1455
|
0
|
|
|
|
|
|
croak(errmsg, neatsvpv(orv,0), imp_mem_name, "unknown _mem package"); |
1456
|
|
|
|
|
|
|
|
1457
|
29563
|
50
|
|
|
|
|
if ((svp = hv_fetch((HV*)SvRV(h), "dbi_imp_data", 12, 0))) { |
1458
|
0
|
|
|
|
|
|
dbi_imp_data = *svp; |
1459
|
0
|
0
|
|
|
|
|
if (SvGMAGICAL(dbi_imp_data)) /* call FETCH via magic */ |
1460
|
0
|
|
|
|
|
|
mg_get(dbi_imp_data); |
1461
|
|
|
|
|
|
|
} |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
DBI_LOCK; |
1464
|
|
|
|
|
|
|
|
1465
|
29563
|
|
|
|
|
|
dbih_imp_sv = dbih_make_com(parent, parent_imp, imp_class, 0, 0, dbi_imp_data); |
1466
|
29563
|
|
|
|
|
|
imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv); |
1467
|
|
|
|
|
|
|
|
1468
|
29563
|
|
|
|
|
|
dbih_imp_rv = newRV_inc(dbih_imp_sv); /* just needed for sv_bless */ |
1469
|
29563
|
|
|
|
|
|
sv_bless(dbih_imp_rv, imp_mem_stash); |
1470
|
29563
|
|
|
|
|
|
sv_free(dbih_imp_rv); |
1471
|
|
|
|
|
|
|
|
1472
|
29563
|
|
|
|
|
|
DBIc_MY_H(imp) = (HV*)SvRV(orv); /* take _copy_ of pointer, not new ref */ |
1473
|
29563
|
100
|
|
|
|
|
DBIc_IMP_DATA(imp) = (imp_datasv) ? newSVsv(imp_datasv) : &PL_sv_undef; |
1474
|
29563
|
|
|
|
|
|
_imp2com(imp, std.pid) = (U32)PerlProc_getpid(); |
1475
|
|
|
|
|
|
|
|
1476
|
29563
|
50
|
|
|
|
|
if (DBIc_TYPE(imp) <= DBIt_ST) { |
1477
|
|
|
|
|
|
|
SV **tmp_svp; |
1478
|
|
|
|
|
|
|
/* Copy some attributes from parent if not defined locally and */ |
1479
|
|
|
|
|
|
|
/* also take address of attributes for speed of direct access. */ |
1480
|
|
|
|
|
|
|
/* parent is null for drh, in which case h must hold the values */ |
1481
|
|
|
|
|
|
|
#define COPY_PARENT(name,ro,opt) SvREFCNT_inc(dbih_setup_attrib(aTHX_ h,imp,(name),parent,ro,opt)) |
1482
|
|
|
|
|
|
|
#define DBIc_ATTR(imp, f) _imp2com(imp, attr.f) |
1483
|
|
|
|
|
|
|
/* XXX we should validate that these are the right type (refs etc) */ |
1484
|
29563
|
|
|
|
|
|
DBIc_ATTR(imp, Err) = COPY_PARENT("Err",1,0); /* scalar ref */ |
1485
|
29563
|
|
|
|
|
|
DBIc_ATTR(imp, State) = COPY_PARENT("State",1,0); /* scalar ref */ |
1486
|
29563
|
|
|
|
|
|
DBIc_ATTR(imp, Errstr) = COPY_PARENT("Errstr",1,0); /* scalar ref */ |
1487
|
29563
|
|
|
|
|
|
DBIc_ATTR(imp, TraceLevel)=COPY_PARENT("TraceLevel",0,0);/* scalar (int)*/ |
1488
|
29563
|
|
|
|
|
|
DBIc_ATTR(imp, FetchHashKeyName) = COPY_PARENT("FetchHashKeyName",0,0); /* scalar ref */ |
1489
|
|
|
|
|
|
|
|
1490
|
29563
|
100
|
|
|
|
|
if (parent) { |
1491
|
29233
|
|
|
|
|
|
dbih_setup_attrib(aTHX_ h,imp,"HandleSetErr",parent,0,1); |
1492
|
29233
|
|
|
|
|
|
dbih_setup_attrib(aTHX_ h,imp,"HandleError",parent,0,1); |
1493
|
29233
|
|
|
|
|
|
dbih_setup_attrib(aTHX_ h,imp,"ReadOnly",parent,0,1); |
1494
|
29233
|
|
|
|
|
|
dbih_setup_attrib(aTHX_ h,imp,"Profile",parent,0,1); |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
/* setup Callbacks from parents' ChildCallbacks */ |
1497
|
29233
|
100
|
|
|
|
|
if (DBIc_has(parent_imp, DBIcf_Callbacks) |
1498
|
1415
|
50
|
|
|
|
|
&& (tmp_svp = hv_fetch((HV*)SvRV(parent), "Callbacks", 9, 0)) |
1499
|
1415
|
50
|
|
|
|
|
&& SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV |
|
|
50
|
|
|
|
|
|
1500
|
1415
|
100
|
|
|
|
|
&& (tmp_svp = hv_fetch((HV*)SvRV(*tmp_svp), "ChildCallbacks", 14, 0)) |
1501
|
2
|
50
|
|
|
|
|
&& SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV |
|
|
50
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
) { |
1503
|
|
|
|
|
|
|
/* XXX mirrors behaviour of dbih_set_attr_k() of Callbacks */ |
1504
|
2
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), "Callbacks", 9, newRV_inc(SvRV(*tmp_svp)), 0); |
1505
|
2
|
|
|
|
|
|
DBIc_set(imp, DBIcf_Callbacks, 1); |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
|
1508
|
29233
|
|
|
|
|
|
DBIc_LongReadLen(imp) = DBIc_LongReadLen(parent_imp); |
1509
|
|
|
|
|
|
|
#ifdef sv_rvweaken |
1510
|
|
|
|
|
|
|
if (1) { |
1511
|
|
|
|
|
|
|
AV *av; |
1512
|
|
|
|
|
|
|
/* add weakref to new (outer) handle into parents ChildHandles array */ |
1513
|
29233
|
|
|
|
|
|
tmp_svp = hv_fetch((HV*)SvRV(parent), "ChildHandles", 12, 1); |
1514
|
29233
|
100
|
|
|
|
|
if (!SvROK(*tmp_svp)) { |
1515
|
3054
|
|
|
|
|
|
SV *ChildHandles_rvav = newRV_noinc((SV*)newAV()); |
1516
|
3054
|
|
|
|
|
|
sv_setsv(*tmp_svp, ChildHandles_rvav); |
1517
|
3054
|
|
|
|
|
|
sv_free(ChildHandles_rvav); |
1518
|
|
|
|
|
|
|
} |
1519
|
29233
|
|
|
|
|
|
av = (AV*)SvRV(*tmp_svp); |
1520
|
29233
|
|
|
|
|
|
av_push(av, (SV*)sv_rvweaken(newRV_inc((SV*)SvRV(orv)))); |
1521
|
29233
|
100
|
|
|
|
|
if (av_len(av) % 120 == 0) { |
1522
|
|
|
|
|
|
|
/* time to do some housekeeping to remove dead handles */ |
1523
|
3257
|
|
|
|
|
|
I32 i = av_len(av); /* 0 = 1 element */ |
1524
|
56850
|
100
|
|
|
|
|
while (i-- >= 0) { |
1525
|
27617
|
|
|
|
|
|
SV *sv = av_shift(av); |
1526
|
27617
|
100
|
|
|
|
|
if (SvOK(sv)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1527
|
3427
|
|
|
|
|
|
av_push(av, sv); |
1528
|
|
|
|
|
|
|
else |
1529
|
24190
|
|
|
|
|
|
sv_free(sv); /* keep it leak-free by Doru Petrescu pdoru.dbi@from.ro */ |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
} |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
#endif |
1534
|
|
|
|
|
|
|
} |
1535
|
|
|
|
|
|
|
else { |
1536
|
330
|
|
|
|
|
|
DBIc_LongReadLen(imp) = DBIc_LongReadLen_init; |
1537
|
|
|
|
|
|
|
} |
1538
|
|
|
|
|
|
|
|
1539
|
29563
|
|
|
|
|
|
switch (DBIc_TYPE(imp)) { |
1540
|
|
|
|
|
|
|
case DBIt_DB: |
1541
|
|
|
|
|
|
|
/* cache _inner_ handle, but also see quick_FETCH */ |
1542
|
3300
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), "Driver", 6, newRV_inc(SvRV(parent)), 0); |
1543
|
3300
|
|
|
|
|
|
(void)hv_fetch((HV*)SvRV(h), "Statement", 9, 1); /* store writable undef */ |
1544
|
3300
|
|
|
|
|
|
break; |
1545
|
|
|
|
|
|
|
case DBIt_ST: |
1546
|
25933
|
|
|
|
|
|
DBIc_NUM_FIELDS((imp_sth_t*)imp) = -1; |
1547
|
|
|
|
|
|
|
/* cache _inner_ handle, but also see quick_FETCH */ |
1548
|
25933
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), "Database", 8, newRV_inc(SvRV(parent)), 0); |
1549
|
|
|
|
|
|
|
/* copy (alias) Statement from the sth up into the dbh */ |
1550
|
25933
|
|
|
|
|
|
tmp_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 1); |
1551
|
25933
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(*tmp_svp), 0); |
1552
|
29563
|
|
|
|
|
|
break; |
1553
|
|
|
|
|
|
|
} |
1554
|
|
|
|
|
|
|
} |
1555
|
|
|
|
|
|
|
else |
1556
|
0
|
|
|
|
|
|
die("panic: invalid DBIc_TYPE"); |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
/* Use DBI magic on inner handle to carry handle attributes */ |
1559
|
|
|
|
|
|
|
/* Note that we store the imp_sv in mg_obj, but as a shortcut, */ |
1560
|
|
|
|
|
|
|
/* also store a direct pointer to imp, aka PVX(dbih_imp_sv), */ |
1561
|
|
|
|
|
|
|
/* in mg_ptr (with mg_len set to null, so it wont be freed) */ |
1562
|
29563
|
|
|
|
|
|
sv_magic(SvRV(h), dbih_imp_sv, DBI_MAGIC, (char*)imp, 0); |
1563
|
29563
|
|
|
|
|
|
SvREFCNT_dec(dbih_imp_sv); /* since sv_magic() incremented it */ |
1564
|
29563
|
|
|
|
|
|
SvRMAGICAL_on(SvRV(h)); /* so DBI magic gets sv_clear'd ok */ |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
{ |
1567
|
|
|
|
|
|
|
dMY_CXT; /* XXX would be nice to get rid of this */ |
1568
|
29563
|
|
|
|
|
|
DBI_SET_LAST_HANDLE(h); |
1569
|
|
|
|
|
|
|
} |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
if (1) { |
1572
|
|
|
|
|
|
|
/* This is a hack to work-around the fast but poor way old versions of |
1573
|
|
|
|
|
|
|
* DBD::Oracle (and possibly other drivers) check for a valid handle |
1574
|
|
|
|
|
|
|
* using (SvMAGIC(SvRV(h)))->mg_type == 'P'). That doesn't work now |
1575
|
|
|
|
|
|
|
* because the weakref magic is inserted ahead of the tie magic. |
1576
|
|
|
|
|
|
|
* So here we swap the tie and weakref magic so the tie comes first. |
1577
|
|
|
|
|
|
|
*/ |
1578
|
29563
|
|
|
|
|
|
MAGIC *tie_mg = mg_find(SvRV(orv),'P'); |
1579
|
29563
|
|
|
|
|
|
MAGIC *first = SvMAGIC(SvRV(orv)); |
1580
|
29563
|
50
|
|
|
|
|
if (tie_mg && first->mg_moremagic == tie_mg && !tie_mg->mg_moremagic) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1581
|
0
|
|
|
|
|
|
MAGIC *next = tie_mg->mg_moremagic; |
1582
|
0
|
|
|
|
|
|
SvMAGIC(SvRV(orv)) = tie_mg; |
1583
|
0
|
|
|
|
|
|
tie_mg->mg_moremagic = first; |
1584
|
0
|
|
|
|
|
|
first->mg_moremagic = next; |
1585
|
|
|
|
|
|
|
} |
1586
|
|
|
|
|
|
|
} |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
DBI_UNLOCK; |
1589
|
29563
|
|
|
|
|
|
} |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
static void |
1593
|
4
|
|
|
|
|
|
dbih_dumphandle(pTHX_ SV *h, const char *msg, int level) |
1594
|
|
|
|
|
|
|
{ |
1595
|
4
|
|
|
|
|
|
D_imp_xxh(h); |
1596
|
4
|
50
|
|
|
|
|
if (level >= 9) { |
1597
|
0
|
|
|
|
|
|
sv_dump(h); |
1598
|
|
|
|
|
|
|
} |
1599
|
4
|
|
|
|
|
|
dbih_dumpcom(aTHX_ imp_xxh, msg, level); |
1600
|
4
|
|
|
|
|
|
} |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
static int |
1603
|
7
|
|
|
|
|
|
dbih_dumpcom(pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level) |
1604
|
|
|
|
|
|
|
{ |
1605
|
|
|
|
|
|
|
dMY_CXT; |
1606
|
7
|
|
|
|
|
|
SV *flags = sv_2mortal(newSVpv("",0)); |
1607
|
|
|
|
|
|
|
SV *inner; |
1608
|
|
|
|
|
|
|
static const char pad[] = " "; |
1609
|
7
|
50
|
|
|
|
|
if (!msg) |
1610
|
0
|
|
|
|
|
|
msg = "dbih_dumpcom"; |
1611
|
14
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP," %s (%sh 0x%lx, com 0x%lx, imp %s):\n", |
1612
|
7
|
|
|
|
|
|
msg, dbih_htype_name(DBIc_TYPE(imp_xxh)), |
1613
|
7
|
|
|
|
|
|
(long)DBIc_MY_H(imp_xxh), (long)imp_xxh, |
1614
|
7
|
50
|
|
|
|
|
(PL_dirty) ? "global destruction" : HvNAME(DBIc_IMP_STASH(imp_xxh))); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1615
|
7
|
50
|
|
|
|
|
if (DBIc_COMSET(imp_xxh)) sv_catpv(flags,"COMSET "); |
1616
|
7
|
50
|
|
|
|
|
if (DBIc_IMPSET(imp_xxh)) sv_catpv(flags,"IMPSET "); |
1617
|
7
|
100
|
|
|
|
|
if (DBIc_ACTIVE(imp_xxh)) sv_catpv(flags,"Active "); |
1618
|
7
|
50
|
|
|
|
|
if (DBIc_WARN(imp_xxh)) sv_catpv(flags,"Warn "); |
1619
|
7
|
50
|
|
|
|
|
if (DBIc_COMPAT(imp_xxh)) sv_catpv(flags,"CompatMode "); |
1620
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_ChopBlanks)) sv_catpv(flags,"ChopBlanks "); |
1621
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_HandleSetErr)) sv_catpv(flags,"HandleSetErr "); |
1622
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_HandleError)) sv_catpv(flags,"HandleError "); |
1623
|
7
|
100
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_RaiseError)) sv_catpv(flags,"RaiseError "); |
1624
|
7
|
100
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_PrintError)) sv_catpv(flags,"PrintError "); |
1625
|
7
|
100
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_PrintWarn)) sv_catpv(flags,"PrintWarn "); |
1626
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_ShowErrorStatement)) sv_catpv(flags,"ShowErrorStatement "); |
1627
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_AutoCommit)) sv_catpv(flags,"AutoCommit "); |
1628
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_BegunWork)) sv_catpv(flags,"BegunWork "); |
1629
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_LongTruncOk)) sv_catpv(flags,"LongTruncOk "); |
1630
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_MultiThread)) sv_catpv(flags,"MultiThread "); |
1631
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_TaintIn)) sv_catpv(flags,"TaintIn "); |
1632
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_TaintOut)) sv_catpv(flags,"TaintOut "); |
1633
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_Profile)) sv_catpv(flags,"Profile "); |
1634
|
7
|
50
|
|
|
|
|
if (DBIc_is(imp_xxh, DBIcf_Callbacks)) sv_catpv(flags,"Callbacks "); |
1635
|
7
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s FLAGS 0x%lx: %s\n", pad, (long)DBIc_FLAGS(imp_xxh), SvPV_nolen(flags)); |
1636
|
7
|
50
|
|
|
|
|
if (SvOK(DBIc_ERR(imp_xxh))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1637
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s ERR %s\n", pad, neatsvpv((SV*)DBIc_ERR(imp_xxh),0)); |
1638
|
7
|
50
|
|
|
|
|
if (SvOK(DBIc_ERR(imp_xxh))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1639
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s ERRSTR %s\n", pad, neatsvpv((SV*)DBIc_ERRSTR(imp_xxh),0)); |
1640
|
7
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s PARENT %s\n", pad, neatsvpv((SV*)DBIc_PARENT_H(imp_xxh),0)); |
1641
|
7
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s KIDS %ld (%ld Active)\n", pad, |
1642
|
14
|
|
|
|
|
|
(long)DBIc_KIDS(imp_xxh), (long)DBIc_ACTIVE_KIDS(imp_xxh)); |
1643
|
7
|
50
|
|
|
|
|
if (DBIc_IMP_DATA(imp_xxh) && SvOK(DBIc_IMP_DATA(imp_xxh))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1644
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s IMP_DATA %s\n", pad, neatsvpv(DBIc_IMP_DATA(imp_xxh),0)); |
1645
|
7
|
50
|
|
|
|
|
if (DBIc_LongReadLen(imp_xxh) != DBIc_LongReadLen_init) |
1646
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s LongReadLen %ld\n", pad, (long)DBIc_LongReadLen(imp_xxh)); |
1647
|
|
|
|
|
|
|
|
1648
|
7
|
50
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) == DBIt_ST) { |
1649
|
0
|
|
|
|
|
|
const imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh; |
1650
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s NUM_OF_FIELDS %d\n", pad, DBIc_NUM_FIELDS(imp_sth)); |
1651
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s NUM_OF_PARAMS %d\n", pad, DBIc_NUM_PARAMS(imp_sth)); |
1652
|
|
|
|
|
|
|
} |
1653
|
7
|
|
|
|
|
|
inner = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_xxh), msg); |
1654
|
7
|
50
|
|
|
|
|
if (!inner || !SvROK(inner)) |
|
|
100
|
|
|
|
|
|
1655
|
3
|
|
|
|
|
|
return 1; |
1656
|
4
|
50
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) <= DBIt_DB) { |
1657
|
4
|
|
|
|
|
|
SV **svp = hv_fetch((HV*)SvRV(inner), "CachedKids", 10, 0); |
1658
|
4
|
50
|
|
|
|
|
if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1659
|
0
|
|
|
|
|
|
HV *hv = (HV*)SvRV(*svp); |
1660
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s CachedKids %d\n", pad, (int)HvKEYS(hv)); |
1661
|
|
|
|
|
|
|
} |
1662
|
|
|
|
|
|
|
} |
1663
|
4
|
50
|
|
|
|
|
if (level > 0) { |
1664
|
|
|
|
|
|
|
SV* value; |
1665
|
|
|
|
|
|
|
char *key; |
1666
|
|
|
|
|
|
|
I32 keylen; |
1667
|
4
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s cached attributes:\n", pad); |
1668
|
82
|
100
|
|
|
|
|
while ( (value = hv_iternextsv((HV*)SvRV(inner), &key, &keylen)) ) { |
1669
|
78
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s '%s' => %s\n", pad, key, neatsvpv(value,0)); |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
} |
1672
|
0
|
0
|
|
|
|
|
else if (DBIc_TYPE(imp_xxh) == DBIt_DB) { |
1673
|
0
|
|
|
|
|
|
SV **svp = hv_fetch((HV*)SvRV(inner), "Name", 4, 0); |
1674
|
0
|
0
|
|
|
|
|
if (svp && SvOK(*svp)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1675
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s Name %s\n", pad, neatsvpv(*svp,0)); |
1676
|
|
|
|
|
|
|
} |
1677
|
0
|
0
|
|
|
|
|
else if (DBIc_TYPE(imp_xxh) == DBIt_ST) { |
1678
|
0
|
|
|
|
|
|
SV **svp = hv_fetch((HV*)SvRV(inner), "Statement", 9, 0); |
1679
|
0
|
0
|
|
|
|
|
if (svp && SvOK(*svp)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1680
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s Statement %s\n", pad, neatsvpv(*svp,0)); |
1681
|
|
|
|
|
|
|
} |
1682
|
4
|
|
|
|
|
|
return 1; |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
static void |
1687
|
29560
|
|
|
|
|
|
dbih_clearcom(imp_xxh_t *imp_xxh) |
1688
|
|
|
|
|
|
|
{ |
1689
|
|
|
|
|
|
|
dTHX; |
1690
|
|
|
|
|
|
|
dTHR; |
1691
|
29560
|
|
|
|
|
|
int dump = FALSE; |
1692
|
29560
|
|
|
|
|
|
int debug = DBIc_TRACE_LEVEL(imp_xxh); |
1693
|
29560
|
|
|
|
|
|
int auto_dump = (debug >= 6); |
1694
|
29560
|
|
|
|
|
|
imp_xxh_t * const parent_xxh = DBIc_PARENT_COM(imp_xxh); |
1695
|
|
|
|
|
|
|
/* Note that we're very much on our own here. DBIc_MY_H(imp_xxh) almost */ |
1696
|
|
|
|
|
|
|
/* certainly points to memory which has been freed. Don't use it! */ |
1697
|
|
|
|
|
|
|
|
1698
|
|
|
|
|
|
|
/* --- pre-clearing sanity checks --- */ |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
1701
|
|
|
|
|
|
|
if (DBIc_THR_USER(imp_xxh) != my_perl) { /* don't clear handle that belongs to another thread */ |
1702
|
|
|
|
|
|
|
if (debug >= 3) { |
1703
|
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," skipped dbih_clearcom: DBI handle (type=%d, %s) is owned by thread %p not current thread %p\n", |
1704
|
|
|
|
|
|
|
DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ; |
1705
|
|
|
|
|
|
|
PerlIO_flush(DBIc_LOGPIO(imp_xxh)); |
1706
|
|
|
|
|
|
|
} |
1707
|
|
|
|
|
|
|
return; |
1708
|
|
|
|
|
|
|
} |
1709
|
|
|
|
|
|
|
#endif |
1710
|
|
|
|
|
|
|
|
1711
|
29560
|
50
|
|
|
|
|
if (!DBIc_COMSET(imp_xxh)) { /* should never happen */ |
1712
|
0
|
|
|
|
|
|
dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom: DBI handle already cleared", 0); |
1713
|
0
|
|
|
|
|
|
return; |
1714
|
|
|
|
|
|
|
} |
1715
|
|
|
|
|
|
|
|
1716
|
29560
|
100
|
|
|
|
|
if (auto_dump) |
1717
|
3
|
|
|
|
|
|
dbih_dumpcom(aTHX_ imp_xxh,"DESTROY (dbih_clearcom)", 0); |
1718
|
|
|
|
|
|
|
|
1719
|
29560
|
100
|
|
|
|
|
if (!PL_dirty) { |
1720
|
|
|
|
|
|
|
|
1721
|
28700
|
100
|
|
|
|
|
if (DBIc_ACTIVE(imp_xxh)) { /* bad news, potentially */ |
1722
|
|
|
|
|
|
|
/* warn for sth, warn for dbh only if it has active sth or isn't AutoCommit */ |
1723
|
315
|
50
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) >= DBIt_ST |
1724
|
315
|
50
|
|
|
|
|
|| (DBIc_ACTIVE_KIDS(imp_xxh) || !DBIc_has(imp_xxh, DBIcf_AutoCommit)) |
|
|
50
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
) { |
1726
|
0
|
|
|
|
|
|
warn("DBI %s handle 0x%lx cleared whilst still active", |
1727
|
0
|
|
|
|
|
|
dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh)); |
1728
|
0
|
|
|
|
|
|
dump = TRUE; |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
} |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
/* check that the implementor has done its own housekeeping */ |
1733
|
28700
|
50
|
|
|
|
|
if (DBIc_IMPSET(imp_xxh)) { |
1734
|
0
|
|
|
|
|
|
warn("DBI %s handle 0x%lx has uncleared implementors data", |
1735
|
0
|
|
|
|
|
|
dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh)); |
1736
|
0
|
|
|
|
|
|
dump = TRUE; |
1737
|
|
|
|
|
|
|
} |
1738
|
|
|
|
|
|
|
|
1739
|
28700
|
50
|
|
|
|
|
if (DBIc_KIDS(imp_xxh)) { |
1740
|
0
|
|
|
|
|
|
warn("DBI %s handle 0x%lx has %d uncleared child handles", |
1741
|
0
|
|
|
|
|
|
dbih_htype_name(DBIc_TYPE(imp_xxh)), |
1742
|
0
|
|
|
|
|
|
(unsigned long)DBIc_MY_H(imp_xxh), (int)DBIc_KIDS(imp_xxh)); |
1743
|
0
|
|
|
|
|
|
dump = TRUE; |
1744
|
|
|
|
|
|
|
} |
1745
|
|
|
|
|
|
|
} |
1746
|
|
|
|
|
|
|
|
1747
|
29560
|
50
|
|
|
|
|
if (dump && !auto_dump) /* else was already dumped above */ |
|
|
0
|
|
|
|
|
|
1748
|
0
|
|
|
|
|
|
dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom", 0); |
1749
|
|
|
|
|
|
|
|
1750
|
|
|
|
|
|
|
/* --- pre-clearing adjustments --- */ |
1751
|
|
|
|
|
|
|
|
1752
|
29560
|
100
|
|
|
|
|
if (!PL_dirty) { |
1753
|
28700
|
50
|
|
|
|
|
if (parent_xxh) { |
1754
|
28700
|
100
|
|
|
|
|
if (DBIc_ACTIVE(imp_xxh)) /* see also DBIc_ACTIVE_off */ |
1755
|
315
|
|
|
|
|
|
--DBIc_ACTIVE_KIDS(parent_xxh); |
1756
|
28700
|
|
|
|
|
|
--DBIc_KIDS(parent_xxh); |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
/* --- clear fields (may invoke object destructors) --- */ |
1761
|
|
|
|
|
|
|
|
1762
|
29560
|
100
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) == DBIt_ST) { |
1763
|
25933
|
|
|
|
|
|
imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh; |
1764
|
25933
|
|
|
|
|
|
sv_free((SV*)DBIc_FIELDS_AV(imp_sth)); |
1765
|
|
|
|
|
|
|
} |
1766
|
|
|
|
|
|
|
|
1767
|
29560
|
|
|
|
|
|
sv_free(DBIc_IMP_DATA(imp_xxh)); /* do this first */ |
1768
|
29560
|
50
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) <= DBIt_ST) { /* DBIt_FD doesn't have attr */ |
1769
|
29560
|
|
|
|
|
|
sv_free(_imp2com(imp_xxh, attr.TraceLevel)); |
1770
|
29560
|
|
|
|
|
|
sv_free(_imp2com(imp_xxh, attr.State)); |
1771
|
29560
|
|
|
|
|
|
sv_free(_imp2com(imp_xxh, attr.Err)); |
1772
|
29560
|
|
|
|
|
|
sv_free(_imp2com(imp_xxh, attr.Errstr)); |
1773
|
29560
|
|
|
|
|
|
sv_free(_imp2com(imp_xxh, attr.FetchHashKeyName)); |
1774
|
|
|
|
|
|
|
} |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
|
1777
|
29560
|
|
|
|
|
|
sv_free((SV*)DBIc_PARENT_H(imp_xxh)); /* do this last */ |
1778
|
|
|
|
|
|
|
|
1779
|
29560
|
|
|
|
|
|
DBIc_COMSET_off(imp_xxh); |
1780
|
|
|
|
|
|
|
|
1781
|
29560
|
100
|
|
|
|
|
if (debug >= 4) |
1782
|
3
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," dbih_clearcom 0x%lx (com 0x%lx, type %d) done.\n\n", |
1783
|
6
|
|
|
|
|
|
(long)DBIc_MY_H(imp_xxh), (long)imp_xxh, DBIc_TYPE(imp_xxh)); |
1784
|
|
|
|
|
|
|
} |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
/* --- Functions for handling field buffer arrays --- */ |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
static AV * |
1790
|
4020
|
|
|
|
|
|
dbih_setup_fbav(imp_sth_t *imp_sth) |
1791
|
|
|
|
|
|
|
{ |
1792
|
|
|
|
|
|
|
/* Usually called to setup the row buffer for new sth. |
1793
|
|
|
|
|
|
|
* Also called if the value of NUM_OF_FIELDS is altered, |
1794
|
|
|
|
|
|
|
* in which case it adjusts the row buffer to match NUM_OF_FIELDS. |
1795
|
|
|
|
|
|
|
*/ |
1796
|
|
|
|
|
|
|
dTHX; |
1797
|
4020
|
|
|
|
|
|
I32 i = DBIc_NUM_FIELDS(imp_sth); |
1798
|
4020
|
|
|
|
|
|
AV *av = DBIc_FIELDS_AV(imp_sth); |
1799
|
|
|
|
|
|
|
|
1800
|
4020
|
50
|
|
|
|
|
if (i < 0) |
1801
|
0
|
|
|
|
|
|
i = 0; |
1802
|
|
|
|
|
|
|
|
1803
|
4020
|
100
|
|
|
|
|
if (av) { |
1804
|
1845
|
100
|
|
|
|
|
if (av_len(av)+1 == i) /* is existing array the right size? */ |
1805
|
1841
|
|
|
|
|
|
return av; |
1806
|
|
|
|
|
|
|
/* we need to adjust the size of the array */ |
1807
|
4
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 2) |
1808
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav realloc from %ld to %ld fields\n", (long)(av_len(av)+1), (long)i); |
1809
|
4
|
|
|
|
|
|
SvREADONLY_off(av); |
1810
|
4
|
100
|
|
|
|
|
if (i < av_len(av)+1) /* trim to size if too big */ |
1811
|
4
|
|
|
|
|
|
av_fill(av, i-1); |
1812
|
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
|
else { |
1814
|
2175
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 5) |
1815
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav alloc for %ld fields\n", (long)i); |
1816
|
2175
|
|
|
|
|
|
av = newAV(); |
1817
|
2175
|
|
|
|
|
|
DBIc_FIELDS_AV(imp_sth) = av; |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
/* row_count will need to be manually reset by the driver if the */ |
1820
|
|
|
|
|
|
|
/* sth is re-executed (since this code won't get rerun) */ |
1821
|
2175
|
|
|
|
|
|
DBIc_ROW_COUNT(imp_sth) = 0; |
1822
|
|
|
|
|
|
|
} |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
/* load array with writeable SV's. Do this backwards so */ |
1825
|
|
|
|
|
|
|
/* the array only gets extended once. */ |
1826
|
8530
|
100
|
|
|
|
|
while(i--) /* field 1 stored at index 0 */ |
1827
|
6351
|
|
|
|
|
|
av_store(av, i, newSV(0)); |
1828
|
2179
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 6) |
1829
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav now %ld fields\n", (long)(av_len(av)+1)); |
1830
|
2179
|
|
|
|
|
|
SvREADONLY_on(av); /* protect against shift @$row etc */ |
1831
|
2179
|
|
|
|
|
|
return av; |
1832
|
|
|
|
|
|
|
} |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
static AV * |
1836
|
103862
|
|
|
|
|
|
dbih_get_fbav(imp_sth_t *imp_sth) |
1837
|
|
|
|
|
|
|
{ |
1838
|
|
|
|
|
|
|
AV *av; |
1839
|
|
|
|
|
|
|
|
1840
|
103862
|
100
|
|
|
|
|
if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav) { |
1841
|
2117
|
|
|
|
|
|
av = dbih_setup_fbav(imp_sth); |
1842
|
|
|
|
|
|
|
} |
1843
|
|
|
|
|
|
|
else { |
1844
|
|
|
|
|
|
|
dTHX; |
1845
|
101745
|
|
|
|
|
|
int i = av_len(av) + 1; |
1846
|
101745
|
50
|
|
|
|
|
if (i != DBIc_NUM_FIELDS(imp_sth)) { |
1847
|
|
|
|
|
|
|
/*SV *sth = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_sth), "_get_fbav");*/ |
1848
|
|
|
|
|
|
|
/* warn via PrintWarn */ |
1849
|
0
|
|
|
|
|
|
set_err_char(SvRV(DBIc_MY_H(imp_sth)), (imp_xxh_t*)imp_sth, |
1850
|
|
|
|
|
|
|
"0", 0, "Number of row fields inconsistent with NUM_OF_FIELDS (driver bug)", "", "_get_fbav"); |
1851
|
|
|
|
|
|
|
/* |
1852
|
|
|
|
|
|
|
DBIc_NUM_FIELDS(imp_sth) = i; |
1853
|
|
|
|
|
|
|
hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD); |
1854
|
|
|
|
|
|
|
*/ |
1855
|
|
|
|
|
|
|
} |
1856
|
|
|
|
|
|
|
/* don't let SvUTF8 flag persist from one row to the next */ |
1857
|
|
|
|
|
|
|
/* (only affects drivers that use sv_setpv, but most XS do) */ |
1858
|
|
|
|
|
|
|
/* XXX turn into option later (force on/force off/ignore) */ |
1859
|
404195
|
100
|
|
|
|
|
while(i--) /* field 1 stored at index 0 */ |
1860
|
302450
|
|
|
|
|
|
SvUTF8_off(AvARRAY(av)[i]); |
1861
|
|
|
|
|
|
|
} |
1862
|
|
|
|
|
|
|
|
1863
|
103862
|
100
|
|
|
|
|
if (DBIc_is(imp_sth, DBIcf_TaintOut)) { |
1864
|
|
|
|
|
|
|
dTHX; |
1865
|
|
|
|
|
|
|
dTHR; |
1866
|
1
|
|
|
|
|
|
TAINT; /* affects sv_setsv()'s called within same perl statement */ |
1867
|
|
|
|
|
|
|
} |
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
/* XXX fancy stuff to happen here later (re scrolling etc) */ |
1870
|
103862
|
|
|
|
|
|
++DBIc_ROW_COUNT(imp_sth); |
1871
|
103862
|
|
|
|
|
|
return av; |
1872
|
|
|
|
|
|
|
} |
1873
|
|
|
|
|
|
|
|
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
static int |
1876
|
162
|
|
|
|
|
|
dbih_sth_bind_col(SV *sth, SV *col, SV *ref, SV *attribs) |
1877
|
|
|
|
|
|
|
{ |
1878
|
|
|
|
|
|
|
dTHX; |
1879
|
162
|
|
|
|
|
|
D_imp_sth(sth); |
1880
|
|
|
|
|
|
|
AV *av; |
1881
|
162
|
50
|
|
|
|
|
int idx = SvIV(col); |
1882
|
162
|
|
|
|
|
|
int fields = DBIc_NUM_FIELDS(imp_sth); |
1883
|
|
|
|
|
|
|
|
1884
|
162
|
50
|
|
|
|
|
if (fields <= 0) { |
1885
|
|
|
|
|
|
|
PERL_UNUSED_VAR(attribs); |
1886
|
0
|
0
|
|
|
|
|
croak("Statement has no result columns to bind%s", |
1887
|
0
|
|
|
|
|
|
DBIc_ACTIVE(imp_sth) |
1888
|
|
|
|
|
|
|
? "" : " (perhaps you need to successfully call execute first, or again)"); |
1889
|
|
|
|
|
|
|
} |
1890
|
|
|
|
|
|
|
|
1891
|
162
|
100
|
|
|
|
|
if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav) |
1892
|
58
|
|
|
|
|
|
av = dbih_setup_fbav(imp_sth); |
1893
|
|
|
|
|
|
|
|
1894
|
162
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 5) |
1895
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_sth_bind_col %s => %s %s\n", |
1896
|
|
|
|
|
|
|
neatsvpv(col,0), neatsvpv(ref,0), neatsvpv(attribs,0)); |
1897
|
|
|
|
|
|
|
|
1898
|
162
|
100
|
|
|
|
|
if (idx < 1 || idx > fields) |
|
|
100
|
|
|
|
|
|
1899
|
6
|
|
|
|
|
|
croak("bind_col: column %d is not a valid column (1..%d)", |
1900
|
|
|
|
|
|
|
idx, fields); |
1901
|
|
|
|
|
|
|
|
1902
|
156
|
100
|
|
|
|
|
if (!SvOK(ref) && SvREADONLY(ref)) { /* binding to literal undef */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
/* presumably the call is just setting the TYPE or other atribs */ |
1904
|
|
|
|
|
|
|
/* but this default method ignores attribs, so we just return */ |
1905
|
2
|
|
|
|
|
|
return 1; |
1906
|
|
|
|
|
|
|
} |
1907
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
/* Write this as > SVt_PVMG because in 5.8.x the next type */ |
1909
|
|
|
|
|
|
|
/* is SVt_PVBM, whereas in 5.9.x it's SVt_PVGV. */ |
1910
|
154
|
50
|
|
|
|
|
if (!SvROK(ref) || SvTYPE(SvRV(ref)) > SVt_PVMG) /* XXX LV */ |
|
|
50
|
|
|
|
|
|
1911
|
0
|
|
|
|
|
|
croak("Can't %s->bind_col(%s, %s,...), need a reference to a scalar", |
1912
|
|
|
|
|
|
|
neatsvpv(sth,0), neatsvpv(col,0), neatsvpv(ref,0)); |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
/* use supplied scalar as storage for this column */ |
1915
|
154
|
|
|
|
|
|
SvREADONLY_off(av); |
1916
|
154
|
|
|
|
|
|
av_store(av, idx-1, SvREFCNT_inc(SvRV(ref)) ); |
1917
|
154
|
|
|
|
|
|
SvREADONLY_on(av); |
1918
|
154
|
|
|
|
|
|
return 1; |
1919
|
|
|
|
|
|
|
} |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
static int |
1923
|
0
|
|
|
|
|
|
quote_type(int sql_type, int p, int s, int *t, void *v) |
1924
|
|
|
|
|
|
|
{ |
1925
|
|
|
|
|
|
|
/* Returns true if type should be bound as a number else */ |
1926
|
|
|
|
|
|
|
/* false implying that binding as a string should be okay. */ |
1927
|
|
|
|
|
|
|
/* The true value is either SQL_INTEGER or SQL_DOUBLE which */ |
1928
|
|
|
|
|
|
|
/* can be used as a hint if desired. */ |
1929
|
|
|
|
|
|
|
(void)p; |
1930
|
|
|
|
|
|
|
(void)s; |
1931
|
|
|
|
|
|
|
(void)t; |
1932
|
|
|
|
|
|
|
(void)v; |
1933
|
|
|
|
|
|
|
/* looks like it's never been used, and doesn't make much sense anyway */ |
1934
|
0
|
|
|
|
|
|
warn("Use of DBI internal bind_as_num/quote_type function is deprecated"); |
1935
|
0
|
|
|
|
|
|
switch(sql_type) { |
1936
|
|
|
|
|
|
|
case SQL_INTEGER: |
1937
|
|
|
|
|
|
|
case SQL_SMALLINT: |
1938
|
|
|
|
|
|
|
case SQL_TINYINT: |
1939
|
|
|
|
|
|
|
case SQL_BIGINT: |
1940
|
0
|
|
|
|
|
|
return 0; |
1941
|
|
|
|
|
|
|
case SQL_FLOAT: |
1942
|
|
|
|
|
|
|
case SQL_REAL: |
1943
|
|
|
|
|
|
|
case SQL_DOUBLE: |
1944
|
0
|
|
|
|
|
|
return 0; |
1945
|
|
|
|
|
|
|
case SQL_NUMERIC: |
1946
|
|
|
|
|
|
|
case SQL_DECIMAL: |
1947
|
0
|
|
|
|
|
|
return 0; /* bind as string to attempt to retain precision */ |
1948
|
|
|
|
|
|
|
} |
1949
|
0
|
|
|
|
|
|
return 1; |
1950
|
|
|
|
|
|
|
} |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
/* Convert a simple string representation of a value into a more specific |
1954
|
|
|
|
|
|
|
* perl type based on an sql_type value. |
1955
|
|
|
|
|
|
|
* The semantics of SQL standard TYPE values are interpreted _very_ loosely |
1956
|
|
|
|
|
|
|
* on the basis of "be liberal in what you accept and let's throw in some |
1957
|
|
|
|
|
|
|
* extra semantics while we're here" :) |
1958
|
|
|
|
|
|
|
* Returns: |
1959
|
|
|
|
|
|
|
* -2: sql_type isn't handled, value unchanged |
1960
|
|
|
|
|
|
|
* -1: sv is undef, value unchanged |
1961
|
|
|
|
|
|
|
* 0: sv couldn't be cast cleanly and DBIstcf_STRICT was used |
1962
|
|
|
|
|
|
|
* 1: sv couldn't be cast cleanly and DBIstcf_STRICT was not used |
1963
|
|
|
|
|
|
|
* 2: sv was cast ok |
1964
|
|
|
|
|
|
|
*/ |
1965
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
int |
1967
|
40
|
|
|
|
|
|
sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v) |
1968
|
|
|
|
|
|
|
{ |
1969
|
40
|
|
|
|
|
|
int cast_ok = 0; |
1970
|
|
|
|
|
|
|
int grok_flags; |
1971
|
|
|
|
|
|
|
UV uv; |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
/* do nothing for undef (NULL) or non-string values */ |
1974
|
40
|
50
|
|
|
|
|
if (!sv || !SvOK(sv)) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1975
|
2
|
|
|
|
|
|
return -1; |
1976
|
|
|
|
|
|
|
|
1977
|
38
|
|
|
|
|
|
switch(sql_type) { |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
default: |
1980
|
2
|
|
|
|
|
|
return -2; /* not a recognised SQL TYPE, value unchanged */ |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
case SQL_INTEGER: |
1983
|
|
|
|
|
|
|
/* sv_2iv is liberal, may return SvIV, SvUV, or SvNV */ |
1984
|
26
|
|
|
|
|
|
sv_2iv(sv); |
1985
|
|
|
|
|
|
|
/* SvNOK will be set if value is out of range for IV/UV. |
1986
|
|
|
|
|
|
|
* SvIOK should be set but won't if sv is not numeric (in which |
1987
|
|
|
|
|
|
|
* case perl would have warn'd already if -w or warnings are in effect) |
1988
|
|
|
|
|
|
|
*/ |
1989
|
26
|
100
|
|
|
|
|
cast_ok = (SvIOK(sv) && !SvNOK(sv)); |
|
|
50
|
|
|
|
|
|
1990
|
26
|
|
|
|
|
|
break; |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
case SQL_DOUBLE: |
1993
|
6
|
|
|
|
|
|
sv_2nv(sv); |
1994
|
|
|
|
|
|
|
/* SvNOK should be set but won't if sv is not numeric (in which |
1995
|
|
|
|
|
|
|
* case perl would have warn'd already if -w or warnings are in effect) |
1996
|
|
|
|
|
|
|
*/ |
1997
|
6
|
|
|
|
|
|
cast_ok = SvNOK(sv); |
1998
|
6
|
|
|
|
|
|
break; |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
/* caller would like IV else UV else NV */ |
2001
|
|
|
|
|
|
|
/* else no error and sv is untouched */ |
2002
|
|
|
|
|
|
|
case SQL_NUMERIC: |
2003
|
|
|
|
|
|
|
/* based on the code in perl's toke.c */ |
2004
|
4
|
|
|
|
|
|
uv = 0; |
2005
|
4
|
|
|
|
|
|
grok_flags = grok_number(SvPVX(sv), SvCUR(sv), &uv); |
2006
|
4
|
|
|
|
|
|
cast_ok = 1; |
2007
|
4
|
50
|
|
|
|
|
if (grok_flags == IS_NUMBER_IN_UV) { /* +ve int */ |
2008
|
0
|
0
|
|
|
|
|
if (uv <= IV_MAX) /* prefer IV over UV */ |
2009
|
0
|
|
|
|
|
|
sv_2iv(sv); |
2010
|
0
|
|
|
|
|
|
else sv_2uv(sv); |
2011
|
|
|
|
|
|
|
} |
2012
|
4
|
50
|
|
|
|
|
else if (grok_flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG) |
2013
|
0
|
0
|
|
|
|
|
&& uv <= IV_MAX |
2014
|
|
|
|
|
|
|
) { |
2015
|
0
|
|
|
|
|
|
sv_2iv(sv); |
2016
|
|
|
|
|
|
|
} |
2017
|
4
|
50
|
|
|
|
|
else if (grok_flags) { /* is numeric */ |
2018
|
0
|
|
|
|
|
|
sv_2nv(sv); |
2019
|
|
|
|
|
|
|
} |
2020
|
|
|
|
|
|
|
else |
2021
|
4
|
|
|
|
|
|
cast_ok = 0; |
2022
|
4
|
|
|
|
|
|
break; |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
#if 0 /* XXX future possibilities */ |
2025
|
|
|
|
|
|
|
case SQL_BIGINT: /* use Math::BigInt if too large for IV/UV */ |
2026
|
|
|
|
|
|
|
#endif |
2027
|
|
|
|
|
|
|
} |
2028
|
|
|
|
|
|
|
|
2029
|
36
|
100
|
|
|
|
|
if (cast_ok) { |
2030
|
|
|
|
|
|
|
|
2031
|
16
|
100
|
|
|
|
|
if (flags & DBIstcf_DISCARD_STRING |
2032
|
2
|
50
|
|
|
|
|
&& SvNIOK(sv) /* we set a numeric value */ |
2033
|
2
|
50
|
|
|
|
|
&& SvPVX(sv) /* we have a buffer to discard */ |
2034
|
|
|
|
|
|
|
) { |
2035
|
2
|
50
|
|
|
|
|
SvOOK_off(sv); |
2036
|
2
|
|
|
|
|
|
sv_force_normal(sv); |
2037
|
2
|
50
|
|
|
|
|
if (SvLEN(sv)) |
2038
|
2
|
|
|
|
|
|
Safefree(SvPVX(sv)); |
2039
|
2
|
|
|
|
|
|
SvPOK_off(sv); |
2040
|
2
|
|
|
|
|
|
SvPV_set(sv, NULL); |
2041
|
2
|
|
|
|
|
|
SvLEN_set(sv, 0); |
2042
|
2
|
|
|
|
|
|
SvCUR_set(sv, 0); |
2043
|
|
|
|
|
|
|
} |
2044
|
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
|
|
2046
|
36
|
100
|
|
|
|
|
if (cast_ok) |
2047
|
16
|
|
|
|
|
|
return 2; |
2048
|
20
|
100
|
|
|
|
|
else if (flags & DBIstcf_STRICT) |
2049
|
10
|
|
|
|
|
|
return 0; |
2050
|
40
|
|
|
|
|
|
else return 1; |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
|
2055
|
|
|
|
|
|
|
/* --- Generic Handle Attributes (for all handle types) --- */ |
2056
|
|
|
|
|
|
|
|
2057
|
|
|
|
|
|
|
static int |
2058
|
79050
|
|
|
|
|
|
dbih_set_attr_k(SV *h, SV *keysv, int dbikey, SV *valuesv) |
2059
|
|
|
|
|
|
|
{ |
2060
|
|
|
|
|
|
|
dTHX; |
2061
|
|
|
|
|
|
|
dTHR; |
2062
|
79050
|
|
|
|
|
|
D_imp_xxh(h); |
2063
|
|
|
|
|
|
|
STRLEN keylen; |
2064
|
79050
|
50
|
|
|
|
|
const char *key = SvPV(keysv, keylen); |
2065
|
79050
|
|
|
|
|
|
const int htype = DBIc_TYPE(imp_xxh); |
2066
|
79050
|
50
|
|
|
|
|
int on = (SvTRUE(valuesv)); |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2067
|
79050
|
|
|
|
|
|
int internal = 1; /* DBIh_IN_PERL_DBD(imp_xxh); -- for DBD's in perl */ |
2068
|
79050
|
|
|
|
|
|
int cacheit = 0; |
2069
|
79050
|
|
|
|
|
|
int weakenit = 0; /* eg for CachedKids ref */ |
2070
|
|
|
|
|
|
|
(void)dbikey; |
2071
|
|
|
|
|
|
|
|
2072
|
79050
|
100
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 3) |
2073
|
51
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," STORE %s %s => %s\n", |
2074
|
|
|
|
|
|
|
neatsvpv(h,0), neatsvpv(keysv,0), neatsvpv(valuesv,0)); |
2075
|
|
|
|
|
|
|
|
2076
|
79050
|
50
|
|
|
|
|
if (internal && strEQ(key, "Active")) { |
|
|
100
|
|
|
|
|
|
2077
|
28158
|
100
|
|
|
|
|
if (on) { |
2078
|
9210
|
|
|
|
|
|
D_imp_sth(h); |
2079
|
9210
|
100
|
|
|
|
|
DBIc_ACTIVE_on(imp_xxh); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2080
|
|
|
|
|
|
|
/* for pure-perl drivers on second and subsequent */ |
2081
|
|
|
|
|
|
|
/* execute()'s, else row count keeps rising. */ |
2082
|
9210
|
100
|
|
|
|
|
if (htype==DBIt_ST && DBIc_FIELDS_AV(imp_sth)) |
|
|
100
|
|
|
|
|
|
2083
|
9210
|
|
|
|
|
|
DBIc_ROW_COUNT(imp_sth) = 0; |
2084
|
|
|
|
|
|
|
} |
2085
|
|
|
|
|
|
|
else { |
2086
|
4869
|
100
|
|
|
|
|
DBIc_ACTIVE_off(imp_xxh); |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
} |
2088
|
|
|
|
|
|
|
} |
2089
|
64971
|
100
|
|
|
|
|
else if (strEQ(key, "FetchHashKeyName")) { |
2090
|
18
|
50
|
|
|
|
|
if (htype >= DBIt_ST) |
2091
|
0
|
|
|
|
|
|
croak("Can't set FetchHashKeyName for a statement handle, set in parent before prepare()"); |
2092
|
18
|
|
|
|
|
|
cacheit = 1; /* just save it */ |
2093
|
|
|
|
|
|
|
} |
2094
|
64953
|
100
|
|
|
|
|
else if (strEQ(key, "CompatMode")) { |
2095
|
12
|
100
|
|
|
|
|
(on) ? DBIc_COMPAT_on(imp_xxh) : DBIc_COMPAT_off(imp_xxh); |
2096
|
|
|
|
|
|
|
} |
2097
|
64941
|
100
|
|
|
|
|
else if (strEQ(key, "Warn")) { |
2098
|
6
|
100
|
|
|
|
|
(on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh); |
2099
|
|
|
|
|
|
|
} |
2100
|
64935
|
100
|
|
|
|
|
else if (strEQ(key, "AutoInactiveDestroy")) { |
2101
|
12
|
100
|
|
|
|
|
(on) ? DBIc_AIADESTROY_on(imp_xxh) : DBIc_AIADESTROY_off(imp_xxh); |
2102
|
|
|
|
|
|
|
} |
2103
|
64923
|
100
|
|
|
|
|
else if (strEQ(key, "InactiveDestroy")) { |
2104
|
8
|
100
|
|
|
|
|
(on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh); |
2105
|
|
|
|
|
|
|
} |
2106
|
64915
|
100
|
|
|
|
|
else if (strEQ(key, "RootClass")) { |
2107
|
14
|
|
|
|
|
|
cacheit = 1; /* just save it */ |
2108
|
|
|
|
|
|
|
} |
2109
|
64901
|
50
|
|
|
|
|
else if (strEQ(key, "RowCacheSize")) { |
2110
|
0
|
|
|
|
|
|
cacheit = 0; /* ignore it */ |
2111
|
|
|
|
|
|
|
} |
2112
|
64901
|
100
|
|
|
|
|
else if (strEQ(key, "Executed")) { |
2113
|
6036
|
50
|
|
|
|
|
DBIc_set(imp_xxh, DBIcf_Executed, on); |
2114
|
|
|
|
|
|
|
} |
2115
|
58865
|
100
|
|
|
|
|
else if (strEQ(key, "ChopBlanks")) { |
2116
|
10
|
100
|
|
|
|
|
DBIc_set(imp_xxh, DBIcf_ChopBlanks, on); |
2117
|
|
|
|
|
|
|
} |
2118
|
58855
|
100
|
|
|
|
|
else if (strEQ(key, "ErrCount")) { |
2119
|
2
|
50
|
|
|
|
|
DBIc_ErrCount(imp_xxh) = SvUV(valuesv); |
2120
|
|
|
|
|
|
|
} |
2121
|
58853
|
50
|
|
|
|
|
else if (strEQ(key, "LongReadLen")) { |
2122
|
0
|
0
|
|
|
|
|
if (SvNV(valuesv) < 0 || SvNV(valuesv) > MAX_LongReadLen) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2123
|
0
|
|
|
|
|
|
croak("Can't set LongReadLen < 0 or > %ld",MAX_LongReadLen); |
2124
|
0
|
0
|
|
|
|
|
DBIc_LongReadLen(imp_xxh) = SvIV(valuesv); |
2125
|
0
|
|
|
|
|
|
cacheit = 1; /* save it for clone */ |
2126
|
|
|
|
|
|
|
} |
2127
|
58853
|
100
|
|
|
|
|
else if (strEQ(key, "LongTruncOk")) { |
2128
|
4
|
50
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_LongTruncOk, on); |
2129
|
|
|
|
|
|
|
} |
2130
|
58849
|
100
|
|
|
|
|
else if (strEQ(key, "RaiseError")) { |
2131
|
6307
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_RaiseError, on); |
2132
|
|
|
|
|
|
|
} |
2133
|
52542
|
100
|
|
|
|
|
else if (strEQ(key, "PrintError")) { |
2134
|
6409
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_PrintError, on); |
2135
|
|
|
|
|
|
|
} |
2136
|
46133
|
100
|
|
|
|
|
else if (strEQ(key, "PrintWarn")) { |
2137
|
6038
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_PrintWarn, on); |
2138
|
|
|
|
|
|
|
} |
2139
|
40095
|
100
|
|
|
|
|
else if (strEQ(key, "HandleError")) { |
2140
|
4
|
100
|
|
|
|
|
if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2141
|
0
|
|
|
|
|
|
croak("Can't set %s to '%s'", "HandleError", neatsvpv(valuesv,0)); |
2142
|
|
|
|
|
|
|
} |
2143
|
4
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_HandleError, on); |
2144
|
4
|
|
|
|
|
|
cacheit = 1; /* child copy setup by dbih_setup_handle() */ |
2145
|
|
|
|
|
|
|
} |
2146
|
40091
|
100
|
|
|
|
|
else if (strEQ(key, "HandleSetErr")) { |
2147
|
2
|
50
|
|
|
|
|
if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2148
|
0
|
|
|
|
|
|
croak("Can't set %s to '%s'","HandleSetErr",neatsvpv(valuesv,0)); |
2149
|
|
|
|
|
|
|
} |
2150
|
2
|
50
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_HandleSetErr, on); |
2151
|
2
|
|
|
|
|
|
cacheit = 1; /* child copy setup by dbih_setup_handle() */ |
2152
|
|
|
|
|
|
|
} |
2153
|
40089
|
50
|
|
|
|
|
else if (strEQ(key, "ChildHandles")) { |
2154
|
0
|
0
|
|
|
|
|
if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVAV)) ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2155
|
0
|
|
|
|
|
|
croak("Can't set %s to '%s'", "ChildHandles", neatsvpv(valuesv,0)); |
2156
|
|
|
|
|
|
|
} |
2157
|
0
|
|
|
|
|
|
cacheit = 1; /* just save it in the hash */ |
2158
|
|
|
|
|
|
|
} |
2159
|
40089
|
100
|
|
|
|
|
else if (strEQ(key, "Profile")) { |
2160
|
|
|
|
|
|
|
static const char profile_class[] = "DBI::Profile"; |
2161
|
41
|
100
|
|
|
|
|
if (on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
/* not a hash ref so use DBI::Profile to work out what to do */ |
2163
|
|
|
|
|
|
|
dTHR; |
2164
|
20
|
|
|
|
|
|
dSP; |
2165
|
|
|
|
|
|
|
I32 returns; |
2166
|
20
|
|
|
|
|
|
TAINT_NOT; /* the require is presumed innocent till proven guilty */ |
2167
|
20
|
|
|
|
|
|
perl_require_pv("DBI/Profile.pm"); |
2168
|
20
|
50
|
|
|
|
|
if (SvTRUE(ERRSV)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2169
|
0
|
0
|
|
|
|
|
warn("Can't load %s: %s", profile_class, SvPV_nolen(ERRSV)); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2170
|
0
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2171
|
|
|
|
|
|
|
} |
2172
|
|
|
|
|
|
|
else { |
2173
|
20
|
50
|
|
|
|
|
PUSHMARK(SP); |
2174
|
20
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newSVpv(profile_class,0))); |
2175
|
20
|
50
|
|
|
|
|
XPUSHs(valuesv); |
2176
|
20
|
|
|
|
|
|
PUTBACK; |
2177
|
20
|
|
|
|
|
|
returns = call_method("_auto_new", G_SCALAR); |
2178
|
20
|
50
|
|
|
|
|
if (returns != 1) |
2179
|
0
|
|
|
|
|
|
croak("%s _auto_new", profile_class); |
2180
|
20
|
|
|
|
|
|
SPAGAIN; |
2181
|
20
|
|
|
|
|
|
valuesv = POPs; |
2182
|
20
|
|
|
|
|
|
PUTBACK; |
2183
|
|
|
|
|
|
|
} |
2184
|
20
|
50
|
|
|
|
|
on = SvTRUE(valuesv); /* in case it returns undef */ |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2185
|
|
|
|
|
|
|
} |
2186
|
41
|
100
|
|
|
|
|
if (on && !sv_isobject(valuesv)) { |
|
|
100
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
/* not blessed already - so default to DBI::Profile */ |
2188
|
|
|
|
|
|
|
HV *stash; |
2189
|
16
|
|
|
|
|
|
perl_require_pv(profile_class); |
2190
|
16
|
|
|
|
|
|
stash = gv_stashpv(profile_class, GV_ADDWARN); |
2191
|
16
|
|
|
|
|
|
sv_bless(valuesv, stash); |
2192
|
|
|
|
|
|
|
} |
2193
|
41
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_Profile, on); |
2194
|
41
|
|
|
|
|
|
cacheit = 1; /* child copy setup by dbih_setup_handle() */ |
2195
|
|
|
|
|
|
|
} |
2196
|
40048
|
100
|
|
|
|
|
else if (strEQ(key, "ShowErrorStatement")) { |
2197
|
1083
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_ShowErrorStatement, on); |
2198
|
|
|
|
|
|
|
} |
2199
|
38965
|
50
|
|
|
|
|
else if (strEQ(key, "MultiThread") && internal) { |
|
|
0
|
|
|
|
|
|
2200
|
|
|
|
|
|
|
/* here to allow pure-perl drivers to set MultiThread */ |
2201
|
0
|
0
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_MultiThread, on); |
2202
|
0
|
0
|
|
|
|
|
if (on && DBIc_WARN(imp_xxh)) { |
|
|
0
|
|
|
|
|
|
2203
|
0
|
|
|
|
|
|
warn("MultiThread support not yet implemented in DBI"); |
2204
|
|
|
|
|
|
|
} |
2205
|
|
|
|
|
|
|
} |
2206
|
38965
|
100
|
|
|
|
|
else if (strEQ(key, "Taint")) { |
2207
|
|
|
|
|
|
|
/* 'Taint' is a shortcut for both in and out mode */ |
2208
|
22
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_TaintIn|DBIcf_TaintOut, on); |
2209
|
|
|
|
|
|
|
} |
2210
|
38943
|
100
|
|
|
|
|
else if (strEQ(key, "TaintIn")) { |
2211
|
8
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_TaintIn, on); |
2212
|
|
|
|
|
|
|
} |
2213
|
38935
|
100
|
|
|
|
|
else if (strEQ(key, "TaintOut")) { |
2214
|
7
|
100
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_TaintOut, on); |
2215
|
|
|
|
|
|
|
} |
2216
|
38928
|
100
|
|
|
|
|
else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "CachedKids") |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2217
|
|
|
|
|
|
|
/* only allow hash refs */ |
2218
|
9
|
50
|
|
|
|
|
&& SvROK(valuesv) && SvTYPE(SvRV(valuesv))==SVt_PVHV |
|
|
50
|
|
|
|
|
|
2219
|
|
|
|
|
|
|
) { |
2220
|
9
|
|
|
|
|
|
cacheit = 1; |
2221
|
9
|
|
|
|
|
|
weakenit = 1; |
2222
|
|
|
|
|
|
|
} |
2223
|
38919
|
100
|
|
|
|
|
else if (keylen==9 && strEQ(key, "Callbacks")) { |
|
|
100
|
|
|
|
|
|
2224
|
27
|
100
|
|
|
|
|
if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) ) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2225
|
0
|
|
|
|
|
|
croak("Can't set Callbacks to '%s'",neatsvpv(valuesv,0)); |
2226
|
|
|
|
|
|
|
/* see also dbih_setup_handle for ChildCallbacks handling */ |
2227
|
27
|
100
|
|
|
|
|
DBIc_set(imp_xxh, DBIcf_Callbacks, on); |
2228
|
27
|
|
|
|
|
|
cacheit = 1; |
2229
|
|
|
|
|
|
|
} |
2230
|
38892
|
100
|
|
|
|
|
else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "AutoCommit")) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
/* driver should have intercepted this and either handled it */ |
2232
|
|
|
|
|
|
|
/* or set valuesv to either the 'magic' on or off value. */ |
2233
|
5519
|
50
|
|
|
|
|
if (SvIV(valuesv) != -900 && SvIV(valuesv) != -901) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2234
|
0
|
|
|
|
|
|
croak("DBD driver has not implemented the AutoCommit attribute"); |
2235
|
5519
|
50
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_AutoCommit, (SvIV(valuesv)==-901)); |
|
|
100
|
|
|
|
|
|
2236
|
|
|
|
|
|
|
} |
2237
|
33373
|
100
|
|
|
|
|
else if (htype==DBIt_DB && keylen==9 && strEQ(key, "BegunWork")) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2238
|
2
|
50
|
|
|
|
|
DBIc_set(imp_xxh,DBIcf_BegunWork, on); |
2239
|
|
|
|
|
|
|
} |
2240
|
33371
|
100
|
|
|
|
|
else if (keylen==10 && strEQ(key, "TraceLevel")) { |
|
|
100
|
|
|
|
|
|
2241
|
98
|
|
|
|
|
|
set_trace(h, valuesv, Nullsv); |
2242
|
|
|
|
|
|
|
} |
2243
|
33273
|
100
|
|
|
|
|
else if (keylen==9 && strEQ(key, "TraceFile")) { /* XXX undocumented and readonly */ |
|
|
50
|
|
|
|
|
|
2244
|
0
|
|
|
|
|
|
set_trace_file(valuesv); |
2245
|
|
|
|
|
|
|
} |
2246
|
40955
|
100
|
|
|
|
|
else if (htype==DBIt_ST && strEQ(key, "NUM_OF_FIELDS")) { |
|
|
100
|
|
|
|
|
|
2247
|
7682
|
|
|
|
|
|
D_imp_sth(h); |
2248
|
7682
|
100
|
|
|
|
|
int new_num_fields = (SvOK(valuesv)) ? SvIV(valuesv) : -1; |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2249
|
7682
|
|
|
|
|
|
DBIc_NUM_FIELDS(imp_sth) = new_num_fields; |
2250
|
7682
|
100
|
|
|
|
|
if (DBIc_FIELDS_AV(imp_sth)) { /* modify existing fbav */ |
2251
|
1845
|
|
|
|
|
|
dbih_setup_fbav(imp_sth); |
2252
|
|
|
|
|
|
|
} |
2253
|
7682
|
|
|
|
|
|
cacheit = 1; |
2254
|
|
|
|
|
|
|
} |
2255
|
30747
|
100
|
|
|
|
|
else if (htype==DBIt_ST && strEQ(key, "NUM_OF_PARAMS")) { |
|
|
100
|
|
|
|
|
|
2256
|
5156
|
|
|
|
|
|
D_imp_sth(h); |
2257
|
5156
|
50
|
|
|
|
|
DBIc_NUM_PARAMS(imp_sth) = SvIV(valuesv); |
2258
|
5156
|
|
|
|
|
|
cacheit = 1; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
/* these are here due to clone() needing to set attribs through a public api */ |
2261
|
20435
|
100
|
|
|
|
|
else if (htype<=DBIt_DB && (strEQ(key, "Name") |
|
|
100
|
|
|
|
|
|
2262
|
20422
|
100
|
|
|
|
|
|| strEQ(key,"ImplementorClass") |
2263
|
20418
|
100
|
|
|
|
|
|| strEQ(key,"ReadOnly") |
2264
|
20139
|
100
|
|
|
|
|
|| strEQ(key,"Statement") |
2265
|
20135
|
100
|
|
|
|
|
|| strEQ(key,"Username") |
2266
|
|
|
|
|
|
|
/* these are here for backwards histerical raisons */ |
2267
|
13828
|
50
|
|
|
|
|
|| strEQ(key,"USER") || strEQ(key,"CURRENT_USER") |
|
|
50
|
|
|
|
|
|
2268
|
|
|
|
|
|
|
) ) { |
2269
|
6598
|
|
|
|
|
|
cacheit = 1; |
2270
|
|
|
|
|
|
|
} |
2271
|
|
|
|
|
|
|
/* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */ |
2272
|
13837
|
100
|
|
|
|
|
else if ((keylen==7 || keylen==9 || keylen==12) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2273
|
20
|
100
|
|
|
|
|
&& strnEQ(key, "NAME_", 5) |
2274
|
5
|
100
|
|
|
|
|
&& ( (keylen==9 && strEQ(key, "NAME_hash")) |
|
|
50
|
|
|
|
|
|
2275
|
4
|
100
|
|
|
|
|
|| ((key[5]=='u' || key[5]=='l') && key[6] == 'c' |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2276
|
4
|
100
|
|
|
|
|
&& (!key[7] || strnEQ(&key[7], "_hash", 5))) |
|
|
50
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
) |
2278
|
|
|
|
|
|
|
) { |
2279
|
5
|
|
|
|
|
|
cacheit = 1; |
2280
|
|
|
|
|
|
|
} |
2281
|
|
|
|
|
|
|
else { /* XXX should really be an event ? */ |
2282
|
13832
|
100
|
|
|
|
|
if (isUPPER(*key)) { |
2283
|
2
|
|
|
|
|
|
char *msg = "Can't set %s->{%s}: unrecognised attribute name or invalid value%s"; |
2284
|
2
|
|
|
|
|
|
char *hint = ""; |
2285
|
2
|
50
|
|
|
|
|
if (strEQ(key, "NUM_FIELDS")) |
2286
|
0
|
|
|
|
|
|
hint = ", perhaps you meant NUM_OF_FIELDS"; |
2287
|
2
|
|
|
|
|
|
warn(msg, neatsvpv(h,0), key, hint); |
2288
|
2
|
|
|
|
|
|
return FALSE; /* don't store it */ |
2289
|
|
|
|
|
|
|
} |
2290
|
|
|
|
|
|
|
/* Allow private_* attributes to be stored in the cache. */ |
2291
|
|
|
|
|
|
|
/* This is designed to make life easier for people subclassing */ |
2292
|
|
|
|
|
|
|
/* the DBI classes and may be of use to simple perl DBD's. */ |
2293
|
13830
|
100
|
|
|
|
|
if (strnNE(key,"private_",8) && strnNE(key,"dbd_",4) && strnNE(key,"dbi_",4)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2294
|
44
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh)) { /* change to DBIc_WARN(imp_xxh) once we can validate prefix against registry */ |
2295
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh),"$h->{%s}=%s ignored for invalid driver-specific attribute\n", |
2296
|
|
|
|
|
|
|
neatsvpv(keysv,0), neatsvpv(valuesv,0)); |
2297
|
|
|
|
|
|
|
} |
2298
|
44
|
|
|
|
|
|
return FALSE; |
2299
|
|
|
|
|
|
|
} |
2300
|
13786
|
|
|
|
|
|
cacheit = 1; |
2301
|
|
|
|
|
|
|
} |
2302
|
79004
|
100
|
|
|
|
|
if (cacheit) { |
2303
|
33342
|
|
|
|
|
|
SV *sv_for_cache = newSVsv(valuesv); |
2304
|
33342
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), key, keylen, sv_for_cache, 0); |
2305
|
33342
|
100
|
|
|
|
|
if (weakenit) { |
2306
|
|
|
|
|
|
|
#ifdef sv_rvweaken |
2307
|
9
|
|
|
|
|
|
sv_rvweaken(sv_for_cache); |
2308
|
|
|
|
|
|
|
#endif |
2309
|
|
|
|
|
|
|
} |
2310
|
|
|
|
|
|
|
} |
2311
|
79050
|
|
|
|
|
|
return TRUE; |
2312
|
|
|
|
|
|
|
} |
2313
|
|
|
|
|
|
|
|
2314
|
|
|
|
|
|
|
|
2315
|
|
|
|
|
|
|
static SV * |
2316
|
44691
|
|
|
|
|
|
dbih_get_attr_k(SV *h, SV *keysv, int dbikey) |
2317
|
|
|
|
|
|
|
{ |
2318
|
|
|
|
|
|
|
dTHX; |
2319
|
|
|
|
|
|
|
dTHR; |
2320
|
44691
|
|
|
|
|
|
D_imp_xxh(h); |
2321
|
|
|
|
|
|
|
STRLEN keylen; |
2322
|
44691
|
50
|
|
|
|
|
char *key = SvPV(keysv, keylen); |
2323
|
44691
|
|
|
|
|
|
int htype = DBIc_TYPE(imp_xxh); |
2324
|
44691
|
|
|
|
|
|
SV *valuesv = Nullsv; |
2325
|
44691
|
|
|
|
|
|
int cacheit = FALSE; |
2326
|
|
|
|
|
|
|
char *p; |
2327
|
|
|
|
|
|
|
int i; |
2328
|
|
|
|
|
|
|
SV *sv; |
2329
|
|
|
|
|
|
|
SV **svp; |
2330
|
|
|
|
|
|
|
(void)dbikey; |
2331
|
|
|
|
|
|
|
|
2332
|
|
|
|
|
|
|
/* DBI quick_FETCH will service some requests (e.g., cached values) */ |
2333
|
|
|
|
|
|
|
|
2334
|
44691
|
100
|
|
|
|
|
if (htype == DBIt_ST) { |
2335
|
6044
|
|
|
|
|
|
switch (*key) { |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
case 'D': |
2338
|
18
|
50
|
|
|
|
|
if (keylen==8 && strEQ(key, "Database")) { |
|
|
50
|
|
|
|
|
|
2339
|
18
|
|
|
|
|
|
D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh); |
2340
|
18
|
|
|
|
|
|
valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh)); |
2341
|
18
|
|
|
|
|
|
cacheit = FALSE; /* else creates ref loop */ |
2342
|
|
|
|
|
|
|
} |
2343
|
18
|
|
|
|
|
|
break; |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
case 'N': |
2346
|
2304
|
100
|
|
|
|
|
if (keylen==8 && strEQ(key, "NULLABLE")) { |
|
|
50
|
|
|
|
|
|
2347
|
52
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2348
|
52
|
|
|
|
|
|
break; |
2349
|
|
|
|
|
|
|
} |
2350
|
|
|
|
|
|
|
|
2351
|
2252
|
100
|
|
|
|
|
if (keylen==4 && strEQ(key, "NAME")) { |
|
|
50
|
|
|
|
|
|
2352
|
56
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2353
|
56
|
|
|
|
|
|
break; |
2354
|
|
|
|
|
|
|
} |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
/* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */ |
2357
|
2196
|
100
|
|
|
|
|
if ((keylen==7 || keylen==9 || keylen==12) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2358
|
2088
|
50
|
|
|
|
|
&& strnEQ(key, "NAME_", 5) |
2359
|
2088
|
100
|
|
|
|
|
&& ( (keylen==9 && strEQ(key, "NAME_hash")) |
|
|
50
|
|
|
|
|
|
2360
|
2040
|
100
|
|
|
|
|
|| ((key[5]=='u' || key[5]=='l') && key[6] == 'c' |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2361
|
2040
|
100
|
|
|
|
|
&& (!key[7] || strnEQ(&key[7], "_hash", 5))) |
|
|
50
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
) |
2363
|
2088
|
|
|
|
|
|
) { |
2364
|
2088
|
|
|
|
|
|
D_imp_sth(h); |
2365
|
2088
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2366
|
|
|
|
|
|
|
|
2367
|
|
|
|
|
|
|
/* fetch from tied outer handle to trigger FETCH magic */ |
2368
|
2088
|
|
|
|
|
|
svp = hv_fetch((HV*)DBIc_MY_H(imp_sth), "NAME",4, FALSE); |
2369
|
2088
|
50
|
|
|
|
|
sv = (svp) ? *svp : &PL_sv_undef; |
2370
|
2088
|
50
|
|
|
|
|
if (SvGMAGICAL(sv)) /* call FETCH via magic */ |
2371
|
2088
|
|
|
|
|
|
mg_get(sv); |
2372
|
|
|
|
|
|
|
|
2373
|
2088
|
100
|
|
|
|
|
if (SvROK(sv)) { |
2374
|
2078
|
|
|
|
|
|
AV *name_av = (AV*)SvRV(sv); |
2375
|
|
|
|
|
|
|
char *name; |
2376
|
2078
|
|
|
|
|
|
int upcase = (key[5] == 'u'); |
2377
|
2078
|
|
|
|
|
|
AV *av = Nullav; |
2378
|
2078
|
|
|
|
|
|
HV *hv = Nullhv; |
2379
|
2078
|
|
|
|
|
|
int num_fields_mismatch = 0; |
2380
|
|
|
|
|
|
|
|
2381
|
2078
|
100
|
|
|
|
|
if (strEQ(&key[strlen(key)-5], "_hash")) |
2382
|
60
|
|
|
|
|
|
hv = newHV(); |
2383
|
2018
|
|
|
|
|
|
else av = newAV(); |
2384
|
2078
|
|
|
|
|
|
i = DBIc_NUM_FIELDS(imp_sth); |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
/* catch invalid NUM_FIELDS */ |
2387
|
2078
|
50
|
|
|
|
|
if (i != AvFILL(name_av)+1) { |
|
|
50
|
|
|
|
|
|
2388
|
|
|
|
|
|
|
/* flag as mismatch, except for "-1 and empty" case */ |
2389
|
0
|
0
|
|
|
|
|
if ( ! (i == -1 && 0 == AvFILL(name_av)+1) ) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2390
|
0
|
|
|
|
|
|
num_fields_mismatch = 1; |
2391
|
0
|
0
|
|
|
|
|
i = AvFILL(name_av)+1; /* limit for safe iteration over array */ |
2392
|
|
|
|
|
|
|
} |
2393
|
|
|
|
|
|
|
|
2394
|
2078
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 10 || (num_fields_mismatch && DBIc_WARN(imp_xxh))) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2395
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth)," FETCH $h->{%s} from $h->{NAME} with $h->{NUM_OF_FIELDS} = %d" |
|
|
0
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
" and %ld entries in $h->{NAME}%s\n", |
2397
|
0
|
|
|
|
|
|
neatsvpv(keysv,0), DBIc_NUM_FIELDS(imp_sth), AvFILL(name_av)+1, |
2398
|
|
|
|
|
|
|
(num_fields_mismatch) ? " (possible bug in driver)" : ""); |
2399
|
|
|
|
|
|
|
} |
2400
|
|
|
|
|
|
|
|
2401
|
8162
|
100
|
|
|
|
|
while (--i >= 0) { |
2402
|
6084
|
|
|
|
|
|
sv = newSVsv(AvARRAY(name_av)[i]); |
2403
|
6084
|
50
|
|
|
|
|
name = SvPV_nolen(sv); |
2404
|
6084
|
100
|
|
|
|
|
if (key[5] != 'h') { /* "NAME_hash" */ |
2405
|
29981
|
50
|
|
|
|
|
for (p = name; p && *p; ++p) { |
|
|
100
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
#ifdef toUPPER_LC |
2407
|
23997
|
100
|
|
|
|
|
*p = (upcase) ? toUPPER_LC(*p) : toLOWER_LC(*p); |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2408
|
|
|
|
|
|
|
#else |
2409
|
|
|
|
|
|
|
*p = (upcase) ? toUPPER(*p) : toLOWER(*p); |
2410
|
|
|
|
|
|
|
#endif |
2411
|
|
|
|
|
|
|
} |
2412
|
|
|
|
|
|
|
} |
2413
|
6084
|
100
|
|
|
|
|
if (av) |
2414
|
5946
|
|
|
|
|
|
av_store(av, i, sv); |
2415
|
|
|
|
|
|
|
else { |
2416
|
138
|
|
|
|
|
|
(void)hv_store(hv, name, SvCUR(sv), newSViv(i), 0); |
2417
|
138
|
|
|
|
|
|
sv_free(sv); |
2418
|
|
|
|
|
|
|
} |
2419
|
|
|
|
|
|
|
} |
2420
|
2078
|
100
|
|
|
|
|
valuesv = newRV_noinc( (av ? (SV*)av : (SV*)hv) ); |
2421
|
2078
|
|
|
|
|
|
cacheit = TRUE; /* can't change */ |
2422
|
|
|
|
|
|
|
} |
2423
|
|
|
|
|
|
|
} |
2424
|
159
|
50
|
|
|
|
|
else if (keylen==13 && strEQ(key, "NUM_OF_FIELDS")) { |
|
|
100
|
|
|
|
|
|
2425
|
51
|
|
|
|
|
|
D_imp_sth(h); |
2426
|
51
|
|
|
|
|
|
IV num_fields = DBIc_NUM_FIELDS(imp_sth); |
2427
|
51
|
50
|
|
|
|
|
valuesv = (num_fields < 0) ? &PL_sv_undef : newSViv(num_fields); |
2428
|
51
|
50
|
|
|
|
|
if (num_fields > 0) |
2429
|
0
|
|
|
|
|
|
cacheit = TRUE; /* can't change once set (XXX except for multiple result sets) */ |
2430
|
|
|
|
|
|
|
} |
2431
|
57
|
50
|
|
|
|
|
else if (keylen==13 && strEQ(key, "NUM_OF_PARAMS")) { |
|
|
50
|
|
|
|
|
|
2432
|
57
|
|
|
|
|
|
D_imp_sth(h); |
2433
|
57
|
|
|
|
|
|
valuesv = newSViv(DBIc_NUM_PARAMS(imp_sth)); |
2434
|
57
|
|
|
|
|
|
cacheit = TRUE; /* can't change */ |
2435
|
|
|
|
|
|
|
} |
2436
|
2196
|
|
|
|
|
|
break; |
2437
|
|
|
|
|
|
|
|
2438
|
|
|
|
|
|
|
case 'P': |
2439
|
148
|
100
|
|
|
|
|
if (strEQ(key, "PRECISION")) |
2440
|
52
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2441
|
96
|
100
|
|
|
|
|
else if (strEQ(key, "ParamValues")) |
2442
|
82
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2443
|
14
|
50
|
|
|
|
|
else if (strEQ(key, "ParamTypes")) |
2444
|
0
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2445
|
148
|
|
|
|
|
|
break; |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
case 'R': |
2448
|
9
|
100
|
|
|
|
|
if (strEQ(key, "RowsInCache")) |
2449
|
4
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2450
|
9
|
|
|
|
|
|
break; |
2451
|
|
|
|
|
|
|
|
2452
|
|
|
|
|
|
|
case 'S': |
2453
|
360
|
100
|
|
|
|
|
if (strEQ(key, "SCALE")) |
2454
|
356
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2455
|
360
|
|
|
|
|
|
break; |
2456
|
|
|
|
|
|
|
|
2457
|
|
|
|
|
|
|
case 'T': |
2458
|
122
|
100
|
|
|
|
|
if (strEQ(key, "TYPE")) |
2459
|
52
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2460
|
6044
|
|
|
|
|
|
break; |
2461
|
|
|
|
|
|
|
} |
2462
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
} |
2464
|
|
|
|
|
|
|
else |
2465
|
38647
|
100
|
|
|
|
|
if (htype == DBIt_DB) { |
2466
|
|
|
|
|
|
|
/* this is here but is, sadly, not called because |
2467
|
|
|
|
|
|
|
* not-preloading them into the handle attrib cache caused |
2468
|
|
|
|
|
|
|
* wierdness in t/proxy.t that I never got to the bottom |
2469
|
|
|
|
|
|
|
* of. One day maybe. */ |
2470
|
38528
|
100
|
|
|
|
|
if (keylen==6 && strEQ(key, "Driver")) { |
|
|
100
|
|
|
|
|
|
2471
|
2511
|
|
|
|
|
|
D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh); |
2472
|
2511
|
|
|
|
|
|
valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh)); |
2473
|
2511
|
|
|
|
|
|
cacheit = FALSE; /* else creates ref loop */ |
2474
|
|
|
|
|
|
|
} |
2475
|
|
|
|
|
|
|
} |
2476
|
|
|
|
|
|
|
|
2477
|
44691
|
100
|
|
|
|
|
if (valuesv == Nullsv && htype <= DBIt_DB) { |
|
|
100
|
|
|
|
|
|
2478
|
36136
|
100
|
|
|
|
|
if (keylen==10 && strEQ(key, "AutoCommit")) { |
|
|
100
|
|
|
|
|
|
2479
|
12
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_AutoCommit)); |
2480
|
|
|
|
|
|
|
} |
2481
|
|
|
|
|
|
|
} |
2482
|
|
|
|
|
|
|
|
2483
|
44691
|
100
|
|
|
|
|
if (valuesv == Nullsv) { |
2484
|
39300
|
|
|
|
|
|
switch (*key) { |
2485
|
|
|
|
|
|
|
case 'A': |
2486
|
11202
|
100
|
|
|
|
|
if (keylen==6 && strEQ(key, "Active")) { |
|
|
50
|
|
|
|
|
|
2487
|
11155
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_ACTIVE(imp_xxh)); |
2488
|
|
|
|
|
|
|
} |
2489
|
47
|
100
|
|
|
|
|
else if (keylen==10 && strEQ(key, "ActiveKids")) { |
|
|
50
|
|
|
|
|
|
2490
|
29
|
|
|
|
|
|
valuesv = newSViv(DBIc_ACTIVE_KIDS(imp_xxh)); |
2491
|
|
|
|
|
|
|
} |
2492
|
18
|
50
|
|
|
|
|
else if (strEQ(key, "AutoInactiveDestroy")) { |
2493
|
18
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_AIADESTROY(imp_xxh)); |
2494
|
|
|
|
|
|
|
} |
2495
|
11202
|
|
|
|
|
|
break; |
2496
|
|
|
|
|
|
|
|
2497
|
|
|
|
|
|
|
case 'B': |
2498
|
6
|
100
|
|
|
|
|
if (keylen==9 && strEQ(key, "BegunWork")) { |
|
|
50
|
|
|
|
|
|
2499
|
4
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_BegunWork)); |
2500
|
|
|
|
|
|
|
} |
2501
|
6
|
|
|
|
|
|
break; |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
case 'C': |
2504
|
9076
|
100
|
|
|
|
|
if (strEQ(key, "ChildHandles")) { |
2505
|
42
|
|
|
|
|
|
svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE); |
2506
|
|
|
|
|
|
|
/* if something has been stored then return it. |
2507
|
|
|
|
|
|
|
* otherwise return a dummy empty array if weakrefs are |
2508
|
|
|
|
|
|
|
* available, else an undef to indicate that they're not */ |
2509
|
42
|
50
|
|
|
|
|
if (svp) { |
2510
|
0
|
|
|
|
|
|
valuesv = newSVsv(*svp); |
2511
|
|
|
|
|
|
|
} else { |
2512
|
|
|
|
|
|
|
#ifdef sv_rvweaken |
2513
|
42
|
|
|
|
|
|
valuesv = newRV_noinc((SV*)newAV()); |
2514
|
|
|
|
|
|
|
#else |
2515
|
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2516
|
|
|
|
|
|
|
#endif |
2517
|
|
|
|
|
|
|
} |
2518
|
|
|
|
|
|
|
} |
2519
|
9034
|
100
|
|
|
|
|
else if (strEQ(key, "ChopBlanks")) { |
2520
|
2967
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ChopBlanks)); |
2521
|
|
|
|
|
|
|
} |
2522
|
6067
|
100
|
|
|
|
|
else if (strEQ(key, "CachedKids")) { |
2523
|
6036
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2524
|
|
|
|
|
|
|
} |
2525
|
31
|
100
|
|
|
|
|
else if (strEQ(key, "CompatMode")) { |
2526
|
18
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_COMPAT(imp_xxh)); |
2527
|
|
|
|
|
|
|
} |
2528
|
9076
|
|
|
|
|
|
break; |
2529
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
case 'E': |
2531
|
6062
|
100
|
|
|
|
|
if (strEQ(key, "Executed")) { |
2532
|
6048
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_is(imp_xxh, DBIcf_Executed)); |
2533
|
|
|
|
|
|
|
} |
2534
|
14
|
50
|
|
|
|
|
else if (strEQ(key, "ErrCount")) { |
2535
|
14
|
|
|
|
|
|
valuesv = newSVuv(DBIc_ErrCount(imp_xxh)); |
2536
|
|
|
|
|
|
|
} |
2537
|
6062
|
|
|
|
|
|
break; |
2538
|
|
|
|
|
|
|
|
2539
|
|
|
|
|
|
|
case 'I': |
2540
|
14
|
50
|
|
|
|
|
if (strEQ(key, "InactiveDestroy")) { |
2541
|
14
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_IADESTROY(imp_xxh)); |
2542
|
|
|
|
|
|
|
} |
2543
|
14
|
|
|
|
|
|
break; |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
case 'K': |
2546
|
56
|
50
|
|
|
|
|
if (keylen==4 && strEQ(key, "Kids")) { |
|
|
50
|
|
|
|
|
|
2547
|
56
|
|
|
|
|
|
valuesv = newSViv(DBIc_KIDS(imp_xxh)); |
2548
|
|
|
|
|
|
|
} |
2549
|
56
|
|
|
|
|
|
break; |
2550
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
case 'L': |
2552
|
5563
|
50
|
|
|
|
|
if (keylen==11 && strEQ(key, "LongReadLen")) { |
|
|
100
|
|
|
|
|
|
2553
|
2780
|
|
|
|
|
|
valuesv = newSVnv((NV)DBIc_LongReadLen(imp_xxh)); |
2554
|
|
|
|
|
|
|
} |
2555
|
2783
|
50
|
|
|
|
|
else if (keylen==11 && strEQ(key, "LongTruncOk")) { |
|
|
50
|
|
|
|
|
|
2556
|
2783
|
50
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_LongTruncOk)); |
2557
|
|
|
|
|
|
|
} |
2558
|
5563
|
|
|
|
|
|
break; |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
case 'M': |
2561
|
0
|
0
|
|
|
|
|
if (keylen==10 && strEQ(key, "MultiThread")) { |
|
|
0
|
|
|
|
|
|
2562
|
0
|
0
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_MultiThread)); |
2563
|
|
|
|
|
|
|
} |
2564
|
0
|
|
|
|
|
|
break; |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
case 'P': |
2567
|
116
|
100
|
|
|
|
|
if (keylen==10 && strEQ(key, "PrintError")) { |
|
|
50
|
|
|
|
|
|
2568
|
38
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintError)); |
2569
|
|
|
|
|
|
|
} |
2570
|
78
|
100
|
|
|
|
|
else if (keylen==9 && strEQ(key, "PrintWarn")) { |
|
|
50
|
|
|
|
|
|
2571
|
10
|
50
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintWarn)); |
2572
|
|
|
|
|
|
|
} |
2573
|
116
|
|
|
|
|
|
break; |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
case 'R': |
2576
|
2866
|
100
|
|
|
|
|
if (keylen==10 && strEQ(key, "RaiseError")) { |
|
|
50
|
|
|
|
|
|
2577
|
100
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_RaiseError)); |
2578
|
|
|
|
|
|
|
} |
2579
|
2766
|
100
|
|
|
|
|
else if (keylen==12 && strEQ(key, "RowCacheSize")) { |
|
|
50
|
|
|
|
|
|
2580
|
2
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2581
|
|
|
|
|
|
|
} |
2582
|
2866
|
|
|
|
|
|
break; |
2583
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
case 'S': |
2585
|
16
|
50
|
|
|
|
|
if (keylen==18 && strEQ(key, "ShowErrorStatement")) { |
|
|
50
|
|
|
|
|
|
2586
|
16
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ShowErrorStatement)); |
2587
|
|
|
|
|
|
|
} |
2588
|
16
|
|
|
|
|
|
break; |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
case 'T': |
2591
|
159
|
100
|
|
|
|
|
if (keylen==4 && strEQ(key, "Type")) { |
|
|
50
|
|
|
|
|
|
2592
|
49
|
|
|
|
|
|
char *type = dbih_htype_name(htype); |
2593
|
49
|
|
|
|
|
|
valuesv = newSVpv(type,0); |
2594
|
49
|
|
|
|
|
|
cacheit = TRUE; /* can't change */ |
2595
|
|
|
|
|
|
|
} |
2596
|
61
|
50
|
|
|
|
|
else if (keylen==10 && strEQ(key, "TraceLevel")) { |
|
|
0
|
|
|
|
|
|
2597
|
0
|
0
|
|
|
|
|
valuesv = newSViv( DBIc_DEBUGIV(imp_xxh) ); |
2598
|
|
|
|
|
|
|
} |
2599
|
61
|
100
|
|
|
|
|
else if (keylen==5 && strEQ(key, "Taint")) { |
|
|
50
|
|
|
|
|
|
2600
|
30
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn) && |
|
|
100
|
|
|
|
|
|
2601
|
|
|
|
|
|
|
DBIc_has(imp_xxh,DBIcf_TaintOut)); |
2602
|
|
|
|
|
|
|
} |
2603
|
31
|
100
|
|
|
|
|
else if (keylen==7 && strEQ(key, "TaintIn")) { |
|
|
50
|
|
|
|
|
|
2604
|
16
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn)); |
2605
|
|
|
|
|
|
|
} |
2606
|
15
|
50
|
|
|
|
|
else if (keylen==8 && strEQ(key, "TaintOut")) { |
|
|
50
|
|
|
|
|
|
2607
|
15
|
100
|
|
|
|
|
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintOut)); |
2608
|
|
|
|
|
|
|
} |
2609
|
110
|
|
|
|
|
|
break; |
2610
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
case 'W': |
2612
|
16
|
50
|
|
|
|
|
if (keylen==4 && strEQ(key, "Warn")) { |
|
|
50
|
|
|
|
|
|
2613
|
16
|
50
|
|
|
|
|
valuesv = boolSV(DBIc_WARN(imp_xxh)); |
2614
|
|
|
|
|
|
|
} |
2615
|
16
|
|
|
|
|
|
break; |
2616
|
|
|
|
|
|
|
} |
2617
|
|
|
|
|
|
|
} |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
/* finally check the actual hash */ |
2620
|
44691
|
100
|
|
|
|
|
if (valuesv == Nullsv) { |
2621
|
7044
|
|
|
|
|
|
valuesv = &PL_sv_undef; |
2622
|
7044
|
|
|
|
|
|
cacheit = 0; |
2623
|
7044
|
|
|
|
|
|
svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE); |
2624
|
7044
|
100
|
|
|
|
|
if (svp) |
2625
|
5
|
|
|
|
|
|
valuesv = newSVsv(*svp); /* take copy to mortalize */ |
2626
|
|
|
|
|
|
|
else /* warn unless it's known attribute name */ |
2627
|
11222
|
100
|
|
|
|
|
if ( !( (*key=='H' && strEQ(key, "HandleError")) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2628
|
7031
|
50
|
|
|
|
|
|| (*key=='H' && strEQ(key, "HandleSetErr")) |
|
|
0
|
|
|
|
|
|
2629
|
7031
|
50
|
|
|
|
|
|| (*key=='S' && strEQ(key, "Statement")) |
|
|
0
|
|
|
|
|
|
2630
|
7031
|
100
|
|
|
|
|
|| (*key=='P' && strEQ(key, "ParamArrays")) |
|
|
50
|
|
|
|
|
|
2631
|
7031
|
100
|
|
|
|
|
|| (*key=='P' && strEQ(key, "ParamValues")) |
|
|
100
|
|
|
|
|
|
2632
|
6975
|
100
|
|
|
|
|
|| (*key=='P' && strEQ(key, "Profile")) |
|
|
50
|
|
|
|
|
|
2633
|
6965
|
100
|
|
|
|
|
|| (*key=='R' && strEQ(key, "ReadOnly")) |
|
|
50
|
|
|
|
|
|
2634
|
4202
|
100
|
|
|
|
|
|| (*key=='C' && strEQ(key, "CursorName")) |
|
|
100
|
|
|
|
|
|
2635
|
4200
|
100
|
|
|
|
|
|| (*key=='C' && strEQ(key, "Callbacks")) |
|
|
50
|
|
|
|
|
|
2636
|
4189
|
100
|
|
|
|
|
|| (*key=='U' && strEQ(key, "Username")) |
|
|
50
|
|
|
|
|
|
2637
|
4183
|
|
|
|
|
|
|| !isUPPER(*key) /* dbd_*, private_* etc */ |
2638
|
|
|
|
|
|
|
)) |
2639
|
2
|
|
|
|
|
|
warn("Can't get %s->{%s}: unrecognised attribute name",neatsvpv(h,0),key); |
2640
|
|
|
|
|
|
|
} |
2641
|
|
|
|
|
|
|
|
2642
|
44691
|
100
|
|
|
|
|
if (cacheit) { |
2643
|
2184
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), key, keylen, newSVsv(valuesv), 0); |
2644
|
|
|
|
|
|
|
} |
2645
|
44691
|
100
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 3) |
2646
|
34
|
50
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," .. FETCH %s %s = %s%s\n", neatsvpv(h,0), |
2647
|
|
|
|
|
|
|
neatsvpv(keysv,0), neatsvpv(valuesv,0), cacheit?" (cached)":""); |
2648
|
44691
|
100
|
|
|
|
|
if (valuesv == &PL_sv_yes || valuesv == &PL_sv_no || valuesv == &PL_sv_undef) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2649
|
37052
|
|
|
|
|
|
return valuesv; /* no need to mortalize yes or no */ |
2650
|
44691
|
|
|
|
|
|
return sv_2mortal(valuesv); |
2651
|
|
|
|
|
|
|
} |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
|
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
/* -------------------------------------------------------------------- */ |
2656
|
|
|
|
|
|
|
/* Functions implementing Error and Event Handling. */ |
2657
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
static SV * |
2660
|
0
|
|
|
|
|
|
dbih_event(SV *hrv, const char *evtype, SV *a1, SV *a2) |
2661
|
|
|
|
|
|
|
{ |
2662
|
|
|
|
|
|
|
dTHX; |
2663
|
|
|
|
|
|
|
/* We arrive here via DBIh_EVENT* macros (see DBIXS.h) called from */ |
2664
|
|
|
|
|
|
|
/* DBD driver C code OR $h->event() method (in DBD::_::common) */ |
2665
|
|
|
|
|
|
|
/* XXX VERY OLD INTERFACE/CONCEPT MAY GO SOON */ |
2666
|
|
|
|
|
|
|
/* OR MAY EVOLVE INTO A WAY TO HANDLE 'SUCCESS_WITH_INFO'/'WARNINGS' from db */ |
2667
|
|
|
|
|
|
|
(void)hrv; |
2668
|
|
|
|
|
|
|
(void)evtype; |
2669
|
|
|
|
|
|
|
(void)a1; |
2670
|
|
|
|
|
|
|
(void)a2; |
2671
|
0
|
|
|
|
|
|
return &PL_sv_undef; |
2672
|
|
|
|
|
|
|
} |
2673
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
/* ----------------------------------------------------------------- */ |
2676
|
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
STATIC I32 |
2679
|
3457
|
|
|
|
|
|
dbi_dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock) |
2680
|
|
|
|
|
|
|
{ |
2681
|
|
|
|
|
|
|
dTHX; |
2682
|
|
|
|
|
|
|
I32 i; |
2683
|
|
|
|
|
|
|
register PERL_CONTEXT *cx; |
2684
|
4580
|
100
|
|
|
|
|
for (i = startingblock; i >= 0; i--) { |
2685
|
4251
|
|
|
|
|
|
cx = &cxstk[i]; |
2686
|
4251
|
100
|
|
|
|
|
switch (CxTYPE(cx)) { |
2687
|
|
|
|
|
|
|
default: |
2688
|
1123
|
|
|
|
|
|
continue; |
2689
|
|
|
|
|
|
|
case CXt_EVAL: |
2690
|
|
|
|
|
|
|
case CXt_SUB: |
2691
|
|
|
|
|
|
|
#ifdef CXt_FORMAT |
2692
|
|
|
|
|
|
|
case CXt_FORMAT: |
2693
|
|
|
|
|
|
|
#endif |
2694
|
|
|
|
|
|
|
DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i)); |
2695
|
3128
|
|
|
|
|
|
return i; |
2696
|
|
|
|
|
|
|
} |
2697
|
|
|
|
|
|
|
} |
2698
|
329
|
|
|
|
|
|
return i; |
2699
|
|
|
|
|
|
|
} |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
static COP * |
2703
|
310
|
|
|
|
|
|
dbi_caller_cop() |
2704
|
|
|
|
|
|
|
{ |
2705
|
|
|
|
|
|
|
dTHX; |
2706
|
|
|
|
|
|
|
register I32 cxix; |
2707
|
|
|
|
|
|
|
register PERL_CONTEXT *cx; |
2708
|
310
|
|
|
|
|
|
register PERL_CONTEXT *ccstack = cxstack; |
2709
|
310
|
|
|
|
|
|
PERL_SI *top_si = PL_curstackinfo; |
2710
|
|
|
|
|
|
|
char *stashname; |
2711
|
|
|
|
|
|
|
|
2712
|
1907
|
|
|
|
|
|
for ( cxix = dbi_dopoptosub_at(ccstack, cxstack_ix) ;; cxix = dbi_dopoptosub_at(ccstack, cxix - 1)) { |
2713
|
|
|
|
|
|
|
/* we may be in a higher stacklevel, so dig down deeper */ |
2714
|
2029
|
100
|
|
|
|
|
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { |
|
|
100
|
|
|
|
|
|
2715
|
122
|
|
|
|
|
|
top_si = top_si->si_prev; |
2716
|
122
|
|
|
|
|
|
ccstack = top_si->si_cxstack; |
2717
|
122
|
|
|
|
|
|
cxix = dbi_dopoptosub_at(ccstack, top_si->si_cxix); |
2718
|
|
|
|
|
|
|
} |
2719
|
1907
|
100
|
|
|
|
|
if (cxix < 0) { |
2720
|
182
|
|
|
|
|
|
break; |
2721
|
|
|
|
|
|
|
} |
2722
|
1725
|
50
|
|
|
|
|
if (PL_DBsub && cxix >= 0 && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2723
|
169
|
|
|
|
|
|
continue; |
2724
|
1556
|
|
|
|
|
|
cx = &ccstack[cxix]; |
2725
|
1556
|
50
|
|
|
|
|
stashname = CopSTASHPV(cx->blk_oldcop); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2726
|
1556
|
50
|
|
|
|
|
if (!stashname) |
2727
|
0
|
|
|
|
|
|
continue; |
2728
|
2984
|
100
|
|
|
|
|
if (!(stashname[0] == 'D' && stashname[1] == 'B' |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2729
|
1428
|
50
|
|
|
|
|
&& strchr("DI", stashname[2]) |
2730
|
1312
|
50
|
|
|
|
|
&& (!stashname[3] || (stashname[3] == ':' && stashname[4] == ':')))) |
|
|
50
|
|
|
|
|
|
2731
|
|
|
|
|
|
|
{ |
2732
|
128
|
|
|
|
|
|
return cx->blk_oldcop; |
2733
|
|
|
|
|
|
|
} |
2734
|
1428
|
|
|
|
|
|
cxix = dbi_dopoptosub_at(ccstack, cxix - 1); |
2735
|
1597
|
|
|
|
|
|
} |
2736
|
182
|
|
|
|
|
|
return NULL; |
2737
|
|
|
|
|
|
|
} |
2738
|
|
|
|
|
|
|
|
2739
|
|
|
|
|
|
|
static void |
2740
|
492
|
|
|
|
|
|
dbi_caller_string(SV *buf, COP *cop, char *prefix, int show_line, int show_path) |
2741
|
|
|
|
|
|
|
{ |
2742
|
|
|
|
|
|
|
dTHX; |
2743
|
|
|
|
|
|
|
STRLEN len; |
2744
|
492
|
|
|
|
|
|
long line = CopLINE(cop); |
2745
|
492
|
50
|
|
|
|
|
char *file = SvPV(GvSV(CopFILEGV(cop)), len); |
2746
|
492
|
100
|
|
|
|
|
if (!show_path) { |
2747
|
|
|
|
|
|
|
char *sep; |
2748
|
155
|
50
|
|
|
|
|
if ( (sep=strrchr(file,'/')) || (sep=strrchr(file,'\\'))) |
|
|
0
|
|
|
|
|
|
2749
|
155
|
|
|
|
|
|
file = sep+1; |
2750
|
|
|
|
|
|
|
} |
2751
|
492
|
100
|
|
|
|
|
if (show_line) { |
2752
|
481
|
50
|
|
|
|
|
sv_catpvf(buf, "%s%s line %ld", (prefix) ? prefix : "", file, line); |
2753
|
|
|
|
|
|
|
} |
2754
|
|
|
|
|
|
|
else { |
2755
|
11
|
50
|
|
|
|
|
sv_catpvf(buf, "%s%s", (prefix) ? prefix : "", file); |
2756
|
|
|
|
|
|
|
} |
2757
|
492
|
|
|
|
|
|
} |
2758
|
|
|
|
|
|
|
|
2759
|
|
|
|
|
|
|
static char * |
2760
|
366
|
|
|
|
|
|
log_where(SV *buf, int append, char *prefix, char *suffix, int show_line, int show_caller, int show_path) |
2761
|
|
|
|
|
|
|
{ |
2762
|
|
|
|
|
|
|
dTHX; |
2763
|
|
|
|
|
|
|
dTHR; |
2764
|
366
|
50
|
|
|
|
|
if (!buf) |
2765
|
366
|
|
|
|
|
|
buf = sv_2mortal(newSVpv("",0)); |
2766
|
0
|
0
|
|
|
|
|
else if (!append) |
2767
|
0
|
|
|
|
|
|
sv_setpv(buf,""); |
2768
|
366
|
100
|
|
|
|
|
if (CopLINE(PL_curcop)) { |
2769
|
|
|
|
|
|
|
COP *cop; |
2770
|
364
|
|
|
|
|
|
dbi_caller_string(buf, PL_curcop, prefix, show_line, show_path); |
2771
|
364
|
100
|
|
|
|
|
if (show_caller && (cop = dbi_caller_cop())) { |
|
|
100
|
|
|
|
|
|
2772
|
128
|
|
|
|
|
|
SV *via = sv_2mortal(newSVpv("",0)); |
2773
|
128
|
|
|
|
|
|
dbi_caller_string(via, cop, prefix, show_line, show_path); |
2774
|
128
|
50
|
|
|
|
|
sv_catpvf(buf, " via %s", SvPV_nolen(via)); |
2775
|
|
|
|
|
|
|
} |
2776
|
|
|
|
|
|
|
} |
2777
|
366
|
100
|
|
|
|
|
if (PL_dirty) |
2778
|
3
|
|
|
|
|
|
sv_catpvf(buf, " during global destruction"); |
2779
|
366
|
50
|
|
|
|
|
if (suffix) |
2780
|
366
|
|
|
|
|
|
sv_catpv(buf, suffix); |
2781
|
366
|
|
|
|
|
|
return SvPVX(buf); |
2782
|
|
|
|
|
|
|
} |
2783
|
|
|
|
|
|
|
|
2784
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
static void |
2786
|
33136
|
|
|
|
|
|
clear_cached_kids(pTHX_ SV *h, imp_xxh_t *imp_xxh, const char *meth_name, int trace_level) |
2787
|
|
|
|
|
|
|
{ |
2788
|
33136
|
100
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) <= DBIt_DB) { |
2789
|
7203
|
|
|
|
|
|
SV **svp = hv_fetch((HV*)SvRV(h), "CachedKids", 10, 0); |
2790
|
7203
|
100
|
|
|
|
|
if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2791
|
260
|
|
|
|
|
|
HV *hv = (HV*)SvRV(*svp); |
2792
|
260
|
50
|
|
|
|
|
if (HvKEYS(hv)) { |
|
|
100
|
|
|
|
|
|
2793
|
132
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) > trace_level) |
2794
|
0
|
|
|
|
|
|
trace_level = DBIc_TRACE_LEVEL(imp_xxh); |
2795
|
132
|
50
|
|
|
|
|
if (trace_level >= 2) { |
2796
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh)," >> %s %s clearing %d CachedKids\n", |
2797
|
0
|
|
|
|
|
|
meth_name, neatsvpv(h,0), (int)HvKEYS(hv)); |
2798
|
0
|
|
|
|
|
|
PerlIO_flush(DBIc_LOGPIO(imp_xxh)); |
2799
|
|
|
|
|
|
|
} |
2800
|
|
|
|
|
|
|
/* This will probably recurse through dispatch to DESTROY the kids */ |
2801
|
|
|
|
|
|
|
/* For drh we should probably explicitly do dbh disconnects */ |
2802
|
132
|
|
|
|
|
|
hv_clear(hv); |
2803
|
|
|
|
|
|
|
} |
2804
|
|
|
|
|
|
|
} |
2805
|
|
|
|
|
|
|
} |
2806
|
33136
|
|
|
|
|
|
} |
2807
|
|
|
|
|
|
|
|
2808
|
|
|
|
|
|
|
|
2809
|
|
|
|
|
|
|
static NV |
2810
|
1057463
|
|
|
|
|
|
dbi_time() { |
2811
|
|
|
|
|
|
|
# ifdef HAS_GETTIMEOFDAY |
2812
|
|
|
|
|
|
|
# ifdef PERL_IMPLICIT_SYS |
2813
|
|
|
|
|
|
|
dTHX; |
2814
|
|
|
|
|
|
|
# endif |
2815
|
|
|
|
|
|
|
struct timeval when; |
2816
|
1057463
|
|
|
|
|
|
gettimeofday(&when, (struct timezone *) 0); |
2817
|
1057463
|
|
|
|
|
|
return when.tv_sec + (when.tv_usec / 1000000.0); |
2818
|
|
|
|
|
|
|
# else /* per-second is almost useless */ |
2819
|
|
|
|
|
|
|
# ifdef _WIN32 /* use _ftime() on Win32 (MS Visual C++ 6.0) */ |
2820
|
|
|
|
|
|
|
# if defined(__BORLANDC__) |
2821
|
|
|
|
|
|
|
# define _timeb timeb |
2822
|
|
|
|
|
|
|
# define _ftime ftime |
2823
|
|
|
|
|
|
|
# endif |
2824
|
|
|
|
|
|
|
struct _timeb when; |
2825
|
|
|
|
|
|
|
_ftime( &when ); |
2826
|
|
|
|
|
|
|
return when.time + (when.millitm / 1000.0); |
2827
|
|
|
|
|
|
|
# else |
2828
|
|
|
|
|
|
|
return time(NULL); |
2829
|
|
|
|
|
|
|
# endif |
2830
|
|
|
|
|
|
|
# endif |
2831
|
|
|
|
|
|
|
} |
2832
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
|
2834
|
|
|
|
|
|
|
static SV * |
2835
|
44867
|
|
|
|
|
|
_profile_next_node(SV *node, const char *name) |
2836
|
|
|
|
|
|
|
{ |
2837
|
|
|
|
|
|
|
/* step one level down profile Data tree and auto-vivify if required */ |
2838
|
|
|
|
|
|
|
dTHX; |
2839
|
44867
|
|
|
|
|
|
SV *orig_node = node; |
2840
|
44867
|
100
|
|
|
|
|
if (SvROK(node)) |
2841
|
44618
|
|
|
|
|
|
node = SvRV(node); |
2842
|
44867
|
100
|
|
|
|
|
if (SvTYPE(node) != SVt_PVHV) { |
2843
|
249
|
|
|
|
|
|
HV *hv = newHV(); |
2844
|
249
|
50
|
|
|
|
|
if (SvOK(node)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2845
|
0
|
|
|
|
|
|
char *key = "(demoted)"; |
2846
|
0
|
|
|
|
|
|
warn("Profile data element %s replaced with new hash ref (for %s) and original value stored with key '%s'", |
2847
|
|
|
|
|
|
|
neatsvpv(orig_node,0), name, key); |
2848
|
0
|
|
|
|
|
|
(void)hv_store(hv, key, strlen(key), SvREFCNT_inc(orig_node), 0); |
2849
|
|
|
|
|
|
|
} |
2850
|
249
|
|
|
|
|
|
sv_setsv(node, newRV_noinc((SV*)hv)); |
2851
|
249
|
|
|
|
|
|
node = (SV*)hv; |
2852
|
|
|
|
|
|
|
} |
2853
|
44867
|
|
|
|
|
|
node = *hv_fetch((HV*)node, name, strlen(name), 1); |
2854
|
44867
|
|
|
|
|
|
return node; |
2855
|
|
|
|
|
|
|
} |
2856
|
|
|
|
|
|
|
|
2857
|
|
|
|
|
|
|
|
2858
|
|
|
|
|
|
|
static SV* |
2859
|
60663
|
|
|
|
|
|
dbi_profile(SV *h, imp_xxh_t *imp_xxh, SV *statement_sv, SV *method, NV t1, NV t2) |
2860
|
|
|
|
|
|
|
{ |
2861
|
|
|
|
|
|
|
#define DBIprof_MAX_PATH_ELEM 100 |
2862
|
|
|
|
|
|
|
#define DBIprof_COUNT 0 |
2863
|
|
|
|
|
|
|
#define DBIprof_TOTAL_TIME 1 |
2864
|
|
|
|
|
|
|
#define DBIprof_FIRST_TIME 2 |
2865
|
|
|
|
|
|
|
#define DBIprof_MIN_TIME 3 |
2866
|
|
|
|
|
|
|
#define DBIprof_MAX_TIME 4 |
2867
|
|
|
|
|
|
|
#define DBIprof_FIRST_CALLED 5 |
2868
|
|
|
|
|
|
|
#define DBIprof_LAST_CALLED 6 |
2869
|
|
|
|
|
|
|
#define DBIprof_max_index 6 |
2870
|
|
|
|
|
|
|
dTHX; |
2871
|
60663
|
|
|
|
|
|
NV ti = t2 - t1; |
2872
|
60663
|
|
|
|
|
|
int src_idx = 0; |
2873
|
60663
|
|
|
|
|
|
HV *dbh_outer_hv = NULL; |
2874
|
60663
|
|
|
|
|
|
HV *dbh_inner_hv = NULL; |
2875
|
|
|
|
|
|
|
char *statement_pv; |
2876
|
|
|
|
|
|
|
char *method_pv; |
2877
|
|
|
|
|
|
|
SV *profile; |
2878
|
|
|
|
|
|
|
SV *tmp; |
2879
|
|
|
|
|
|
|
SV *dest_node; |
2880
|
|
|
|
|
|
|
AV *av; |
2881
|
|
|
|
|
|
|
HV *h_hv; |
2882
|
|
|
|
|
|
|
|
2883
|
60663
|
|
|
|
|
|
const int call_depth = DBIc_CALL_DEPTH(imp_xxh); |
2884
|
60663
|
100
|
|
|
|
|
const int parent_call_depth = DBIc_PARENT_COM(imp_xxh) ? DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) : 0; |
2885
|
|
|
|
|
|
|
/* Only count calls originating from the application code */ |
2886
|
60663
|
100
|
|
|
|
|
if (call_depth > 1 || parent_call_depth > 0) |
|
|
100
|
|
|
|
|
|
2887
|
43912
|
|
|
|
|
|
return &PL_sv_undef; |
2888
|
|
|
|
|
|
|
|
2889
|
16751
|
100
|
|
|
|
|
if (!DBIc_has(imp_xxh, DBIcf_Profile)) |
2890
|
1
|
|
|
|
|
|
return &PL_sv_undef; |
2891
|
|
|
|
|
|
|
|
2892
|
15
|
|
|
|
|
|
method_pv = (SvTYPE(method)==SVt_PVCV) ? GvNAME(CvGV(method)) |
2893
|
33500
|
100
|
|
|
|
|
: isGV(method) ? GvNAME(method) |
2894
|
16747
|
100
|
|
|
|
|
: SvOK(method) ? SvPV_nolen(method) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2895
|
12
|
50
|
|
|
|
|
: ""; |
2896
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
/* we don't profile DESTROY during global destruction */ |
2898
|
16750
|
100
|
|
|
|
|
if (PL_dirty && instr(method_pv, "DESTROY")) |
|
|
100
|
|
|
|
|
|
2899
|
4
|
|
|
|
|
|
return &PL_sv_undef; |
2900
|
|
|
|
|
|
|
|
2901
|
16746
|
|
|
|
|
|
h_hv = (HV*)SvRV(dbih_inner(aTHX_ h, "dbi_profile")); |
2902
|
|
|
|
|
|
|
|
2903
|
16746
|
|
|
|
|
|
profile = *hv_fetch(h_hv, "Profile", 7, 1); |
2904
|
16746
|
50
|
|
|
|
|
if (profile && SvMAGICAL(profile)) |
|
|
50
|
|
|
|
|
|
2905
|
0
|
|
|
|
|
|
mg_get(profile); /* FETCH */ |
2906
|
16746
|
50
|
|
|
|
|
if (!profile || !SvROK(profile)) { |
|
|
100
|
|
|
|
|
|
2907
|
1
|
|
|
|
|
|
DBIc_set(imp_xxh, DBIcf_Profile, 0); /* disable */ |
2908
|
1
|
50
|
|
|
|
|
if (SvOK(profile) && !PL_dirty) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2909
|
0
|
|
|
|
|
|
warn("Profile attribute isn't a hash ref (%s,%ld)", neatsvpv(profile,0), (long)SvTYPE(profile)); |
2910
|
1
|
|
|
|
|
|
return &PL_sv_undef; |
2911
|
|
|
|
|
|
|
} |
2912
|
|
|
|
|
|
|
|
2913
|
|
|
|
|
|
|
/* statement_sv: undef = use $h->{Statement}, "" (&sv_no) = use empty string */ |
2914
|
|
|
|
|
|
|
|
2915
|
16745
|
100
|
|
|
|
|
if (!SvOK(statement_sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2916
|
16481
|
|
|
|
|
|
SV **psv = hv_fetch(h_hv, "Statement", 9, 0); |
2917
|
16481
|
50
|
|
|
|
|
statement_sv = (psv && SvOK(*psv)) ? *psv : &PL_sv_no; |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
} |
2919
|
16745
|
50
|
|
|
|
|
statement_pv = SvPV_nolen(statement_sv); |
2920
|
|
|
|
|
|
|
|
2921
|
16745
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 4) |
2922
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_xxh), " dbi_profile +%" NVff "s %s %s\n", |
2923
|
|
|
|
|
|
|
ti, method_pv, neatsvpv(statement_sv,0)); |
2924
|
|
|
|
|
|
|
|
2925
|
16745
|
|
|
|
|
|
dest_node = _profile_next_node(profile, "Data"); |
2926
|
|
|
|
|
|
|
|
2927
|
16745
|
|
|
|
|
|
tmp = *hv_fetch((HV*)SvRV(profile), "Path", 4, 1); |
2928
|
33425
|
50
|
|
|
|
|
if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVAV) { |
|
|
50
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
int len; |
2930
|
16745
|
|
|
|
|
|
av = (AV*)SvRV(tmp); |
2931
|
16745
|
|
|
|
|
|
len = av_len(av); /* -1=empty, 0=one element */ |
2932
|
|
|
|
|
|
|
|
2933
|
44830
|
100
|
|
|
|
|
while ( src_idx <= len ) { |
2934
|
28150
|
|
|
|
|
|
SV *pathsv = AvARRAY(av)[src_idx++]; |
2935
|
|
|
|
|
|
|
|
2936
|
28249
|
100
|
|
|
|
|
if (SvROK(pathsv) && SvTYPE(SvRV(pathsv))==SVt_PVCV) { |
|
|
100
|
|
|
|
|
|
2937
|
|
|
|
|
|
|
/* call sub, use returned list of values as path */ |
2938
|
|
|
|
|
|
|
/* returning a ref to undef vetos this profile data */ |
2939
|
164
|
|
|
|
|
|
dSP; |
2940
|
|
|
|
|
|
|
I32 ax; |
2941
|
164
|
|
|
|
|
|
SV *code_sv = SvRV(pathsv); |
2942
|
|
|
|
|
|
|
I32 items; |
2943
|
|
|
|
|
|
|
I32 item_idx; |
2944
|
164
|
50
|
|
|
|
|
EXTEND(SP, 4); |
2945
|
164
|
50
|
|
|
|
|
PUSHMARK(SP); |
2946
|
164
|
|
|
|
|
|
PUSHs(h); /* push inner handle, then others params */ |
2947
|
164
|
|
|
|
|
|
PUSHs( sv_2mortal(newSVpv(method_pv,0))); |
2948
|
164
|
|
|
|
|
|
PUTBACK; |
2949
|
164
|
|
|
|
|
|
SAVE_DEFSV; /* local($_) = $statement */ |
2950
|
164
|
|
|
|
|
|
DEFSV_set(statement_sv); |
2951
|
164
|
|
|
|
|
|
items = call_sv(code_sv, G_ARRAY); |
2952
|
164
|
|
|
|
|
|
SPAGAIN; |
2953
|
164
|
|
|
|
|
|
SP -= items ; |
2954
|
164
|
|
|
|
|
|
ax = (SP - PL_stack_base) + 1 ; |
2955
|
300
|
100
|
|
|
|
|
for (item_idx=0; item_idx < items; ++item_idx) { |
2956
|
201
|
|
|
|
|
|
SV *item_sv = ST(item_idx); |
2957
|
201
|
100
|
|
|
|
|
if (SvROK(item_sv)) { |
2958
|
65
|
50
|
|
|
|
|
if (!SvOK(SvRV(item_sv))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2959
|
65
|
|
|
|
|
|
items = -2; /* flag that we're rejecting this profile data */ |
2960
|
|
|
|
|
|
|
else /* other refs reserved */ |
2961
|
0
|
|
|
|
|
|
warn("Ignored ref returned by code ref in Profile Path"); |
2962
|
65
|
|
|
|
|
|
break; |
2963
|
|
|
|
|
|
|
} |
2964
|
136
|
50
|
|
|
|
|
dest_node = _profile_next_node(dest_node, (SvOK(item_sv) ? SvPV_nolen(item_sv) : "undef")); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2965
|
|
|
|
|
|
|
} |
2966
|
164
|
|
|
|
|
|
PUTBACK; |
2967
|
164
|
100
|
|
|
|
|
if (items == -2) /* this profile data was vetoed */ |
2968
|
65
|
|
|
|
|
|
return &PL_sv_undef; |
2969
|
|
|
|
|
|
|
} |
2970
|
27986
|
100
|
|
|
|
|
else if (SvROK(pathsv)) { |
2971
|
|
|
|
|
|
|
/* only meant for refs to scalars currently */ |
2972
|
22
|
50
|
|
|
|
|
const char *p = SvPV_nolen(SvRV(pathsv)); |
2973
|
22
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, p); |
2974
|
|
|
|
|
|
|
} |
2975
|
27964
|
50
|
|
|
|
|
else if (SvOK(pathsv)) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2976
|
|
|
|
|
|
|
STRLEN len; |
2977
|
27964
|
50
|
|
|
|
|
const char *p = SvPV(pathsv,len); |
2978
|
27964
|
100
|
|
|
|
|
if (p[0] == '!') { /* special cases */ |
2979
|
27794
|
100
|
|
|
|
|
if (p[1] == 'S' && strEQ(p, "!Statement")) { |
|
|
50
|
|
|
|
|
|
2980
|
16537
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, statement_pv); |
2981
|
|
|
|
|
|
|
} |
2982
|
11257
|
100
|
|
|
|
|
else if (p[1] == 'M' && strEQ(p, "!MethodName")) { |
|
|
50
|
|
|
|
|
|
2983
|
11227
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, method_pv); |
2984
|
|
|
|
|
|
|
} |
2985
|
30
|
50
|
|
|
|
|
else if (p[1] == 'M' && strEQ(p, "!MethodClass")) { |
|
|
0
|
|
|
|
|
|
2986
|
0
|
0
|
|
|
|
|
if (SvTYPE(method) == SVt_PVCV) { |
2987
|
0
|
0
|
|
|
|
|
p = SvPV_nolen((SV*)CvGV(method)); |
2988
|
|
|
|
|
|
|
} |
2989
|
0
|
0
|
|
|
|
|
else if (isGV(method)) { |
2990
|
|
|
|
|
|
|
/* just using SvPV_nolen(method) sometimes causes an error: */ |
2991
|
|
|
|
|
|
|
/* "Can't coerce GLOB to string" so we use gv_efullname() */ |
2992
|
0
|
|
|
|
|
|
SV *tmpsv = sv_2mortal(newSVpv("",0)); |
2993
|
|
|
|
|
|
|
#if (PERL_VERSION < 6) |
2994
|
|
|
|
|
|
|
gv_efullname(tmpsv, (GV*)method); |
2995
|
|
|
|
|
|
|
#else |
2996
|
0
|
|
|
|
|
|
gv_efullname4(tmpsv, (GV*)method, "", TRUE); |
2997
|
|
|
|
|
|
|
#endif |
2998
|
0
|
0
|
|
|
|
|
p = SvPV_nolen(tmpsv); |
2999
|
0
|
0
|
|
|
|
|
if (*p == '*') ++p; /* skip past leading '*' glob sigil */ |
3000
|
|
|
|
|
|
|
} |
3001
|
|
|
|
|
|
|
else { |
3002
|
0
|
|
|
|
|
|
p = method_pv; |
3003
|
|
|
|
|
|
|
} |
3004
|
0
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, p); |
3005
|
|
|
|
|
|
|
} |
3006
|
30
|
100
|
|
|
|
|
else if (p[1] == 'F' && strEQ(p, "!File")) { |
|
|
100
|
|
|
|
|
|
3007
|
4
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 0, 0)); |
3008
|
|
|
|
|
|
|
} |
3009
|
26
|
100
|
|
|
|
|
else if (p[1] == 'F' && strEQ(p, "!File2")) { |
|
|
50
|
|
|
|
|
|
3010
|
4
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 1, 0)); |
3011
|
|
|
|
|
|
|
} |
3012
|
22
|
100
|
|
|
|
|
else if (p[1] == 'C' && strEQ(p, "!Caller")) { |
|
|
100
|
|
|
|
|
|
3013
|
4
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 0, 0)); |
3014
|
|
|
|
|
|
|
} |
3015
|
18
|
100
|
|
|
|
|
else if (p[1] == 'C' && strEQ(p, "!Caller2")) { |
|
|
50
|
|
|
|
|
|
3016
|
10
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 1, 0)); |
3017
|
|
|
|
|
|
|
} |
3018
|
16
|
50
|
|
|
|
|
else if (p[1] == 'T' && (strEQ(p, "!Time") || strnEQ(p, "!Time~", 6))) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3019
|
|
|
|
|
|
|
char timebuf[20]; |
3020
|
8
|
|
|
|
|
|
int factor = 1; |
3021
|
8
|
100
|
|
|
|
|
if (p[5] == '~') { |
3022
|
4
|
|
|
|
|
|
factor = atoi(&p[6]); |
3023
|
4
|
50
|
|
|
|
|
if (factor == 0) /* sanity check to avoid div by zero error */ |
3024
|
0
|
|
|
|
|
|
factor = 3600; |
3025
|
|
|
|
|
|
|
} |
3026
|
8
|
|
|
|
|
|
sprintf(timebuf, "%ld", ((long)(dbi_time()/factor))*factor); |
3027
|
8
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, timebuf); |
3028
|
|
|
|
|
|
|
} |
3029
|
|
|
|
|
|
|
else { |
3030
|
0
|
|
|
|
|
|
warn("Unknown ! element in DBI::Profile Path: %s", p); |
3031
|
27794
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, p); |
3032
|
|
|
|
|
|
|
} |
3033
|
|
|
|
|
|
|
} |
3034
|
192
|
100
|
|
|
|
|
else if (p[0] == '{' && p[len-1] == '}') { /* treat as name of dbh attribute to use */ |
|
|
50
|
|
|
|
|
|
3035
|
|
|
|
|
|
|
SV **attr_svp; |
3036
|
22
|
50
|
|
|
|
|
if (!dbh_inner_hv) { /* cache dbh handles the first time we need them */ |
3037
|
22
|
100
|
|
|
|
|
imp_dbh_t *imp_dbh = (DBIc_TYPE(imp_xxh) <= DBIt_DB) ? (imp_dbh_t*)imp_xxh : (imp_dbh_t*)DBIc_PARENT_COM(imp_xxh); |
3038
|
22
|
|
|
|
|
|
dbh_outer_hv = DBIc_MY_H(imp_dbh); |
3039
|
22
|
50
|
|
|
|
|
if (SvTYPE(dbh_outer_hv) != SVt_PVHV) |
3040
|
0
|
|
|
|
|
|
return &PL_sv_undef; /* presumably global destruction - bail */ |
3041
|
22
|
|
|
|
|
|
dbh_inner_hv = (HV*)SvRV(dbih_inner(aTHX_ (SV*)dbh_outer_hv, "profile")); |
3042
|
22
|
50
|
|
|
|
|
if (SvTYPE(dbh_inner_hv) != SVt_PVHV) |
3043
|
0
|
|
|
|
|
|
return &PL_sv_undef; /* presumably global destruction - bail */ |
3044
|
|
|
|
|
|
|
} |
3045
|
|
|
|
|
|
|
/* fetch from inner first, then outer if key doesn't exist */ |
3046
|
|
|
|
|
|
|
/* (yes, this is an evil premature optimization) */ |
3047
|
22
|
|
|
|
|
|
p += 1; len -= 2; /* ignore the braces */ |
3048
|
22
|
100
|
|
|
|
|
if ((attr_svp = hv_fetch(dbh_inner_hv, p, len, 0)) == NULL) { |
3049
|
|
|
|
|
|
|
/* try outer (tied) hash - for things like AutoCommit */ |
3050
|
|
|
|
|
|
|
/* (will always return something even for unknowns) */ |
3051
|
6
|
50
|
|
|
|
|
if ((attr_svp = hv_fetch(dbh_outer_hv, p, len, 0))) { |
3052
|
6
|
50
|
|
|
|
|
if (SvGMAGICAL(*attr_svp)) |
3053
|
6
|
|
|
|
|
|
mg_get(*attr_svp); /* FETCH */ |
3054
|
|
|
|
|
|
|
} |
3055
|
|
|
|
|
|
|
} |
3056
|
22
|
50
|
|
|
|
|
if (!attr_svp) |
3057
|
0
|
|
|
|
|
|
p -= 1; /* unignore the braces */ |
3058
|
22
|
100
|
|
|
|
|
else if (!SvOK(*attr_svp)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3059
|
6
|
|
|
|
|
|
p = ""; |
3060
|
16
|
50
|
|
|
|
|
else if (!SvTRUE(*attr_svp) && SvPOK(*attr_svp) && SvNIOK(*attr_svp)) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3061
|
0
|
|
|
|
|
|
p = "0"; /* catch &sv_no style special case */ |
3062
|
|
|
|
|
|
|
else |
3063
|
16
|
50
|
|
|
|
|
p = SvPV_nolen(*attr_svp); |
3064
|
22
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, p); |
3065
|
|
|
|
|
|
|
} |
3066
|
|
|
|
|
|
|
else { |
3067
|
27964
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, p); |
3068
|
|
|
|
|
|
|
} |
3069
|
|
|
|
|
|
|
} |
3070
|
|
|
|
|
|
|
/* else undef, so ignore */ |
3071
|
|
|
|
|
|
|
} |
3072
|
|
|
|
|
|
|
} |
3073
|
|
|
|
|
|
|
else { /* a bad Path value is treated as a Path of just Statement */ |
3074
|
0
|
|
|
|
|
|
dest_node = _profile_next_node(dest_node, statement_pv); |
3075
|
|
|
|
|
|
|
} |
3076
|
|
|
|
|
|
|
|
3077
|
|
|
|
|
|
|
|
3078
|
16680
|
100
|
|
|
|
|
if (!SvOK(dest_node)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3079
|
410
|
|
|
|
|
|
av = newAV(); |
3080
|
410
|
|
|
|
|
|
sv_setsv(dest_node, newRV_noinc((SV*)av)); |
3081
|
410
|
|
|
|
|
|
av_store(av, DBIprof_COUNT, newSViv(1)); |
3082
|
410
|
|
|
|
|
|
av_store(av, DBIprof_TOTAL_TIME, newSVnv(ti)); |
3083
|
410
|
|
|
|
|
|
av_store(av, DBIprof_FIRST_TIME, newSVnv(ti)); |
3084
|
410
|
|
|
|
|
|
av_store(av, DBIprof_MIN_TIME, newSVnv(ti)); |
3085
|
410
|
|
|
|
|
|
av_store(av, DBIprof_MAX_TIME, newSVnv(ti)); |
3086
|
410
|
|
|
|
|
|
av_store(av, DBIprof_FIRST_CALLED, newSVnv(t1)); |
3087
|
410
|
|
|
|
|
|
av_store(av, DBIprof_LAST_CALLED, newSVnv(t1)); |
3088
|
|
|
|
|
|
|
} |
3089
|
|
|
|
|
|
|
else { |
3090
|
16270
|
|
|
|
|
|
tmp = dest_node; |
3091
|
16270
|
50
|
|
|
|
|
if (SvROK(tmp)) |
3092
|
16270
|
|
|
|
|
|
tmp = SvRV(tmp); |
3093
|
16270
|
50
|
|
|
|
|
if (SvTYPE(tmp) != SVt_PVAV) |
3094
|
0
|
|
|
|
|
|
croak("Invalid Profile data leaf element: %s (type %ld)", |
3095
|
0
|
|
|
|
|
|
neatsvpv(tmp,0), (long)SvTYPE(tmp)); |
3096
|
16270
|
|
|
|
|
|
av = (AV*)tmp; |
3097
|
16270
|
|
|
|
|
|
sv_inc( *av_fetch(av, DBIprof_COUNT, 1)); |
3098
|
16270
|
|
|
|
|
|
tmp = *av_fetch(av, DBIprof_TOTAL_TIME, 1); |
3099
|
16270
|
100
|
|
|
|
|
sv_setnv(tmp, SvNV(tmp) + ti); |
3100
|
16270
|
|
|
|
|
|
tmp = *av_fetch(av, DBIprof_MIN_TIME, 1); |
3101
|
16270
|
100
|
|
|
|
|
if (ti < SvNV(tmp)) sv_setnv(tmp, ti); |
|
|
100
|
|
|
|
|
|
3102
|
16270
|
|
|
|
|
|
tmp = *av_fetch(av, DBIprof_MAX_TIME, 1); |
3103
|
16270
|
100
|
|
|
|
|
if (ti > SvNV(tmp)) sv_setnv(tmp, ti); |
|
|
100
|
|
|
|
|
|
3104
|
16270
|
|
|
|
|
|
sv_setnv( *av_fetch(av, DBIprof_LAST_CALLED, 1), t1); |
3105
|
|
|
|
|
|
|
} |
3106
|
16680
|
|
|
|
|
|
return dest_node; /* use with caution - copy first, ie sv_mortalcopy() */ |
3107
|
|
|
|
|
|
|
} |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
|
3110
|
|
|
|
|
|
|
static void |
3111
|
372
|
|
|
|
|
|
dbi_profile_merge_nodes(SV *dest, SV *increment) |
3112
|
|
|
|
|
|
|
{ |
3113
|
|
|
|
|
|
|
dTHX; |
3114
|
|
|
|
|
|
|
AV *d_av, *i_av; |
3115
|
|
|
|
|
|
|
SV *tmp; |
3116
|
|
|
|
|
|
|
SV *tmp2; |
3117
|
|
|
|
|
|
|
NV i_nv; |
3118
|
|
|
|
|
|
|
int i_is_earlier; |
3119
|
|
|
|
|
|
|
|
3120
|
372
|
50
|
|
|
|
|
if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV) |
|
|
50
|
|
|
|
|
|
3121
|
0
|
|
|
|
|
|
croak("dbi_profile_merge_nodes(%s, ...) requires array ref", neatsvpv(dest,0)); |
3122
|
372
|
|
|
|
|
|
d_av = (AV*)SvRV(dest); |
3123
|
|
|
|
|
|
|
|
3124
|
372
|
100
|
|
|
|
|
if (av_len(d_av) < DBIprof_max_index) { |
3125
|
|
|
|
|
|
|
int idx; |
3126
|
46
|
|
|
|
|
|
av_extend(d_av, DBIprof_max_index); |
3127
|
368
|
100
|
|
|
|
|
for(idx=0; idx<=DBIprof_max_index; ++idx) { |
3128
|
322
|
|
|
|
|
|
tmp = *av_fetch(d_av, idx, 1); |
3129
|
322
|
50
|
|
|
|
|
if (!SvOK(tmp) && idx != DBIprof_MIN_TIME && idx != DBIprof_FIRST_CALLED) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3130
|
230
|
|
|
|
|
|
sv_setnv(tmp, 0.0); /* leave 'min' values as undef */ |
3131
|
|
|
|
|
|
|
} |
3132
|
|
|
|
|
|
|
} |
3133
|
|
|
|
|
|
|
|
3134
|
372
|
50
|
|
|
|
|
if (!SvOK(increment)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3135
|
0
|
|
|
|
|
|
return; |
3136
|
|
|
|
|
|
|
|
3137
|
372
|
50
|
|
|
|
|
if (SvROK(increment) && SvTYPE(SvRV(increment)) == SVt_PVHV) { |
|
|
100
|
|
|
|
|
|
3138
|
2
|
|
|
|
|
|
HV *hv = (HV*)SvRV(increment); |
3139
|
|
|
|
|
|
|
char *key; |
3140
|
2
|
|
|
|
|
|
I32 keylen = 0; |
3141
|
2
|
|
|
|
|
|
hv_iterinit(hv); |
3142
|
6
|
100
|
|
|
|
|
while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) { |
3143
|
4
|
|
|
|
|
|
dbi_profile_merge_nodes(dest, tmp); |
3144
|
|
|
|
|
|
|
}; |
3145
|
2
|
|
|
|
|
|
return; |
3146
|
|
|
|
|
|
|
} |
3147
|
|
|
|
|
|
|
|
3148
|
370
|
50
|
|
|
|
|
if (!SvROK(increment) || SvTYPE(SvRV(increment)) != SVt_PVAV) |
|
|
50
|
|
|
|
|
|
3149
|
0
|
|
|
|
|
|
croak("dbi_profile_merge_nodes: increment %s not an array or hash ref", neatsvpv(increment,0)); |
3150
|
370
|
|
|
|
|
|
i_av = (AV*)SvRV(increment); |
3151
|
|
|
|
|
|
|
|
3152
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_COUNT, 1); |
3153
|
370
|
|
|
|
|
|
tmp2 = *av_fetch(i_av, DBIprof_COUNT, 1); |
3154
|
370
|
50
|
|
|
|
|
if (SvIOK(tmp) && SvIOK(tmp2)) |
|
|
0
|
|
|
|
|
|
3155
|
0
|
0
|
|
|
|
|
sv_setiv( tmp, SvIV(tmp) + SvIV(tmp2) ); |
|
|
0
|
|
|
|
|
|
3156
|
|
|
|
|
|
|
else |
3157
|
370
|
100
|
|
|
|
|
sv_setnv( tmp, SvNV(tmp) + SvNV(tmp2) ); |
|
|
100
|
|
|
|
|
|
3158
|
|
|
|
|
|
|
|
3159
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_TOTAL_TIME, 1); |
3160
|
370
|
100
|
|
|
|
|
sv_setnv( tmp, SvNV(tmp) + SvNV( *av_fetch(i_av, DBIprof_TOTAL_TIME, 1)) ); |
|
|
100
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
|
3162
|
370
|
100
|
|
|
|
|
i_nv = SvNV(*av_fetch(i_av, DBIprof_MIN_TIME, 1)); |
3163
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_MIN_TIME, 1); |
3164
|
370
|
100
|
|
|
|
|
if (!SvOK(tmp) || i_nv < SvNV(tmp)) sv_setnv(tmp, i_nv); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3165
|
|
|
|
|
|
|
|
3166
|
370
|
100
|
|
|
|
|
i_nv = SvNV(*av_fetch(i_av, DBIprof_MAX_TIME, 1)); |
3167
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_MAX_TIME, 1); |
3168
|
370
|
100
|
|
|
|
|
if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv); |
|
|
100
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
|
3170
|
370
|
100
|
|
|
|
|
i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_CALLED, 1)); |
3171
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_FIRST_CALLED, 1); |
3172
|
370
|
100
|
|
|
|
|
i_is_earlier = (!SvOK(tmp) || i_nv < SvNV(tmp)); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3173
|
370
|
100
|
|
|
|
|
if (i_is_earlier) |
3174
|
77
|
|
|
|
|
|
sv_setnv(tmp, i_nv); |
3175
|
|
|
|
|
|
|
|
3176
|
370
|
100
|
|
|
|
|
i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_TIME, 1)); |
3177
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_FIRST_TIME, 1); |
3178
|
370
|
100
|
|
|
|
|
if (i_is_earlier || !SvOK(tmp)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3179
|
|
|
|
|
|
|
/* If the increment has an earlier DBIprof_FIRST_CALLED |
3180
|
|
|
|
|
|
|
then we set the DBIprof_FIRST_TIME from the increment */ |
3181
|
77
|
|
|
|
|
|
sv_setnv(tmp, i_nv); |
3182
|
|
|
|
|
|
|
} |
3183
|
|
|
|
|
|
|
|
3184
|
370
|
100
|
|
|
|
|
i_nv = SvNV(*av_fetch(i_av, DBIprof_LAST_CALLED, 1)); |
3185
|
370
|
|
|
|
|
|
tmp = *av_fetch(d_av, DBIprof_LAST_CALLED, 1); |
3186
|
370
|
100
|
|
|
|
|
if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv); |
|
|
100
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
} |
3188
|
|
|
|
|
|
|
|
3189
|
|
|
|
|
|
|
|
3190
|
|
|
|
|
|
|
/* ----------------------------------------------------------------- */ |
3191
|
|
|
|
|
|
|
/* --- The DBI dispatcher. The heart of the perl DBI. --- */ |
3192
|
|
|
|
|
|
|
|
3193
|
|
|
|
|
|
|
XS(XS_DBI_dispatch); /* prototype to pass -Wmissing-prototypes */ |
3194
|
611852
|
|
|
|
|
|
XS(XS_DBI_dispatch) |
3195
|
|
|
|
|
|
|
{ |
3196
|
611852
|
|
|
|
|
|
dXSARGS; |
3197
|
611852
|
|
|
|
|
|
dORIGMARK; |
3198
|
|
|
|
|
|
|
dMY_CXT; |
3199
|
|
|
|
|
|
|
|
3200
|
611852
|
|
|
|
|
|
SV *h = ST(0); /* the DBI handle we are working with */ |
3201
|
611852
|
|
|
|
|
|
SV *st1 = ST(1); /* used in debugging */ |
3202
|
611852
|
|
|
|
|
|
SV *st2 = ST(2); /* used in debugging */ |
3203
|
611852
|
|
|
|
|
|
SV *orig_h = h; |
3204
|
|
|
|
|
|
|
SV *err_sv; |
3205
|
|
|
|
|
|
|
SV **tmp_svp; |
3206
|
611852
|
|
|
|
|
|
SV **hook_svp = 0; |
3207
|
|
|
|
|
|
|
MAGIC *mg; |
3208
|
611852
|
100
|
|
|
|
|
int gimme = GIMME; |
|
|
100
|
|
|
|
|
|
3209
|
611852
|
|
|
|
|
|
I32 trace_flags = DBIS->debug; /* local copy may change during dispatch */ |
3210
|
611852
|
|
|
|
|
|
I32 trace_level = (trace_flags & DBIc_TRACE_LEVEL_MASK); |
3211
|
|
|
|
|
|
|
int is_DESTROY; |
3212
|
|
|
|
|
|
|
meth_types meth_type; |
3213
|
611852
|
|
|
|
|
|
int is_unrelated_to_Statement = 0; |
3214
|
611852
|
|
|
|
|
|
U32 keep_error = FALSE; |
3215
|
611852
|
|
|
|
|
|
UV ErrCount = UV_MAX; |
3216
|
|
|
|
|
|
|
int i, outitems; |
3217
|
|
|
|
|
|
|
int call_depth; |
3218
|
|
|
|
|
|
|
int is_nested_call; |
3219
|
611852
|
|
|
|
|
|
NV profile_t1 = 0.0; |
3220
|
611852
|
|
|
|
|
|
int is_orig_method_name = 1; |
3221
|
|
|
|
|
|
|
|
3222
|
611852
|
|
|
|
|
|
const char *meth_name = GvNAME(CvGV(cv)); |
3223
|
611852
|
|
|
|
|
|
dbi_ima_t *ima = (dbi_ima_t*)CvXSUBANY(cv).any_ptr; |
3224
|
|
|
|
|
|
|
U32 ima_flags; |
3225
|
611852
|
|
|
|
|
|
imp_xxh_t *imp_xxh = NULL; |
3226
|
611852
|
|
|
|
|
|
SV *imp_msv = Nullsv; |
3227
|
611852
|
|
|
|
|
|
SV *qsv = Nullsv; /* quick result from a shortcut method */ |
3228
|
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
|
|
3230
|
|
|
|
|
|
|
#ifdef BROKEN_DUP_ANY_PTR |
3231
|
|
|
|
|
|
|
if (ima->my_perl != my_perl) { |
3232
|
|
|
|
|
|
|
/* we couldn't dup the ima struct at clone time, so do it now */ |
3233
|
|
|
|
|
|
|
dbi_ima_t *nima; |
3234
|
|
|
|
|
|
|
Newx(nima, 1, dbi_ima_t); |
3235
|
|
|
|
|
|
|
*nima = *ima; /* structure copy */ |
3236
|
|
|
|
|
|
|
CvXSUBANY(cv).any_ptr = nima; |
3237
|
|
|
|
|
|
|
nima->stash = NULL; |
3238
|
|
|
|
|
|
|
nima->gv = NULL; |
3239
|
|
|
|
|
|
|
nima->my_perl = my_perl; |
3240
|
|
|
|
|
|
|
ima = nima; |
3241
|
|
|
|
|
|
|
} |
3242
|
|
|
|
|
|
|
#endif |
3243
|
|
|
|
|
|
|
|
3244
|
611852
|
|
|
|
|
|
ima_flags = ima->flags; |
3245
|
611852
|
|
|
|
|
|
meth_type = ima->meth_type; |
3246
|
611852
|
100
|
|
|
|
|
if (trace_level >= 9) { |
3247
|
116
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3248
|
116
|
50
|
|
|
|
|
PerlIO_printf(logfp,"%c >> %-11s DISPATCH (%s rc%ld/%ld @%ld g%x ima%lx pid#%ld)", |
|
|
50
|
|
|
|
|
|
3249
|
116
|
|
|
|
|
|
(PL_dirty?'!':' '), meth_name, neatsvpv(h,0), |
3250
|
348
|
|
|
|
|
|
(long)SvREFCNT(h), (SvROK(h) ? (long)SvREFCNT(SvRV(h)) : (long)-1), |
3251
|
116
|
|
|
|
|
|
(long)items, (int)gimme, (long)ima_flags, (long)PerlProc_getpid()); |
3252
|
116
|
|
|
|
|
|
PerlIO_puts(logfp, log_where(0, 0, " at ","\n", 1, (trace_level >= 3), (trace_level >= 4))); |
3253
|
116
|
|
|
|
|
|
PerlIO_flush(logfp); |
3254
|
|
|
|
|
|
|
} |
3255
|
|
|
|
|
|
|
|
3256
|
611852
|
100
|
|
|
|
|
if ( ( (is_DESTROY=(meth_type == methtype_DESTROY))) ) { |
3257
|
|
|
|
|
|
|
/* note that croak()'s won't propagate, only append to $@ */ |
3258
|
59123
|
|
|
|
|
|
keep_error = TRUE; |
3259
|
|
|
|
|
|
|
} |
3260
|
|
|
|
|
|
|
|
3261
|
|
|
|
|
|
|
/* If h is a tied hash ref, switch to the inner ref 'behind' the tie. |
3262
|
|
|
|
|
|
|
This means *all* DBI methods work with the inner (non-tied) ref. |
3263
|
|
|
|
|
|
|
This makes it much easier for methods to access the real hash |
3264
|
|
|
|
|
|
|
data (without having to go through FETCH and STORE methods) and |
3265
|
|
|
|
|
|
|
for tie and non-tie methods to call each other. |
3266
|
|
|
|
|
|
|
*/ |
3267
|
611852
|
100
|
|
|
|
|
if (SvROK(h) |
3268
|
611846
|
50
|
|
|
|
|
&& SvRMAGICAL(SvRV(h)) |
3269
|
611846
|
100
|
|
|
|
|
&& ( |
3270
|
611846
|
|
|
|
|
|
((mg=SvMAGIC(SvRV(h)))->mg_type == 'P') |
3271
|
455725
|
50
|
|
|
|
|
|| ((mg=mg_find(SvRV(h),'P')) != NULL) |
3272
|
|
|
|
|
|
|
) |
3273
|
|
|
|
|
|
|
) { |
3274
|
156121
|
50
|
|
|
|
|
if (mg->mg_obj==NULL || !SvOK(mg->mg_obj) || SvRV(mg->mg_obj)==NULL) { /* maybe global destruction */ |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3275
|
54
|
50
|
|
|
|
|
if (trace_level >= 3) |
3276
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP, |
3277
|
|
|
|
|
|
|
"%c <> %s for %s ignored (inner handle gone)\n", |
3278
|
0
|
|
|
|
|
|
(PL_dirty?'!':' '), meth_name, neatsvpv(h,0)); |
3279
|
54
|
|
|
|
|
|
XSRETURN(0); |
3280
|
|
|
|
|
|
|
} |
3281
|
|
|
|
|
|
|
/* Distinguish DESTROY of tie (outer) from DESTROY of inner ref */ |
3282
|
|
|
|
|
|
|
/* This may one day be used to manually destroy extra internal */ |
3283
|
|
|
|
|
|
|
/* refs if the application ceases to use the handle. */ |
3284
|
156067
|
100
|
|
|
|
|
if (is_DESTROY) { |
3285
|
29505
|
|
|
|
|
|
imp_xxh = DBIh_COM(mg->mg_obj); |
3286
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
3287
|
|
|
|
|
|
|
if (imp_xxh && DBIc_THR_USER(imp_xxh) != my_perl) { |
3288
|
|
|
|
|
|
|
goto is_DESTROY_wrong_thread; |
3289
|
|
|
|
|
|
|
} |
3290
|
|
|
|
|
|
|
#endif |
3291
|
29505
|
100
|
|
|
|
|
if (imp_xxh && DBIc_TYPE(imp_xxh) <= DBIt_DB) |
|
|
100
|
|
|
|
|
|
3292
|
3573
|
|
|
|
|
|
clear_cached_kids(aTHX_ mg->mg_obj, imp_xxh, meth_name, trace_level); |
3293
|
|
|
|
|
|
|
/* XXX might be better to move this down to after call_depth has been |
3294
|
|
|
|
|
|
|
* incremented and then also SvREFCNT_dec(mg->mg_obj) to force an immediate |
3295
|
|
|
|
|
|
|
* DESTROY of the inner handle if there are no other refs to it. |
3296
|
|
|
|
|
|
|
* That way the inner DESTROY is properly flagged as a nested call, |
3297
|
|
|
|
|
|
|
* and the outer DESTROY gets profiled more accurately, and callbacks work. |
3298
|
|
|
|
|
|
|
*/ |
3299
|
29505
|
100
|
|
|
|
|
if (trace_level >= 3) { |
3300
|
4
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP, |
3301
|
|
|
|
|
|
|
"%c <> DESTROY(%s) ignored for outer handle (inner %s has ref cnt %ld)\n", |
3302
|
4
|
|
|
|
|
|
(PL_dirty?'!':' '), neatsvpv(h,0), neatsvpv(mg->mg_obj,0), |
3303
|
4
|
|
|
|
|
|
(long)SvREFCNT(SvRV(mg->mg_obj)) |
3304
|
|
|
|
|
|
|
); |
3305
|
|
|
|
|
|
|
} |
3306
|
|
|
|
|
|
|
/* for now we ignore it since it'll be followed soon by */ |
3307
|
|
|
|
|
|
|
/* a destroy of the inner hash and that'll do the real work */ |
3308
|
|
|
|
|
|
|
|
3309
|
|
|
|
|
|
|
/* However, we must at least modify DBIc_MY_H() as that is */ |
3310
|
|
|
|
|
|
|
/* pointing (without a refcnt inc) to the scalar that is */ |
3311
|
|
|
|
|
|
|
/* being destroyed, so it'll contain random values later. */ |
3312
|
29505
|
100
|
|
|
|
|
if (imp_xxh) |
3313
|
29504
|
|
|
|
|
|
DBIc_MY_H(imp_xxh) = (HV*)SvRV(mg->mg_obj); /* inner (untied) HV */ |
3314
|
|
|
|
|
|
|
|
3315
|
29505
|
|
|
|
|
|
XSRETURN(0); |
3316
|
|
|
|
|
|
|
} |
3317
|
126562
|
|
|
|
|
|
h = mg->mg_obj; /* switch h to inner ref */ |
3318
|
126562
|
|
|
|
|
|
ST(0) = h; /* switch handle on stack to inner ref */ |
3319
|
|
|
|
|
|
|
} |
3320
|
|
|
|
|
|
|
|
3321
|
582293
|
|
|
|
|
|
imp_xxh = dbih_getcom2(aTHX_ h, 0); /* get common Internal Handle Attributes */ |
3322
|
582293
|
100
|
|
|
|
|
if (!imp_xxh) { |
3323
|
11
|
100
|
|
|
|
|
if (meth_type == methtype_can) { /* ref($h)->can("foo") */ |
3324
|
6
|
50
|
|
|
|
|
const char *can_meth = SvPV_nolen(st1); |
3325
|
6
|
|
|
|
|
|
SV *rv = &PL_sv_undef; |
3326
|
6
|
|
|
|
|
|
GV *gv = gv_fetchmethod_autoload(gv_stashsv(orig_h,FALSE), can_meth, FALSE); |
3327
|
6
|
100
|
|
|
|
|
if (gv && isGV(gv)) |
|
|
50
|
|
|
|
|
|
3328
|
4
|
|
|
|
|
|
rv = sv_2mortal(newRV_inc((SV*)GvCV(gv))); |
3329
|
6
|
50
|
|
|
|
|
if (trace_level >= 1) { |
3330
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," <- %s(%s) = %p\n", meth_name, can_meth, neatsvpv(rv,0)); |
3331
|
|
|
|
|
|
|
} |
3332
|
6
|
|
|
|
|
|
ST(0) = rv; |
3333
|
6
|
|
|
|
|
|
XSRETURN(1); |
3334
|
|
|
|
|
|
|
} |
3335
|
5
|
50
|
|
|
|
|
if (trace_level) |
3336
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP, "%c <> %s for %s ignored (no imp_data)\n", |
3337
|
0
|
|
|
|
|
|
(PL_dirty?'!':' '), meth_name, neatsvpv(h,0)); |
3338
|
5
|
100
|
|
|
|
|
if (!is_DESTROY) |
3339
|
4
|
50
|
|
|
|
|
warn("Can't call %s method on handle %s%s", meth_name, neatsvpv(h,0), |
3340
|
4
|
|
|
|
|
|
SvROK(h) ? " after take_imp_data()" : " (not a reference)"); |
3341
|
5
|
|
|
|
|
|
XSRETURN(0); |
3342
|
|
|
|
|
|
|
} |
3343
|
|
|
|
|
|
|
|
3344
|
582282
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh,DBIcf_Profile)) { |
3345
|
60806
|
|
|
|
|
|
profile_t1 = dbi_time(); /* just get start time here */ |
3346
|
|
|
|
|
|
|
} |
3347
|
|
|
|
|
|
|
|
3348
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
3349
|
|
|
|
|
|
|
{ |
3350
|
|
|
|
|
|
|
PerlInterpreter * h_perl; |
3351
|
|
|
|
|
|
|
is_DESTROY_wrong_thread: |
3352
|
|
|
|
|
|
|
h_perl = DBIc_THR_USER(imp_xxh) ; |
3353
|
|
|
|
|
|
|
if (h_perl != my_perl) { |
3354
|
|
|
|
|
|
|
/* XXX could call a 'handle clone' method here?, for dbh's at least */ |
3355
|
|
|
|
|
|
|
if (is_DESTROY) { |
3356
|
|
|
|
|
|
|
if (trace_level >= 3) { |
3357
|
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," DESTROY ignored because DBI %sh handle (%s) is owned by thread %p not current thread %p\n", |
3358
|
|
|
|
|
|
|
dbih_htype_name(DBIc_TYPE(imp_xxh)), HvNAME(DBIc_IMP_STASH(imp_xxh)), |
3359
|
|
|
|
|
|
|
(void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ; |
3360
|
|
|
|
|
|
|
PerlIO_flush(DBILOGFP); |
3361
|
|
|
|
|
|
|
} |
3362
|
|
|
|
|
|
|
XSRETURN(0); /* don't DESTROY handle, if it is not our's !*/ |
3363
|
|
|
|
|
|
|
} |
3364
|
|
|
|
|
|
|
croak("%s %s failed: handle %d is owned by thread %lx not current thread %lx (%s)", |
3365
|
|
|
|
|
|
|
HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, DBIc_TYPE(imp_xxh), |
3366
|
|
|
|
|
|
|
(unsigned long)h_perl, (unsigned long)my_perl, |
3367
|
|
|
|
|
|
|
"handles can't be shared between threads and your driver may need a CLONE method added"); |
3368
|
|
|
|
|
|
|
} |
3369
|
|
|
|
|
|
|
} |
3370
|
|
|
|
|
|
|
#endif |
3371
|
|
|
|
|
|
|
|
3372
|
582282
|
50
|
|
|
|
|
if ((i = DBIc_DEBUGIV(imp_xxh))) { /* merge handle into global */ |
|
|
100
|
|
|
|
|
|
3373
|
373
|
|
|
|
|
|
I32 h_trace_level = (i & DBIc_TRACE_LEVEL_MASK); |
3374
|
373
|
100
|
|
|
|
|
if ( h_trace_level > trace_level ) |
3375
|
44
|
|
|
|
|
|
trace_level = h_trace_level; |
3376
|
373
|
|
|
|
|
|
trace_flags = (trace_flags & ~DBIc_TRACE_LEVEL_MASK) |
3377
|
373
|
|
|
|
|
|
| ( i & ~DBIc_TRACE_LEVEL_MASK) |
3378
|
|
|
|
|
|
|
| trace_level; |
3379
|
|
|
|
|
|
|
} |
3380
|
|
|
|
|
|
|
|
3381
|
|
|
|
|
|
|
/* Check method call against Internal Method Attributes */ |
3382
|
582282
|
100
|
|
|
|
|
if (ima_flags) { |
3383
|
|
|
|
|
|
|
|
3384
|
356152
|
100
|
|
|
|
|
if (ima_flags & (IMA_STUB|IMA_FUNC_REDIRECT|IMA_KEEP_ERR|IMA_KEEP_ERR_SUB|IMA_CLEAR_STMT)) { |
3385
|
|
|
|
|
|
|
|
3386
|
289748
|
100
|
|
|
|
|
if (ima_flags & IMA_STUB) { |
3387
|
106
|
50
|
|
|
|
|
if (meth_type == methtype_can) { |
3388
|
106
|
50
|
|
|
|
|
const char *can_meth = SvPV_nolen(st1); |
3389
|
106
|
|
|
|
|
|
SV *dbi_msv = Nullsv; |
3390
|
|
|
|
|
|
|
/* find handle implementors method (GV or CV) */ |
3391
|
106
|
100
|
|
|
|
|
if ( (imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), can_meth, FALSE)) ) { |
3392
|
|
|
|
|
|
|
/* return DBI's CV, not the implementors CV (else we'd bypass dispatch) */ |
3393
|
|
|
|
|
|
|
/* and anyway, we may have hit a private method not part of the DBI */ |
3394
|
2
|
|
|
|
|
|
GV *gv = gv_fetchmethod_autoload(SvSTASH(SvRV(orig_h)), can_meth, FALSE); |
3395
|
2
|
50
|
|
|
|
|
if (gv && isGV(gv)) |
|
|
50
|
|
|
|
|
|
3396
|
2
|
|
|
|
|
|
dbi_msv = (SV*)GvCV(gv); |
3397
|
|
|
|
|
|
|
} |
3398
|
106
|
100
|
|
|
|
|
if (trace_level >= 1) { |
3399
|
4
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3400
|
4
|
50
|
|
|
|
|
PerlIO_printf(logfp," <- %s(%s) = %p (%s %p)\n", meth_name, can_meth, (void*)dbi_msv, |
3401
|
0
|
0
|
|
|
|
|
(imp_msv && isGV(imp_msv)) ? HvNAME(GvSTASH(imp_msv)) : "?", (void*)imp_msv); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3402
|
|
|
|
|
|
|
} |
3403
|
106
|
100
|
|
|
|
|
ST(0) = (dbi_msv) ? sv_2mortal(newRV_inc(dbi_msv)) : &PL_sv_undef; |
3404
|
106
|
|
|
|
|
|
XSRETURN(1); |
3405
|
|
|
|
|
|
|
} |
3406
|
0
|
|
|
|
|
|
XSRETURN(0); |
3407
|
|
|
|
|
|
|
} |
3408
|
289642
|
100
|
|
|
|
|
if (ima_flags & IMA_FUNC_REDIRECT) { |
3409
|
|
|
|
|
|
|
/* XXX this doesn't redispatch, nor consider the IMA of the new method */ |
3410
|
7066
|
|
|
|
|
|
SV *meth_name_sv = POPs; |
3411
|
7066
|
|
|
|
|
|
PUTBACK; |
3412
|
7066
|
|
|
|
|
|
--items; |
3413
|
7066
|
50
|
|
|
|
|
if (!SvPOK(meth_name_sv) || SvNIOK(meth_name_sv)) |
|
|
50
|
|
|
|
|
|
3414
|
0
|
|
|
|
|
|
croak("%s->%s() invalid redirect method name %s", |
3415
|
|
|
|
|
|
|
neatsvpv(h,0), meth_name, neatsvpv(meth_name_sv,0)); |
3416
|
7066
|
50
|
|
|
|
|
meth_name = SvPV_nolen(meth_name_sv); |
3417
|
7066
|
|
|
|
|
|
meth_type = get_meth_type(meth_name); |
3418
|
7066
|
|
|
|
|
|
is_orig_method_name = 0; |
3419
|
|
|
|
|
|
|
} |
3420
|
289642
|
100
|
|
|
|
|
if (ima_flags & IMA_KEEP_ERR) |
3421
|
257216
|
|
|
|
|
|
keep_error = TRUE; |
3422
|
289642
|
100
|
|
|
|
|
if ((ima_flags & IMA_KEEP_ERR_SUB) |
3423
|
93658
|
100
|
|
|
|
|
&& !PL_dirty |
3424
|
93174
|
100
|
|
|
|
|
&& DBIc_PARENT_COM(imp_xxh) && DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) > 0) |
|
|
100
|
|
|
|
|
|
3425
|
32223
|
|
|
|
|
|
keep_error = TRUE; |
3426
|
289642
|
100
|
|
|
|
|
if (ima_flags & IMA_CLEAR_STMT) { |
3427
|
|
|
|
|
|
|
/* don't use SvOK_off: dbh's Statement may be ref to sth's */ |
3428
|
32426
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(h), "Statement", 9, &PL_sv_undef, 0); |
3429
|
|
|
|
|
|
|
} |
3430
|
289642
|
100
|
|
|
|
|
if (ima_flags & IMA_CLEAR_CACHED_KIDS) |
3431
|
29563
|
|
|
|
|
|
clear_cached_kids(aTHX_ h, imp_xxh, meth_name, trace_flags); |
3432
|
|
|
|
|
|
|
|
3433
|
|
|
|
|
|
|
} |
3434
|
|
|
|
|
|
|
|
3435
|
356046
|
100
|
|
|
|
|
if (ima_flags & IMA_HAS_USAGE) { |
3436
|
114255
|
|
|
|
|
|
const char *err = NULL; |
3437
|
|
|
|
|
|
|
char msg[200]; |
3438
|
|
|
|
|
|
|
|
3439
|
114255
|
50
|
|
|
|
|
if (ima->minargs && (items < ima->minargs |
|
|
50
|
|
|
|
|
|
3440
|
114255
|
100
|
|
|
|
|
|| (ima->maxargs>0 && items > ima->maxargs))) { |
|
|
100
|
|
|
|
|
|
3441
|
6
|
|
|
|
|
|
sprintf(msg, |
3442
|
|
|
|
|
|
|
"DBI %s: invalid number of arguments: got handle + %ld, expected handle + between %d and %d\n", |
3443
|
6
|
|
|
|
|
|
meth_name, (long)items-1, (int)ima->minargs-1, (int)ima->maxargs-1); |
3444
|
2
|
|
|
|
|
|
err = msg; |
3445
|
|
|
|
|
|
|
} |
3446
|
|
|
|
|
|
|
/* arg type checking could be added here later */ |
3447
|
114255
|
100
|
|
|
|
|
if (err) { |
3448
|
114255
|
50
|
|
|
|
|
croak("%sUsage: %s->%s(%s)", err, "$h", meth_name, |
3449
|
2
|
|
|
|
|
|
(ima->usage_msg) ? ima->usage_msg : "...?"); |
3450
|
|
|
|
|
|
|
} |
3451
|
|
|
|
|
|
|
} |
3452
|
|
|
|
|
|
|
} |
3453
|
|
|
|
|
|
|
|
3454
|
582174
|
100
|
|
|
|
|
is_unrelated_to_Statement = ( (DBIc_TYPE(imp_xxh) == DBIt_ST) ? 0 |
|
|
100
|
|
|
|
|
|
3455
|
213221
|
|
|
|
|
|
: (DBIc_TYPE(imp_xxh) == DBIt_DR) ? 1 |
3456
|
|
|
|
|
|
|
: (ima_flags & IMA_UNRELATED_TO_STMT) ); |
3457
|
|
|
|
|
|
|
|
3458
|
582174
|
100
|
|
|
|
|
if (PL_tainting && items > 1 /* method call has args */ |
|
|
100
|
|
|
|
|
|
3459
|
71
|
100
|
|
|
|
|
&& DBIc_is(imp_xxh, DBIcf_TaintIn) /* taint checks requested */ |
3460
|
34
|
100
|
|
|
|
|
&& !(ima_flags & IMA_NO_TAINT_IN) |
3461
|
|
|
|
|
|
|
) { |
3462
|
39
|
100
|
|
|
|
|
for(i=1; i < items; ++i) { |
3463
|
22
|
100
|
|
|
|
|
if (SvTAINTED(ST(i))) { |
|
|
50
|
|
|
|
|
|
3464
|
|
|
|
|
|
|
char buf[100]; |
3465
|
2
|
50
|
|
|
|
|
sprintf(buf,"parameter %d of %s->%s method call", |
3466
|
2
|
|
|
|
|
|
i, SvPV_nolen(h), meth_name); |
3467
|
2
|
|
|
|
|
|
PL_tainted = 1; /* needed for TAINT_PROPER to work */ |
3468
|
2
|
50
|
|
|
|
|
TAINT_PROPER(buf); /* die's */ |
3469
|
|
|
|
|
|
|
} |
3470
|
|
|
|
|
|
|
} |
3471
|
|
|
|
|
|
|
} |
3472
|
|
|
|
|
|
|
|
3473
|
|
|
|
|
|
|
/* record this inner handle for use by DBI::var::FETCH */ |
3474
|
582172
|
100
|
|
|
|
|
if (is_DESTROY) { |
3475
|
|
|
|
|
|
|
|
3476
|
|
|
|
|
|
|
/* force destruction of any outstanding children */ |
3477
|
29563
|
100
|
|
|
|
|
if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) { |
|
|
50
|
|
|
|
|
|
3478
|
3052
|
|
|
|
|
|
AV *av = (AV*)SvRV(*tmp_svp); |
3479
|
|
|
|
|
|
|
I32 kidslots; |
3480
|
3052
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3481
|
|
|
|
|
|
|
|
3482
|
3052
|
50
|
|
|
|
|
for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) { |
|
|
50
|
|
|
|
|
|
3483
|
3052
|
|
|
|
|
|
SV **hp = av_fetch(av, kidslots, FALSE); |
3484
|
3052
|
50
|
|
|
|
|
if (!hp || !SvROK(*hp) || SvTYPE(SvRV(*hp))!=SVt_PVHV) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3485
|
|
|
|
|
|
|
break; |
3486
|
|
|
|
|
|
|
|
3487
|
0
|
0
|
|
|
|
|
if (trace_level >= 1) { |
3488
|
0
|
|
|
|
|
|
PerlIO_printf(logfp, "on DESTROY handle %s still has child %s (refcnt %ld, obj %d, dirty=%d)\n", |
3489
|
0
|
|
|
|
|
|
neatsvpv(h,0), neatsvpv(*hp, 0), (long)SvREFCNT(*hp), !!sv_isobject(*hp), PL_dirty); |
3490
|
0
|
0
|
|
|
|
|
if (trace_level >= 9) |
3491
|
0
|
|
|
|
|
|
sv_dump(SvRV(*hp)); |
3492
|
|
|
|
|
|
|
} |
3493
|
0
|
0
|
|
|
|
|
if (sv_isobject(*hp)) { /* call DESTROY on the handle */ |
3494
|
0
|
0
|
|
|
|
|
PUSHMARK(SP); |
3495
|
0
|
0
|
|
|
|
|
XPUSHs(*hp); |
3496
|
0
|
|
|
|
|
|
PUTBACK; |
3497
|
0
|
|
|
|
|
|
call_method("DESTROY", G_VOID|G_EVAL|G_KEEPERR); |
3498
|
0
|
|
|
|
|
|
MSPAGAIN; |
3499
|
|
|
|
|
|
|
} |
3500
|
|
|
|
|
|
|
else { |
3501
|
0
|
|
|
|
|
|
imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ *hp, 0); |
3502
|
0
|
0
|
|
|
|
|
if (imp_xxh && DBIc_COMSET(imp_xxh)) { |
|
|
0
|
|
|
|
|
|
3503
|
0
|
|
|
|
|
|
dbih_clearcom(imp_xxh); |
3504
|
0
|
|
|
|
|
|
sv_setsv(*hp, &PL_sv_undef); |
3505
|
|
|
|
|
|
|
} |
3506
|
|
|
|
|
|
|
} |
3507
|
|
|
|
|
|
|
} |
3508
|
|
|
|
|
|
|
} |
3509
|
|
|
|
|
|
|
|
3510
|
29563
|
100
|
|
|
|
|
if (DBIc_TYPE(imp_xxh) <= DBIt_DB ) { /* is dbh or drh */ |
3511
|
|
|
|
|
|
|
imp_xxh_t *parent_imp; |
3512
|
|
|
|
|
|
|
|
3513
|
3630
|
100
|
|
|
|
|
if (SvOK(DBIc_ERR(imp_xxh)) && (parent_imp = DBIc_PARENT_COM(imp_xxh)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3514
|
47
|
100
|
|
|
|
|
&& !PL_dirty /* XXX - remove? */ |
3515
|
|
|
|
|
|
|
) { |
3516
|
|
|
|
|
|
|
/* copy err/errstr/state values to $DBI::err etc still work */ |
3517
|
37
|
|
|
|
|
|
sv_setsv(DBIc_ERR(parent_imp), DBIc_ERR(imp_xxh)); |
3518
|
37
|
|
|
|
|
|
sv_setsv(DBIc_ERRSTR(parent_imp), DBIc_ERRSTR(imp_xxh)); |
3519
|
37
|
|
|
|
|
|
sv_setsv(DBIc_STATE(parent_imp), DBIc_STATE(imp_xxh)); |
3520
|
|
|
|
|
|
|
} |
3521
|
|
|
|
|
|
|
} |
3522
|
|
|
|
|
|
|
|
3523
|
29563
|
100
|
|
|
|
|
if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective destroy after fork */ |
3524
|
10
|
100
|
|
|
|
|
if ((U32)PerlProc_getpid() != _imp2com(imp_xxh, std.pid)) |
3525
|
4
|
|
|
|
|
|
DBIc_set(imp_xxh, DBIcf_IADESTROY, 1); |
3526
|
|
|
|
|
|
|
} |
3527
|
29563
|
100
|
|
|
|
|
if (DBIc_IADESTROY(imp_xxh)) { /* wants ineffective destroy */ |
3528
|
8
|
100
|
|
|
|
|
DBIc_ACTIVE_off(imp_xxh); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3529
|
|
|
|
|
|
|
} |
3530
|
29563
|
|
|
|
|
|
call_depth = 0; |
3531
|
29563
|
|
|
|
|
|
is_nested_call = 0; |
3532
|
|
|
|
|
|
|
} |
3533
|
|
|
|
|
|
|
else { |
3534
|
552609
|
|
|
|
|
|
DBI_SET_LAST_HANDLE(h); |
3535
|
552609
|
|
|
|
|
|
SAVEINT(DBIc_CALL_DEPTH(imp_xxh)); |
3536
|
552609
|
|
|
|
|
|
call_depth = ++DBIc_CALL_DEPTH(imp_xxh); |
3537
|
|
|
|
|
|
|
|
3538
|
552609
|
100
|
|
|
|
|
if (ima_flags & IMA_COPY_UP_STMT) { /* execute() */ |
3539
|
7997
|
|
|
|
|
|
copy_statement_to_parent(aTHX_ h, imp_xxh); |
3540
|
|
|
|
|
|
|
} |
3541
|
552609
|
|
|
|
|
|
is_nested_call = |
3542
|
|
|
|
|
|
|
(call_depth > 1 |
3543
|
785704
|
100
|
|
|
|
|
|| (!PL_dirty /* not in global destruction [CPAN #75614] */ |
|
|
100
|
|
|
|
|
|
3544
|
232591
|
100
|
|
|
|
|
&& DBIc_PARENT_COM(imp_xxh) |
3545
|
465686
|
100
|
|
|
|
|
&& DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh))) >= 1); |
|
|
100
|
|
|
|
|
|
3546
|
|
|
|
|
|
|
|
3547
|
|
|
|
|
|
|
} |
3548
|
|
|
|
|
|
|
|
3549
|
|
|
|
|
|
|
|
3550
|
|
|
|
|
|
|
/* --- dispatch --- */ |
3551
|
|
|
|
|
|
|
|
3552
|
897763
|
100
|
|
|
|
|
if (!keep_error && meth_type != methtype_set_err) { |
|
|
100
|
|
|
|
|
|
3553
|
|
|
|
|
|
|
SV *err_sv; |
3554
|
315591
|
100
|
|
|
|
|
if (trace_level && SvOK(err_sv=DBIc_ERR(imp_xxh))) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3555
|
0
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3556
|
0
|
0
|
|
|
|
|
PerlIO_printf(logfp, " !! The %s '%s' was CLEARED by call to %s method\n", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3557
|
0
|
0
|
|
|
|
|
SvTRUE(err_sv) ? "ERROR" : strlen(SvPV_nolen(err_sv)) ? "warn" : "info", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3558
|
0
|
|
|
|
|
|
neatsvpv(DBIc_ERR(imp_xxh),0), meth_name); |
3559
|
|
|
|
|
|
|
} |
3560
|
315591
|
50
|
|
|
|
|
DBIh_CLEAR_ERROR(imp_xxh); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3561
|
|
|
|
|
|
|
} |
3562
|
|
|
|
|
|
|
else { /* we check for change in ErrCount/err_hash during call */ |
3563
|
266581
|
|
|
|
|
|
ErrCount = DBIc_ErrCount(imp_xxh); |
3564
|
266581
|
100
|
|
|
|
|
if (keep_error) |
3565
|
257216
|
|
|
|
|
|
keep_error = err_hash(aTHX_ imp_xxh); |
3566
|
|
|
|
|
|
|
} |
3567
|
|
|
|
|
|
|
|
3568
|
582172
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh,DBIcf_Callbacks) |
3569
|
64512
|
50
|
|
|
|
|
&& (tmp_svp = hv_fetch((HV*)SvRV(h), "Callbacks", 9, 0)) |
3570
|
64512
|
100
|
|
|
|
|
&& ( (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), meth_name, strlen(meth_name), 0)) |
3571
|
|
|
|
|
|
|
/* the "*" fallback callback only applies to non-nested calls |
3572
|
|
|
|
|
|
|
* and also doesn't apply to the 'set_err' or DESTROY methods. |
3573
|
|
|
|
|
|
|
* Nor during global destruction. |
3574
|
|
|
|
|
|
|
* Other restrictions may be added over time. |
3575
|
|
|
|
|
|
|
* It's an undocumented hack. |
3576
|
|
|
|
|
|
|
*/ |
3577
|
61582
|
100
|
|
|
|
|
|| (!is_nested_call && !PL_dirty && meth_type != methtype_set_err && |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3578
|
40905
|
100
|
|
|
|
|
meth_type != methtype_DESTROY && |
3579
|
40905
|
|
|
|
|
|
(hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), "*", 1, 0)) |
3580
|
|
|
|
|
|
|
) |
3581
|
|
|
|
|
|
|
) |
3582
|
2940
|
50
|
|
|
|
|
&& SvROK(*hook_svp) |
3583
|
|
|
|
|
|
|
) { |
3584
|
|
|
|
|
|
|
SV *orig_defsv; |
3585
|
|
|
|
|
|
|
SV *temp_defsv; |
3586
|
2940
|
|
|
|
|
|
SV *code = SvRV(*hook_svp); |
3587
|
2940
|
|
|
|
|
|
I32 skip_dispatch = 0; |
3588
|
2940
|
50
|
|
|
|
|
if (trace_level) |
3589
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP, "%c {{ %s callback %s being invoked with %ld args\n", |
3590
|
0
|
|
|
|
|
|
(PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), (long)items); |
3591
|
|
|
|
|
|
|
|
3592
|
|
|
|
|
|
|
/* we don't use ENTER,SAVETMPS & FREETMPS,LEAVE because we may need mortal |
3593
|
|
|
|
|
|
|
* results to live long enough to be returned to our caller |
3594
|
|
|
|
|
|
|
*/ |
3595
|
|
|
|
|
|
|
/* we want to localize $_ for the callback but can't just do that alone |
3596
|
|
|
|
|
|
|
* because we're not using SAVETMPS & FREETMPS, so we have to get sneaky. |
3597
|
|
|
|
|
|
|
* We still localize, so we're safe from the callback die-ing, |
3598
|
|
|
|
|
|
|
* but after the callback we manually restore the original $_. |
3599
|
|
|
|
|
|
|
*/ |
3600
|
2940
|
50
|
|
|
|
|
orig_defsv = DEFSV; /* remember the current $_ */ |
3601
|
2940
|
|
|
|
|
|
SAVE_DEFSV; /* local($_) = $method_name */ |
3602
|
2940
|
|
|
|
|
|
temp_defsv = sv_2mortal(newSVpv(meth_name,0)); |
3603
|
|
|
|
|
|
|
# ifdef SvTEMP_off |
3604
|
2940
|
|
|
|
|
|
SvTEMP_off(temp_defsv); |
3605
|
|
|
|
|
|
|
# endif |
3606
|
2940
|
|
|
|
|
|
DEFSV_set(temp_defsv); |
3607
|
|
|
|
|
|
|
|
3608
|
2940
|
50
|
|
|
|
|
EXTEND(SP, items+1); |
|
|
100
|
|
|
|
|
|
3609
|
2940
|
50
|
|
|
|
|
PUSHMARK(SP); |
3610
|
2940
|
|
|
|
|
|
PUSHs(orig_h); /* push outer handle, then others params */ |
3611
|
14762
|
100
|
|
|
|
|
for (i=1; i < items; ++i) { /* start at 1 to skip handle */ |
3612
|
11822
|
|
|
|
|
|
PUSHs( ST(i) ); |
3613
|
|
|
|
|
|
|
} |
3614
|
2940
|
|
|
|
|
|
PUTBACK; |
3615
|
2940
|
|
|
|
|
|
outitems = call_sv(code, G_ARRAY); /* call the callback code */ |
3616
|
2938
|
|
|
|
|
|
MSPAGAIN; |
3617
|
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
|
/* The callback code can undef $_ to indicate to skip dispatch */ |
3619
|
2938
|
50
|
|
|
|
|
skip_dispatch = !SvOK(DEFSV); |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3620
|
|
|
|
|
|
|
/* put $_ back now, but with an incremented ref count to compensate |
3621
|
|
|
|
|
|
|
* for the ref count decrement that will happen when we exit the scope. |
3622
|
|
|
|
|
|
|
*/ |
3623
|
2938
|
|
|
|
|
|
DEFSV_set(SvREFCNT_inc(orig_defsv)); |
3624
|
|
|
|
|
|
|
|
3625
|
2938
|
50
|
|
|
|
|
if (trace_level) |
3626
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP, "%c }} %s callback %s returned%s\n", |
|
|
0
|
|
|
|
|
|
3627
|
0
|
|
|
|
|
|
(PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), |
3628
|
|
|
|
|
|
|
skip_dispatch ? ", actual method will not be called" : "" |
3629
|
|
|
|
|
|
|
); |
3630
|
2938
|
100
|
|
|
|
|
if (skip_dispatch) { /* XXX experimental */ |
3631
|
1501
|
|
|
|
|
|
int ix = outitems; |
3632
|
|
|
|
|
|
|
/* copy the new items down to the destination list */ |
3633
|
3000
|
100
|
|
|
|
|
while (ix-- > 0) { |
3634
|
|
|
|
|
|
|
if(0)warn("\tcopy down %d: %s overwriting %s\n", ix, SvPV_nolen(TOPs), SvPV_nolen(ST(ix)) ); |
3635
|
1499
|
|
|
|
|
|
ST(ix) = POPs; |
3636
|
|
|
|
|
|
|
} |
3637
|
1501
|
|
|
|
|
|
imp_msv = *hook_svp; /* for trace and profile */ |
3638
|
1501
|
|
|
|
|
|
goto post_dispatch; |
3639
|
|
|
|
|
|
|
} |
3640
|
|
|
|
|
|
|
else { |
3641
|
1437
|
100
|
|
|
|
|
if (outitems != 0) |
3642
|
2
|
|
|
|
|
|
die("Callback for %s returned %d values but must not return any (temporary restriction in current version)", |
3643
|
|
|
|
|
|
|
meth_name, (int)outitems); |
3644
|
|
|
|
|
|
|
/* POP's and PUTBACK? to clear stack */ |
3645
|
|
|
|
|
|
|
} |
3646
|
|
|
|
|
|
|
} |
3647
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
/* set Executed after Callbacks so it's not set if callback elects to skip the method */ |
3649
|
580667
|
100
|
|
|
|
|
if (ima_flags & IMA_EXECUTE) { |
3650
|
12756
|
|
|
|
|
|
imp_xxh_t *parent = DBIc_PARENT_COM(imp_xxh); |
3651
|
12756
|
|
|
|
|
|
DBIc_on(imp_xxh, DBIcf_Executed); |
3652
|
12756
|
50
|
|
|
|
|
if (parent) |
3653
|
12756
|
|
|
|
|
|
DBIc_on(parent, DBIcf_Executed); |
3654
|
|
|
|
|
|
|
} |
3655
|
|
|
|
|
|
|
|
3656
|
|
|
|
|
|
|
/* The "quick_FETCH" logic... */ |
3657
|
|
|
|
|
|
|
/* Shortcut for fetching attributes to bypass method call overheads */ |
3658
|
580667
|
100
|
|
|
|
|
if (meth_type == methtype_FETCH && !DBIc_COMPAT(imp_xxh)) { |
|
|
100
|
|
|
|
|
|
3659
|
|
|
|
|
|
|
STRLEN kl; |
3660
|
97551
|
50
|
|
|
|
|
const char *key = SvPV(st1, kl); |
3661
|
|
|
|
|
|
|
SV **attr_svp; |
3662
|
97551
|
50
|
|
|
|
|
if (*key != '_' && (attr_svp=hv_fetch((HV*)SvRV(h), key, kl, 0))) { |
|
|
100
|
|
|
|
|
|
3663
|
48980
|
|
|
|
|
|
qsv = *attr_svp; |
3664
|
|
|
|
|
|
|
/* disable FETCH from cache for special attributes */ |
3665
|
48980
|
100
|
|
|
|
|
if (SvROK(qsv) && SvTYPE(SvRV(qsv))==SVt_PVHV && *key=='D' && |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3666
|
2511
|
50
|
|
|
|
|
( (kl==6 && DBIc_TYPE(imp_xxh)==DBIt_DB && strEQ(key,"Driver")) |
|
|
50
|
|
|
|
|
|
3667
|
18
|
50
|
|
|
|
|
|| (kl==8 && DBIc_TYPE(imp_xxh)==DBIt_ST && strEQ(key,"Database")) ) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3668
|
|
|
|
|
|
|
) { |
3669
|
2529
|
|
|
|
|
|
qsv = Nullsv; |
3670
|
|
|
|
|
|
|
} |
3671
|
|
|
|
|
|
|
/* disable profiling of FETCH of Profile data */ |
3672
|
48980
|
100
|
|
|
|
|
if (*key == 'P' && strEQ(key, "Profile")) |
|
|
100
|
|
|
|
|
|
3673
|
157
|
|
|
|
|
|
profile_t1 = 0.0; |
3674
|
|
|
|
|
|
|
} |
3675
|
97551
|
100
|
|
|
|
|
if (qsv) { /* skip real method call if we already have a 'quick' value */ |
3676
|
46451
|
|
|
|
|
|
ST(0) = sv_mortalcopy(qsv); |
3677
|
46451
|
|
|
|
|
|
outitems = 1; |
3678
|
97551
|
|
|
|
|
|
goto post_dispatch; |
3679
|
|
|
|
|
|
|
} |
3680
|
|
|
|
|
|
|
} |
3681
|
|
|
|
|
|
|
|
3682
|
|
|
|
|
|
|
{ |
3683
|
|
|
|
|
|
|
CV *meth_cv; |
3684
|
|
|
|
|
|
|
#ifdef DBI_save_hv_fetch_ent |
3685
|
|
|
|
|
|
|
HE save_mh; |
3686
|
|
|
|
|
|
|
if (meth_type == methtype_FETCH) |
3687
|
|
|
|
|
|
|
save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */ |
3688
|
|
|
|
|
|
|
#endif |
3689
|
|
|
|
|
|
|
|
3690
|
534216
|
100
|
|
|
|
|
if (trace_flags) { |
3691
|
1035
|
|
|
|
|
|
SAVEI32(DBIS->debug); /* fall back to orig value later */ |
3692
|
1035
|
|
|
|
|
|
DBIS->debug = trace_flags; /* make new value global (for now) */ |
3693
|
1035
|
50
|
|
|
|
|
if (ima) { |
3694
|
|
|
|
|
|
|
/* enabling trace via flags takes precedence over disabling due to min level */ |
3695
|
1035
|
100
|
|
|
|
|
if ((trace_flags & DBIc_TRACE_FLAGS_MASK) & (ima->method_trace & DBIc_TRACE_FLAGS_MASK)) |
3696
|
24
|
|
|
|
|
|
trace_level = (trace_level < 2) ? 2 : trace_level; /* min */ |
3697
|
|
|
|
|
|
|
else |
3698
|
1011
|
100
|
|
|
|
|
if (trace_level < (DBIc_TRACE_LEVEL_MASK & ima->method_trace)) |
3699
|
174
|
|
|
|
|
|
trace_level = 0; /* silence dispatch log for this method */ |
3700
|
|
|
|
|
|
|
} |
3701
|
|
|
|
|
|
|
} |
3702
|
|
|
|
|
|
|
|
3703
|
534216
|
100
|
|
|
|
|
if (is_orig_method_name |
3704
|
527150
|
100
|
|
|
|
|
&& ima->stash == DBIc_IMP_STASH(imp_xxh) |
3705
|
455242
|
100
|
|
|
|
|
&& ima->generation == PL_sub_generation + |
3706
|
455242
|
50
|
|
|
|
|
MY_cache_gen(DBIc_IMP_STASH(imp_xxh)) |
3707
|
|
|
|
|
|
|
) |
3708
|
455200
|
|
|
|
|
|
imp_msv = (SV*)ima->gv; |
3709
|
|
|
|
|
|
|
else { |
3710
|
79016
|
|
|
|
|
|
imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), |
3711
|
|
|
|
|
|
|
meth_name, FALSE); |
3712
|
79016
|
100
|
|
|
|
|
if (is_orig_method_name) { |
3713
|
|
|
|
|
|
|
/* clear stale entry, if any */ |
3714
|
71950
|
|
|
|
|
|
SvREFCNT_dec(ima->stash); |
3715
|
71950
|
|
|
|
|
|
SvREFCNT_dec(ima->gv); |
3716
|
71950
|
100
|
|
|
|
|
if (!imp_msv) { |
3717
|
128
|
|
|
|
|
|
ima->stash = NULL; |
3718
|
128
|
|
|
|
|
|
ima->gv = NULL; |
3719
|
|
|
|
|
|
|
} |
3720
|
|
|
|
|
|
|
else { |
3721
|
71822
|
|
|
|
|
|
ima->stash = (HV*)SvREFCNT_inc(DBIc_IMP_STASH(imp_xxh)); |
3722
|
71822
|
|
|
|
|
|
ima->gv = (GV*)SvREFCNT_inc(imp_msv); |
3723
|
71822
|
|
|
|
|
|
ima->generation = PL_sub_generation + |
3724
|
71822
|
50
|
|
|
|
|
MY_cache_gen(DBIc_IMP_STASH(imp_xxh)); |
3725
|
|
|
|
|
|
|
} |
3726
|
|
|
|
|
|
|
} |
3727
|
|
|
|
|
|
|
} |
3728
|
|
|
|
|
|
|
|
3729
|
|
|
|
|
|
|
/* if method was a 'func' then try falling back to real 'func' method */ |
3730
|
534216
|
100
|
|
|
|
|
if (!imp_msv && (ima_flags & IMA_FUNC_REDIRECT)) { |
|
|
100
|
|
|
|
|
|
3731
|
3
|
|
|
|
|
|
imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), "func", FALSE); |
3732
|
3
|
50
|
|
|
|
|
if (imp_msv) { |
3733
|
|
|
|
|
|
|
/* driver does have func method so undo the earlier 'func' stack changes */ |
3734
|
3
|
|
|
|
|
|
PUSHs(sv_2mortal(newSVpv(meth_name,0))); |
3735
|
3
|
|
|
|
|
|
PUTBACK; |
3736
|
3
|
|
|
|
|
|
++items; |
3737
|
3
|
|
|
|
|
|
meth_name = "func"; |
3738
|
3
|
|
|
|
|
|
meth_type = methtype_ordinary; |
3739
|
|
|
|
|
|
|
} |
3740
|
|
|
|
|
|
|
} |
3741
|
|
|
|
|
|
|
|
3742
|
534216
|
100
|
|
|
|
|
if (trace_level >= (is_nested_call ? 4 : 2)) { |
|
|
100
|
|
|
|
|
|
3743
|
167
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3744
|
|
|
|
|
|
|
/* Full pkg method name (or just meth_name for ANON CODE) */ |
3745
|
167
|
50
|
|
|
|
|
const char *imp_meth_name = (imp_msv && isGV(imp_msv)) ? GvNAME(imp_msv) : meth_name; |
|
|
50
|
|
|
|
|
|
3746
|
167
|
|
|
|
|
|
HV *imp_stash = DBIc_IMP_STASH(imp_xxh); |
3747
|
297
|
100
|
|
|
|
|
PerlIO_printf(logfp, "%c -> %s ", |
3748
|
130
|
50
|
|
|
|
|
call_depth>1 ? '0'+call_depth-1 : (PL_dirty?'!':' '), imp_meth_name); |
3749
|
167
|
50
|
|
|
|
|
if (imp_meth_name[0] == 'A' && strEQ(imp_meth_name,"AUTOLOAD")) |
|
|
0
|
|
|
|
|
|
3750
|
0
|
|
|
|
|
|
PerlIO_printf(logfp, "\"%s\" ", meth_name); |
3751
|
167
|
50
|
|
|
|
|
if (imp_msv && isGV(imp_msv) && GvSTASH(imp_msv) != imp_stash) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3752
|
24
|
50
|
|
|
|
|
PerlIO_printf(logfp, "in %s ", HvNAME(GvSTASH(imp_msv))); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3753
|
167
|
50
|
|
|
|
|
PerlIO_printf(logfp, "for %s (%s", HvNAME(imp_stash), |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3754
|
167
|
|
|
|
|
|
SvPV_nolen(orig_h)); |
3755
|
167
|
100
|
|
|
|
|
if (h != orig_h) /* show inner handle to aid tracing */ |
3756
|
57
|
|
|
|
|
|
PerlIO_printf(logfp, "~0x%lx", (long)SvRV(h)); |
3757
|
110
|
|
|
|
|
|
else PerlIO_printf(logfp, "~INNER"); |
3758
|
474
|
100
|
|
|
|
|
for(i=1; i
|
3759
|
614
|
50
|
|
|
|
|
PerlIO_printf(logfp," %s", |
3760
|
307
|
100
|
|
|
|
|
(ima && i==ima->hidearg) ? "****" : neatsvpv(ST(i),0)); |
3761
|
|
|
|
|
|
|
} |
3762
|
|
|
|
|
|
|
#ifdef DBI_USE_THREADS |
3763
|
|
|
|
|
|
|
PerlIO_printf(logfp, ") thr#%p\n", (void*)DBIc_THR_USER(imp_xxh)); |
3764
|
|
|
|
|
|
|
#else |
3765
|
167
|
|
|
|
|
|
PerlIO_printf(logfp, ")\n"); |
3766
|
|
|
|
|
|
|
#endif |
3767
|
167
|
|
|
|
|
|
PerlIO_flush(logfp); |
3768
|
|
|
|
|
|
|
} |
3769
|
|
|
|
|
|
|
|
3770
|
534216
|
100
|
|
|
|
|
if (!imp_msv || ! ((meth_cv = GvCV(imp_msv))) ) { |
|
|
50
|
|
|
|
|
|
3771
|
128
|
50
|
|
|
|
|
if (PL_dirty || is_DESTROY) { |
|
|
50
|
|
|
|
|
|
3772
|
0
|
|
|
|
|
|
outitems = 0; |
3773
|
0
|
|
|
|
|
|
goto post_dispatch; |
3774
|
|
|
|
|
|
|
} |
3775
|
128
|
100
|
|
|
|
|
if (ima_flags & IMA_NOT_FOUND_OKAY) { |
3776
|
124
|
|
|
|
|
|
outitems = 0; |
3777
|
124
|
|
|
|
|
|
goto post_dispatch; |
3778
|
|
|
|
|
|
|
} |
3779
|
12
|
50
|
|
|
|
|
croak("Can't locate DBI object method \"%s\" via package \"%s\"", |
|
|
50
|
|
|
|
|
|
3780
|
8
|
50
|
|
|
|
|
meth_name, HvNAME(DBIc_IMP_STASH(imp_xxh))); |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3781
|
|
|
|
|
|
|
} |
3782
|
|
|
|
|
|
|
|
3783
|
534088
|
50
|
|
|
|
|
PUSHMARK(mark); /* mark arguments again so we can pass them on */ |
3784
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
/* Note: the handle on the stack is still an object blessed into a |
3786
|
|
|
|
|
|
|
* DBI::* class and not the DBD::*::* class whose method is being |
3787
|
|
|
|
|
|
|
* invoked. This is correct and should be largely transparent. |
3788
|
|
|
|
|
|
|
*/ |
3789
|
|
|
|
|
|
|
|
3790
|
|
|
|
|
|
|
/* SHORT-CUT ALERT! */ |
3791
|
534088
|
50
|
|
|
|
|
if (use_xsbypass && CvISXSUB(meth_cv) && CvXSUB(meth_cv)) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
|
3793
|
|
|
|
|
|
|
/* If we are calling an XSUB we jump directly to its C code and |
3794
|
|
|
|
|
|
|
* bypass perl_call_sv(), pp_entersub() etc. This is fast. |
3795
|
|
|
|
|
|
|
* This code is based on a small section of pp_entersub(). |
3796
|
|
|
|
|
|
|
*/ |
3797
|
165600
|
|
|
|
|
|
(void)(*CvXSUB(meth_cv))(aTHXo_ meth_cv); /* Call the C code directly */ |
3798
|
|
|
|
|
|
|
|
3799
|
331188
|
100
|
|
|
|
|
if (gimme == G_SCALAR) { /* Enforce sanity in scalar context */ |
3800
|
164082
|
100
|
|
|
|
|
if (ax != PL_stack_sp - PL_stack_base ) { /* outitems != 1 */ |
3801
|
50644
|
|
|
|
|
|
ST(0) = |
3802
|
25322
|
|
|
|
|
|
(ax > PL_stack_sp - PL_stack_base) |
3803
|
|
|
|
|
|
|
? &PL_sv_undef /* outitems == 0 */ |
3804
|
25322
|
50
|
|
|
|
|
: *PL_stack_sp; /* outitems > 1 */ |
3805
|
25322
|
|
|
|
|
|
PL_stack_sp = PL_stack_base + ax; |
3806
|
|
|
|
|
|
|
} |
3807
|
164082
|
|
|
|
|
|
outitems = 1; |
3808
|
|
|
|
|
|
|
} |
3809
|
|
|
|
|
|
|
else { |
3810
|
1512
|
|
|
|
|
|
outitems = PL_stack_sp - (PL_stack_base + ax - 1); |
3811
|
|
|
|
|
|
|
} |
3812
|
|
|
|
|
|
|
|
3813
|
|
|
|
|
|
|
} |
3814
|
|
|
|
|
|
|
else { |
3815
|
|
|
|
|
|
|
/* sv_dump(imp_msv); */ |
3816
|
368488
|
100
|
|
|
|
|
outitems = call_sv((SV*)meth_cv, |
3817
|
|
|
|
|
|
|
(is_DESTROY ? gimme | G_EVAL | G_KEEPERR : gimme) ); |
3818
|
|
|
|
|
|
|
} |
3819
|
|
|
|
|
|
|
|
3820
|
534056
|
|
|
|
|
|
XSprePUSH; /* reset SP to base of stack frame */ |
3821
|
|
|
|
|
|
|
|
3822
|
|
|
|
|
|
|
#ifdef DBI_save_hv_fetch_ent |
3823
|
|
|
|
|
|
|
if (meth_type == methtype_FETCH) |
3824
|
|
|
|
|
|
|
PL_hv_fetch_ent_mh = save_mh; /* see start of block */ |
3825
|
|
|
|
|
|
|
#endif |
3826
|
|
|
|
|
|
|
} |
3827
|
|
|
|
|
|
|
|
3828
|
|
|
|
|
|
|
post_dispatch: |
3829
|
|
|
|
|
|
|
|
3830
|
582132
|
100
|
|
|
|
|
if (is_DESTROY && DBI_IS_LAST_HANDLE(h)) { /* if destroying _this_ handle */ |
|
|
100
|
|
|
|
|
|
3831
|
26629
|
|
|
|
|
|
SV *lhp = DBIc_PARENT_H(imp_xxh); |
3832
|
26629
|
50
|
|
|
|
|
if (lhp && SvROK(lhp)) { |
|
|
100
|
|
|
|
|
|
3833
|
26346
|
|
|
|
|
|
DBI_SET_LAST_HANDLE(lhp); |
3834
|
|
|
|
|
|
|
} |
3835
|
|
|
|
|
|
|
else { |
3836
|
283
|
|
|
|
|
|
DBI_UNSET_LAST_HANDLE; |
3837
|
|
|
|
|
|
|
} |
3838
|
|
|
|
|
|
|
} |
3839
|
|
|
|
|
|
|
|
3840
|
582132
|
100
|
|
|
|
|
if (keep_error) { |
3841
|
|
|
|
|
|
|
/* if we didn't clear err before the call, check to see if a new error |
3842
|
|
|
|
|
|
|
* or warning has been recorded. If so, turn off keep_error so it gets acted on |
3843
|
|
|
|
|
|
|
*/ |
3844
|
257212
|
100
|
|
|
|
|
if (DBIc_ErrCount(imp_xxh) > ErrCount || err_hash(aTHX_ imp_xxh) != keep_error) { |
|
|
100
|
|
|
|
|
|
3845
|
1485
|
|
|
|
|
|
keep_error = 0; |
3846
|
|
|
|
|
|
|
} |
3847
|
|
|
|
|
|
|
} |
3848
|
|
|
|
|
|
|
|
3849
|
582132
|
|
|
|
|
|
err_sv = DBIc_ERR(imp_xxh); |
3850
|
|
|
|
|
|
|
|
3851
|
582132
|
100
|
|
|
|
|
if (trace_level >= (is_nested_call ? 3 : 1)) { |
|
|
100
|
|
|
|
|
|
3852
|
222
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
3853
|
222
|
50
|
|
|
|
|
const int is_fetch = (meth_type == methtype_fetch_star && DBIc_TYPE(imp_xxh)==DBIt_ST); |
|
|
0
|
|
|
|
|
|
3854
|
222
|
50
|
|
|
|
|
const IV row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0; |
3855
|
222
|
50
|
|
|
|
|
if (is_fetch && row_count>=2 && trace_level<=4 && SvOK(ST(0))) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3856
|
|
|
|
|
|
|
/* skip the 'middle' rows to reduce output */ |
3857
|
|
|
|
|
|
|
goto skip_meth_return_trace; |
3858
|
|
|
|
|
|
|
} |
3859
|
222
|
50
|
|
|
|
|
if (SvOK(err_sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3860
|
0
|
0
|
|
|
|
|
PerlIO_printf(logfp, " %s %s %s %s (err#%ld)\n", (keep_error) ? " " : "!!", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3861
|
0
|
0
|
|
|
|
|
SvTRUE(err_sv) ? "ERROR:" : strlen(SvPV_nolen(err_sv)) ? "warn:" : "info:", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3862
|
0
|
|
|
|
|
|
neatsvpv(err_sv,0), neatsvpv(DBIc_ERRSTR(imp_xxh),0), (long)DBIc_ErrCount(imp_xxh)); |
3863
|
|
|
|
|
|
|
} |
3864
|
394
|
100
|
|
|
|
|
PerlIO_printf(logfp,"%c%c <%c %s", |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3865
|
172
|
100
|
|
|
|
|
(call_depth > 1) ? '0'+call_depth-1 : (PL_dirty?'!':' '), |
3866
|
222
|
|
|
|
|
|
(DBIc_is(imp_xxh, DBIcf_TaintIn|DBIcf_TaintOut)) ? 'T' : ' ', |
3867
|
|
|
|
|
|
|
(qsv) ? '>' : '-', |
3868
|
|
|
|
|
|
|
meth_name); |
3869
|
222
|
100
|
|
|
|
|
if (trace_level==1 && (items>=2||is_DESTROY)) { /* make level 1 more useful */ |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3870
|
|
|
|
|
|
|
/* we only have the first two parameters available here */ |
3871
|
28
|
100
|
|
|
|
|
if (is_DESTROY) /* show handle as first arg to DESTROY */ |
3872
|
|
|
|
|
|
|
/* want to show outer handle so trace makes sense */ |
3873
|
|
|
|
|
|
|
/* but outer handle has been destroyed so we fake it */ |
3874
|
3
|
50
|
|
|
|
|
PerlIO_printf(logfp,"(%s=HASH(0x%p)", HvNAME(SvSTASH(SvRV(orig_h))), (void*)DBIc_MY_H(imp_xxh)); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3875
|
|
|
|
|
|
|
else |
3876
|
25
|
|
|
|
|
|
PerlIO_printf(logfp,"(%s", neatsvpv(st1,0)); |
3877
|
28
|
100
|
|
|
|
|
if (items >= 3) |
3878
|
20
|
|
|
|
|
|
PerlIO_printf(logfp,", %s", neatsvpv(st2,0)); |
3879
|
28
|
100
|
|
|
|
|
PerlIO_printf(logfp,"%s)", (items > 3) ? ", ..." : ""); |
3880
|
|
|
|
|
|
|
} |
3881
|
|
|
|
|
|
|
|
3882
|
222
|
50
|
|
|
|
|
if (gimme & G_ARRAY) |
3883
|
222
|
|
|
|
|
|
PerlIO_printf(logfp,"= ("); |
3884
|
0
|
|
|
|
|
|
else PerlIO_printf(logfp,"="); |
3885
|
478
|
100
|
|
|
|
|
for(i=0; i < outitems; ++i) { |
3886
|
256
|
|
|
|
|
|
SV *s = ST(i); |
3887
|
256
|
100
|
|
|
|
|
if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVAV) { |
|
|
50
|
|
|
|
|
|
3888
|
0
|
|
|
|
|
|
AV *av = (AV*)SvRV(s); |
3889
|
|
|
|
|
|
|
int avi; |
3890
|
0
|
0
|
|
|
|
|
int avi_last = SvIV(DBIS->neatsvpvlen) / 10; |
3891
|
0
|
0
|
|
|
|
|
if (avi_last < 39) |
3892
|
0
|
|
|
|
|
|
avi_last = 39; |
3893
|
0
|
|
|
|
|
|
PerlIO_printf(logfp, " ["); |
3894
|
0
|
0
|
|
|
|
|
for (avi=0; avi <= AvFILL(av); ++avi) { |
|
|
0
|
|
|
|
|
|
3895
|
0
|
|
|
|
|
|
PerlIO_printf(logfp, " %s", neatsvpv(AvARRAY(av)[avi],0)); |
3896
|
0
|
0
|
|
|
|
|
if (avi >= avi_last && AvFILL(av) - avi > 1) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3897
|
0
|
0
|
|
|
|
|
PerlIO_printf(logfp, " ... %ld others skipped", AvFILL(av) - avi); |
3898
|
0
|
|
|
|
|
|
break; |
3899
|
|
|
|
|
|
|
} |
3900
|
|
|
|
|
|
|
} |
3901
|
0
|
|
|
|
|
|
PerlIO_printf(logfp, " ]"); |
3902
|
|
|
|
|
|
|
} |
3903
|
|
|
|
|
|
|
else { |
3904
|
256
|
|
|
|
|
|
PerlIO_printf(logfp, " %s", neatsvpv(s,0)); |
3905
|
256
|
100
|
|
|
|
|
if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVHV && !SvOBJECT(SvRV(s)) ) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3906
|
5
|
50
|
|
|
|
|
PerlIO_printf(logfp, "%ldkeys", (long)HvKEYS(SvRV(s))); |
3907
|
|
|
|
|
|
|
} |
3908
|
|
|
|
|
|
|
} |
3909
|
222
|
50
|
|
|
|
|
if (gimme & G_ARRAY) { |
3910
|
222
|
|
|
|
|
|
PerlIO_printf(logfp," ) [%d items]", outitems); |
3911
|
|
|
|
|
|
|
} |
3912
|
222
|
50
|
|
|
|
|
if (is_fetch && row_count) { |
|
|
0
|
|
|
|
|
|
3913
|
0
|
|
|
|
|
|
PerlIO_printf(logfp," row%"IVdf, row_count); |
3914
|
|
|
|
|
|
|
} |
3915
|
222
|
100
|
|
|
|
|
if (qsv) /* flag as quick and peek at the first arg (still on the stack) */ |
3916
|
11
|
|
|
|
|
|
PerlIO_printf(logfp," (%s from cache)", neatsvpv(st1,0)); |
3917
|
211
|
50
|
|
|
|
|
else if (!imp_msv) |
3918
|
0
|
|
|
|
|
|
PerlIO_printf(logfp," (not implemented)"); |
3919
|
|
|
|
|
|
|
/* XXX add flag to show pid here? */ |
3920
|
|
|
|
|
|
|
/* add file and line number information */ |
3921
|
222
|
|
|
|
|
|
PerlIO_puts(logfp, log_where(0, 0, " at ", "\n", 1, (trace_level >= 3), (trace_level >= 4))); |
3922
|
|
|
|
|
|
|
skip_meth_return_trace: |
3923
|
222
|
|
|
|
|
|
PerlIO_flush(logfp); |
3924
|
|
|
|
|
|
|
} |
3925
|
|
|
|
|
|
|
|
3926
|
582132
|
100
|
|
|
|
|
if (ima_flags & IMA_END_WORK) { /* commit() or rollback() */ |
3927
|
|
|
|
|
|
|
/* XXX does not consider if the method call actually worked or not */ |
3928
|
4
|
|
|
|
|
|
DBIc_off(imp_xxh, DBIcf_Executed); |
3929
|
|
|
|
|
|
|
|
3930
|
4
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh, DBIcf_BegunWork)) { |
3931
|
2
|
|
|
|
|
|
DBIc_off(imp_xxh, DBIcf_BegunWork); |
3932
|
2
|
50
|
|
|
|
|
if (!DBIc_has(imp_xxh, DBIcf_AutoCommit)) { |
3933
|
|
|
|
|
|
|
/* We only get here if the driver hasn't implemented their own code */ |
3934
|
|
|
|
|
|
|
/* for begin_work, or has but hasn't correctly turned AutoCommit */ |
3935
|
|
|
|
|
|
|
/* back on in their commit or rollback code. So we have to do it. */ |
3936
|
|
|
|
|
|
|
/* This is bad because it'll probably trigger a spurious commit() */ |
3937
|
|
|
|
|
|
|
/* and may mess up the error handling below for the commit/rollback */ |
3938
|
2
|
50
|
|
|
|
|
PUSHMARK(SP); |
3939
|
2
|
50
|
|
|
|
|
XPUSHs(h); |
3940
|
2
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newSVpv("AutoCommit",0))); |
3941
|
2
|
50
|
|
|
|
|
XPUSHs(&PL_sv_yes); |
3942
|
2
|
|
|
|
|
|
PUTBACK; |
3943
|
2
|
|
|
|
|
|
call_method("STORE", G_VOID); |
3944
|
582132
|
|
|
|
|
|
MSPAGAIN; |
3945
|
|
|
|
|
|
|
} |
3946
|
|
|
|
|
|
|
} |
3947
|
|
|
|
|
|
|
} |
3948
|
|
|
|
|
|
|
|
3949
|
|
|
|
|
|
|
if (PL_tainting |
3950
|
|
|
|
|
|
|
&& DBIc_is(imp_xxh, DBIcf_TaintOut) /* taint checks requested */ |
3951
|
|
|
|
|
|
|
/* XXX this would taint *everything* being returned from *any* */ |
3952
|
|
|
|
|
|
|
/* method that doesn't have IMA_NO_TAINT_OUT set. */ |
3953
|
|
|
|
|
|
|
/* DISABLED: just tainting fetched data in get_fbav seems ok */ |
3954
|
|
|
|
|
|
|
&& 0/* XXX disabled*/ /* !(ima_flags & IMA_NO_TAINT_OUT) */ |
3955
|
|
|
|
|
|
|
) { |
3956
|
|
|
|
|
|
|
dTHR; |
3957
|
|
|
|
|
|
|
TAINT; /* affects sv_setsv()'s within same perl statement */ |
3958
|
|
|
|
|
|
|
for(i=0; i < outitems; ++i) { |
3959
|
|
|
|
|
|
|
I32 avi; |
3960
|
|
|
|
|
|
|
char *p; |
3961
|
|
|
|
|
|
|
SV *s; |
3962
|
|
|
|
|
|
|
SV *agg = ST(i); |
3963
|
|
|
|
|
|
|
if ( !SvROK(agg) ) |
3964
|
|
|
|
|
|
|
continue; |
3965
|
|
|
|
|
|
|
agg = SvRV(agg); |
3966
|
|
|
|
|
|
|
#define DBI_OUT_TAINTABLE(s) (!SvREADONLY(s) && !SvTAINTED(s)) |
3967
|
|
|
|
|
|
|
switch (SvTYPE(agg)) { |
3968
|
|
|
|
|
|
|
case SVt_PVAV: |
3969
|
|
|
|
|
|
|
for(avi=0; avi <= AvFILL((AV*)agg); ++avi) { |
3970
|
|
|
|
|
|
|
s = AvARRAY((AV*)agg)[avi]; |
3971
|
|
|
|
|
|
|
if (DBI_OUT_TAINTABLE(s)) |
3972
|
|
|
|
|
|
|
SvTAINTED_on(s); |
3973
|
|
|
|
|
|
|
} |
3974
|
|
|
|
|
|
|
break; |
3975
|
|
|
|
|
|
|
case SVt_PVHV: |
3976
|
|
|
|
|
|
|
hv_iterinit((HV*)agg); |
3977
|
|
|
|
|
|
|
while( (s = hv_iternextsv((HV*)agg, &p, &avi)) ) { |
3978
|
|
|
|
|
|
|
if (DBI_OUT_TAINTABLE(s)) |
3979
|
|
|
|
|
|
|
SvTAINTED_on(s); |
3980
|
|
|
|
|
|
|
} |
3981
|
|
|
|
|
|
|
break; |
3982
|
|
|
|
|
|
|
default: |
3983
|
|
|
|
|
|
|
if (DBIc_WARN(imp_xxh)) { |
3984
|
|
|
|
|
|
|
PerlIO_printf(DBILOGFP,"Don't know how to taint contents of returned %s (type %d)\n", |
3985
|
|
|
|
|
|
|
neatsvpv(agg,0), (int)SvTYPE(agg)); |
3986
|
|
|
|
|
|
|
} |
3987
|
|
|
|
|
|
|
} |
3988
|
|
|
|
|
|
|
} |
3989
|
|
|
|
|
|
|
} |
3990
|
|
|
|
|
|
|
|
3991
|
|
|
|
|
|
|
/* if method returned a new handle, and that handle has an error on it |
3992
|
|
|
|
|
|
|
* then copy the error up into the parent handle |
3993
|
|
|
|
|
|
|
*/ |
3994
|
582132
|
100
|
|
|
|
|
if (ima_flags & IMA_IS_FACTORY && SvROK(ST(0))) { |
|
|
100
|
|
|
|
|
|
3995
|
32414
|
|
|
|
|
|
SV *h_new = ST(0); |
3996
|
32414
|
|
|
|
|
|
D_impdata(imp_xxh_new, imp_xxh_t, h_new); |
3997
|
32414
|
50
|
|
|
|
|
if (SvOK(DBIc_ERR(imp_xxh_new))) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3998
|
0
|
|
|
|
|
|
set_err_sv(h, imp_xxh, DBIc_ERR(imp_xxh_new), DBIc_ERRSTR(imp_xxh_new), DBIc_STATE(imp_xxh_new), &PL_sv_no); |
3999
|
|
|
|
|
|
|
} |
4000
|
|
|
|
|
|
|
} |
4001
|
|
|
|
|
|
|
|
4002
|
669601
|
100
|
|
|
|
|
if ( !keep_error /* is a new err/warn/info */ |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4003
|
326405
|
100
|
|
|
|
|
&& !is_nested_call /* skip nested (internal) calls */ |
4004
|
84168
|
50
|
|
|
|
|
&& ( |
4005
|
|
|
|
|
|
|
/* is an error and has RaiseError|PrintError|HandleError set */ |
4006
|
87469
|
0
|
|
|
|
|
(SvTRUE(err_sv) && DBIc_has(imp_xxh, DBIcf_RaiseError|DBIcf_PrintError|DBIcf_HandleError)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4007
|
|
|
|
|
|
|
/* is a warn (not info) and has PrintWarn set */ |
4008
|
80995
|
100
|
|
|
|
|
|| ( SvOK(err_sv) && strlen(SvPV_nolen(err_sv)) && DBIc_has(imp_xxh, DBIcf_PrintWarn)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4009
|
|
|
|
|
|
|
) |
4010
|
167
|
|
|
|
|
|
) { |
4011
|
|
|
|
|
|
|
SV *msg; |
4012
|
3310
|
|
|
|
|
|
SV **statement_svp = NULL; |
4013
|
3310
|
50
|
|
|
|
|
const int is_warning = (!SvTRUE(err_sv) && strlen(SvPV_nolen(err_sv))==1); |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4014
|
3310
|
|
|
|
|
|
const char *err_meth_name = meth_name; |
4015
|
|
|
|
|
|
|
char intro[200]; |
4016
|
|
|
|
|
|
|
|
4017
|
3310
|
100
|
|
|
|
|
if (meth_type == methtype_set_err) { |
4018
|
56
|
|
|
|
|
|
SV **sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, GV_ADDWARN); |
4019
|
56
|
100
|
|
|
|
|
if (SvOK(*sem_svp)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4020
|
8
|
50
|
|
|
|
|
err_meth_name = SvPV_nolen(*sem_svp); |
4021
|
|
|
|
|
|
|
} |
4022
|
|
|
|
|
|
|
|
4023
|
|
|
|
|
|
|
/* XXX change to vsprintf into sv directly */ |
4024
|
6620
|
50
|
|
|
|
|
sprintf(intro,"%s %s %s: ", HvNAME(DBIc_IMP_STASH(imp_xxh)), err_meth_name, |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4025
|
3310
|
0
|
|
|
|
|
SvTRUE(err_sv) ? "failed" : is_warning ? "warning" : "information"); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4026
|
3310
|
|
|
|
|
|
msg = sv_2mortal(newSVpv(intro,0)); |
4027
|
3310
|
50
|
|
|
|
|
if (SvOK(DBIc_ERRSTR(imp_xxh))) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4028
|
3310
|
|
|
|
|
|
sv_catsv(msg, DBIc_ERRSTR(imp_xxh)); |
4029
|
|
|
|
|
|
|
else |
4030
|
0
|
|
|
|
|
|
sv_catpvf(msg, "(err=%s, errstr=undef, state=%s)", |
4031
|
0
|
|
|
|
|
|
neatsvpv(DBIc_ERR(imp_xxh),0), neatsvpv(DBIc_STATE(imp_xxh),0) ); |
4032
|
|
|
|
|
|
|
|
4033
|
3310
|
100
|
|
|
|
|
if ( DBIc_has(imp_xxh, DBIcf_ShowErrorStatement) |
4034
|
160
|
100
|
|
|
|
|
&& !is_unrelated_to_Statement |
4035
|
152
|
100
|
|
|
|
|
&& (DBIc_TYPE(imp_xxh) == DBIt_ST || ima_flags & IMA_SHOW_ERR_STMT) |
|
|
50
|
|
|
|
|
|
4036
|
152
|
50
|
|
|
|
|
&& (statement_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 0)) |
4037
|
152
|
50
|
|
|
|
|
&& statement_svp && SvOK(*statement_svp) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4038
|
|
|
|
|
|
|
) { |
4039
|
152
|
|
|
|
|
|
SV **svp = 0; |
4040
|
152
|
|
|
|
|
|
sv_catpv(msg, " [for Statement \""); |
4041
|
152
|
|
|
|
|
|
sv_catsv(msg, *statement_svp); |
4042
|
|
|
|
|
|
|
|
4043
|
|
|
|
|
|
|
/* fetch from tied outer handle to trigger FETCH magic */ |
4044
|
|
|
|
|
|
|
/* could add DBIcf_ShowErrorParams (default to on?) */ |
4045
|
152
|
100
|
|
|
|
|
if (!(ima_flags & IMA_HIDE_ERR_PARAMVALUES)) { |
4046
|
144
|
|
|
|
|
|
svp = hv_fetch((HV*)DBIc_MY_H(imp_xxh),"ParamValues",11,FALSE); |
4047
|
144
|
50
|
|
|
|
|
if (svp && SvMAGICAL(*svp)) |
|
|
50
|
|
|
|
|
|
4048
|
144
|
|
|
|
|
|
mg_get(*svp); /* XXX may recurse, may croak. could use eval */ |
4049
|
|
|
|
|
|
|
} |
4050
|
160
|
100
|
|
|
|
|
if (svp && SvRV(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV && HvKEYS(SvRV(*svp))>0 ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4051
|
8
|
|
|
|
|
|
SV *param_values_sv = sv_2mortal(_join_hash_sorted((HV*)SvRV(*svp), "=",1, ", ",2, 1, -1)); |
4052
|
8
|
|
|
|
|
|
sv_catpv(msg, "\" with ParamValues: "); |
4053
|
8
|
|
|
|
|
|
sv_catsv(msg, param_values_sv); |
4054
|
8
|
|
|
|
|
|
sv_catpvn(msg, "]", 1); |
4055
|
|
|
|
|
|
|
} |
4056
|
|
|
|
|
|
|
else { |
4057
|
3310
|
|
|
|
|
|
sv_catpv(msg, "\"]"); |
4058
|
|
|
|
|
|
|
} |
4059
|
|
|
|
|
|
|
} |
4060
|
|
|
|
|
|
|
|
4061
|
|
|
|
|
|
|
if (0) { |
4062
|
|
|
|
|
|
|
COP *cop = dbi_caller_cop(); |
4063
|
|
|
|
|
|
|
if (cop && (CopLINE(cop) != CopLINE(PL_curcop) || CopFILEGV(cop) != CopFILEGV(PL_curcop))) { |
4064
|
|
|
|
|
|
|
dbi_caller_string(msg, cop, " called via ", 1, 0); |
4065
|
|
|
|
|
|
|
} |
4066
|
|
|
|
|
|
|
} |
4067
|
|
|
|
|
|
|
|
4068
|
3310
|
|
|
|
|
|
hook_svp = NULL; |
4069
|
3310
|
50
|
|
|
|
|
if ( SvTRUE(err_sv) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4070
|
3301
|
100
|
|
|
|
|
&& DBIc_has(imp_xxh, DBIcf_HandleError) |
4071
|
8
|
50
|
|
|
|
|
&& (hook_svp = hv_fetch((HV*)SvRV(h),"HandleError",11,0)) |
4072
|
8
|
50
|
|
|
|
|
&& hook_svp && SvOK(*hook_svp) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4073
|
|
|
|
|
|
|
) { |
4074
|
8
|
|
|
|
|
|
dSP; |
4075
|
8
|
|
|
|
|
|
PerlIO *logfp = DBILOGFP; |
4076
|
|
|
|
|
|
|
IV items; |
4077
|
|
|
|
|
|
|
SV *status; |
4078
|
|
|
|
|
|
|
SV *result; /* point to result SV that's pointed to by the stack */ |
4079
|
8
|
50
|
|
|
|
|
if (outitems) { |
4080
|
8
|
|
|
|
|
|
result = *(sp-outitems+1); |
4081
|
8
|
50
|
|
|
|
|
if (SvREADONLY(result)) { |
4082
|
8
|
|
|
|
|
|
*(sp-outitems+1) = result = sv_2mortal(newSVsv(result)); |
4083
|
|
|
|
|
|
|
} |
4084
|
|
|
|
|
|
|
} |
4085
|
|
|
|
|
|
|
else { |
4086
|
0
|
|
|
|
|
|
result = sv_newmortal(); |
4087
|
|
|
|
|
|
|
} |
4088
|
8
|
50
|
|
|
|
|
if (trace_level) |
4089
|
0
|
0
|
|
|
|
|
PerlIO_printf(logfp," -> HandleError on %s via %s%s%s%s\n", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4090
|
|
|
|
|
|
|
neatsvpv(h,0), neatsvpv(*hook_svp,0), |
4091
|
|
|
|
|
|
|
(!outitems ? "" : " ("), |
4092
|
|
|
|
|
|
|
(!outitems ? "" : neatsvpv(result ,0)), |
4093
|
|
|
|
|
|
|
(!outitems ? "" : ")") |
4094
|
|
|
|
|
|
|
); |
4095
|
8
|
50
|
|
|
|
|
PUSHMARK(SP); |
4096
|
8
|
50
|
|
|
|
|
XPUSHs(msg); |
4097
|
8
|
50
|
|
|
|
|
XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh)))); |
4098
|
8
|
50
|
|
|
|
|
XPUSHs( result ); |
4099
|
8
|
|
|
|
|
|
PUTBACK; |
4100
|
8
|
|
|
|
|
|
items = call_sv(*hook_svp, G_SCALAR); |
4101
|
6
|
|
|
|
|
|
MSPAGAIN; |
4102
|
6
|
50
|
|
|
|
|
status = (items) ? POPs : &PL_sv_undef; |
4103
|
6
|
|
|
|
|
|
PUTBACK; |
4104
|
6
|
50
|
|
|
|
|
if (trace_level) |
4105
|
0
|
0
|
|
|
|
|
PerlIO_printf(logfp," <- HandleError= %s%s%s%s\n", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4106
|
|
|
|
|
|
|
neatsvpv(status,0), |
4107
|
|
|
|
|
|
|
(!outitems ? "" : " ("), |
4108
|
|
|
|
|
|
|
(!outitems ? "" : neatsvpv(result,0)), |
4109
|
|
|
|
|
|
|
(!outitems ? "" : ")") |
4110
|
|
|
|
|
|
|
); |
4111
|
6
|
50
|
|
|
|
|
if (!SvTRUE(status)) /* handler says it didn't handle it, so... */ |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4112
|
2
|
|
|
|
|
|
hook_svp = 0; /* pretend we didn't have a handler... */ |
4113
|
|
|
|
|
|
|
} |
4114
|
|
|
|
|
|
|
|
4115
|
3308
|
50
|
|
|
|
|
if (profile_t1) { /* see also dbi_profile() call a few lines below */ |
4116
|
0
|
0
|
|
|
|
|
SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef; |
4117
|
0
|
0
|
|
|
|
|
dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv, |
4118
|
|
|
|
|
|
|
profile_t1, dbi_time()); |
4119
|
|
|
|
|
|
|
} |
4120
|
3308
|
100
|
|
|
|
|
if (is_warning) { |
4121
|
9
|
50
|
|
|
|
|
if (DBIc_has(imp_xxh, DBIcf_PrintWarn)) |
4122
|
9
|
|
|
|
|
|
warn_sv(msg); |
4123
|
|
|
|
|
|
|
} |
4124
|
3299
|
100
|
|
|
|
|
else if (!hook_svp && SvTRUE(err_sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4125
|
3295
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh, DBIcf_PrintError)) |
4126
|
26
|
|
|
|
|
|
warn_sv(msg); |
4127
|
3295
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh, DBIcf_RaiseError)) |
4128
|
3141
|
|
|
|
|
|
croak_sv(msg); |
4129
|
|
|
|
|
|
|
} |
4130
|
|
|
|
|
|
|
} |
4131
|
578822
|
100
|
|
|
|
|
else if (profile_t1) { /* see also dbi_profile() call a few lines above */ |
4132
|
60649
|
100
|
|
|
|
|
SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef; |
4133
|
60649
|
100
|
|
|
|
|
dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv, |
4134
|
|
|
|
|
|
|
profile_t1, dbi_time()); |
4135
|
|
|
|
|
|
|
} |
4136
|
578989
|
|
|
|
|
|
XSRETURN(outitems); |
4137
|
|
|
|
|
|
|
} |
4138
|
|
|
|
|
|
|
|
4139
|
|
|
|
|
|
|
|
4140
|
|
|
|
|
|
|
|
4141
|
|
|
|
|
|
|
/* -------------------------------------------------------------------- */ |
4142
|
|
|
|
|
|
|
|
4143
|
|
|
|
|
|
|
/* comment and placeholder styles to accept and return */ |
4144
|
|
|
|
|
|
|
|
4145
|
|
|
|
|
|
|
#define DBIpp_cm_cs 0x000001 /* C style */ |
4146
|
|
|
|
|
|
|
#define DBIpp_cm_hs 0x000002 /* # */ |
4147
|
|
|
|
|
|
|
#define DBIpp_cm_dd 0x000004 /* -- */ |
4148
|
|
|
|
|
|
|
#define DBIpp_cm_br 0x000008 /* {} */ |
4149
|
|
|
|
|
|
|
#define DBIpp_cm_dw 0x000010 /* '-- ' dash dash whitespace */ |
4150
|
|
|
|
|
|
|
#define DBIpp_cm_XX 0x00001F /* any of the above */ |
4151
|
|
|
|
|
|
|
|
4152
|
|
|
|
|
|
|
#define DBIpp_ph_qm 0x000100 /* ? */ |
4153
|
|
|
|
|
|
|
#define DBIpp_ph_cn 0x000200 /* :1 */ |
4154
|
|
|
|
|
|
|
#define DBIpp_ph_cs 0x000400 /* :name */ |
4155
|
|
|
|
|
|
|
#define DBIpp_ph_sp 0x000800 /* %s (as return only, not accept) */ |
4156
|
|
|
|
|
|
|
#define DBIpp_ph_XX 0x000F00 /* any of the above */ |
4157
|
|
|
|
|
|
|
|
4158
|
|
|
|
|
|
|
#define DBIpp_st_qq 0x010000 /* '' char escape */ |
4159
|
|
|
|
|
|
|
#define DBIpp_st_bs 0x020000 /* \ char escape */ |
4160
|
|
|
|
|
|
|
#define DBIpp_st_XX 0x030000 /* any of the above */ |
4161
|
|
|
|
|
|
|
|
4162
|
|
|
|
|
|
|
#define DBIpp_L_BRACE '{' |
4163
|
|
|
|
|
|
|
#define DBIpp_R_BRACE '}' |
4164
|
|
|
|
|
|
|
#define PS_accept(flag) DBIbf_has(ps_accept,(flag)) |
4165
|
|
|
|
|
|
|
#define PS_return(flag) DBIbf_has(ps_return,(flag)) |
4166
|
|
|
|
|
|
|
|
4167
|
|
|
|
|
|
|
SV * |
4168
|
52
|
|
|
|
|
|
preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo) |
4169
|
|
|
|
|
|
|
{ |
4170
|
|
|
|
|
|
|
dTHX; |
4171
|
52
|
|
|
|
|
|
D_imp_xxh(dbh); |
4172
|
|
|
|
|
|
|
/* |
4173
|
|
|
|
|
|
|
The idea here is that ps_accept defines which constructs to |
4174
|
|
|
|
|
|
|
recognize (accept) as valid in the source string (other |
4175
|
|
|
|
|
|
|
constructs are ignored), and ps_return defines which |
4176
|
|
|
|
|
|
|
constructs are valid to return in the result string. |
4177
|
|
|
|
|
|
|
|
4178
|
|
|
|
|
|
|
If a construct that is valid in the input is also valid in the |
4179
|
|
|
|
|
|
|
output then it's simply copied. If it's not valid in the output |
4180
|
|
|
|
|
|
|
then it's editied into one of the valid forms (ideally the most |
4181
|
|
|
|
|
|
|
'standard' and/or information preserving one). |
4182
|
|
|
|
|
|
|
|
4183
|
|
|
|
|
|
|
For example, if ps_accept includes '--' style comments but |
4184
|
|
|
|
|
|
|
ps_return doesn't, but ps_return does include '#' style |
4185
|
|
|
|
|
|
|
comments then any '--' style comments would be rewritten as '#' |
4186
|
|
|
|
|
|
|
style comments. |
4187
|
|
|
|
|
|
|
|
4188
|
|
|
|
|
|
|
Similarly for placeholders. DBD::Oracle, for example, would say |
4189
|
|
|
|
|
|
|
'?', ':1' and ':name' are all acceptable input, but only |
4190
|
|
|
|
|
|
|
':name' should be returned. |
4191
|
|
|
|
|
|
|
|
4192
|
|
|
|
|
|
|
(There's a tricky issue with the '--' comment style because it can |
4193
|
|
|
|
|
|
|
clash with valid syntax, i.e., "... set foo=foo--1 ..." so it |
4194
|
|
|
|
|
|
|
would be *bad* to misinterpret that as the start of a comment. |
4195
|
|
|
|
|
|
|
Perhaps we need a DBIpp_cm_dw (for dash-dash-whitespace) style |
4196
|
|
|
|
|
|
|
to allow for that.) |
4197
|
|
|
|
|
|
|
|
4198
|
|
|
|
|
|
|
Also, we'll only support DBIpp_cm_br as an input style. And |
4199
|
|
|
|
|
|
|
even then, only with reluctance. We may (need to) drop it when |
4200
|
|
|
|
|
|
|
we add support for odbc escape sequences. |
4201
|
|
|
|
|
|
|
*/ |
4202
|
52
|
|
|
|
|
|
int idx = 1; |
4203
|
|
|
|
|
|
|
|
4204
|
52
|
|
|
|
|
|
char in_quote = '\0'; |
4205
|
52
|
|
|
|
|
|
char in_comment = '\0'; |
4206
|
52
|
|
|
|
|
|
char rt_comment = '\0'; |
4207
|
|
|
|
|
|
|
char *dest, *start; |
4208
|
|
|
|
|
|
|
const char *src; |
4209
|
52
|
|
|
|
|
|
const char *style = "", *laststyle = NULL; |
4210
|
|
|
|
|
|
|
SV *new_stmt_sv; |
4211
|
|
|
|
|
|
|
|
4212
|
|
|
|
|
|
|
(void)foo; |
4213
|
|
|
|
|
|
|
|
4214
|
|
|
|
|
|
|
if (!(ps_return | DBIpp_ph_XX)) { /* no return ph type specified */ |
4215
|
|
|
|
|
|
|
ps_return |= ps_accept | DBIpp_ph_XX; /* so copy from ps_accept */ |
4216
|
|
|
|
|
|
|
} |
4217
|
|
|
|
|
|
|
|
4218
|
|
|
|
|
|
|
/* XXX this allocation strategy won't work when we get to more advanced stuff */ |
4219
|
52
|
|
|
|
|
|
new_stmt_sv = newSV(strlen(statement) * 3); |
4220
|
52
|
|
|
|
|
|
sv_setpv(new_stmt_sv,""); |
4221
|
52
|
|
|
|
|
|
src = statement; |
4222
|
52
|
|
|
|
|
|
dest = SvPVX(new_stmt_sv); |
4223
|
|
|
|
|
|
|
|
4224
|
684
|
100
|
|
|
|
|
while( *src ) |
4225
|
|
|
|
|
|
|
{ |
4226
|
636
|
50
|
|
|
|
|
if (*src == '%' && PS_return(DBIpp_ph_sp)) |
|
|
0
|
|
|
|
|
|
4227
|
0
|
|
|
|
|
|
*dest++ = '%'; |
4228
|
|
|
|
|
|
|
|
4229
|
636
|
100
|
|
|
|
|
if (in_comment) |
4230
|
|
|
|
|
|
|
{ |
4231
|
116
|
100
|
|
|
|
|
if ( (in_comment == '-' && (*src == '\n' || *(src+1) == '\0')) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4232
|
108
|
100
|
|
|
|
|
|| (in_comment == '#' && (*src == '\n' || *(src+1) == '\0')) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4233
|
102
|
100
|
|
|
|
|
|| (in_comment == DBIpp_L_BRACE && *src == DBIpp_R_BRACE) /* XXX nesting? */ |
|
|
100
|
|
|
|
|
|
4234
|
98
|
100
|
|
|
|
|
|| (in_comment == '/' && *src == '*' && *(src+1) == '/') |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4235
|
|
|
|
|
|
|
) { |
4236
|
28
|
|
|
|
|
|
switch (rt_comment) { |
4237
|
4
|
|
|
|
|
|
case '/': *dest++ = '*'; *dest++ = '/'; break; |
4238
|
4
|
|
|
|
|
|
case '-': *dest++ = '\n'; break; |
4239
|
2
|
|
|
|
|
|
case '#': *dest++ = '\n'; break; |
4240
|
8
|
|
|
|
|
|
case DBIpp_L_BRACE: *dest++ = DBIpp_R_BRACE; break; |
4241
|
|
|
|
|
|
|
case '\0': /* ensure deleting a comment doesn't join two tokens */ |
4242
|
10
|
100
|
|
|
|
|
if (in_comment=='/' || in_comment==DBIpp_L_BRACE) |
|
|
100
|
|
|
|
|
|
4243
|
4
|
|
|
|
|
|
*dest++ = ' '; /* ('-' and '#' styles use the newline) */ |
4244
|
10
|
|
|
|
|
|
break; |
4245
|
|
|
|
|
|
|
} |
4246
|
28
|
100
|
|
|
|
|
if (in_comment == '/') |
4247
|
10
|
|
|
|
|
|
src++; |
4248
|
28
|
100
|
|
|
|
|
src += (*src != '\n' || *(dest-1)=='\n') ? 1 : 0; |
|
|
100
|
|
|
|
|
|
4249
|
28
|
|
|
|
|
|
in_comment = '\0'; |
4250
|
28
|
|
|
|
|
|
rt_comment = '\0'; |
4251
|
|
|
|
|
|
|
} |
4252
|
|
|
|
|
|
|
else |
4253
|
88
|
100
|
|
|
|
|
if (rt_comment) |
4254
|
76
|
|
|
|
|
|
*dest++ = *src++; |
4255
|
|
|
|
|
|
|
else |
4256
|
12
|
|
|
|
|
|
src++; /* delete (don't copy) the comment */ |
4257
|
116
|
|
|
|
|
|
continue; |
4258
|
|
|
|
|
|
|
} |
4259
|
|
|
|
|
|
|
|
4260
|
520
|
100
|
|
|
|
|
if (in_quote) |
4261
|
|
|
|
|
|
|
{ |
4262
|
100
|
100
|
|
|
|
|
if (*src == in_quote) { |
4263
|
8
|
|
|
|
|
|
in_quote = 0; |
4264
|
|
|
|
|
|
|
} |
4265
|
100
|
|
|
|
|
|
*dest++ = *src++; |
4266
|
100
|
|
|
|
|
|
continue; |
4267
|
|
|
|
|
|
|
} |
4268
|
|
|
|
|
|
|
|
4269
|
|
|
|
|
|
|
/* Look for comments */ |
4270
|
420
|
100
|
|
|
|
|
if (*src == '-' && *(src+1) == '-' && |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4271
|
2
|
50
|
|
|
|
|
(PS_accept(DBIpp_cm_dd) || (*(src+2) == ' ' && PS_accept(DBIpp_cm_dw))) |
|
|
50
|
|
|
|
|
|
4272
|
|
|
|
|
|
|
) |
4273
|
|
|
|
|
|
|
{ |
4274
|
8
|
|
|
|
|
|
in_comment = *src; |
4275
|
8
|
|
|
|
|
|
src += 2; /* skip past 2nd char of double char delimiters */ |
4276
|
8
|
50
|
|
|
|
|
if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) { |
|
|
50
|
|
|
|
|
|
4277
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '-'; |
4278
|
0
|
|
|
|
|
|
*dest++ = '-'; |
4279
|
0
|
0
|
|
|
|
|
if (PS_return(DBIpp_cm_dw) && *src!=' ') |
|
|
0
|
|
|
|
|
|
4280
|
0
|
|
|
|
|
|
*dest++ = ' '; /* insert needed white space */ |
4281
|
|
|
|
|
|
|
} |
4282
|
8
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_cs)) { |
4283
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '/'; |
4284
|
0
|
|
|
|
|
|
*dest++ = '*'; |
4285
|
|
|
|
|
|
|
} |
4286
|
8
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_hs)) { |
4287
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '#'; |
4288
|
|
|
|
|
|
|
} |
4289
|
8
|
100
|
|
|
|
|
else if (PS_return(DBIpp_cm_br)) { |
4290
|
4
|
|
|
|
|
|
*dest++ = rt_comment = DBIpp_L_BRACE; |
4291
|
|
|
|
|
|
|
} |
4292
|
8
|
|
|
|
|
|
continue; |
4293
|
|
|
|
|
|
|
} |
4294
|
412
|
100
|
|
|
|
|
else if (*src == '/' && *(src+1) == '*' && PS_accept(DBIpp_cm_cs)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4295
|
|
|
|
|
|
|
{ |
4296
|
12
|
|
|
|
|
|
in_comment = *src; |
4297
|
12
|
|
|
|
|
|
src += 2; /* skip past 2nd char of double char delimiters */ |
4298
|
12
|
100
|
|
|
|
|
if (PS_return(DBIpp_cm_cs)) { |
4299
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '/'; |
4300
|
2
|
|
|
|
|
|
*dest++ = '*'; |
4301
|
|
|
|
|
|
|
} |
4302
|
10
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) { |
|
|
100
|
|
|
|
|
|
4303
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '-'; |
4304
|
2
|
|
|
|
|
|
*dest++ = '-'; |
4305
|
2
|
50
|
|
|
|
|
if (PS_return(DBIpp_cm_dw)) *dest++ = ' '; |
4306
|
|
|
|
|
|
|
} |
4307
|
8
|
100
|
|
|
|
|
else if (PS_return(DBIpp_cm_hs)) { |
4308
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '#'; |
4309
|
|
|
|
|
|
|
} |
4310
|
6
|
100
|
|
|
|
|
else if (PS_return(DBIpp_cm_br)) { |
4311
|
4
|
|
|
|
|
|
*dest++ = rt_comment = DBIpp_L_BRACE; |
4312
|
|
|
|
|
|
|
} |
4313
|
12
|
|
|
|
|
|
continue; |
4314
|
|
|
|
|
|
|
} |
4315
|
400
|
100
|
|
|
|
|
else if (*src == '#' && PS_accept(DBIpp_cm_hs)) |
|
|
50
|
|
|
|
|
|
4316
|
|
|
|
|
|
|
{ |
4317
|
6
|
|
|
|
|
|
in_comment = *src; |
4318
|
6
|
|
|
|
|
|
src++; |
4319
|
6
|
50
|
|
|
|
|
if (PS_return(DBIpp_cm_hs)) { |
4320
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '#'; |
4321
|
|
|
|
|
|
|
} |
4322
|
6
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) { |
|
|
100
|
|
|
|
|
|
4323
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '-'; |
4324
|
2
|
|
|
|
|
|
*dest++ = '-'; |
4325
|
2
|
50
|
|
|
|
|
if (PS_return(DBIpp_cm_dw)) *dest++ = ' '; |
4326
|
|
|
|
|
|
|
} |
4327
|
4
|
100
|
|
|
|
|
else if (PS_return(DBIpp_cm_cs)) { |
4328
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '/'; |
4329
|
2
|
|
|
|
|
|
*dest++ = '*'; |
4330
|
|
|
|
|
|
|
} |
4331
|
2
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_br)) { |
4332
|
0
|
|
|
|
|
|
*dest++ = rt_comment = DBIpp_L_BRACE; |
4333
|
|
|
|
|
|
|
} |
4334
|
6
|
|
|
|
|
|
continue; |
4335
|
|
|
|
|
|
|
} |
4336
|
394
|
100
|
|
|
|
|
else if (*src == DBIpp_L_BRACE && PS_accept(DBIpp_cm_br)) |
|
|
50
|
|
|
|
|
|
4337
|
|
|
|
|
|
|
{ |
4338
|
6
|
|
|
|
|
|
in_comment = *src; |
4339
|
6
|
|
|
|
|
|
src++; |
4340
|
6
|
100
|
|
|
|
|
if (PS_return(DBIpp_cm_br)) { |
4341
|
2
|
|
|
|
|
|
*dest++ = rt_comment = DBIpp_L_BRACE; |
4342
|
|
|
|
|
|
|
} |
4343
|
4
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) { |
|
|
50
|
|
|
|
|
|
4344
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '-'; |
4345
|
0
|
|
|
|
|
|
*dest++ = '-'; |
4346
|
0
|
0
|
|
|
|
|
if (PS_return(DBIpp_cm_dw)) *dest++ = ' '; |
4347
|
|
|
|
|
|
|
} |
4348
|
4
|
100
|
|
|
|
|
else if (PS_return(DBIpp_cm_cs)) { |
4349
|
2
|
|
|
|
|
|
*dest++ = rt_comment = '/'; |
4350
|
2
|
|
|
|
|
|
*dest++ = '*'; |
4351
|
|
|
|
|
|
|
} |
4352
|
2
|
50
|
|
|
|
|
else if (PS_return(DBIpp_cm_hs)) { |
4353
|
0
|
|
|
|
|
|
*dest++ = rt_comment = '#'; |
4354
|
|
|
|
|
|
|
} |
4355
|
6
|
|
|
|
|
|
continue; |
4356
|
|
|
|
|
|
|
} |
4357
|
|
|
|
|
|
|
|
4358
|
388
|
100
|
|
|
|
|
if ( !(*src==':' && (PS_accept(DBIpp_ph_cn) || PS_accept(DBIpp_ph_cs))) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4359
|
372
|
100
|
|
|
|
|
&& !(*src=='?' && PS_accept(DBIpp_ph_qm)) |
|
|
50
|
|
|
|
|
|
4360
|
|
|
|
|
|
|
){ |
4361
|
338
|
100
|
|
|
|
|
if (*src == '\'' || *src == '"') |
|
|
100
|
|
|
|
|
|
4362
|
12
|
|
|
|
|
|
in_quote = *src; |
4363
|
338
|
|
|
|
|
|
*dest++ = *src++; |
4364
|
338
|
|
|
|
|
|
continue; |
4365
|
|
|
|
|
|
|
} |
4366
|
|
|
|
|
|
|
|
4367
|
|
|
|
|
|
|
/* only here for : or ? outside of a comment or literal */ |
4368
|
|
|
|
|
|
|
|
4369
|
50
|
|
|
|
|
|
start = dest; /* save name inc colon */ |
4370
|
50
|
|
|
|
|
|
*dest++ = *src++; /* copy and move past first char */ |
4371
|
|
|
|
|
|
|
|
4372
|
50
|
100
|
|
|
|
|
if (*start == '?') /* X/Open Standard */ |
4373
|
|
|
|
|
|
|
{ |
4374
|
34
|
|
|
|
|
|
style = "?"; |
4375
|
|
|
|
|
|
|
|
4376
|
34
|
50
|
|
|
|
|
if (PS_return(DBIpp_ph_qm)) |
4377
|
|
|
|
|
|
|
; |
4378
|
34
|
100
|
|
|
|
|
else if (PS_return(DBIpp_ph_cn)) { /* '?' -> ':p1' (etc) */ |
4379
|
32
|
|
|
|
|
|
sprintf(start,":p%d", idx++); |
4380
|
32
|
|
|
|
|
|
dest = start+strlen(start); |
4381
|
|
|
|
|
|
|
} |
4382
|
2
|
50
|
|
|
|
|
else if (PS_return(DBIpp_ph_sp)) { /* '?' -> '%s' */ |
4383
|
2
|
|
|
|
|
|
*start = '%'; |
4384
|
34
|
|
|
|
|
|
*dest++ = 's'; |
4385
|
|
|
|
|
|
|
} |
4386
|
|
|
|
|
|
|
} |
4387
|
16
|
100
|
|
|
|
|
else if (isDIGIT(*src)) { /* :1 */ |
4388
|
10
|
|
|
|
|
|
const int pln = atoi(src); |
4389
|
10
|
|
|
|
|
|
style = ":1"; |
4390
|
|
|
|
|
|
|
|
4391
|
10
|
50
|
|
|
|
|
if (PS_return(DBIpp_ph_cn)) { /* ':1'->':p1' */ |
4392
|
0
|
|
|
|
|
|
idx = pln; |
4393
|
0
|
|
|
|
|
|
*dest++ = 'p'; |
4394
|
0
|
0
|
|
|
|
|
while(isDIGIT(*src)) |
4395
|
0
|
|
|
|
|
|
*dest++ = *src++; |
4396
|
|
|
|
|
|
|
} |
4397
|
10
|
100
|
|
|
|
|
else if (PS_return(DBIpp_ph_qm) /* ':1' -> '?' */ |
4398
|
2
|
50
|
|
|
|
|
|| PS_return(DBIpp_ph_sp) /* ':1' -> '%s' */ |
4399
|
|
|
|
|
|
|
) { |
4400
|
10
|
100
|
|
|
|
|
PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s"); |
4401
|
10
|
|
|
|
|
|
dest = start + strlen(start); |
4402
|
10
|
100
|
|
|
|
|
if (pln != idx) { |
4403
|
|
|
|
|
|
|
char buf[99]; |
4404
|
2
|
|
|
|
|
|
sprintf(buf, "preparse found placeholder :%d out of sequence, expected :%d", pln, idx); |
4405
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse"); |
4406
|
2
|
|
|
|
|
|
return &PL_sv_undef; |
4407
|
|
|
|
|
|
|
} |
4408
|
16
|
100
|
|
|
|
|
while(isDIGIT(*src)) src++; |
4409
|
8
|
|
|
|
|
|
idx++; |
4410
|
|
|
|
|
|
|
} |
4411
|
|
|
|
|
|
|
} |
4412
|
6
|
50
|
|
|
|
|
else if (isALNUM(*src)) /* :name */ |
4413
|
|
|
|
|
|
|
{ |
4414
|
6
|
|
|
|
|
|
style = ":name"; |
4415
|
|
|
|
|
|
|
|
4416
|
6
|
50
|
|
|
|
|
if (PS_return(DBIpp_ph_cs)) { |
4417
|
|
|
|
|
|
|
; |
4418
|
|
|
|
|
|
|
} |
4419
|
6
|
100
|
|
|
|
|
else if (PS_return(DBIpp_ph_qm) /* ':name' -> '?' */ |
4420
|
2
|
50
|
|
|
|
|
|| PS_return(DBIpp_ph_sp) /* ':name' -> '%s' */ |
4421
|
|
|
|
|
|
|
) { |
4422
|
6
|
100
|
|
|
|
|
PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s"); |
4423
|
6
|
|
|
|
|
|
dest = start + strlen(start); |
4424
|
32
|
100
|
|
|
|
|
while (isALNUM(*src)) /* consume name, includes '_' */ |
4425
|
26
|
|
|
|
|
|
src++; |
4426
|
|
|
|
|
|
|
} |
4427
|
|
|
|
|
|
|
} |
4428
|
|
|
|
|
|
|
/* perhaps ':=' PL/SQL construct */ |
4429
|
0
|
|
|
|
|
|
else { continue; } |
4430
|
|
|
|
|
|
|
|
4431
|
48
|
|
|
|
|
|
*dest = '\0'; /* handy for debugging */ |
4432
|
|
|
|
|
|
|
|
4433
|
48
|
100
|
|
|
|
|
if (laststyle && style != laststyle) { |
|
|
100
|
|
|
|
|
|
4434
|
|
|
|
|
|
|
char buf[99]; |
4435
|
2
|
|
|
|
|
|
sprintf(buf, "preparse found mixed placeholder styles (%s / %s)", style, laststyle); |
4436
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse"); |
4437
|
2
|
|
|
|
|
|
return &PL_sv_undef; |
4438
|
|
|
|
|
|
|
} |
4439
|
46
|
|
|
|
|
|
laststyle = style; |
4440
|
|
|
|
|
|
|
} |
4441
|
48
|
|
|
|
|
|
*dest = '\0'; |
4442
|
|
|
|
|
|
|
|
4443
|
|
|
|
|
|
|
/* warn about probable parsing errors, but continue anyway (returning processed string) */ |
4444
|
48
|
|
|
|
|
|
switch (in_quote) |
4445
|
|
|
|
|
|
|
{ |
4446
|
|
|
|
|
|
|
case '\'': |
4447
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated single-quoted string", 0, "preparse"); |
4448
|
2
|
|
|
|
|
|
break; |
4449
|
|
|
|
|
|
|
case '\"': |
4450
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated double-quoted string", 0, "preparse"); |
4451
|
2
|
|
|
|
|
|
break; |
4452
|
|
|
|
|
|
|
} |
4453
|
48
|
|
|
|
|
|
switch (in_comment) |
4454
|
|
|
|
|
|
|
{ |
4455
|
|
|
|
|
|
|
case DBIpp_L_BRACE: |
4456
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed {...} comment", 0, "preparse"); |
4457
|
2
|
|
|
|
|
|
break; |
4458
|
|
|
|
|
|
|
case '/': |
4459
|
2
|
|
|
|
|
|
set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed C-style comment", 0, "preparse"); |
4460
|
2
|
|
|
|
|
|
break; |
4461
|
|
|
|
|
|
|
} |
4462
|
|
|
|
|
|
|
|
4463
|
48
|
|
|
|
|
|
SvCUR_set(new_stmt_sv, strlen(SvPVX(new_stmt_sv))); |
4464
|
48
|
|
|
|
|
|
*SvEND(new_stmt_sv) = '\0'; |
4465
|
48
|
|
|
|
|
|
return new_stmt_sv; |
4466
|
|
|
|
|
|
|
} |
4467
|
|
|
|
|
|
|
|
4468
|
|
|
|
|
|
|
|
4469
|
|
|
|
|
|
|
/* -------------------------------------------------------------------- */ |
4470
|
|
|
|
|
|
|
/* The DBI Perl interface (via XS) starts here. Currently these are */ |
4471
|
|
|
|
|
|
|
/* all internal support functions. Note install_method and see DBI.pm */ |
4472
|
|
|
|
|
|
|
|
4473
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBI |
4474
|
|
|
|
|
|
|
|
4475
|
|
|
|
|
|
|
REQUIRE: 1.929 |
4476
|
|
|
|
|
|
|
PROTOTYPES: DISABLE |
4477
|
|
|
|
|
|
|
|
4478
|
|
|
|
|
|
|
|
4479
|
|
|
|
|
|
|
BOOT: |
4480
|
|
|
|
|
|
|
{ |
4481
|
|
|
|
|
|
|
MY_CXT_INIT; |
4482
|
|
|
|
|
|
|
PERL_UNUSED_VAR(MY_CXT); |
4483
|
|
|
|
|
|
|
} |
4484
|
|
|
|
|
|
|
PERL_UNUSED_VAR(cv); |
4485
|
|
|
|
|
|
|
PERL_UNUSED_VAR(items); |
4486
|
292
|
|
|
|
|
|
dbi_bootinit(NULL); |
4487
|
|
|
|
|
|
|
/* make this sub into a fake XS so it can bee seen by DBD::* modules; |
4488
|
|
|
|
|
|
|
* never actually call it as an XS sub, or it will crash and burn! */ |
4489
|
292
|
|
|
|
|
|
(void) newXS("DBI::_dbi_state_lval", (XSUBADDR_t)_dbi_state_lval, __FILE__); |
4490
|
|
|
|
|
|
|
|
4491
|
|
|
|
|
|
|
|
4492
|
|
|
|
|
|
|
I32 |
4493
|
|
|
|
|
|
|
constant() |
4494
|
|
|
|
|
|
|
PROTOTYPE: |
4495
|
|
|
|
|
|
|
ALIAS: |
4496
|
|
|
|
|
|
|
SQL_ALL_TYPES = SQL_ALL_TYPES |
4497
|
|
|
|
|
|
|
SQL_ARRAY = SQL_ARRAY |
4498
|
|
|
|
|
|
|
SQL_ARRAY_LOCATOR = SQL_ARRAY_LOCATOR |
4499
|
|
|
|
|
|
|
SQL_BIGINT = SQL_BIGINT |
4500
|
|
|
|
|
|
|
SQL_BINARY = SQL_BINARY |
4501
|
|
|
|
|
|
|
SQL_BIT = SQL_BIT |
4502
|
|
|
|
|
|
|
SQL_BLOB = SQL_BLOB |
4503
|
|
|
|
|
|
|
SQL_BLOB_LOCATOR = SQL_BLOB_LOCATOR |
4504
|
|
|
|
|
|
|
SQL_BOOLEAN = SQL_BOOLEAN |
4505
|
|
|
|
|
|
|
SQL_CHAR = SQL_CHAR |
4506
|
|
|
|
|
|
|
SQL_CLOB = SQL_CLOB |
4507
|
|
|
|
|
|
|
SQL_CLOB_LOCATOR = SQL_CLOB_LOCATOR |
4508
|
|
|
|
|
|
|
SQL_DATE = SQL_DATE |
4509
|
|
|
|
|
|
|
SQL_DATETIME = SQL_DATETIME |
4510
|
|
|
|
|
|
|
SQL_DECIMAL = SQL_DECIMAL |
4511
|
|
|
|
|
|
|
SQL_DOUBLE = SQL_DOUBLE |
4512
|
|
|
|
|
|
|
SQL_FLOAT = SQL_FLOAT |
4513
|
|
|
|
|
|
|
SQL_GUID = SQL_GUID |
4514
|
|
|
|
|
|
|
SQL_INTEGER = SQL_INTEGER |
4515
|
|
|
|
|
|
|
SQL_INTERVAL = SQL_INTERVAL |
4516
|
|
|
|
|
|
|
SQL_INTERVAL_DAY = SQL_INTERVAL_DAY |
4517
|
|
|
|
|
|
|
SQL_INTERVAL_DAY_TO_HOUR = SQL_INTERVAL_DAY_TO_HOUR |
4518
|
|
|
|
|
|
|
SQL_INTERVAL_DAY_TO_MINUTE = SQL_INTERVAL_DAY_TO_MINUTE |
4519
|
|
|
|
|
|
|
SQL_INTERVAL_DAY_TO_SECOND = SQL_INTERVAL_DAY_TO_SECOND |
4520
|
|
|
|
|
|
|
SQL_INTERVAL_HOUR = SQL_INTERVAL_HOUR |
4521
|
|
|
|
|
|
|
SQL_INTERVAL_HOUR_TO_MINUTE = SQL_INTERVAL_HOUR_TO_MINUTE |
4522
|
|
|
|
|
|
|
SQL_INTERVAL_HOUR_TO_SECOND = SQL_INTERVAL_HOUR_TO_SECOND |
4523
|
|
|
|
|
|
|
SQL_INTERVAL_MINUTE = SQL_INTERVAL_MINUTE |
4524
|
|
|
|
|
|
|
SQL_INTERVAL_MINUTE_TO_SECOND = SQL_INTERVAL_MINUTE_TO_SECOND |
4525
|
|
|
|
|
|
|
SQL_INTERVAL_MONTH = SQL_INTERVAL_MONTH |
4526
|
|
|
|
|
|
|
SQL_INTERVAL_SECOND = SQL_INTERVAL_SECOND |
4527
|
|
|
|
|
|
|
SQL_INTERVAL_YEAR = SQL_INTERVAL_YEAR |
4528
|
|
|
|
|
|
|
SQL_INTERVAL_YEAR_TO_MONTH = SQL_INTERVAL_YEAR_TO_MONTH |
4529
|
|
|
|
|
|
|
SQL_LONGVARBINARY = SQL_LONGVARBINARY |
4530
|
|
|
|
|
|
|
SQL_LONGVARCHAR = SQL_LONGVARCHAR |
4531
|
|
|
|
|
|
|
SQL_MULTISET = SQL_MULTISET |
4532
|
|
|
|
|
|
|
SQL_MULTISET_LOCATOR = SQL_MULTISET_LOCATOR |
4533
|
|
|
|
|
|
|
SQL_NUMERIC = SQL_NUMERIC |
4534
|
|
|
|
|
|
|
SQL_REAL = SQL_REAL |
4535
|
|
|
|
|
|
|
SQL_REF = SQL_REF |
4536
|
|
|
|
|
|
|
SQL_ROW = SQL_ROW |
4537
|
|
|
|
|
|
|
SQL_SMALLINT = SQL_SMALLINT |
4538
|
|
|
|
|
|
|
SQL_TIME = SQL_TIME |
4539
|
|
|
|
|
|
|
SQL_TIMESTAMP = SQL_TIMESTAMP |
4540
|
|
|
|
|
|
|
SQL_TINYINT = SQL_TINYINT |
4541
|
|
|
|
|
|
|
SQL_TYPE_DATE = SQL_TYPE_DATE |
4542
|
|
|
|
|
|
|
SQL_TYPE_TIME = SQL_TYPE_TIME |
4543
|
|
|
|
|
|
|
SQL_TYPE_TIMESTAMP = SQL_TYPE_TIMESTAMP |
4544
|
|
|
|
|
|
|
SQL_TYPE_TIMESTAMP_WITH_TIMEZONE = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE |
4545
|
|
|
|
|
|
|
SQL_TYPE_TIME_WITH_TIMEZONE = SQL_TYPE_TIME_WITH_TIMEZONE |
4546
|
|
|
|
|
|
|
SQL_UDT = SQL_UDT |
4547
|
|
|
|
|
|
|
SQL_UDT_LOCATOR = SQL_UDT_LOCATOR |
4548
|
|
|
|
|
|
|
SQL_UNKNOWN_TYPE = SQL_UNKNOWN_TYPE |
4549
|
|
|
|
|
|
|
SQL_VARBINARY = SQL_VARBINARY |
4550
|
|
|
|
|
|
|
SQL_VARCHAR = SQL_VARCHAR |
4551
|
|
|
|
|
|
|
SQL_WCHAR = SQL_WCHAR |
4552
|
|
|
|
|
|
|
SQL_WLONGVARCHAR = SQL_WLONGVARCHAR |
4553
|
|
|
|
|
|
|
SQL_WVARCHAR = SQL_WVARCHAR |
4554
|
|
|
|
|
|
|
SQL_CURSOR_FORWARD_ONLY = SQL_CURSOR_FORWARD_ONLY |
4555
|
|
|
|
|
|
|
SQL_CURSOR_KEYSET_DRIVEN = SQL_CURSOR_KEYSET_DRIVEN |
4556
|
|
|
|
|
|
|
SQL_CURSOR_DYNAMIC = SQL_CURSOR_DYNAMIC |
4557
|
|
|
|
|
|
|
SQL_CURSOR_STATIC = SQL_CURSOR_STATIC |
4558
|
|
|
|
|
|
|
SQL_CURSOR_TYPE_DEFAULT = SQL_CURSOR_TYPE_DEFAULT |
4559
|
|
|
|
|
|
|
DBIpp_cm_cs = DBIpp_cm_cs |
4560
|
|
|
|
|
|
|
DBIpp_cm_hs = DBIpp_cm_hs |
4561
|
|
|
|
|
|
|
DBIpp_cm_dd = DBIpp_cm_dd |
4562
|
|
|
|
|
|
|
DBIpp_cm_dw = DBIpp_cm_dw |
4563
|
|
|
|
|
|
|
DBIpp_cm_br = DBIpp_cm_br |
4564
|
|
|
|
|
|
|
DBIpp_cm_XX = DBIpp_cm_XX |
4565
|
|
|
|
|
|
|
DBIpp_ph_qm = DBIpp_ph_qm |
4566
|
|
|
|
|
|
|
DBIpp_ph_cn = DBIpp_ph_cn |
4567
|
|
|
|
|
|
|
DBIpp_ph_cs = DBIpp_ph_cs |
4568
|
|
|
|
|
|
|
DBIpp_ph_sp = DBIpp_ph_sp |
4569
|
|
|
|
|
|
|
DBIpp_ph_XX = DBIpp_ph_XX |
4570
|
|
|
|
|
|
|
DBIpp_st_qq = DBIpp_st_qq |
4571
|
|
|
|
|
|
|
DBIpp_st_bs = DBIpp_st_bs |
4572
|
|
|
|
|
|
|
DBIpp_st_XX = DBIpp_st_XX |
4573
|
|
|
|
|
|
|
DBIstcf_DISCARD_STRING = DBIstcf_DISCARD_STRING |
4574
|
|
|
|
|
|
|
DBIstcf_STRICT = DBIstcf_STRICT |
4575
|
|
|
|
|
|
|
DBIf_TRACE_SQL = DBIf_TRACE_SQL |
4576
|
|
|
|
|
|
|
DBIf_TRACE_CON = DBIf_TRACE_CON |
4577
|
|
|
|
|
|
|
DBIf_TRACE_ENC = DBIf_TRACE_ENC |
4578
|
|
|
|
|
|
|
DBIf_TRACE_DBD = DBIf_TRACE_DBD |
4579
|
|
|
|
|
|
|
DBIf_TRACE_TXN = DBIf_TRACE_TXN |
4580
|
|
|
|
|
|
|
CODE: |
4581
|
1298
|
|
|
|
|
|
RETVAL = ix; |
4582
|
|
|
|
|
|
|
OUTPUT: |
4583
|
|
|
|
|
|
|
RETVAL |
4584
|
|
|
|
|
|
|
|
4585
|
|
|
|
|
|
|
|
4586
|
|
|
|
|
|
|
void |
4587
|
|
|
|
|
|
|
_clone_dbis() |
4588
|
|
|
|
|
|
|
CODE: |
4589
|
|
|
|
|
|
|
dMY_CXT; |
4590
|
0
|
|
|
|
|
|
dbistate_t * parent_dbis = DBIS; |
4591
|
|
|
|
|
|
|
|
4592
|
|
|
|
|
|
|
(void)cv; |
4593
|
|
|
|
|
|
|
{ |
4594
|
|
|
|
|
|
|
MY_CXT_CLONE; |
4595
|
|
|
|
|
|
|
} |
4596
|
0
|
|
|
|
|
|
dbi_bootinit(parent_dbis); |
4597
|
|
|
|
|
|
|
|
4598
|
|
|
|
|
|
|
|
4599
|
|
|
|
|
|
|
void |
4600
|
|
|
|
|
|
|
_new_handle(class, parent, attr_ref, imp_datasv, imp_class) |
4601
|
|
|
|
|
|
|
SV * class |
4602
|
|
|
|
|
|
|
SV * parent |
4603
|
|
|
|
|
|
|
SV * attr_ref |
4604
|
|
|
|
|
|
|
SV * imp_datasv |
4605
|
|
|
|
|
|
|
SV * imp_class |
4606
|
|
|
|
|
|
|
PPCODE: |
4607
|
|
|
|
|
|
|
dMY_CXT; |
4608
|
|
|
|
|
|
|
HV *outer; |
4609
|
|
|
|
|
|
|
SV *outer_ref; |
4610
|
29563
|
|
|
|
|
|
HV *class_stash = gv_stashsv(class, GV_ADDWARN); |
4611
|
|
|
|
|
|
|
|
4612
|
29563
|
100
|
|
|
|
|
if (DBIS_TRACE_LEVEL >= 5) { |
4613
|
3
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP, " New %s (for %s, parent=%s, id=%s)\n", |
4614
|
3
|
|
|
|
|
|
neatsvpv(class,0), SvPV_nolen(imp_class), neatsvpv(parent,0), neatsvpv(imp_datasv,0)); |
4615
|
|
|
|
|
|
|
PERL_UNUSED_VAR(cv); |
4616
|
|
|
|
|
|
|
} |
4617
|
|
|
|
|
|
|
|
4618
|
29563
|
|
|
|
|
|
(void)hv_store((HV*)SvRV(attr_ref), "ImplementorClass", 16, SvREFCNT_inc(imp_class), 0); |
4619
|
|
|
|
|
|
|
|
4620
|
|
|
|
|
|
|
/* make attr into inner handle by blessing it into class */ |
4621
|
29563
|
|
|
|
|
|
sv_bless(attr_ref, class_stash); |
4622
|
|
|
|
|
|
|
/* tie new outer hash to inner handle */ |
4623
|
29563
|
|
|
|
|
|
outer = newHV(); /* create new hash to be outer handle */ |
4624
|
29563
|
|
|
|
|
|
outer_ref = newRV_noinc((SV*)outer); |
4625
|
|
|
|
|
|
|
/* make outer hash into a handle by blessing it into class */ |
4626
|
29563
|
|
|
|
|
|
sv_bless(outer_ref, class_stash); |
4627
|
|
|
|
|
|
|
/* tie outer handle to inner handle */ |
4628
|
29563
|
|
|
|
|
|
sv_magic((SV*)outer, attr_ref, PERL_MAGIC_tied, Nullch, 0); |
4629
|
|
|
|
|
|
|
|
4630
|
29563
|
100
|
|
|
|
|
dbih_setup_handle(aTHX_ outer_ref, SvPV_nolen(imp_class), parent, SvOK(imp_datasv) ? imp_datasv : Nullsv); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4631
|
|
|
|
|
|
|
|
4632
|
|
|
|
|
|
|
/* return outer handle, plus inner handle if not in scalar context */ |
4633
|
29563
|
|
|
|
|
|
sv_2mortal(outer_ref); |
4634
|
29563
|
50
|
|
|
|
|
EXTEND(SP, 2); |
4635
|
29563
|
|
|
|
|
|
PUSHs(outer_ref); |
4636
|
29563
|
100
|
|
|
|
|
if (GIMME != G_SCALAR) { |
|
|
100
|
|
|
|
|
|
4637
|
28373
|
|
|
|
|
|
PUSHs(attr_ref); |
4638
|
|
|
|
|
|
|
} |
4639
|
|
|
|
|
|
|
|
4640
|
|
|
|
|
|
|
|
4641
|
|
|
|
|
|
|
void |
4642
|
|
|
|
|
|
|
_setup_handle(sv, imp_class, parent, imp_datasv) |
4643
|
|
|
|
|
|
|
SV * sv |
4644
|
|
|
|
|
|
|
char * imp_class |
4645
|
|
|
|
|
|
|
SV * parent |
4646
|
|
|
|
|
|
|
SV * imp_datasv |
4647
|
|
|
|
|
|
|
CODE: |
4648
|
|
|
|
|
|
|
(void)cv; |
4649
|
0
|
0
|
|
|
|
|
dbih_setup_handle(aTHX_ sv, imp_class, parent, SvOK(imp_datasv) ? imp_datasv : Nullsv); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4650
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
4651
|
|
|
|
|
|
|
|
4652
|
|
|
|
|
|
|
|
4653
|
|
|
|
|
|
|
void |
4654
|
|
|
|
|
|
|
_get_imp_data(sv) |
4655
|
|
|
|
|
|
|
SV * sv |
4656
|
|
|
|
|
|
|
CODE: |
4657
|
2
|
|
|
|
|
|
D_imp_xxh(sv); |
4658
|
|
|
|
|
|
|
(void)cv; |
4659
|
2
|
|
|
|
|
|
ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh)); /* okay if NULL */ |
4660
|
|
|
|
|
|
|
|
4661
|
|
|
|
|
|
|
|
4662
|
|
|
|
|
|
|
void |
4663
|
|
|
|
|
|
|
_handles(sv) |
4664
|
|
|
|
|
|
|
SV * sv |
4665
|
|
|
|
|
|
|
PPCODE: |
4666
|
|
|
|
|
|
|
/* return the outer and inner handle for any given handle */ |
4667
|
14
|
|
|
|
|
|
D_imp_xxh(sv); |
4668
|
14
|
|
|
|
|
|
SV *ih = sv_mortalcopy( dbih_inner(aTHX_ sv, "_handles") ); |
4669
|
14
|
|
|
|
|
|
SV *oh = sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))); /* XXX dangerous */ |
4670
|
|
|
|
|
|
|
(void)cv; |
4671
|
14
|
50
|
|
|
|
|
EXTEND(SP, 2); |
4672
|
14
|
|
|
|
|
|
PUSHs(oh); /* returns outer handle then inner */ |
4673
|
14
|
50
|
|
|
|
|
if (GIMME != G_SCALAR) { |
|
|
50
|
|
|
|
|
|
4674
|
14
|
|
|
|
|
|
PUSHs(ih); |
4675
|
|
|
|
|
|
|
} |
4676
|
|
|
|
|
|
|
|
4677
|
|
|
|
|
|
|
|
4678
|
|
|
|
|
|
|
void |
4679
|
|
|
|
|
|
|
neat(sv, maxlen=0) |
4680
|
|
|
|
|
|
|
SV * sv |
4681
|
|
|
|
|
|
|
U32 maxlen |
4682
|
|
|
|
|
|
|
CODE: |
4683
|
377
|
|
|
|
|
|
ST(0) = sv_2mortal(newSVpv(neatsvpv(sv, maxlen), 0)); |
4684
|
|
|
|
|
|
|
(void)cv; |
4685
|
|
|
|
|
|
|
|
4686
|
|
|
|
|
|
|
|
4687
|
|
|
|
|
|
|
I32 |
4688
|
|
|
|
|
|
|
hash(key, type=0) |
4689
|
|
|
|
|
|
|
const char *key |
4690
|
|
|
|
|
|
|
long type |
4691
|
|
|
|
|
|
|
CODE: |
4692
|
|
|
|
|
|
|
(void)cv; |
4693
|
10
|
|
|
|
|
|
RETVAL = dbi_hash(key, type); |
4694
|
|
|
|
|
|
|
OUTPUT: |
4695
|
|
|
|
|
|
|
RETVAL |
4696
|
|
|
|
|
|
|
|
4697
|
|
|
|
|
|
|
void |
4698
|
|
|
|
|
|
|
looks_like_number(...) |
4699
|
|
|
|
|
|
|
PPCODE: |
4700
|
|
|
|
|
|
|
int i; |
4701
|
608
|
50
|
|
|
|
|
EXTEND(SP, items); |
|
|
50
|
|
|
|
|
|
4702
|
|
|
|
|
|
|
(void)cv; |
4703
|
1228
|
100
|
|
|
|
|
for(i=0; i < items ; ++i) { |
4704
|
620
|
|
|
|
|
|
SV *sv = ST(i); |
4705
|
620
|
100
|
|
|
|
|
if (!SvOK(sv) || (SvPOK(sv) && SvCUR(sv)==0)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4706
|
8
|
|
|
|
|
|
PUSHs(&PL_sv_undef); |
4707
|
612
|
100
|
|
|
|
|
else if ( looks_like_number(sv) ) |
4708
|
363
|
|
|
|
|
|
PUSHs(&PL_sv_yes); |
4709
|
|
|
|
|
|
|
else |
4710
|
249
|
|
|
|
|
|
PUSHs(&PL_sv_no); |
4711
|
|
|
|
|
|
|
} |
4712
|
|
|
|
|
|
|
|
4713
|
|
|
|
|
|
|
|
4714
|
|
|
|
|
|
|
void |
4715
|
|
|
|
|
|
|
_install_method(dbi_class, meth_name, file, attribs=Nullsv) |
4716
|
|
|
|
|
|
|
const char * dbi_class |
4717
|
|
|
|
|
|
|
char * meth_name |
4718
|
|
|
|
|
|
|
char * file |
4719
|
|
|
|
|
|
|
SV * attribs |
4720
|
|
|
|
|
|
|
CODE: |
4721
|
|
|
|
|
|
|
{ |
4722
|
|
|
|
|
|
|
dMY_CXT; |
4723
|
|
|
|
|
|
|
/* install another method name/interface for the DBI dispatcher */ |
4724
|
27972
|
50
|
|
|
|
|
SV *trace_msg = (DBIS_TRACE_LEVEL >= 10) ? sv_2mortal(newSVpv("",0)) : Nullsv; |
4725
|
|
|
|
|
|
|
CV *cv; |
4726
|
|
|
|
|
|
|
SV **svp; |
4727
|
|
|
|
|
|
|
dbi_ima_t *ima; |
4728
|
|
|
|
|
|
|
MAGIC *mg; |
4729
|
|
|
|
|
|
|
(void)dbi_class; |
4730
|
|
|
|
|
|
|
|
4731
|
27972
|
50
|
|
|
|
|
if (strnNE(meth_name, "DBI::", 5)) /* XXX m/^DBI::\w+::\w+$/ */ |
4732
|
0
|
|
|
|
|
|
croak("install_method %s: invalid class", meth_name); |
4733
|
|
|
|
|
|
|
|
4734
|
27972
|
50
|
|
|
|
|
if (trace_msg) |
4735
|
0
|
|
|
|
|
|
sv_catpvf(trace_msg, "install_method %-21s", meth_name); |
4736
|
|
|
|
|
|
|
|
4737
|
27972
|
|
|
|
|
|
Newxz(ima, 1, dbi_ima_t); |
4738
|
|
|
|
|
|
|
|
4739
|
27972
|
50
|
|
|
|
|
if (attribs && SvOK(attribs)) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4740
|
|
|
|
|
|
|
/* convert and store method attributes in a fast access form */ |
4741
|
26220
|
50
|
|
|
|
|
if (SvTYPE(SvRV(attribs)) != SVt_PVHV) |
4742
|
0
|
|
|
|
|
|
croak("install_method %s: bad attribs", meth_name); |
4743
|
|
|
|
|
|
|
|
4744
|
26220
|
50
|
|
|
|
|
DBD_ATTRIB_GET_IV(attribs, "O",1, svp, ima->flags); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4745
|
26220
|
50
|
|
|
|
|
DBD_ATTRIB_GET_UV(attribs, "T",1, svp, ima->method_trace); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4746
|
26220
|
50
|
|
|
|
|
DBD_ATTRIB_GET_IV(attribs, "H",1, svp, ima->hidearg); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4747
|
|
|
|
|
|
|
|
4748
|
26220
|
50
|
|
|
|
|
if (trace_msg) { |
4749
|
0
|
0
|
|
|
|
|
if (ima->flags) sv_catpvf(trace_msg, ", flags 0x%04x", (unsigned)ima->flags); |
4750
|
0
|
0
|
|
|
|
|
if (ima->method_trace)sv_catpvf(trace_msg, ", T 0x%08lx", (unsigned long)ima->method_trace); |
4751
|
0
|
0
|
|
|
|
|
if (ima->hidearg) sv_catpvf(trace_msg, ", H %u", (unsigned)ima->hidearg); |
4752
|
|
|
|
|
|
|
} |
4753
|
26220
|
50
|
|
|
|
|
if ( (svp=DBD_ATTRIB_GET_SVP(attribs, "U",1)) != NULL) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
4754
|
18688
|
|
|
|
|
|
AV *av = (AV*)SvRV(*svp); |
4755
|
18688
|
50
|
|
|
|
|
ima->minargs = (U8)SvIV(*av_fetch(av, 0, 1)); |
4756
|
18688
|
50
|
|
|
|
|
ima->maxargs = (U8)SvIV(*av_fetch(av, 1, 1)); |
4757
|
18688
|
|
|
|
|
|
svp = av_fetch(av, 2, 0); |
4758
|
18688
|
100
|
|
|
|
|
ima->usage_msg = (svp) ? savepv_using_sv(SvPV_nolen(*svp)) : ""; |
|
|
50
|
|
|
|
|
|
4759
|
18688
|
|
|
|
|
|
ima->flags |= IMA_HAS_USAGE; |
4760
|
18688
|
50
|
|
|
|
|
if (trace_msg && DBIS_TRACE_LEVEL >= 11) |
|
|
0
|
|
|
|
|
|
4761
|
0
|
|
|
|
|
|
sv_catpvf(trace_msg, ",\n usage: min %d, max %d, '%s'", |
4762
|
0
|
|
|
|
|
|
ima->minargs, ima->maxargs, ima->usage_msg); |
4763
|
|
|
|
|
|
|
} |
4764
|
|
|
|
|
|
|
} |
4765
|
27972
|
50
|
|
|
|
|
if (trace_msg) |
4766
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBILOGFP,"%s\n", SvPV_nolen(trace_msg)); |
4767
|
27972
|
|
|
|
|
|
file = savepv(file); |
4768
|
27972
|
|
|
|
|
|
cv = newXS(meth_name, XS_DBI_dispatch, file); |
4769
|
27972
|
|
|
|
|
|
SvPVX((SV *)cv) = file; |
4770
|
27972
|
|
|
|
|
|
SvLEN((SV *)cv) = 1; |
4771
|
27972
|
|
|
|
|
|
CvXSUBANY(cv).any_ptr = ima; |
4772
|
27972
|
|
|
|
|
|
ima->meth_type = get_meth_type(GvNAME(CvGV(cv))); |
4773
|
|
|
|
|
|
|
|
4774
|
|
|
|
|
|
|
/* Attach magic to handle duping and freeing of the dbi_ima_t struct. |
4775
|
|
|
|
|
|
|
* Due to the poor interface of the mg dup function, sneak a pointer |
4776
|
|
|
|
|
|
|
* to the original CV in the mg_ptr field (we get called with a |
4777
|
|
|
|
|
|
|
* pointer to the mg, but not the SV) */ |
4778
|
27972
|
|
|
|
|
|
mg = sv_magicext((SV*)cv, NULL, DBI_MAGIC, &dbi_ima_vtbl, |
4779
|
|
|
|
|
|
|
(char *)cv, 0); |
4780
|
|
|
|
|
|
|
#ifdef BROKEN_DUP_ANY_PTR |
4781
|
|
|
|
|
|
|
ima->my_perl = my_perl; /* who owns this struct */ |
4782
|
|
|
|
|
|
|
#else |
4783
|
27972
|
|
|
|
|
|
mg->mg_flags |= MGf_DUP; |
4784
|
|
|
|
|
|
|
#endif |
4785
|
27972
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
4786
|
|
|
|
|
|
|
} |
4787
|
|
|
|
|
|
|
|
4788
|
|
|
|
|
|
|
|
4789
|
|
|
|
|
|
|
int |
4790
|
|
|
|
|
|
|
trace(class, level_sv=&PL_sv_undef, file=Nullsv) |
4791
|
|
|
|
|
|
|
SV * class |
4792
|
|
|
|
|
|
|
SV * level_sv |
4793
|
|
|
|
|
|
|
SV * file |
4794
|
|
|
|
|
|
|
ALIAS: |
4795
|
|
|
|
|
|
|
_debug_dispatch = 1 |
4796
|
|
|
|
|
|
|
CODE: |
4797
|
|
|
|
|
|
|
{ |
4798
|
|
|
|
|
|
|
dMY_CXT; |
4799
|
|
|
|
|
|
|
IV level; |
4800
|
24
|
50
|
|
|
|
|
if (!DBIS) { |
4801
|
|
|
|
|
|
|
PERL_UNUSED_VAR(ix); |
4802
|
0
|
|
|
|
|
|
croak("DBI not initialised"); |
4803
|
|
|
|
|
|
|
} |
4804
|
|
|
|
|
|
|
/* Return old/current value. No change if new value not given. */ |
4805
|
24
|
50
|
|
|
|
|
RETVAL = (DBIS) ? DBIS->debug : 0; |
4806
|
24
|
|
|
|
|
|
level = parse_trace_flags(class, level_sv, RETVAL); |
4807
|
24
|
100
|
|
|
|
|
if (level) /* call before or after altering DBI trace level */ |
4808
|
6
|
|
|
|
|
|
set_trace_file(file); |
4809
|
24
|
100
|
|
|
|
|
if (level != RETVAL) { |
4810
|
12
|
100
|
|
|
|
|
if ((level & DBIc_TRACE_LEVEL_MASK) > 0) { |
4811
|
12
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," DBI %s%s default trace level set to 0x%lx/%ld (pid %d pi %p) at %s\n", |
4812
|
|
|
|
|
|
|
XS_VERSION, dbi_build_opt, |
4813
|
|
|
|
|
|
|
(long)(level & DBIc_TRACE_FLAGS_MASK), |
4814
|
|
|
|
|
|
|
(long)(level & DBIc_TRACE_LEVEL_MASK), |
4815
|
6
|
|
|
|
|
|
(int)PerlProc_getpid(), |
4816
|
|
|
|
|
|
|
#ifdef MULTIPLICITY |
4817
|
|
|
|
|
|
|
(void *)my_perl, |
4818
|
|
|
|
|
|
|
#else |
4819
|
|
|
|
|
|
|
(void*)NULL, |
4820
|
|
|
|
|
|
|
#endif |
4821
|
|
|
|
|
|
|
log_where(Nullsv, 0, "", "", 1, 1, 0) |
4822
|
|
|
|
|
|
|
); |
4823
|
6
|
50
|
|
|
|
|
if (!PL_dowarn) |
4824
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," Note: perl is running without the recommended perl -w option\n"); |
4825
|
6
|
|
|
|
|
|
PerlIO_flush(DBILOGFP); |
4826
|
|
|
|
|
|
|
} |
4827
|
12
|
|
|
|
|
|
DBIS->debug = level; |
4828
|
12
|
|
|
|
|
|
sv_setiv(get_sv("DBI::dbi_debug",0x5), level); |
4829
|
|
|
|
|
|
|
} |
4830
|
24
|
100
|
|
|
|
|
if (!level) /* call before or after altering DBI trace level */ |
4831
|
18
|
|
|
|
|
|
set_trace_file(file); |
4832
|
|
|
|
|
|
|
} |
4833
|
|
|
|
|
|
|
OUTPUT: |
4834
|
|
|
|
|
|
|
RETVAL |
4835
|
|
|
|
|
|
|
|
4836
|
|
|
|
|
|
|
|
4837
|
|
|
|
|
|
|
|
4838
|
|
|
|
|
|
|
void |
4839
|
|
|
|
|
|
|
dump_handle(sv, msg="DBI::dump_handle", level=0) |
4840
|
|
|
|
|
|
|
SV * sv |
4841
|
|
|
|
|
|
|
const char *msg |
4842
|
|
|
|
|
|
|
int level |
4843
|
|
|
|
|
|
|
CODE: |
4844
|
|
|
|
|
|
|
(void)cv; |
4845
|
4
|
|
|
|
|
|
dbih_dumphandle(aTHX_ sv, msg, level); |
4846
|
|
|
|
|
|
|
|
4847
|
|
|
|
|
|
|
|
4848
|
|
|
|
|
|
|
|
4849
|
|
|
|
|
|
|
void |
4850
|
|
|
|
|
|
|
_svdump(sv) |
4851
|
|
|
|
|
|
|
SV * sv |
4852
|
|
|
|
|
|
|
CODE: |
4853
|
|
|
|
|
|
|
{ |
4854
|
|
|
|
|
|
|
dMY_CXT; |
4855
|
|
|
|
|
|
|
(void)cv; |
4856
|
0
|
|
|
|
|
|
PerlIO_printf(DBILOGFP, "DBI::_svdump(%s)", neatsvpv(sv,0)); |
4857
|
|
|
|
|
|
|
#ifdef DEBUGGING |
4858
|
|
|
|
|
|
|
sv_dump(sv); |
4859
|
|
|
|
|
|
|
#endif |
4860
|
|
|
|
|
|
|
} |
4861
|
|
|
|
|
|
|
|
4862
|
|
|
|
|
|
|
|
4863
|
|
|
|
|
|
|
NV |
4864
|
|
|
|
|
|
|
dbi_time() |
4865
|
|
|
|
|
|
|
|
4866
|
|
|
|
|
|
|
|
4867
|
|
|
|
|
|
|
void |
4868
|
|
|
|
|
|
|
dbi_profile(h, statement, method, t1, t2) |
4869
|
|
|
|
|
|
|
SV *h |
4870
|
|
|
|
|
|
|
SV *statement |
4871
|
|
|
|
|
|
|
SV *method |
4872
|
|
|
|
|
|
|
NV t1 |
4873
|
|
|
|
|
|
|
NV t2 |
4874
|
|
|
|
|
|
|
CODE: |
4875
|
6
|
|
|
|
|
|
SV *leaf = &PL_sv_undef; |
4876
|
|
|
|
|
|
|
PERL_UNUSED_VAR(cv); |
4877
|
6
|
50
|
|
|
|
|
if (SvROK(method)) |
4878
|
0
|
|
|
|
|
|
method = SvRV(method); |
4879
|
6
|
100
|
|
|
|
|
if (dbih_inner(aTHX_ h, NULL)) { /* is a DBI handle */ |
4880
|
4
|
|
|
|
|
|
D_imp_xxh(h); |
4881
|
4
|
|
|
|
|
|
leaf = dbi_profile(h, imp_xxh, statement, method, t1, t2); |
4882
|
|
|
|
|
|
|
} |
4883
|
4
|
50
|
|
|
|
|
else if (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV) { |
|
|
50
|
|
|
|
|
|
4884
|
|
|
|
|
|
|
/* iterate over values %$h */ |
4885
|
2
|
|
|
|
|
|
HV *hv = (HV*)SvRV(h); |
4886
|
|
|
|
|
|
|
SV *tmp; |
4887
|
|
|
|
|
|
|
char *key; |
4888
|
2
|
|
|
|
|
|
I32 keylen = 0; |
4889
|
2
|
|
|
|
|
|
hv_iterinit(hv); |
4890
|
6
|
100
|
|
|
|
|
while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) { |
4891
|
4
|
100
|
|
|
|
|
if (SvOK(tmp)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4892
|
2
|
|
|
|
|
|
D_imp_xxh(tmp); |
4893
|
2
|
|
|
|
|
|
leaf = dbi_profile(tmp, imp_xxh, statement, method, t1, t2); |
4894
|
|
|
|
|
|
|
} |
4895
|
|
|
|
|
|
|
}; |
4896
|
|
|
|
|
|
|
} |
4897
|
|
|
|
|
|
|
else { |
4898
|
0
|
|
|
|
|
|
croak("dbi_profile(%s,...) invalid handle argument", neatsvpv(h,0)); |
4899
|
|
|
|
|
|
|
} |
4900
|
6
|
50
|
|
|
|
|
if (GIMME_V == G_VOID) |
|
|
100
|
|
|
|
|
|
4901
|
4
|
|
|
|
|
|
ST(0) = &PL_sv_undef; /* skip sv_mortalcopy if not needed */ |
4902
|
|
|
|
|
|
|
else |
4903
|
2
|
|
|
|
|
|
ST(0) = sv_mortalcopy(leaf); |
4904
|
|
|
|
|
|
|
|
4905
|
|
|
|
|
|
|
|
4906
|
|
|
|
|
|
|
|
4907
|
|
|
|
|
|
|
SV * |
4908
|
|
|
|
|
|
|
dbi_profile_merge_nodes(dest, ...) |
4909
|
|
|
|
|
|
|
SV * dest |
4910
|
|
|
|
|
|
|
ALIAS: |
4911
|
|
|
|
|
|
|
dbi_profile_merge = 1 |
4912
|
|
|
|
|
|
|
CODE: |
4913
|
|
|
|
|
|
|
{ |
4914
|
254
|
50
|
|
|
|
|
if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV) |
|
|
50
|
|
|
|
|
|
4915
|
0
|
|
|
|
|
|
croak("dbi_profile_merge_nodes(%s,...) destination is not an array reference", neatsvpv(dest,0)); |
4916
|
254
|
50
|
|
|
|
|
if (items <= 1) { |
4917
|
|
|
|
|
|
|
PERL_UNUSED_VAR(cv); |
4918
|
|
|
|
|
|
|
PERL_UNUSED_VAR(ix); |
4919
|
0
|
|
|
|
|
|
RETVAL = 0; |
4920
|
|
|
|
|
|
|
} |
4921
|
|
|
|
|
|
|
else { |
4922
|
|
|
|
|
|
|
/* items==2 for dest + 1 arg, ST(0) is dest, ST(1) is first arg */ |
4923
|
622
|
100
|
|
|
|
|
while (--items >= 1) { |
4924
|
368
|
|
|
|
|
|
SV *thingy = ST(items); |
4925
|
368
|
|
|
|
|
|
dbi_profile_merge_nodes(dest, thingy); |
4926
|
|
|
|
|
|
|
} |
4927
|
254
|
|
|
|
|
|
RETVAL = newSVsv(*av_fetch((AV*)SvRV(dest), DBIprof_TOTAL_TIME, 1)); |
4928
|
|
|
|
|
|
|
} |
4929
|
|
|
|
|
|
|
} |
4930
|
|
|
|
|
|
|
OUTPUT: |
4931
|
|
|
|
|
|
|
RETVAL |
4932
|
|
|
|
|
|
|
|
4933
|
|
|
|
|
|
|
|
4934
|
|
|
|
|
|
|
SV * |
4935
|
|
|
|
|
|
|
_concat_hash_sorted(hash_sv, kv_sep_sv, pair_sep_sv, use_neat_sv, num_sort_sv) |
4936
|
|
|
|
|
|
|
SV *hash_sv |
4937
|
|
|
|
|
|
|
SV *kv_sep_sv |
4938
|
|
|
|
|
|
|
SV *pair_sep_sv |
4939
|
|
|
|
|
|
|
SV *use_neat_sv |
4940
|
|
|
|
|
|
|
SV *num_sort_sv |
4941
|
|
|
|
|
|
|
PREINIT: |
4942
|
|
|
|
|
|
|
char *kv_sep, *pair_sep; |
4943
|
|
|
|
|
|
|
STRLEN kv_sep_len, pair_sep_len; |
4944
|
|
|
|
|
|
|
CODE: |
4945
|
3330
|
100
|
|
|
|
|
if (!SvOK(hash_sv)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4946
|
19
|
|
|
|
|
|
XSRETURN_UNDEF; |
4947
|
3311
|
50
|
|
|
|
|
if (!SvROK(hash_sv) || SvTYPE(SvRV(hash_sv))!=SVt_PVHV) |
|
|
100
|
|
|
|
|
|
4948
|
2
|
|
|
|
|
|
croak("hash is not a hash reference"); |
4949
|
|
|
|
|
|
|
|
4950
|
3309
|
100
|
|
|
|
|
kv_sep = SvPV(kv_sep_sv, kv_sep_len); |
4951
|
3309
|
100
|
|
|
|
|
pair_sep = SvPV(pair_sep_sv, pair_sep_len); |
4952
|
|
|
|
|
|
|
|
4953
|
3357
|
100
|
|
|
|
|
RETVAL = _join_hash_sorted( (HV*)SvRV(hash_sv), |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4954
|
|
|
|
|
|
|
kv_sep, kv_sep_len, |
4955
|
|
|
|
|
|
|
pair_sep, pair_sep_len, |
4956
|
|
|
|
|
|
|
/* use_neat should be undef, 0 or 1, may allow sprintf format strings later */ |
4957
|
6
|
50
|
|
|
|
|
(SvOK(use_neat_sv)) ? SvIV(use_neat_sv) : 0, |
|
|
50
|
|
|
|
|
|
4958
|
42
|
50
|
|
|
|
|
(SvOK(num_sort_sv)) ? SvIV(num_sort_sv) : -1 |
|
|
50
|
|
|
|
|
|
4959
|
|
|
|
|
|
|
); |
4960
|
|
|
|
|
|
|
OUTPUT: |
4961
|
|
|
|
|
|
|
RETVAL |
4962
|
|
|
|
|
|
|
|
4963
|
|
|
|
|
|
|
|
4964
|
|
|
|
|
|
|
int |
4965
|
|
|
|
|
|
|
sql_type_cast(sv, sql_type, flags=0) |
4966
|
|
|
|
|
|
|
SV * sv |
4967
|
|
|
|
|
|
|
int sql_type |
4968
|
|
|
|
|
|
|
U32 flags |
4969
|
|
|
|
|
|
|
CODE: |
4970
|
40
|
|
|
|
|
|
RETVAL = sql_type_cast_svpv(aTHX_ sv, sql_type, flags, 0); |
4971
|
|
|
|
|
|
|
OUTPUT: |
4972
|
|
|
|
|
|
|
RETVAL |
4973
|
|
|
|
|
|
|
|
4974
|
|
|
|
|
|
|
|
4975
|
|
|
|
|
|
|
|
4976
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBI::var |
4977
|
|
|
|
|
|
|
|
4978
|
|
|
|
|
|
|
void |
4979
|
|
|
|
|
|
|
FETCH(sv) |
4980
|
|
|
|
|
|
|
SV * sv |
4981
|
|
|
|
|
|
|
CODE: |
4982
|
|
|
|
|
|
|
dMY_CXT; |
4983
|
|
|
|
|
|
|
/* Note that we do not come through the dispatcher to get here. */ |
4984
|
19497
|
50
|
|
|
|
|
char *meth = SvPV_nolen(SvRV(sv)); /* what should this tie do ? */ |
4985
|
19497
|
|
|
|
|
|
char type = *meth++; /* is this a $ or & style */ |
4986
|
19497
|
50
|
|
|
|
|
imp_xxh_t *imp_xxh = (DBI_LAST_HANDLE_OK) ? DBIh_COM(DBI_LAST_HANDLE) : NULL; |
4987
|
19497
|
50
|
|
|
|
|
int trace_level = (imp_xxh ? DBIc_TRACE_LEVEL(imp_xxh) : DBIS_TRACE_LEVEL); |
4988
|
19497
|
|
|
|
|
|
NV profile_t1 = 0.0; |
4989
|
|
|
|
|
|
|
|
4990
|
19497
|
50
|
|
|
|
|
if (imp_xxh && DBIc_has(imp_xxh,DBIcf_Profile)) |
|
|
100
|
|
|
|
|
|
4991
|
12
|
|
|
|
|
|
profile_t1 = dbi_time(); |
4992
|
|
|
|
|
|
|
|
4993
|
19497
|
100
|
|
|
|
|
if (trace_level >= 2) { |
4994
|
12
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP," -> $DBI::%s (%c) FETCH from lasth=%s\n", meth, type, |
4995
|
12
|
|
|
|
|
|
(imp_xxh) ? neatsvpv(DBI_LAST_HANDLE,0): "none"); |
4996
|
|
|
|
|
|
|
} |
4997
|
|
|
|
|
|
|
|
4998
|
19497
|
50
|
|
|
|
|
if (type == '!') { /* special case for $DBI::lasth */ |
4999
|
|
|
|
|
|
|
/* Currently we can only return the INNER handle. */ |
5000
|
|
|
|
|
|
|
/* This handle should only be used for true/false tests */ |
5001
|
0
|
0
|
|
|
|
|
ST(0) = (imp_xxh) ? sv_2mortal(newRV_inc(DBI_LAST_HANDLE)) : &PL_sv_undef; |
5002
|
|
|
|
|
|
|
} |
5003
|
19497
|
50
|
|
|
|
|
else if ( !imp_xxh ) { |
5004
|
0
|
0
|
|
|
|
|
if (trace_level) |
5005
|
0
|
|
|
|
|
|
warn("Can't read $DBI::%s, last handle unknown or destroyed", meth); |
5006
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
5007
|
|
|
|
|
|
|
} |
5008
|
19497
|
100
|
|
|
|
|
else if (type == '*') { /* special case for $DBI::err, see also err method */ |
5009
|
6647
|
|
|
|
|
|
SV *errsv = DBIc_ERR(imp_xxh); |
5010
|
6647
|
|
|
|
|
|
ST(0) = sv_mortalcopy(errsv); |
5011
|
|
|
|
|
|
|
} |
5012
|
12850
|
100
|
|
|
|
|
else if (type == '"') { /* special case for $DBI::state */ |
5013
|
6220
|
|
|
|
|
|
SV *state = DBIc_STATE(imp_xxh); |
5014
|
6220
|
100
|
|
|
|
|
ST(0) = DBIc_STATE_adjust(imp_xxh, state); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5015
|
|
|
|
|
|
|
} |
5016
|
6630
|
50
|
|
|
|
|
else if (type == '$') { /* lookup scalar variable in implementors stash */ |
5017
|
0
|
|
|
|
|
|
const char *vname = mkvname(aTHX_ DBIc_IMP_STASH(imp_xxh), meth, 0); |
5018
|
0
|
|
|
|
|
|
SV *vsv = get_sv(vname, 1); |
5019
|
0
|
|
|
|
|
|
ST(0) = sv_mortalcopy(vsv); |
5020
|
|
|
|
|
|
|
} |
5021
|
|
|
|
|
|
|
else { |
5022
|
|
|
|
|
|
|
/* default to method call via stash of implementor of DBI_LAST_HANDLE */ |
5023
|
|
|
|
|
|
|
GV *imp_gv; |
5024
|
6630
|
|
|
|
|
|
HV *imp_stash = DBIc_IMP_STASH(imp_xxh); |
5025
|
|
|
|
|
|
|
#ifdef DBI_save_hv_fetch_ent |
5026
|
|
|
|
|
|
|
HE save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */ |
5027
|
|
|
|
|
|
|
#endif |
5028
|
6630
|
|
|
|
|
|
profile_t1 = 0.0; /* profile this via dispatch only (else we'll double count) */ |
5029
|
6630
|
100
|
|
|
|
|
if (trace_level >= 3) |
5030
|
4
|
50
|
|
|
|
|
PerlIO_printf(DBILOGFP," >> %s::%s\n", HvNAME(imp_stash), meth); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5031
|
6630
|
|
|
|
|
|
ST(0) = sv_2mortal(newRV_inc(DBI_LAST_HANDLE)); |
5032
|
6630
|
50
|
|
|
|
|
if ((imp_gv = gv_fetchmethod(imp_stash,meth)) == NULL) { |
5033
|
0
|
0
|
|
|
|
|
croak("Can't locate $DBI::%s object method \"%s\" via package \"%s\"", |
|
|
0
|
|
|
|
|
|
5034
|
0
|
0
|
|
|
|
|
meth, meth, HvNAME(imp_stash)); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5035
|
|
|
|
|
|
|
} |
5036
|
6630
|
50
|
|
|
|
|
PUSHMARK(mark); /* reset mark (implies one arg as we were called with one arg?) */ |
5037
|
6630
|
50
|
|
|
|
|
call_sv((SV*)GvCV(imp_gv), GIMME); |
|
|
50
|
|
|
|
|
|
5038
|
6630
|
|
|
|
|
|
SPAGAIN; |
5039
|
|
|
|
|
|
|
#ifdef DBI_save_hv_fetch_ent |
5040
|
|
|
|
|
|
|
PL_hv_fetch_ent_mh = save_mh; |
5041
|
|
|
|
|
|
|
#endif |
5042
|
|
|
|
|
|
|
} |
5043
|
19497
|
100
|
|
|
|
|
if (trace_level) |
5044
|
15
|
|
|
|
|
|
PerlIO_printf(DBILOGFP," <- $DBI::%s= %s\n", meth, neatsvpv(ST(0),0)); |
5045
|
19497
|
100
|
|
|
|
|
if (profile_t1) { |
5046
|
8
|
|
|
|
|
|
SV *h = sv_2mortal(newRV_inc(DBI_LAST_HANDLE)); |
5047
|
8
|
|
|
|
|
|
dbi_profile(h, imp_xxh, &PL_sv_undef, (SV*)cv, profile_t1, dbi_time()); |
5048
|
|
|
|
|
|
|
} |
5049
|
|
|
|
|
|
|
|
5050
|
|
|
|
|
|
|
|
5051
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBD::_::dr |
5052
|
|
|
|
|
|
|
|
5053
|
|
|
|
|
|
|
void |
5054
|
|
|
|
|
|
|
dbixs_revision(h) |
5055
|
|
|
|
|
|
|
SV * h |
5056
|
|
|
|
|
|
|
CODE: |
5057
|
|
|
|
|
|
|
PERL_UNUSED_VAR(h); |
5058
|
4
|
|
|
|
|
|
ST(0) = sv_2mortal(newSViv(DBIXS_REVISION)); |
5059
|
|
|
|
|
|
|
|
5060
|
|
|
|
|
|
|
|
5061
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBD::_::db |
5062
|
|
|
|
|
|
|
|
5063
|
|
|
|
|
|
|
void |
5064
|
|
|
|
|
|
|
connected(...) |
5065
|
|
|
|
|
|
|
CODE: |
5066
|
|
|
|
|
|
|
/* defined here just to avoid AUTOLOAD */ |
5067
|
|
|
|
|
|
|
(void)cv; |
5068
|
|
|
|
|
|
|
(void)items; |
5069
|
5938
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
5070
|
|
|
|
|
|
|
|
5071
|
|
|
|
|
|
|
|
5072
|
|
|
|
|
|
|
SV * |
5073
|
|
|
|
|
|
|
preparse(dbh, statement, ps_accept, ps_return, foo=Nullch) |
5074
|
|
|
|
|
|
|
SV * dbh |
5075
|
|
|
|
|
|
|
char * statement |
5076
|
|
|
|
|
|
|
IV ps_accept |
5077
|
|
|
|
|
|
|
IV ps_return |
5078
|
|
|
|
|
|
|
void *foo |
5079
|
|
|
|
|
|
|
|
5080
|
|
|
|
|
|
|
|
5081
|
|
|
|
|
|
|
void |
5082
|
|
|
|
|
|
|
take_imp_data(h) |
5083
|
|
|
|
|
|
|
SV * h |
5084
|
|
|
|
|
|
|
PREINIT: |
5085
|
|
|
|
|
|
|
/* take_imp_data currently in DBD::_::db not DBD::_::common, so for dbh's only */ |
5086
|
1
|
|
|
|
|
|
D_imp_xxh(h); |
5087
|
|
|
|
|
|
|
MAGIC *mg; |
5088
|
|
|
|
|
|
|
SV *imp_xxh_sv; |
5089
|
|
|
|
|
|
|
SV **tmp_svp; |
5090
|
|
|
|
|
|
|
CODE: |
5091
|
|
|
|
|
|
|
PERL_UNUSED_VAR(cv); |
5092
|
|
|
|
|
|
|
/* |
5093
|
|
|
|
|
|
|
* Remove and return the imp_xxh_t structure that's attached to the inner |
5094
|
|
|
|
|
|
|
* hash of the handle. Effectively this removes the 'brain' of the handle |
5095
|
|
|
|
|
|
|
* leaving it as an empty shell - brain dead. All method calls on it fail. |
5096
|
|
|
|
|
|
|
* |
5097
|
|
|
|
|
|
|
* The imp_xxh_t structure that's removed and returned is a plain scalar |
5098
|
|
|
|
|
|
|
* (containing binary data). It can be passed to a new DBI->connect call |
5099
|
|
|
|
|
|
|
* in order to have the new $dbh use the same 'connection' as the original |
5100
|
|
|
|
|
|
|
* handle. In this way a multi-threaded connection pool can be implemented. |
5101
|
|
|
|
|
|
|
* |
5102
|
|
|
|
|
|
|
* If the drivers imp_xxh_t structure contains SV*'s, or other interpreter |
5103
|
|
|
|
|
|
|
* specific items, they should be freed by the drivers own take_imp_data() |
5104
|
|
|
|
|
|
|
* method before it then calls SUPER::take_imp_data() to finalize removal |
5105
|
|
|
|
|
|
|
* of the imp_xxh_t structure. |
5106
|
|
|
|
|
|
|
* |
5107
|
|
|
|
|
|
|
* The driver needs to view the take_imp_data method as being nearly the |
5108
|
|
|
|
|
|
|
* same as disconnect+DESTROY only not actually calling the database API to |
5109
|
|
|
|
|
|
|
* disconnect. All that needs to remain valid in the imp_xxh_t structure |
5110
|
|
|
|
|
|
|
* is the underlying database API connection data. Everything else should |
5111
|
|
|
|
|
|
|
* in a 'clean' state such that if the drivers own DESTROY method was |
5112
|
|
|
|
|
|
|
* called it would be able to properly handle the contents of the |
5113
|
|
|
|
|
|
|
* structure. This is important in case a new handle created using this |
5114
|
|
|
|
|
|
|
* imp_data, possibly in a new thread, might end up being DESTROY'd before |
5115
|
|
|
|
|
|
|
* the driver has had a chance to 're-setup' the data. See dbih_setup_handle() |
5116
|
|
|
|
|
|
|
* |
5117
|
|
|
|
|
|
|
* All the above relates to the 'typical use case' for a compiled driver. |
5118
|
|
|
|
|
|
|
* For a pure-perl driver using a socket pair, for example, the drivers |
5119
|
|
|
|
|
|
|
* take_imp_data method might just return a string containing the fileno() |
5120
|
|
|
|
|
|
|
* values of the sockets (without calling this SUPER::take_imp_data() code). |
5121
|
|
|
|
|
|
|
* The key point is that the take_imp_data() method returns an opaque buffer |
5122
|
|
|
|
|
|
|
* containing whatever the driver would need to reuse the same underlying |
5123
|
|
|
|
|
|
|
* 'connection to the database' in a new handle. |
5124
|
|
|
|
|
|
|
* |
5125
|
|
|
|
|
|
|
* In all cases, care should be taken that driver attributes (such as |
5126
|
|
|
|
|
|
|
* AutoCommit) match the state of the underlying connection. |
5127
|
|
|
|
|
|
|
*/ |
5128
|
|
|
|
|
|
|
|
5129
|
1
|
50
|
|
|
|
|
if (!DBIc_ACTIVE(imp_xxh)) {/* sanity check, may be relaxed later */ |
5130
|
0
|
|
|
|
|
|
set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle that's not Active", 0, "take_imp_data"); |
5131
|
0
|
|
|
|
|
|
XSRETURN(0); |
5132
|
|
|
|
|
|
|
} |
5133
|
|
|
|
|
|
|
|
5134
|
|
|
|
|
|
|
/* Ideally there should be no child statement handles existing when |
5135
|
|
|
|
|
|
|
* take_imp_data is called because when those statement handles are |
5136
|
|
|
|
|
|
|
* destroyed they may need to interact with the 'zombie' parent dbh. |
5137
|
|
|
|
|
|
|
* So we do our best to neautralize them (finish & rebless) |
5138
|
|
|
|
|
|
|
*/ |
5139
|
1
|
50
|
|
|
|
|
if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) { |
|
|
50
|
|
|
|
|
|
5140
|
1
|
|
|
|
|
|
AV *av = (AV*)SvRV(*tmp_svp); |
5141
|
1
|
|
|
|
|
|
HV *zombie_stash = gv_stashpv("DBI::zombie", GV_ADDWARN); |
5142
|
|
|
|
|
|
|
I32 kidslots; |
5143
|
4
|
50
|
|
|
|
|
for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) { |
|
|
100
|
|
|
|
|
|
5144
|
3
|
|
|
|
|
|
SV **hp = av_fetch(av, kidslots, FALSE); |
5145
|
3
|
50
|
|
|
|
|
if (hp && SvROK(*hp) && SvMAGICAL(SvRV(*hp))) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5146
|
2
|
50
|
|
|
|
|
PUSHMARK(sp); |
5147
|
2
|
50
|
|
|
|
|
XPUSHs(*hp); |
5148
|
2
|
|
|
|
|
|
PUTBACK; |
5149
|
2
|
|
|
|
|
|
call_method("finish", G_VOID); |
5150
|
2
|
|
|
|
|
|
SPAGAIN; |
5151
|
2
|
|
|
|
|
|
PUTBACK; |
5152
|
2
|
|
|
|
|
|
sv_unmagic(SvRV(*hp), 'P'); /* untie */ |
5153
|
2
|
|
|
|
|
|
sv_bless(*hp, zombie_stash); /* neutralise */ |
5154
|
|
|
|
|
|
|
} |
5155
|
|
|
|
|
|
|
} |
5156
|
|
|
|
|
|
|
} |
5157
|
|
|
|
|
|
|
/* The above measures may not be sufficient if weakrefs aren't available |
5158
|
|
|
|
|
|
|
* or something has a reference to the inner-handle of an sth. |
5159
|
|
|
|
|
|
|
* We'll require no Active kids, but just warn about others. |
5160
|
|
|
|
|
|
|
*/ |
5161
|
1
|
50
|
|
|
|
|
if (DBIc_ACTIVE_KIDS(imp_xxh)) { |
5162
|
0
|
|
|
|
|
|
set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle while it still has Active kids", 0, "take_imp_data"); |
5163
|
0
|
|
|
|
|
|
XSRETURN(0); |
5164
|
|
|
|
|
|
|
} |
5165
|
1
|
50
|
|
|
|
|
if (DBIc_KIDS(imp_xxh)) |
5166
|
0
|
|
|
|
|
|
warn("take_imp_data from handle while it still has kids"); |
5167
|
|
|
|
|
|
|
|
5168
|
|
|
|
|
|
|
/* it may be better here to return a copy and poison the original |
5169
|
|
|
|
|
|
|
* rather than detatching and returning the original |
5170
|
|
|
|
|
|
|
*/ |
5171
|
|
|
|
|
|
|
|
5172
|
|
|
|
|
|
|
/* --- perform the surgery */ |
5173
|
1
|
|
|
|
|
|
dbih_getcom2(aTHX_ h, &mg); /* get the MAGIC so we can change it */ |
5174
|
1
|
|
|
|
|
|
imp_xxh_sv = mg->mg_obj; /* take local copy of the imp_data pointer */ |
5175
|
1
|
|
|
|
|
|
mg->mg_obj = Nullsv; /* sever the link from handle to imp_xxh */ |
5176
|
1
|
|
|
|
|
|
mg->mg_ptr = NULL; /* and sever the shortcut too */ |
5177
|
1
|
50
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_xxh) >= 9) |
5178
|
0
|
|
|
|
|
|
sv_dump(imp_xxh_sv); |
5179
|
|
|
|
|
|
|
/* --- housekeeping */ |
5180
|
1
|
50
|
|
|
|
|
DBIc_ACTIVE_off(imp_xxh); /* silence warning from dbih_clearcom */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5181
|
1
|
|
|
|
|
|
DBIc_IMPSET_off(imp_xxh); /* silence warning from dbih_clearcom */ |
5182
|
1
|
|
|
|
|
|
dbih_clearcom(imp_xxh); /* free SVs like DBD::_mem::common::DESTROY */ |
5183
|
1
|
|
|
|
|
|
SvOBJECT_off(imp_xxh_sv); /* no longer needs DESTROY via dbih_clearcom */ |
5184
|
|
|
|
|
|
|
/* restore flags to mark fact imp data holds active connection */ |
5185
|
|
|
|
|
|
|
/* (don't use magical DBIc_ACTIVE_on here) */ |
5186
|
1
|
|
|
|
|
|
DBIc_FLAGS(imp_xxh) |= DBIcf_IMPSET | DBIcf_ACTIVE; |
5187
|
|
|
|
|
|
|
/* --- tidy up the raw PV for life as a more normal string */ |
5188
|
1
|
|
|
|
|
|
SvPOK_on(imp_xxh_sv); /* SvCUR & SvEND were set at creation */ |
5189
|
|
|
|
|
|
|
/* --- return the actual imp_xxh_sv on the stack */ |
5190
|
1
|
|
|
|
|
|
ST(0) = imp_xxh_sv; |
5191
|
|
|
|
|
|
|
|
5192
|
|
|
|
|
|
|
|
5193
|
|
|
|
|
|
|
|
5194
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBD::_::st |
5195
|
|
|
|
|
|
|
|
5196
|
|
|
|
|
|
|
void |
5197
|
|
|
|
|
|
|
_get_fbav(sth) |
5198
|
|
|
|
|
|
|
SV * sth |
5199
|
|
|
|
|
|
|
CODE: |
5200
|
6
|
|
|
|
|
|
D_imp_sth(sth); |
5201
|
6
|
|
|
|
|
|
AV *av = dbih_get_fbav(imp_sth); |
5202
|
|
|
|
|
|
|
(void)cv; |
5203
|
6
|
|
|
|
|
|
ST(0) = sv_2mortal(newRV_inc((SV*)av)); |
5204
|
|
|
|
|
|
|
|
5205
|
|
|
|
|
|
|
void |
5206
|
|
|
|
|
|
|
_set_fbav(sth, src_rv) |
5207
|
|
|
|
|
|
|
SV * sth |
5208
|
|
|
|
|
|
|
SV * src_rv |
5209
|
|
|
|
|
|
|
CODE: |
5210
|
103856
|
|
|
|
|
|
D_imp_sth(sth); |
5211
|
|
|
|
|
|
|
int i; |
5212
|
|
|
|
|
|
|
AV *src_av; |
5213
|
103856
|
|
|
|
|
|
AV *dst_av = dbih_get_fbav(imp_sth); |
5214
|
103856
|
50
|
|
|
|
|
int dst_fields = AvFILL(dst_av)+1; |
5215
|
|
|
|
|
|
|
int src_fields; |
5216
|
|
|
|
|
|
|
(void)cv; |
5217
|
|
|
|
|
|
|
|
5218
|
103856
|
50
|
|
|
|
|
if (!SvROK(src_rv) || SvTYPE(SvRV(src_rv)) != SVt_PVAV) |
|
|
50
|
|
|
|
|
|
5219
|
0
|
|
|
|
|
|
croak("_set_fbav(%s): not an array ref", neatsvpv(src_rv,0)); |
5220
|
103856
|
|
|
|
|
|
src_av = (AV*)SvRV(src_rv); |
5221
|
103856
|
50
|
|
|
|
|
src_fields = AvFILL(src_av)+1; |
5222
|
103856
|
50
|
|
|
|
|
if (src_fields != dst_fields) { |
5223
|
0
|
|
|
|
|
|
warn("_set_fbav(%s): array has %d elements, the statement handle row buffer has %d (and NUM_OF_FIELDS is %d)", |
5224
|
|
|
|
|
|
|
neatsvpv(src_rv,0), src_fields, dst_fields, DBIc_NUM_FIELDS(imp_sth)); |
5225
|
0
|
|
|
|
|
|
SvREADONLY_off(dst_av); |
5226
|
0
|
0
|
|
|
|
|
if (src_fields < dst_fields) { |
5227
|
|
|
|
|
|
|
/* shrink the array - sadly this looses column bindings for the lost columns */ |
5228
|
0
|
|
|
|
|
|
av_fill(dst_av, src_fields-1); |
5229
|
0
|
|
|
|
|
|
dst_fields = src_fields; |
5230
|
|
|
|
|
|
|
} |
5231
|
|
|
|
|
|
|
else { |
5232
|
0
|
|
|
|
|
|
av_fill(dst_av, src_fields-1); |
5233
|
|
|
|
|
|
|
/* av_fill pads with immutable undefs which we need to change */ |
5234
|
0
|
0
|
|
|
|
|
for(i=dst_fields-1; i < src_fields; ++i) { |
5235
|
0
|
|
|
|
|
|
sv_setsv(AvARRAY(dst_av)[i], newSV(0)); |
5236
|
|
|
|
|
|
|
} |
5237
|
|
|
|
|
|
|
} |
5238
|
0
|
|
|
|
|
|
SvREADONLY_on(dst_av); |
5239
|
|
|
|
|
|
|
} |
5240
|
412489
|
100
|
|
|
|
|
for(i=0; i < dst_fields; ++i) { /* copy over the row */ |
5241
|
|
|
|
|
|
|
/* If we're given the values, then taint them if required */ |
5242
|
308633
|
100
|
|
|
|
|
if (DBIc_is(imp_sth, DBIcf_TaintOut)) |
5243
|
3
|
50
|
|
|
|
|
SvTAINT(AvARRAY(src_av)[i]); |
|
|
50
|
|
|
|
|
|
5244
|
308633
|
|
|
|
|
|
sv_setsv(AvARRAY(dst_av)[i], AvARRAY(src_av)[i]); |
5245
|
|
|
|
|
|
|
} |
5246
|
103856
|
|
|
|
|
|
ST(0) = sv_2mortal(newRV_inc((SV*)dst_av)); |
5247
|
|
|
|
|
|
|
|
5248
|
|
|
|
|
|
|
|
5249
|
|
|
|
|
|
|
void |
5250
|
|
|
|
|
|
|
bind_col(sth, col, ref, attribs=Nullsv) |
5251
|
|
|
|
|
|
|
SV * sth |
5252
|
|
|
|
|
|
|
SV * col |
5253
|
|
|
|
|
|
|
SV * ref |
5254
|
|
|
|
|
|
|
SV * attribs |
5255
|
|
|
|
|
|
|
CODE: |
5256
|
162
|
100
|
|
|
|
|
DBD_ATTRIBS_CHECK("bind_col", sth, attribs); |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5257
|
162
|
50
|
|
|
|
|
ST(0) = boolSV(dbih_sth_bind_col(sth, col, ref, attribs)); |
5258
|
|
|
|
|
|
|
(void)cv; |
5259
|
|
|
|
|
|
|
|
5260
|
|
|
|
|
|
|
|
5261
|
|
|
|
|
|
|
void |
5262
|
|
|
|
|
|
|
fetchrow_array(sth) |
5263
|
|
|
|
|
|
|
SV * sth |
5264
|
|
|
|
|
|
|
ALIAS: |
5265
|
|
|
|
|
|
|
fetchrow = 1 |
5266
|
|
|
|
|
|
|
PPCODE: |
5267
|
|
|
|
|
|
|
SV *retsv; |
5268
|
7
|
50
|
|
|
|
|
if (CvDEPTH(cv) == 99) { |
5269
|
|
|
|
|
|
|
PERL_UNUSED_VAR(ix); |
5270
|
0
|
|
|
|
|
|
croak("Deep recursion, probably fetchrow-fetch-fetchrow loop"); |
5271
|
|
|
|
|
|
|
} |
5272
|
7
|
50
|
|
|
|
|
PUSHMARK(sp); |
5273
|
7
|
50
|
|
|
|
|
XPUSHs(sth); |
5274
|
7
|
|
|
|
|
|
PUTBACK; |
5275
|
7
|
50
|
|
|
|
|
if (call_method("fetch", G_SCALAR) != 1) |
5276
|
0
|
|
|
|
|
|
croak("panic: DBI fetch"); /* should never happen */ |
5277
|
7
|
|
|
|
|
|
SPAGAIN; |
5278
|
7
|
|
|
|
|
|
retsv = POPs; |
5279
|
7
|
|
|
|
|
|
PUTBACK; |
5280
|
7
|
50
|
|
|
|
|
if (SvROK(retsv) && SvTYPE(SvRV(retsv)) == SVt_PVAV) { |
|
|
50
|
|
|
|
|
|
5281
|
7
|
|
|
|
|
|
D_imp_sth(sth); |
5282
|
|
|
|
|
|
|
int num_fields, i; |
5283
|
|
|
|
|
|
|
AV *bound_av; |
5284
|
7
|
|
|
|
|
|
AV *av = (AV*)SvRV(retsv); |
5285
|
7
|
50
|
|
|
|
|
num_fields = AvFILL(av)+1; |
5286
|
7
|
50
|
|
|
|
|
EXTEND(sp, num_fields+1); |
|
|
50
|
|
|
|
|
|
5287
|
|
|
|
|
|
|
|
5288
|
|
|
|
|
|
|
/* We now check for bind_col() having been called but fetch */ |
5289
|
|
|
|
|
|
|
/* not returning the fields_svav array. Probably because the */ |
5290
|
|
|
|
|
|
|
/* driver is implemented in perl. XXX This logic may change later. */ |
5291
|
7
|
|
|
|
|
|
bound_av = DBIc_FIELDS_AV(imp_sth); /* bind_col() called ? */ |
5292
|
7
|
50
|
|
|
|
|
if (bound_av && av != bound_av) { |
|
|
50
|
|
|
|
|
|
5293
|
|
|
|
|
|
|
/* let dbih_get_fbav know what's going on */ |
5294
|
0
|
|
|
|
|
|
bound_av = dbih_get_fbav(imp_sth); |
5295
|
0
|
0
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth) >= 3) { |
5296
|
0
|
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth), |
5297
|
|
|
|
|
|
|
"fetchrow: updating fbav 0x%lx from 0x%lx\n", |
5298
|
|
|
|
|
|
|
(long)bound_av, (long)av); |
5299
|
|
|
|
|
|
|
} |
5300
|
0
|
0
|
|
|
|
|
for(i=0; i < num_fields; ++i) { /* copy over the row */ |
5301
|
0
|
|
|
|
|
|
sv_setsv(AvARRAY(bound_av)[i], AvARRAY(av)[i]); |
5302
|
|
|
|
|
|
|
} |
5303
|
|
|
|
|
|
|
} |
5304
|
28
|
100
|
|
|
|
|
for(i=0; i < num_fields; ++i) { |
5305
|
21
|
|
|
|
|
|
PUSHs(AvARRAY(av)[i]); |
5306
|
|
|
|
|
|
|
} |
5307
|
|
|
|
|
|
|
} |
5308
|
|
|
|
|
|
|
|
5309
|
|
|
|
|
|
|
|
5310
|
|
|
|
|
|
|
SV * |
5311
|
|
|
|
|
|
|
fetchrow_hashref(sth, keyattrib=Nullch) |
5312
|
|
|
|
|
|
|
SV * sth |
5313
|
|
|
|
|
|
|
const char *keyattrib |
5314
|
|
|
|
|
|
|
PREINIT: |
5315
|
|
|
|
|
|
|
SV *rowavr; |
5316
|
|
|
|
|
|
|
SV *ka_rv; |
5317
|
8855
|
|
|
|
|
|
D_imp_sth(sth); |
5318
|
|
|
|
|
|
|
CODE: |
5319
|
|
|
|
|
|
|
(void)cv; |
5320
|
8855
|
50
|
|
|
|
|
PUSHMARK(sp); |
5321
|
8855
|
50
|
|
|
|
|
XPUSHs(sth); |
5322
|
8855
|
|
|
|
|
|
PUTBACK; |
5323
|
8855
|
100
|
|
|
|
|
if (!keyattrib || !*keyattrib) { |
|
|
50
|
|
|
|
|
|
5324
|
8851
|
|
|
|
|
|
SV *kn = DBIc_FetchHashKeyName(imp_sth); |
5325
|
8851
|
50
|
|
|
|
|
if (kn && SvOK(kn)) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5326
|
8851
|
|
|
|
|
|
keyattrib = SvPVX(kn); |
5327
|
|
|
|
|
|
|
else |
5328
|
0
|
|
|
|
|
|
keyattrib = "NAME"; |
5329
|
|
|
|
|
|
|
} |
5330
|
8855
|
|
|
|
|
|
ka_rv = *hv_fetch((HV*)DBIc_MY_H(imp_sth), keyattrib,strlen(keyattrib), TRUE); |
5331
|
|
|
|
|
|
|
/* we copy to invoke FETCH magic, and we do that before fetch() so if tainting */ |
5332
|
|
|
|
|
|
|
/* then the taint triggered by the fetch won't then apply to the fetched name */ |
5333
|
8855
|
|
|
|
|
|
ka_rv = newSVsv(ka_rv); |
5334
|
8855
|
50
|
|
|
|
|
if (call_method("fetch", G_SCALAR) != 1) |
5335
|
0
|
|
|
|
|
|
croak("panic: DBI fetch"); /* should never happen */ |
5336
|
8855
|
|
|
|
|
|
SPAGAIN; |
5337
|
8855
|
|
|
|
|
|
rowavr = POPs; |
5338
|
8855
|
|
|
|
|
|
PUTBACK; |
5339
|
|
|
|
|
|
|
/* have we got an array ref in rowavr */ |
5340
|
17604
|
100
|
|
|
|
|
if (SvROK(rowavr) && SvTYPE(SvRV(rowavr)) == SVt_PVAV) { |
|
|
50
|
|
|
|
|
|
5341
|
|
|
|
|
|
|
int i; |
5342
|
8751
|
|
|
|
|
|
AV *rowav = (AV*)SvRV(rowavr); |
5343
|
8751
|
50
|
|
|
|
|
const int num_fields = AvFILL(rowav)+1; |
5344
|
|
|
|
|
|
|
HV *hv; |
5345
|
|
|
|
|
|
|
AV *ka_av; |
5346
|
8751
|
50
|
|
|
|
|
if (!(SvROK(ka_rv) && SvTYPE(SvRV(ka_rv))==SVt_PVAV)) { |
|
|
100
|
|
|
|
|
|
5347
|
2
|
|
|
|
|
|
sv_setiv(DBIc_ERR(imp_sth), 1); |
5348
|
2
|
|
|
|
|
|
sv_setpvf(DBIc_ERRSTR(imp_sth), |
5349
|
|
|
|
|
|
|
"Can't use attribute '%s' because it doesn't contain a reference to an array (%s)", |
5350
|
|
|
|
|
|
|
keyattrib, neatsvpv(ka_rv,0)); |
5351
|
2
|
|
|
|
|
|
XSRETURN_UNDEF; |
5352
|
|
|
|
|
|
|
} |
5353
|
8749
|
|
|
|
|
|
ka_av = (AV*)SvRV(ka_rv); |
5354
|
8749
|
|
|
|
|
|
hv = newHV(); |
5355
|
34968
|
100
|
|
|
|
|
for (i=0; i < num_fields; ++i) { /* honor the original order as sent by the database */ |
5356
|
26219
|
|
|
|
|
|
SV **field_name_svp = av_fetch(ka_av, i, 1); |
5357
|
26219
|
|
|
|
|
|
(void)hv_store_ent(hv, *field_name_svp, newSVsv((SV*)(AvARRAY(rowav)[i])), 0); |
5358
|
|
|
|
|
|
|
} |
5359
|
8749
|
|
|
|
|
|
RETVAL = newRV_inc((SV*)hv); |
5360
|
8749
|
|
|
|
|
|
SvREFCNT_dec(hv); /* since newRV incremented it */ |
5361
|
|
|
|
|
|
|
} |
5362
|
|
|
|
|
|
|
else { |
5363
|
104
|
|
|
|
|
|
RETVAL = &PL_sv_undef; |
5364
|
|
|
|
|
|
|
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 4)) |
5365
|
|
|
|
|
|
|
RETVAL = newSV(0); /* mutable undef for 5.004_04 */ |
5366
|
|
|
|
|
|
|
#endif |
5367
|
|
|
|
|
|
|
} |
5368
|
8853
|
|
|
|
|
|
SvREFCNT_dec(ka_rv); /* since we created it */ |
5369
|
|
|
|
|
|
|
OUTPUT: |
5370
|
|
|
|
|
|
|
RETVAL |
5371
|
|
|
|
|
|
|
|
5372
|
|
|
|
|
|
|
|
5373
|
|
|
|
|
|
|
void |
5374
|
|
|
|
|
|
|
fetch(sth) |
5375
|
|
|
|
|
|
|
SV * sth |
5376
|
|
|
|
|
|
|
ALIAS: |
5377
|
|
|
|
|
|
|
fetchrow_arrayref = 1 |
5378
|
|
|
|
|
|
|
CODE: |
5379
|
|
|
|
|
|
|
int num_fields; |
5380
|
0
|
0
|
|
|
|
|
if (CvDEPTH(cv) == 99) { |
5381
|
|
|
|
|
|
|
PERL_UNUSED_VAR(ix); |
5382
|
0
|
|
|
|
|
|
croak("Deep recursion. Probably fetch-fetchrow-fetch loop."); |
5383
|
|
|
|
|
|
|
} |
5384
|
0
|
0
|
|
|
|
|
PUSHMARK(sp); |
5385
|
0
|
0
|
|
|
|
|
XPUSHs(sth); |
5386
|
0
|
|
|
|
|
|
PUTBACK; |
5387
|
0
|
|
|
|
|
|
num_fields = call_method("fetchrow", G_ARRAY); /* XXX change the name later */ |
5388
|
0
|
|
|
|
|
|
SPAGAIN; |
5389
|
0
|
0
|
|
|
|
|
if (num_fields == 0) { |
5390
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
5391
|
|
|
|
|
|
|
} else { |
5392
|
0
|
|
|
|
|
|
D_imp_sth(sth); |
5393
|
0
|
|
|
|
|
|
AV *av = dbih_get_fbav(imp_sth); |
5394
|
0
|
0
|
|
|
|
|
if (num_fields != AvFILL(av)+1) |
|
|
0
|
|
|
|
|
|
5395
|
0
|
0
|
|
|
|
|
croak("fetchrow returned %d fields, expected %d", |
5396
|
0
|
|
|
|
|
|
num_fields, (int)AvFILL(av)+1); |
5397
|
0
|
|
|
|
|
|
SPAGAIN; |
5398
|
0
|
0
|
|
|
|
|
while(--num_fields >= 0) |
5399
|
0
|
|
|
|
|
|
sv_setsv(AvARRAY(av)[num_fields], POPs); |
5400
|
0
|
|
|
|
|
|
PUTBACK; |
5401
|
0
|
|
|
|
|
|
ST(0) = sv_2mortal(newRV_inc((SV*)av)); |
5402
|
|
|
|
|
|
|
} |
5403
|
|
|
|
|
|
|
|
5404
|
|
|
|
|
|
|
|
5405
|
|
|
|
|
|
|
void |
5406
|
|
|
|
|
|
|
rows(sth) |
5407
|
|
|
|
|
|
|
SV * sth |
5408
|
|
|
|
|
|
|
CODE: |
5409
|
5
|
|
|
|
|
|
D_imp_sth(sth); |
5410
|
5
|
|
|
|
|
|
const IV rows = DBIc_ROW_COUNT(imp_sth); |
5411
|
5
|
|
|
|
|
|
ST(0) = sv_2mortal(newSViv(rows)); |
5412
|
|
|
|
|
|
|
(void)cv; |
5413
|
|
|
|
|
|
|
|
5414
|
|
|
|
|
|
|
|
5415
|
|
|
|
|
|
|
void |
5416
|
|
|
|
|
|
|
finish(sth) |
5417
|
|
|
|
|
|
|
SV * sth |
5418
|
|
|
|
|
|
|
CODE: |
5419
|
14391
|
|
|
|
|
|
D_imp_sth(sth); |
5420
|
14391
|
100
|
|
|
|
|
DBIc_ACTIVE_off(imp_sth); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5421
|
14391
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
5422
|
|
|
|
|
|
|
(void)cv; |
5423
|
|
|
|
|
|
|
|
5424
|
|
|
|
|
|
|
|
5425
|
|
|
|
|
|
|
void |
5426
|
|
|
|
|
|
|
DESTROY(sth) |
5427
|
|
|
|
|
|
|
SV * sth |
5428
|
|
|
|
|
|
|
PPCODE: |
5429
|
|
|
|
|
|
|
/* keep in sync with DESTROY in Driver.xst */ |
5430
|
25318
|
|
|
|
|
|
D_imp_sth(sth); |
5431
|
25318
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
5432
|
|
|
|
|
|
|
/* we don't test IMPSET here because this code applies to pure-perl drivers */ |
5433
|
25318
|
50
|
|
|
|
|
if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */ |
5434
|
0
|
0
|
|
|
|
|
DBIc_ACTIVE_off(imp_sth); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5435
|
0
|
0
|
|
|
|
|
if (DBIc_TRACE_LEVEL(imp_sth)) |
5436
|
0
|
0
|
|
|
|
|
PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth)); |
5437
|
|
|
|
|
|
|
} |
5438
|
25318
|
100
|
|
|
|
|
if (DBIc_ACTIVE(imp_sth)) { |
5439
|
5
|
|
|
|
|
|
D_imp_dbh_from_sth; |
5440
|
10
|
50
|
|
|
|
|
if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) { |
|
|
50
|
|
|
|
|
|
5441
|
5
|
|
|
|
|
|
dSP; |
5442
|
5
|
50
|
|
|
|
|
PUSHMARK(sp); |
5443
|
5
|
50
|
|
|
|
|
XPUSHs(sth); |
5444
|
5
|
|
|
|
|
|
PUTBACK; |
5445
|
5
|
|
|
|
|
|
call_method("finish", G_SCALAR); |
5446
|
5
|
|
|
|
|
|
SPAGAIN; |
5447
|
5
|
|
|
|
|
|
PUTBACK; |
5448
|
|
|
|
|
|
|
} |
5449
|
|
|
|
|
|
|
else { |
5450
|
0
|
0
|
|
|
|
|
DBIc_ACTIVE_off(imp_sth); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5451
|
|
|
|
|
|
|
} |
5452
|
|
|
|
|
|
|
} |
5453
|
|
|
|
|
|
|
|
5454
|
|
|
|
|
|
|
|
5455
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBI::st |
5456
|
|
|
|
|
|
|
|
5457
|
|
|
|
|
|
|
void |
5458
|
|
|
|
|
|
|
TIEHASH(class, inner_ref) |
5459
|
|
|
|
|
|
|
SV * class |
5460
|
|
|
|
|
|
|
SV * inner_ref |
5461
|
|
|
|
|
|
|
CODE: |
5462
|
0
|
|
|
|
|
|
HV *stash = gv_stashsv(class, GV_ADDWARN); /* a new hash is supplied to us, we just need to bless and apply tie magic */ |
5463
|
0
|
|
|
|
|
|
sv_bless(inner_ref, stash); |
5464
|
0
|
|
|
|
|
|
ST(0) = inner_ref; |
5465
|
|
|
|
|
|
|
|
5466
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBD::_::common |
5467
|
|
|
|
|
|
|
|
5468
|
|
|
|
|
|
|
|
5469
|
|
|
|
|
|
|
void |
5470
|
|
|
|
|
|
|
DESTROY(h) |
5471
|
|
|
|
|
|
|
SV * h |
5472
|
|
|
|
|
|
|
CODE: |
5473
|
|
|
|
|
|
|
/* DESTROY defined here just to avoid AUTOLOAD */ |
5474
|
|
|
|
|
|
|
(void)cv; |
5475
|
|
|
|
|
|
|
(void)h; |
5476
|
543
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
5477
|
|
|
|
|
|
|
|
5478
|
|
|
|
|
|
|
|
5479
|
|
|
|
|
|
|
void |
5480
|
|
|
|
|
|
|
STORE(h, keysv, valuesv) |
5481
|
|
|
|
|
|
|
SV * h |
5482
|
|
|
|
|
|
|
SV * keysv |
5483
|
|
|
|
|
|
|
SV * valuesv |
5484
|
|
|
|
|
|
|
CODE: |
5485
|
79050
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
5486
|
79050
|
100
|
|
|
|
|
if (!dbih_set_attr_k(h, keysv, 0, valuesv)) |
5487
|
46
|
|
|
|
|
|
ST(0) = &PL_sv_no; |
5488
|
|
|
|
|
|
|
(void)cv; |
5489
|
|
|
|
|
|
|
|
5490
|
|
|
|
|
|
|
|
5491
|
|
|
|
|
|
|
void |
5492
|
|
|
|
|
|
|
FETCH(h, keysv) |
5493
|
|
|
|
|
|
|
SV * h |
5494
|
|
|
|
|
|
|
SV * keysv |
5495
|
|
|
|
|
|
|
CODE: |
5496
|
44688
|
|
|
|
|
|
ST(0) = dbih_get_attr_k(h, keysv, 0); |
5497
|
|
|
|
|
|
|
(void)cv; |
5498
|
|
|
|
|
|
|
|
5499
|
|
|
|
|
|
|
void |
5500
|
|
|
|
|
|
|
DELETE(h, keysv) |
5501
|
|
|
|
|
|
|
SV * h |
5502
|
|
|
|
|
|
|
SV * keysv |
5503
|
|
|
|
|
|
|
CODE: |
5504
|
|
|
|
|
|
|
/* only private_* keys can be deleted, for others DELETE acts like FETCH */ |
5505
|
|
|
|
|
|
|
/* because the DBI internals rely on certain handle attributes existing */ |
5506
|
5
|
50
|
|
|
|
|
if (strnEQ(SvPV_nolen(keysv),"private_",8)) |
|
|
100
|
|
|
|
|
|
5507
|
2
|
|
|
|
|
|
ST(0) = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0); |
5508
|
|
|
|
|
|
|
else |
5509
|
3
|
|
|
|
|
|
ST(0) = dbih_get_attr_k(h, keysv, 0); |
5510
|
|
|
|
|
|
|
(void)cv; |
5511
|
|
|
|
|
|
|
|
5512
|
|
|
|
|
|
|
|
5513
|
|
|
|
|
|
|
void |
5514
|
|
|
|
|
|
|
private_data(h) |
5515
|
|
|
|
|
|
|
SV * h |
5516
|
|
|
|
|
|
|
CODE: |
5517
|
0
|
|
|
|
|
|
D_imp_xxh(h); |
5518
|
|
|
|
|
|
|
(void)cv; |
5519
|
0
|
|
|
|
|
|
ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh)); |
5520
|
|
|
|
|
|
|
|
5521
|
|
|
|
|
|
|
|
5522
|
|
|
|
|
|
|
void |
5523
|
|
|
|
|
|
|
err(h) |
5524
|
|
|
|
|
|
|
SV * h |
5525
|
|
|
|
|
|
|
CODE: |
5526
|
55
|
|
|
|
|
|
D_imp_xxh(h); |
5527
|
55
|
|
|
|
|
|
SV *errsv = DBIc_ERR(imp_xxh); |
5528
|
|
|
|
|
|
|
(void)cv; |
5529
|
55
|
|
|
|
|
|
ST(0) = sv_mortalcopy(errsv); |
5530
|
|
|
|
|
|
|
|
5531
|
|
|
|
|
|
|
void |
5532
|
|
|
|
|
|
|
state(h) |
5533
|
|
|
|
|
|
|
SV * h |
5534
|
|
|
|
|
|
|
CODE: |
5535
|
10
|
|
|
|
|
|
D_imp_xxh(h); |
5536
|
10
|
|
|
|
|
|
SV *state = DBIc_STATE(imp_xxh); |
5537
|
|
|
|
|
|
|
(void)cv; |
5538
|
10
|
100
|
|
|
|
|
ST(0) = DBIc_STATE_adjust(imp_xxh, state); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5539
|
|
|
|
|
|
|
|
5540
|
|
|
|
|
|
|
void |
5541
|
|
|
|
|
|
|
errstr(h) |
5542
|
|
|
|
|
|
|
SV * h |
5543
|
|
|
|
|
|
|
CODE: |
5544
|
6702
|
|
|
|
|
|
D_imp_xxh(h); |
5545
|
6702
|
|
|
|
|
|
SV *errstr = DBIc_ERRSTR(imp_xxh); |
5546
|
|
|
|
|
|
|
SV *err; |
5547
|
|
|
|
|
|
|
/* If there's no errstr but there is an err then use err */ |
5548
|
|
|
|
|
|
|
(void)cv; |
5549
|
6702
|
50
|
|
|
|
|
if (!SvTRUE(errstr) && (err=DBIc_ERR(imp_xxh)) && SvTRUE(err)) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5550
|
0
|
|
|
|
|
|
errstr = err; |
5551
|
6702
|
|
|
|
|
|
ST(0) = sv_mortalcopy(errstr); |
5552
|
|
|
|
|
|
|
|
5553
|
|
|
|
|
|
|
|
5554
|
|
|
|
|
|
|
void |
5555
|
|
|
|
|
|
|
set_err(h, err, errstr=&PL_sv_no, state=&PL_sv_undef, method=&PL_sv_undef, result=Nullsv) |
5556
|
|
|
|
|
|
|
SV * h |
5557
|
|
|
|
|
|
|
SV * err |
5558
|
|
|
|
|
|
|
SV * errstr |
5559
|
|
|
|
|
|
|
SV * state |
5560
|
|
|
|
|
|
|
SV * method |
5561
|
|
|
|
|
|
|
SV * result |
5562
|
|
|
|
|
|
|
PPCODE: |
5563
|
|
|
|
|
|
|
{ |
5564
|
9365
|
|
|
|
|
|
D_imp_xxh(h); |
5565
|
|
|
|
|
|
|
SV **sem_svp; |
5566
|
|
|
|
|
|
|
(void)cv; |
5567
|
|
|
|
|
|
|
|
5568
|
9365
|
100
|
|
|
|
|
if (DBIc_has(imp_xxh, DBIcf_HandleSetErr) && SvREADONLY(method)) |
|
|
50
|
|
|
|
|
|
5569
|
38
|
|
|
|
|
|
method = sv_mortalcopy(method); /* HandleSetErr may want to change it */ |
5570
|
|
|
|
|
|
|
|
5571
|
9365
|
100
|
|
|
|
|
if (!set_err_sv(h, imp_xxh, err, errstr, state, method)) { |
5572
|
|
|
|
|
|
|
/* set_err was canceled by HandleSetErr, */ |
5573
|
|
|
|
|
|
|
/* don't set "dbi_set_err_method", return an empty list */ |
5574
|
|
|
|
|
|
|
} |
5575
|
|
|
|
|
|
|
else { |
5576
|
|
|
|
|
|
|
/* store provided method name so handler code can find it */ |
5577
|
9363
|
|
|
|
|
|
sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, 1); |
5578
|
9363
|
100
|
|
|
|
|
if (SvOK(method)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
5579
|
6
|
50
|
|
|
|
|
sv_setpv(*sem_svp, SvPV_nolen(method)); |
5580
|
|
|
|
|
|
|
} |
5581
|
|
|
|
|
|
|
else |
5582
|
9357
|
50
|
|
|
|
|
(void)SvOK_off(*sem_svp); |
5583
|
9363
|
50
|
|
|
|
|
EXTEND(SP, 1); |
5584
|
9363
|
100
|
|
|
|
|
PUSHs( result ? result : &PL_sv_undef ); |
5585
|
|
|
|
|
|
|
} |
5586
|
|
|
|
|
|
|
/* We don't check RaiseError and call die here because that must be */ |
5587
|
|
|
|
|
|
|
/* done by returning through dispatch and letting the DBI handle it */ |
5588
|
|
|
|
|
|
|
} |
5589
|
|
|
|
|
|
|
|
5590
|
|
|
|
|
|
|
|
5591
|
|
|
|
|
|
|
int |
5592
|
|
|
|
|
|
|
trace(h, level=&PL_sv_undef, file=Nullsv) |
5593
|
|
|
|
|
|
|
SV *h |
5594
|
|
|
|
|
|
|
SV *level |
5595
|
|
|
|
|
|
|
SV *file |
5596
|
|
|
|
|
|
|
ALIAS: |
5597
|
|
|
|
|
|
|
debug = 1 |
5598
|
|
|
|
|
|
|
CODE: |
5599
|
68
|
|
|
|
|
|
RETVAL = set_trace(h, level, file); |
5600
|
|
|
|
|
|
|
(void)cv; /* Unused variables */ |
5601
|
|
|
|
|
|
|
(void)ix; |
5602
|
|
|
|
|
|
|
OUTPUT: |
5603
|
|
|
|
|
|
|
RETVAL |
5604
|
|
|
|
|
|
|
|
5605
|
|
|
|
|
|
|
|
5606
|
|
|
|
|
|
|
void |
5607
|
|
|
|
|
|
|
trace_msg(sv, msg, this_trace=1) |
5608
|
|
|
|
|
|
|
SV *sv |
5609
|
|
|
|
|
|
|
const char *msg |
5610
|
|
|
|
|
|
|
int this_trace |
5611
|
|
|
|
|
|
|
PREINIT: |
5612
|
|
|
|
|
|
|
int current_trace; |
5613
|
|
|
|
|
|
|
PerlIO *pio; |
5614
|
|
|
|
|
|
|
CODE: |
5615
|
|
|
|
|
|
|
{ |
5616
|
|
|
|
|
|
|
dMY_CXT; |
5617
|
|
|
|
|
|
|
(void)cv; |
5618
|
27309
|
100
|
|
|
|
|
if (SvROK(sv)) { |
5619
|
5460
|
|
|
|
|
|
D_imp_xxh(sv); |
5620
|
5460
|
|
|
|
|
|
current_trace = DBIc_TRACE_LEVEL(imp_xxh); |
5621
|
5460
|
|
|
|
|
|
pio = DBIc_LOGPIO(imp_xxh); |
5622
|
|
|
|
|
|
|
} |
5623
|
|
|
|
|
|
|
else { /* called as a static method */ |
5624
|
21849
|
|
|
|
|
|
current_trace = DBIS_TRACE_FLAGS; |
5625
|
21849
|
|
|
|
|
|
pio = DBILOGFP; |
5626
|
|
|
|
|
|
|
} |
5627
|
27309
|
100
|
|
|
|
|
if (DBIc_TRACE_MATCHES(this_trace, current_trace)) { |
|
|
50
|
|
|
|
|
|
5628
|
98
|
|
|
|
|
|
PerlIO_puts(pio, msg); |
5629
|
98
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
5630
|
|
|
|
|
|
|
} |
5631
|
|
|
|
|
|
|
else { |
5632
|
27211
|
|
|
|
|
|
ST(0) = &PL_sv_no; |
5633
|
|
|
|
|
|
|
} |
5634
|
|
|
|
|
|
|
} |
5635
|
|
|
|
|
|
|
|
5636
|
|
|
|
|
|
|
|
5637
|
|
|
|
|
|
|
void |
5638
|
|
|
|
|
|
|
rows(h) |
5639
|
|
|
|
|
|
|
SV * h |
5640
|
|
|
|
|
|
|
CODE: |
5641
|
|
|
|
|
|
|
/* fallback esp for $DBI::rows after $drh was last used */ |
5642
|
0
|
|
|
|
|
|
ST(0) = sv_2mortal(newSViv(-1)); |
5643
|
|
|
|
|
|
|
(void)h; |
5644
|
|
|
|
|
|
|
(void)cv; |
5645
|
|
|
|
|
|
|
|
5646
|
|
|
|
|
|
|
|
5647
|
|
|
|
|
|
|
void |
5648
|
|
|
|
|
|
|
swap_inner_handle(rh1, rh2, allow_reparent=0) |
5649
|
|
|
|
|
|
|
SV * rh1 |
5650
|
|
|
|
|
|
|
SV * rh2 |
5651
|
|
|
|
|
|
|
IV allow_reparent |
5652
|
|
|
|
|
|
|
CODE: |
5653
|
|
|
|
|
|
|
{ |
5654
|
14
|
|
|
|
|
|
D_impdata(imp_xxh1, imp_xxh_t, rh1); |
5655
|
14
|
|
|
|
|
|
D_impdata(imp_xxh2, imp_xxh_t, rh2); |
5656
|
14
|
|
|
|
|
|
SV *h1i = dbih_inner(aTHX_ rh1, "swap_inner_handle"); |
5657
|
14
|
|
|
|
|
|
SV *h2i = dbih_inner(aTHX_ rh2, "swap_inner_handle"); |
5658
|
14
|
50
|
|
|
|
|
SV *h1 = (rh1 == h1i) ? (SV*)DBIc_MY_H(imp_xxh1) : SvRV(rh1); |
5659
|
14
|
50
|
|
|
|
|
SV *h2 = (rh2 == h2i) ? (SV*)DBIc_MY_H(imp_xxh2) : SvRV(rh2); |
5660
|
|
|
|
|
|
|
(void)cv; |
5661
|
|
|
|
|
|
|
|
5662
|
14
|
100
|
|
|
|
|
if (DBIc_TYPE(imp_xxh1) != DBIc_TYPE(imp_xxh2)) { |
5663
|
|
|
|
|
|
|
char buf[99]; |
5664
|
2
|
|
|
|
|
|
sprintf(buf, "Can't swap_inner_handle between %sh and %sh", |
5665
|
4
|
|
|
|
|
|
dbih_htype_name(DBIc_TYPE(imp_xxh1)), dbih_htype_name(DBIc_TYPE(imp_xxh2))); |
5666
|
2
|
|
|
|
|
|
DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1, buf, Nullch, Nullch); |
5667
|
2
|
|
|
|
|
|
XSRETURN_NO; |
5668
|
|
|
|
|
|
|
} |
5669
|
12
|
100
|
|
|
|
|
if (!allow_reparent && DBIc_PARENT_COM(imp_xxh1) != DBIc_PARENT_COM(imp_xxh2)) { |
|
|
100
|
|
|
|
|
|
5670
|
2
|
|
|
|
|
|
DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1, |
5671
|
|
|
|
|
|
|
"Can't swap_inner_handle with handle from different parent", |
5672
|
|
|
|
|
|
|
Nullch, Nullch); |
5673
|
2
|
|
|
|
|
|
XSRETURN_NO; |
5674
|
|
|
|
|
|
|
} |
5675
|
|
|
|
|
|
|
|
5676
|
10
|
|
|
|
|
|
(void)SvREFCNT_inc(h1i); |
5677
|
10
|
|
|
|
|
|
(void)SvREFCNT_inc(h2i); |
5678
|
|
|
|
|
|
|
|
5679
|
10
|
|
|
|
|
|
sv_unmagic(h1, 'P'); /* untie(%$h1) */ |
5680
|
10
|
|
|
|
|
|
sv_unmagic(h2, 'P'); /* untie(%$h2) */ |
5681
|
|
|
|
|
|
|
|
5682
|
10
|
|
|
|
|
|
sv_magic(h1, h2i, 'P', Nullch, 0); /* tie %$h1, $h2i */ |
5683
|
10
|
|
|
|
|
|
DBIc_MY_H(imp_xxh2) = (HV*)h1; |
5684
|
|
|
|
|
|
|
|
5685
|
10
|
|
|
|
|
|
sv_magic(h2, h1i, 'P', Nullch, 0); /* tie %$h2, $h1i */ |
5686
|
10
|
|
|
|
|
|
DBIc_MY_H(imp_xxh1) = (HV*)h2; |
5687
|
|
|
|
|
|
|
|
5688
|
10
|
|
|
|
|
|
SvREFCNT_dec(h1i); |
5689
|
10
|
|
|
|
|
|
SvREFCNT_dec(h2i); |
5690
|
|
|
|
|
|
|
|
5691
|
10
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
5692
|
|
|
|
|
|
|
} |
5693
|
|
|
|
|
|
|
|
5694
|
|
|
|
|
|
|
|
5695
|
|
|
|
|
|
|
MODULE = DBI PACKAGE = DBD::_mem::common |
5696
|
|
|
|
|
|
|
|
5697
|
|
|
|
|
|
|
void |
5698
|
|
|
|
|
|
|
DESTROY(imp_xxh_rv) |
5699
|
|
|
|
|
|
|
SV * imp_xxh_rv |
5700
|
|
|
|
|
|
|
CODE: |
5701
|
|
|
|
|
|
|
/* ignore 'cast increases required alignment' warning */ |
5702
|
29559
|
|
|
|
|
|
imp_xxh_t *imp_xxh = (imp_xxh_t*)SvPVX(SvRV(imp_xxh_rv)); |
5703
|
29559
|
|
|
|
|
|
DBIc_DBISTATE(imp_xxh)->clearcom(imp_xxh); |
5704
|
|
|
|
|
|
|
(void)cv; |
5705
|
|
|
|
|
|
|
|
5706
|
|
|
|
|
|
|
# end |