#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) ;