MODULE = Oracle::OCI PACKAGE = Oracle::OCI
BOOT:
Perl_require_pv(aTHX_ "DBD::Oracle");
DBISTATE_INIT;
oci_util_init(DBIS);
SV *
get_oci_error(errhp, status, what="", debug=-1)
OCIError *errhp
int status
char *what
int debug
void
get_oci_handle(h, handle_type)
SV *h
int handle_type
PPCODE:
void *handle = get_oci_handle(h, handle_type, 0);
PUSHs(sv_2mortal(newSViv((IV)handle)));
if (GIMME != G_SCALAR) {
PUSHs(sv_2mortal(newSViv((IV)handle_type)));
}
void
oci_buf_len(sv, len=-1, ref_len_sv=Nullsv)
SV *sv
IV len
SV *ref_len_sv
PPCODE:
if (GIMME == G_SCALAR) /* sanity check */
croak("oci_buf_len not called in list context");
PUSHs(sv);
if (len == -1) {
/* is simple input param, no magic required */
STRLEN l = SvOK(sv) ? SvCUR(sv) : 0;
XPUSHs(sv_2mortal(newSViv(l))); /* return the current string length */
}
else {
STRLEN lna;
struct ufuncs uf;
SV *len_mg = sv_2mortal(newSViv(len));
if (!SvOK(sv))
sv_setpv(sv,"");
SvPV_force(sv, lna);
SvGROW(sv, len); /* will typically allocate more than len bytes */
uf.uf_val = &oci_buf_getmaxlen; /* get the allocated length of the sv */
uf.uf_set = &oci_buf_setcurlen; /* SET the current length of the sv */
uf.uf_index = (IV)sv; /* store pointer to the SV to get/set the length of */
sv_magic(len_mg, 0, 'U', (char*)&uf, sizeof(uf));
if (ref_len_sv) {
if (!SvROK(ref_len_sv))
croak("oci_buf_len(,,ref_len_sv) not a ref to scalar");
uf.uf_val = 0; /* don't want 'getmaxlen' behaviour here */
sv_magic(SvRV(ref_len_sv), 0, 'U', (char*)&uf, sizeof(uf));
}
XPUSHs(len_mg);
}
sword_status
OCIAttrGet(trgthndlp, trghndltyp, attributep_sv, sizep_sv, attrtype, errhp, result_type)
void * trgthndlp
ub4 trghndltyp
SV * attributep_sv
SV * sizep_sv
ub4 attrtype
OCIError * errhp
SV * result_type
CODE:
{
ub4 b4_val = 0;
char *ptr = Nullch;
STRLEN lna=0;
ub4 sizep = SvIV(sizep_sv);
int debug = DBIS->debug;
char * bless = Nullch;
int ptr_len = (SvNIOK(result_type)) ? SvIV(result_type) : 0;
if (ptr_len==0 && !looks_like_number(result_type) ) {
/* result_type is the name of a class to bless pointer into */
/* so we set ptr_len 4 and arrange to return a blessed ref. */
ptr_len = 4;
bless = SvPV(result_type,lna);
}
switch (ptr_len) {
case 1: case 2: case 4:
case -1: case -2: case -4:
RETVAL = OCIAttrGet(trgthndlp, trghndltyp, (void*)&b4_val, 0, attrtype, errhp);
if (RETVAL==OCI_SUCCESS || RETVAL==OCI_SUCCESS_WITH_INFO) {
switch (ptr_len) {
case 1: sv_setiv(attributep_sv, (IV)*((ub1*)&b4_val)); break;
case -1: sv_setiv(attributep_sv, (IV)*((sb1*)&b4_val)); break;
case 2: sv_setiv(attributep_sv, (IV)*((ub2*)&b4_val)); break;
case -2: sv_setiv(attributep_sv, (IV)*((sb2*)&b4_val)); break;
case 4: sv_setuv(attributep_sv, (UV)*((ub4*)&b4_val)); break;
case -4: sv_setiv(attributep_sv, (IV)*((sb4*)&b4_val)); break;
}
if (bless) {
SV *rv = newRV(sv_mortalcopy(attributep_sv));
HV * bless_stash = gv_stashpv(bless, 0);
if (!bless_stash) {
if (strlen(bless) < 6 || strnNE(bless,"OCI",3)
|| strnNE(&bless[strlen(bless)-3],"Ptr",3))
warn("OCIAttrGet '%s' doesn't look like an OCI*Ptr type name",bless);
bless_stash = gv_stashpv(bless, GV_ADD);
}
sv_bless(rv, bless_stash);
sv_setsv(attributep_sv, rv);
}
}
else SvOK_off(attributep_sv);
break;
case 0:
RETVAL = OCIAttrGet(trgthndlp, trghndltyp, &ptr, &sizep, attrtype, errhp);
if (RETVAL==OCI_SUCCESS || RETVAL==OCI_SUCCESS_WITH_INFO) {
/* OCIAttrGet may set ptr to null, sv_setpvn() treats that as undef */
sv_setpvn(attributep_sv, ptr, sizep);
if (!SvREADONLY(sizep_sv)) {
sv_setiv(sizep_sv, sizep);
SvSETMAGIC(sizep_sv); /* redundant */
}
}
else SvOK_off(attributep_sv);
break;
default:
croak("Invalid pointer width '%s' for OCIAttrGet", SvPV(result_type,lna));
}
if (RETVAL != OCI_SUCCESS || debug) {
char *q = SvOK(attributep_sv) ? "'" : "";
warn(" %s returned %s %s%s%s", "OCIAttrGet", oci_status_name(RETVAL),
q, *q ? SvPV(attributep_sv,lna) : "undef", q);
}
ST(0) = sv_newmortal();
sv_setiv(ST(0), (IV)RETVAL);
}