File Coverage

Oracle.xs
Criterion Covered Total %
statement 14 125 11.2
branch n/a
condition n/a
subroutine n/a
pod n/a
total 14 125 11.2


line stmt bran cond sub pod time code
1             #include "Oracle.h"
2              
3             DBISTATE_DECLARE;
4              
5             MODULE = DBD::Oracle PACKAGE = DBD::Oracle
6              
7             I32
8             constant(name=Nullch)
9                 char *name
10                 ALIAS:
11                 ORA_VARCHAR2 = 1
12                 ORA_NUMBER = 2
13                 ORA_STRING = 5
14                 ORA_LONG = 8
15                 ORA_ROWID = 11
16                 ORA_DATE = 12
17                 ORA_RAW = 23
18                 ORA_LONGRAW = 24
19                 ORA_CHAR = 96
20                 ORA_CHARZ = 97
21                 ORA_MLSLABEL = 105
22                 ORA_NTY = 108
23                 ORA_CLOB = 112
24                 ORA_BLOB = 113
25                 ORA_RSET = 116
26                 ORA_SYSDBA = 0x0002
27                 ORA_SYSOPER = 0x0004
28                 SQLCS_IMPLICIT = SQLCS_IMPLICIT
29                 SQLCS_NCHAR = SQLCS_NCHAR
30                 CODE:
31 4               if (!ix) {
32 0           if (!name) name = GvNAME(CvGV(cv));
33 0           croak("Unknown DBD::Oracle constant '%s'", name);
34                 }
35                 else RETVAL = ix;
36                 OUTPUT:
37                 RETVAL
38              
39             void
40             ORA_OCI()
41                 CODE:
42 31               SV *sv = sv_newmortal();
43 31               sv_setnv(sv, atof(ORA_OCI_VERSION)); /* 9.1! see docs */
44 31               sv_setpv(sv, ORA_OCI_VERSION); /* 9.10.11.12 */
45 31               SvNOK_on(sv); /* dualvar hack */
46 31               ST(0) = sv;
47              
48             void
49             ora_env_var(name)
50                 char *name
51                 CODE:
52                 char buf[1024];
53 116               char *p = ora_env_var(name, buf, sizeof(buf)-1);
54 116               SV *sv = sv_newmortal();
55 116               if (p)
56 2                   sv_setpv(sv, p);
57 116               ST(0) = sv;
58              
59             #ifdef __CYGWIN32__
60             void
61             ora_cygwin_set_env(name, value)
62                 char * name
63                 char * value
64                 CODE:
65                 ora_cygwin_set_env(name, value);
66              
67             #endif /* __CYGWIN32__ */
68              
69              
70             INCLUDE: Oracle.xsi
71              
72             MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
73              
74             void
75             ora_fetch(sth)
76                 SV * sth
77                 PPCODE:
78                 /* fetchrow: but with scalar fetch returning NUM_FIELDS for Oraperl */
79             /* This code is called _directly_ by Oraperl.pm bypassing the DBI. */
80             /* as a result we have to do some things ourselves (like calling */
81             /* CLEAR_ERROR) and we loose the tracing that the DBI offers :-( */
82 0           D_imp_sth(sth);
83             AV *av;
84 0           int debug = DBIc_DEBUGIV(imp_sth);
85 0           if (DBIS->debug > debug)
86             debug = DBIS->debug;
87 0           DBIh_CLEAR_ERROR(imp_sth);
88 0           if (GIMME == G_SCALAR) { /* XXX Oraperl */
89             /* This non-standard behaviour added only to increase the */
90             /* performance of the oraperl emulation layer (Oraperl.pm) */
91 0           if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth))
92 0           XSRETURN_UNDEF;
93 0           XSRETURN_IV(DBIc_NUM_FIELDS(imp_sth));
94             }
95 0           if (debug >= 2)
96 0           PerlIO_printf(DBILOGFP, " -> ora_fetch\n");
97 0           av = dbd_st_fetch(sth, imp_sth);
98 0           if (av) {
99 0           int num_fields = AvFILL(av)+1;
100             int i;
101 0           EXTEND(sp, num_fields);
102 0           for(i=0; i < num_fields; ++i) {
103 0           PUSHs(AvARRAY(av)[i]);
104             }
105 0           if (debug >= 2)
106 0           PerlIO_printf(DBILOGFP, " <- (...) [%d items]\n", num_fields);
107             }
108             else {
109 0           if (debug >= 2)
110 0           PerlIO_printf(DBILOGFP, " <- () [0 items]\n");
111             }
112 0           if (debug >= 2 && SvTRUE(DBIc_ERR(imp_sth)))
113 0           PerlIO_printf(DBILOGFP, " !! ERROR: %s %s",
114             neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0));
115            
116             void
117             ora_execute_array(sth, tuples, exe_count, tuples_status, cols=&sv_undef)
118             SV * sth
119             SV * tuples
120             IV exe_count
121             SV * tuples_status
122             SV * cols
123             PREINIT:
124 0           D_imp_sth(sth);
125             int retval;
126             CODE:
127             /* XXX Need default bindings if any phs are so far unbound(?) */
128             /* XXX this code is duplicated in selectrow_arrayref above */
129 0           if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
130 0           DBIc_ROW_COUNT(imp_sth) = 0;
131 0           retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status,
132             cols, (ub4)exe_count);
133             /* XXX Handle return value ... like DBI::execute_array(). */
134             /* remember that dbd_st_execute must return <= -2 for error */
135 0           if (retval == 0) /* ok with no rows affected */
136 0           XST_mPV(0, "0E0"); /* (true but zero) */
137 0           else if (retval < -1) /* -1 == unknown number of rows */
138 0           XST_mUNDEF(0); /* <= -2 means error */
139             else
140 0           XST_mIV(0, retval); /* typically 1, rowcount or -1 */
141            
142            
143             void
144             cancel(sth)
145             SV * sth
146             CODE:
147 0           D_imp_sth(sth);
148 0           ST(0) = dbd_st_cancel(sth, imp_sth) ? &sv_yes : &sv_no;
149            
150            
151             MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
152            
153             void
154             reauthenticate(dbh, uid, pwd)
155             SV * dbh
156             char * uid
157             char * pwd
158             CODE:
159 0           D_imp_dbh(dbh);
160 0           ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &sv_yes : &sv_no;
161            
162             void
163             ora_lob_write(dbh, locator, offset, data)
164             SV *dbh
165             OCILobLocator *locator
166             UV offset
167             SV *data
168             PREINIT:
169 0           D_imp_dbh(dbh);
170             ub4 amtp;
171             STRLEN data_len; /* bytes not chars */
172             dvoid *bufp;
173             sword status;
174             ub2 csid;
175             ub1 csform;
176             CODE:
177 0           csid = 0;
178 0           csform = SQLCS_IMPLICIT;
179 0           bufp = SvPV(data, data_len);
180 0           amtp = data_len;
181             /* if locator is CLOB and data is UTF8 and not in bytes pragma */
182             /* if (0 && SvUTF8(data) && !IN_BYTES) { amtp = sv_len_utf8(data); } */
183             /* added by lab: */
184             /* LAB do something about length here? see above comment */
185 0           OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
186 0           if (status != OCI_SUCCESS) {
187 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
188 0           ST(0) = &sv_undef;
189 0           return;
190             }
191             #ifdef OCI_ATTR_CHARSET_ID
192             /* Effectively only used so AL32UTF8 works properly */
193 0           OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status );
194 0           if (status != OCI_SUCCESS) {
195 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
196 0           ST(0) = &sv_undef;
197 0           return;
198             }
199             #endif /* OCI_ATTR_CHARSET_ID */
200             /* if data is utf8 but charset isn't then switch to utf8 csid */
201 0           csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
202            
203 0           OCILobWrite_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator,
204             &amtp, (ub4)offset,
205             bufp, (ub4)data_len, OCI_ONE_PIECE,
206             NULL, NULL,
207             (ub2)0, csform , status);
208 0           if (status != OCI_SUCCESS) {
209 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite");
210 0           ST(0) = &sv_undef;
211             }
212             else {
213 0           ST(0) = &sv_yes;
214             }
215            
216             void
217             ora_lob_append(dbh, locator, data)
218             SV *dbh
219             OCILobLocator *locator
220             SV *data
221             PREINIT:
222 0           D_imp_dbh(dbh);
223             ub4 amtp;
224             STRLEN data_len; /* bytes not chars */
225             dvoid *bufp;
226             sword status;
227             #if defined(ORA_OCI_8) || !defined(OCI_HTYPE_DIRPATH_FN_CTX) /* Oracle is < 9.0 */
228             ub4 startp;
229             #endif
230             ub1 csform;
231             ub2 csid;
232             CODE:
233 0           csid = 0;
234 0           csform = SQLCS_IMPLICIT;
235 0           bufp = SvPV(data, data_len);
236 0           amtp = data_len;
237             /* if locator is CLOB and data is UTF8 and not in bytes pragma */
238             /* if (1 && SvUTF8(data) && !IN_BYTES) */
239             /* added by lab: */
240             /* LAB do something about length here? see above comment */
241 0           OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
242 0           if (status != OCI_SUCCESS) {
243 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
244 0           ST(0) = &sv_undef;
245 0           return;
246             }
247             #ifdef OCI_ATTR_CHARSET_ID
248             /* Effectively only used so AL32UTF8 works properly */
249 0           OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status );
250 0           if (status != OCI_SUCCESS) {
251 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
252 0           ST(0) = &sv_undef;
253 0           return;
254             }
255             #endif /* OCI_ATTR_CHARSET_ID */
256             /* if data is utf8 but charset isn't then switch to utf8 csid */
257 0           csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
258             #if !defined(ORA_OCI_8) && defined(OCI_HTYPE_DIRPATH_FN_CTX) /* Oracle is >= 9.0 */
259 0           OCILobWriteAppend_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator,
260             &amtp, bufp, (ub4)data_len, OCI_ONE_PIECE,
261             NULL, NULL,
262             csid, csform, status);
263 0           if (status != OCI_SUCCESS) {
264 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend");
265 0           ST(0) = &sv_undef;
266             }
267             else {
268 0           ST(0) = &sv_yes;
269             }
270             #else
271             OCILobGetLength_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &startp, status);
272             if (status != OCI_SUCCESS) {
273             oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength");
274             ST(0) = &sv_undef;
275             } else {
276             /* start one after the end -- the first position in the LOB is 1 */
277             startp++;
278             if (DBIS->debug >= 2 )
279             PerlIO_printf(DBILOGFP, " Calling OCILobWrite with csid=%d csform=%d\n",csid, csform );
280             OCILobWrite_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator,
281             &amtp, startp,
282             bufp, (ub4)data_len, OCI_ONE_PIECE,
283             NULL, NULL,
284             csid, csform , status);
285             if (status != OCI_SUCCESS) {
286             oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite");
287             ST(0) = &sv_undef;
288             }
289             else {
290             ST(0) = &sv_yes;
291             }
292             }
293             #endif
294            
295            
296             void
297             ora_lob_read(dbh, locator, offset, length)
298             SV *dbh
299             OCILobLocator *locator
300             UV offset
301             UV length
302             PREINIT:
303 0           D_imp_dbh(dbh);
304             ub4 amtp;
305             STRLEN bufp_len;
306             SV *dest_sv;
307             dvoid *bufp;
308             sword status;
309             ub1 csform;
310             CODE:
311 0           csform = SQLCS_IMPLICIT;
312 0           dest_sv = sv_2mortal(newSV(length*4)); /*LAB: crude hack that works... tim did it else where XXX */
313 0           SvPOK_on(dest_sv);
314 0           bufp_len = SvLEN(dest_sv); /* XXX bytes not chars? (lab: yes) */
315 0           bufp = SvPVX(dest_sv);
316 0           amtp = length; /* if utf8 and clob/nclob: in: chars, out: bytes */
317             /* http://www.lc.leidenuniv.nl/awcourse/oracle/appdev.920/a96584/oci16m40.htm#427818 */
318                 /* if locator is CLOB and data is UTF8 and not in bytes pragma */
319             /* if (0 && SvUTF8(dest_sv) && !IN_BYTES) { amtp = sv_len_utf8(dest_sv); } */
320             /* added by lab: */
321 0           OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
322 0           if (status != OCI_SUCCESS) {
323 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
324             dest_sv = &sv_undef;
325 0           return;
326             }
327 0           OCILobRead_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator,
328             &amtp, (ub4)offset, /* offset starts at 1 */
329             bufp, (ub4)bufp_len,
330             0, 0, (ub2)0, csform, status);
331 0           if (status != OCI_SUCCESS) {
332 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobRead");
333             dest_sv = &sv_undef;
334             }
335             else {
336 0           SvCUR(dest_sv) = amtp; /* always bytes here */
337 0           *SvEND(dest_sv) = '\0';
338 0           if (CSFORM_IMPLIES_UTF8(csform))
339 0           SvUTF8_on(dest_sv);
340            
341             }
342 0           ST(0) = dest_sv;
343            
344             void
345             ora_lob_trim(dbh, locator, length)
346             SV *dbh
347             OCILobLocator *locator
348             UV length
349             PREINIT:
350 0           D_imp_dbh(dbh);
351             sword status;
352             CODE:
353 0           OCILobTrim_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, length, status);
354 0           if (status != OCI_SUCCESS) {
355 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim");
356 0           ST(0) = &sv_undef;
357             }
358             else {
359 0           ST(0) = &sv_yes;
360             }
361            
362             void
363             ora_lob_length(dbh, locator)
364             SV *dbh
365             OCILobLocator *locator
366             PREINIT:
367 0           D_imp_dbh(dbh);
368             sword status;
369 0           ub4 len = 0;
370             CODE:
371 0           OCILobGetLength_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &len, status);
372 0           if (status != OCI_SUCCESS) {
373 0           oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim");
374 0           ST(0) = &sv_undef;
375             }
376             else {
377 0           ST(0) = sv_2mortal(newSVuv(len));
378             }
379            
380            
381            
382             MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr
383            
384             void
385             init_oci(drh)
386             SV * drh
387             CODE:
388 19           D_imp_drh(drh);
389 19           dbd_init_oci(DBIS) ;
390 19           dbd_init_oci_drh(imp_drh) ;
391            
392            
393            
394            
395