#include "Oracle.h" #define BIND_PARAM_INOUT_ALLOW_ARRAY DBISTATE_DECLARE; MODULE = DBD::Oracle PACKAGE = DBD::Oracle I32 constant(name=Nullch) char *name ALIAS: ORA_VARCHAR2 = 1 ORA_NUMBER = 2 ORA_STRING = 5 ORA_LONG = 8 ORA_ROWID = 11 ORA_DATE = 12 ORA_RAW = 23 ORA_LONGRAW = 24 ORA_CHAR = 96 ORA_CHARZ = 97 ORA_MLSLABEL = 105 ORA_XMLTYPE = ORA_XMLTYPE ORA_CLOB = 112 ORA_BLOB = 113 ORA_RSET = 116 ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE = ORA_NUMBER_TABLE ORA_SYSDBA = 0x0002 ORA_SYSOPER = 0x0004 SQLCS_IMPLICIT = SQLCS_IMPLICIT SQLCS_NCHAR = SQLCS_NCHAR SQLT_INT = SQLT_INT SQLT_FLT = SQLT_FLT OCI_BATCH_MODE = 0x01 OCI_EXACT_FETCH = 0x02 OCI_KEEP_FETCH_STATE = 0x04 OCI_DESCRIBE_ONLY = 0x10 OCI_COMMIT_ON_SUCCESS = 0x20 OCI_NON_BLOCKING = 0x40 OCI_BATCH_ERRORS = 0x80 OCI_PARSE_ONLY = 0x100 OCI_SHOW_DML_WARNINGS = 0x400 OCI_STMT_SCROLLABLE_READONLY = 0x08 OCI_FETCH_CURRENT = OCI_FETCH_CURRENT OCI_FETCH_NEXT = OCI_FETCH_NEXT OCI_FETCH_FIRST = OCI_FETCH_FIRST OCI_FETCH_LAST = OCI_FETCH_LAST OCI_FETCH_PRIOR = OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE SQLT_CHR = SQLT_CHR SQLT_BIN = SQLT_BIN CODE: if (!ix) { if (!name) name = GvNAME(CvGV(cv)); croak("Unknown DBD::Oracle constant '%s'", name); } else RETVAL = ix; OUTPUT: RETVAL void ORA_OCI() CODE: SV *sv = sv_newmortal(); sv_setnv(sv, atof(ORA_OCI_VERSION)); /* 9.1! see docs */ sv_setpv(sv, ORA_OCI_VERSION); /* 9.10.11.12 */ SvNOK_on(sv); /* dualvar hack */ ST(0) = sv; void ora_env_var(name) char *name CODE: char buf[1024]; char *p = ora_env_var(name, buf, sizeof(buf)-1); SV *sv = sv_newmortal(); if (p) sv_setpv(sv, p); ST(0) = sv; #ifdef __CYGWIN32__ void ora_cygwin_set_env(name, value) char * name char * value CODE: ora_cygwin_set_env(name, value); #endif /* __CYGWIN32__ */ INCLUDE: Oracle.xsi MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st void ora_scroll_position(sth) SV * sth PREINIT: D_imp_sth(sth); CODE: { XSRETURN_IV( imp_sth->fetch_position); } void ora_fetch_scroll(sth,fetch_orient,fetch_offset) SV * sth IV fetch_orient IV fetch_offset PREINIT: D_imp_sth(sth); CODE: { AV *av; imp_sth->fetch_orient=fetch_orient; imp_sth->fetch_offset=fetch_offset; av = dbd_st_fetch(sth,imp_sth); ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef; } void ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs) SV * sth SV * param SV * av_ref IV maxlen SV * attribs CODE: { IV sql_type = 0; D_imp_sth(sth); SV *av_value; if (!SvROK(av_ref) || SvTYPE(SvRV(av_ref)) != SVt_PVAV) croak("bind_param_inout_array needs a reference to a array value"); av_value = av_ref; if (SvREADONLY(av_value)) croak("Modification of a read-only value attempted"); if (attribs) { if (SvNIOK(attribs)) { sql_type = SvIV(attribs); attribs = Nullsv; } else { SV **svp; DBD_ATTRIBS_CHECK("bind_param", sth, attribs); DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type); } } ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no; } void ora_fetch(sth) SV * sth PPCODE: /* fetchrow: but with scalar fetch returning NUM_FIELDS for Oraperl */ /* This code is called _directly_ by Oraperl.pm bypassing the DBI. */ /* as a result we have to do some things ourselves (like calling */ /* CLEAR_ERROR) and we loose the tracing that the DBI offers :-( */ D_imp_sth(sth); AV *av; int debug = DBIc_DEBUGIV(imp_sth); if (DBIS->debug > debug) debug = DBIS->debug; DBIh_CLEAR_ERROR(imp_sth); if (GIMME == G_SCALAR) { /* XXX Oraperl */ /* This non-standard behaviour added only to increase the */ /* performance of the oraperl emulation layer (Oraperl.pm) */ if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) XSRETURN_UNDEF; XSRETURN_IV(DBIc_NUM_FIELDS(imp_sth)); } if (debug >= 2) PerlIO_printf(DBILOGFP, " -> ora_fetch\n"); av = dbd_st_fetch(sth, imp_sth); if (av) { int num_fields = AvFILL(av)+1; int i; EXTEND(sp, num_fields); for(i=0; i < num_fields; ++i) { PUSHs(AvARRAY(av)[i]); } if (debug >= 2) PerlIO_printf(DBILOGFP, " <- (...) [%d items]\n", num_fields); } else { if (debug >= 2) PerlIO_printf(DBILOGFP, " <- () [0 items]\n"); } if (debug >= 2 && SvTRUE(DBIc_ERR(imp_sth))) PerlIO_printf(DBILOGFP, " !! ERROR: %s %s", neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0)); void ora_execute_array(sth, tuples, exe_count, tuples_status, cols=&sv_undef) SV * sth SV * tuples IV exe_count SV * tuples_status SV * cols PREINIT: D_imp_sth(sth); int retval; CODE: /* XXX Need default bindings if any phs are so far unbound(?) */ /* XXX this code is duplicated in selectrow_arrayref above */ if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */ DBIc_ROW_COUNT(imp_sth) = 0; retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status, cols, (ub4)exe_count); /* XXX Handle return value ... like DBI::execute_array(). */ /* remember that dbd_st_execute must return <= -2 for error */ if (retval == 0) /* ok with no rows affected */ XST_mPV(0, "0E0"); /* (true but zero) */ else if (retval < -1) /* -1 == unknown number of rows */ XST_mUNDEF(0); /* <= -2 means error */ else XST_mIV(0, retval); /* typically 1, rowcount or -1 */ void cancel(sth) SV * sth CODE: D_imp_sth(sth); ST(0) = dbd_st_cancel(sth, imp_sth) ? &sv_yes : &sv_no; MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db void ora_ping(dbh) SV *dbh PREINIT: D_imp_dbh(dbh); sword status; text buf[2]; CODE: /*simply does a call to OCIServerVersion which should make 1 round trip*/ /*later I will replace this with the actual OCIPing command*/ /*This will work if the DB goes down, */ /*If the listener goes down it is another case as the Listener is needed to establish the connection not maintain it*/ /*so we should stay connected but we cannot get nay new connections*/ { OCIServerVersion_log_stat(imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); if (status != OCI_SUCCESS){ XSRETURN_IV(0); } else { XSRETURN_IV(1); } } void reauthenticate(dbh, uid, pwd) SV * dbh char * uid char * pwd CODE: D_imp_dbh(dbh); ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &sv_yes : &sv_no; void ora_lob_write(dbh, locator, offset, data) SV *dbh OCILobLocator *locator UV offset SV *data PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN data_len; /* bytes not chars */ dvoid *bufp; sword status; ub2 csid; ub1 csform; CODE: csid = 0; csform = SQLCS_IMPLICIT; bufp = SvPV(data, data_len); amtp = data_len; /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (0 && SvUTF8(data) && !IN_BYTES) { amtp = sv_len_utf8(data); } */ /* added by lab: */ /* LAB do something about length here? see above comment */ OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); ST(0) = &sv_undef; return; } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId"); ST(0) = &sv_undef; return; } #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); OCILobWrite_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, (ub4)offset, bufp, (ub4)data_len, OCI_ONE_PIECE, NULL, NULL, (ub2)0, csform , status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite"); ST(0) = &sv_undef; } else { ST(0) = &sv_yes; } void ora_lob_append(dbh, locator, data) SV *dbh OCILobLocator *locator SV *data PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN data_len; /* bytes not chars */ dvoid *bufp; sword status; #if !defined(OCI_HTYPE_DIRPATH_FN_CTX) /* Oracle is < 9.0 */ ub4 startp; #endif ub1 csform; ub2 csid; CODE: csid = 0; csform = SQLCS_IMPLICIT; bufp = SvPV(data, data_len); amtp = data_len; /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (1 && SvUTF8(data) && !IN_BYTES) */ /* added by lab: */ /* LAB do something about length here? see above comment */ OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); ST(0) = &sv_undef; return; } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId"); ST(0) = &sv_undef; return; } #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); OCILobWriteAppend_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, bufp, (ub4)data_len, OCI_ONE_PIECE, NULL, NULL, csid, csform, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend"); ST(0) = &sv_undef; } else { ST(0) = &sv_yes; } void ora_lob_read(dbh, locator, offset, length) SV *dbh OCILobLocator *locator UV offset UV length PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN bufp_len; SV *dest_sv; dvoid *bufp; sword status; ub1 csform; CODE: csform = SQLCS_IMPLICIT; dest_sv = sv_2mortal(newSV(length*4)); /*LAB: crude hack that works... tim did it else where XXX */ SvPOK_on(dest_sv); bufp_len = SvLEN(dest_sv); /* XXX bytes not chars? (lab: yes) */ bufp = SvPVX(dest_sv); amtp = length; /* if utf8 and clob/nclob: in: chars, out: bytes */ /* http://www.lc.leidenuniv.nl/awcourse/oracle/appdev.920/a96584/oci16m40.htm#427818 */ /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (0 && SvUTF8(dest_sv) && !IN_BYTES) { amtp = sv_len_utf8(dest_sv); } */ /* added by lab: */ OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); dest_sv = &sv_undef; return; } OCILobRead_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, (ub4)offset, /* offset starts at 1 */ bufp, (ub4)bufp_len, 0, 0, (ub2)0, csform, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobRead"); dest_sv = &sv_undef; } else { SvCUR(dest_sv) = amtp; /* always bytes here */ *SvEND(dest_sv) = '\0'; if (CSFORM_IMPLIES_UTF8(csform)) SvUTF8_on(dest_sv); } ST(0) = dest_sv; void ora_lob_trim(dbh, locator, length) SV *dbh OCILobLocator *locator UV length PREINIT: D_imp_dbh(dbh); sword status; CODE: OCILobTrim_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, length, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim"); ST(0) = &sv_undef; } else { ST(0) = &sv_yes; } void ora_lob_length(dbh, locator) SV *dbh OCILobLocator *locator PREINIT: D_imp_dbh(dbh); sword status; ub4 len = 0; CODE: OCILobGetLength_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &len, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength"); ST(0) = &sv_undef; } else { ST(0) = sv_2mortal(newSVuv(len)); } void ora_lob_chunk_size(dbh, locator) SV *dbh OCILobLocator *locator PREINIT: D_imp_dbh(dbh); sword status; ub4 chunk_size = 0; CODE: OCILobGetChunkSize_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobGetChunkSize"); ST(0) = &sv_undef; } else { ST(0) = sv_2mortal(newSVuv(chunk_size)); } MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr void init_oci(drh) SV * drh CODE: D_imp_drh(drh); dbd_init_oci(DBIS) ; dbd_init_oci_drh(imp_drh) ;