Listing 1
/*
* oci.xs -- Perl/Oracle XSUBs
*
* by Danny Lawrence
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
static double
constant(name, arg)
char *name;=7F
int arg;
{
errno = ENOENT;
return 0;
}
#define ORA_EOF 1403 /* csrarc return value */
#define ORA_EOL 1007 /* variable not in select list */
#define FT_SELECT 4 /* value in ft field if stmt is select */
#define EXT_ASCIIZ 5 /* external null-terminated data type */
#define BIND_NULL (-1) /* indicator val for null fetches */
#ifndef min
#define min(a,b) ((a)<(b)?(a):(b))
#endif
#ifdef ORACLE7
#include
#else
typedef signed short sb2;
typedef unsigned short ub2;
typedef unsigned int ub4;
typedef unsigned char ub1;
typedef signed int sword;
typedef char text;
/* V6 cursor
* Adapted from ORACLE_HOME/c/demo/sample.c and Pro*C User's Guide Version
1.1
*/
struct cda_def {
sb2 v2_rc; /* return code */
ub2 ft; /* function type */
ub4 rpc; /* rows processed count */
ub2 peo; /* parse error offset */
ub1 fc; /* function code */
ub1 rcs1; /* filler */
ub2 rc; /* reserved, private */
ub1 wrn; /* warning flags */
ub1 rcs2; /* error flags */
sword rcs3; /* cursor number */
struct { /* rowid structure */
struct {
ub4 rcs4; /* rba of first block of table */
ub2 rcs5; /* partition id of table */
ub1 rcs6; /* table id of table */
} rd;
ub4 rcs7; /* rba of datablock */
ub2 rcs8; /* sequence number of row in bock */
} rid;
sword ose; /* os dependent error code */
ub1 chk; /* check byte */
ub1 rcs9[26]; /* private, reserved fill */
};
/* prototypes for V6 functions */
int olon(struct cda_def *lda, text *uid, sword uidlen, text *psw, sword
pswl,
sword audit);
int oopen(struct cda_def *cursor, struct cda_def *lda, text *dbn,
sword dbnlen, sword areasize, text *uid, sword uidlen);
int osql3(struct cda_def *cursor, text *sqlstatement, sword sqllen);
int odsc(struct cda_def *cursor, sword position, sb2 *dbsize,
sb2 *fsize, sb2 *rcode, sb2 *dbtype, text *cbuf, sb2 *cbufl,
sb2 *dsize);
int odefin(struct cda_def *cursor, sword pos, ub1 *buffer, sword bufl,
sword ftype, sword scale, sb2 *indp, text *fmt, sword fmtl,
sword fmtt, ub2 *retl, ub2 *rcode);
int obndrv(struct cda_def *cursor, text *sqlvar, sword sqlvl, ub1 *progvar,
sword progvl, sword ftype, sword scale, sb2 *indp, text *fmt,
sword fmtl, sword fmtt);
int oexec(struct cda_def *cursor);
int ofetch(struct cda_def *cursor);
int ocan(struct cda_def *cursor);
int ocom(struct cda_def *lda);
int orol(struct cda_def *lda);
int oermsg(ub2 rcode, text *msgbuf);
int oclose(struct cda_def *cursor);
int ologof(struct cda_def *lda);
#endif /* ORACLE7 */
/* linked list node for select lists and bind lists */
typedef struct node {
struct node *next; /* next node in list */
text *buf; /* oracle field i/o buf */
sb2 bufsize; /* allocated size of buf */
sb2 ind; /* null indicator */
ub2 retl; /* ofetch actual length @@@*/
ub2 rcode; /* ofetch return code */
text *var; /* name of substitution var */
SV *ref; /* perl reference var */
} NODE;
typedef struct {
struct cda_def cur;
NODE *sfirst; /* first NODE in select list */
NODE *slast; /* last NODE in select list */
NODE *bfirst; /* first NODE in bind list */
NODE *blast; /* last NODE in bind list */
} CURSOR;
static struct cda_def lda; /* oracle logon data area */
#ifdef ORACLE7
static ub1 hda[256];
#endif
static CURSOR *new_cursor()
{
CURSOR *c;
New(0, c, 1, CURSOR);
c->sfirst = c->slast = NULL;
c->bfirst = c->blast = NULL;
return c;
}
static NODE *new_node(sb2 size)
{
NODE *p;
New(0, p, 1, NODE);
New(0, p->buf, size, text);
p->bufsize = size;
p->ind = 0;
p->retl = 0;
p->rcode = 0;
p->var = NULL;
p->ref = NULL;
p->next = NULL;
return p;
}
static void free_node(NODE *p)
{
Safefree(p->buf);
if (p->var)
Safefree(p->var);
if (p->ref)
SvREFCNT_dec(p->ref);
Safefree(p);
}
static void free_list(NODE *p)
{
NODE *prev = NULL;
for (; p; p = p->next) {
if (prev)
free_node(prev);
prev = p;
}
if (prev)
free_node(prev);
}
static void free_cursor(CURSOR *c)
{
free_list(c->sfirst);
free_list(c->bfirst);
Safefree(c);
}
static void set_oerr(int n)
{
char buf[133];
SV *p;
p = perl_get_sv("Oci::oerr", TRUE);
if (p)
sv_setnv(p, (double) n);
p = perl_get_sv("Oci::oermsg", TRUE);
if (p) {
oermsg(n, buf);
sv_setpv(p, buf);
}
}
static int build_slist(CURSOR *c, char *stmt)
{
sb2 displaysize;
sword pos;
NODE *p;
for (pos = 1; ;pos++) {
odsc(&c->cur, pos, (sb2 *)0, (sb2 *)0, (sb2 *)0, (sb2 *)0,
(text *)0, (sb2 *)0, &displaysize);
if (c->cur.rc == ORA_EOL)
break;
if (c->cur.rc != 0) {
set_oerr(c->cur.rc);
return c->cur.rc;
}
p = new_node(displaysize+1); /* +1 for \0 */
if (c->sfirst == NULL)
c->sfirst = p;
else
c->slast->next = p;
c->slast = p;
odefin(&c->cur, pos, p->buf, displaysize+1,
(sword)EXT_ASCIIZ, (sword)-1, &p->ind, (text *)0,
(sword)-1, (sword)-1, &p->retl, &p->rcode);
if (c->cur.rc != 0) {
set_oerr(c->cur.rc);
return c->cur.rc;
}
}
return 0;
}
static int bind_vars(CURSOR *c) /* bind oracle vars to node buffers */
{
NODE *p;
for (p = c->bfirst; p; p = p->next) {
/* if node is a reference, copy current value of
* referenced var to buf
*/
if (p->ref != NULL) {
strncpy(p->buf, SvPV(SvRV(p->ref), na), p->bufsize);
p->buf[p->bufsize-1] = '\0';
}
obndrv(&c->cur, p->var, (sword)-1, p->buf, (sword) p->bufsize,
(sword)EXT_ASCIIZ, (sword)-1, (sb2 *)0, (text *)0, (sword)-1,
(sword)-1);
if (c->cur.rc != 0)
return c->cur.rc;
}
return 0;
}
static void copy_back(CURSOR *c) /* copy node buffers to referenced vars
*/
{
NODE *p;
/* for every node that has a referenced var, set var to buf */
for (p = c->bfirst; p; p = p->next)
if (p->ref)
sv_setpv(SvRV(p->ref), p->buf);
}
MODULE = Oci PACKAGE = Oci
double
constant(name,arg)
char * name
int arg
#-----------------------------------------------------------
# connect
#
int
oraconnect(connect_string, pwd="")
char * connect_string
char * pwd
CODE:
{
#ifdef ORACLE7
olog(&lda, hda,
(text *)connect_string, (sword)-1,
(text *)pwd, (sword)-1,
(text *)0, (sword)-1,
(ub4) OCI_LM_DEF);
#else
olon(&lda, (text *)connect_string, (sword)-1, (text *)pwd, (sword)-1,
(sword)-1);
#endif
RETVAL = (lda.rc == 0);
set_oerr(lda.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# disconnect
#
int
oradisconnect()
CODE:
{
ologof(&lda);
RETVAL = (lda.rc == 0);
set_oerr(lda.rc);=7F
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# cursor -- create cursor for statement
#
void
oracursor(stmt,areasize=-1)
char * stmt
int areasize
PPCODE:
{
CURSOR *c;
set_oerr(0);
c = new_cursor();
oopen(&c->cur, &lda, (text *)0, (sword)-1, (sword)areasize, (text *)0,
(sword)-1);
if (c->cur.rc != 0) {
XPUSHs(sv_2mortal(newSVnv(0)));
set_oerr(c->cur.rc);
free_cursor(c);
return;
}
osql3(&c->cur, (text *)stmt, (sword)-1);
if (c->cur.rc != 0) {
XPUSHs(sv_2mortal(newSVnv(0)));
set_oerr(c->cur.rc);
oclose(&c->cur);
free_cursor(c);
return;
}
if (c->cur.ft == FT_SELECT)
if (build_slist(c, stmt)) {
XPUSHs(sv_2mortal(newSVnv(0)));
oclose(&c->cur);
free_cursor(c);
return;
}
EXTEND(sp, 2);
PUSHs(sv_2mortal(newSVnv(1)));
PUSHs(sv_newmortal());
sv_setref_pv(ST(1), "CURSORPtr", (void *) c);
}
#-----------------------------------------------------------
# oraexec -- execute PL/SQL block
#
int
oraexec(c)
CURSOR * c
CODE:
{=7F
if (bind_vars(c) == 0)
if (oexec(&c->cur) == 0) {
copy_back(c);
ocan(&c->cur);=7F
}
RETVAL = (c->cur.rc == 0);
set_oerr(c->cur.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# bind
#
int
orabind(c, var, val, len=0)
CURSOR * c
char * var
char * val
int len
CODE:
{
NODE *p;
SV *sv;
RETVAL = 1;
set_oerr(0);
/* determine len if not specified */
if (len == 0) {
if (SvROK(ST(2))) {
sv = SvRV(ST(2));
if (SvPOK(sv))
len = SvLEN(sv);
else {
set_oerr(20000);
RETVAL = 0;
goto skip_it;
}
} else
len = strlen(val);
}
/* look for existing entry with same var name */
for (p = c->bfirst; p; p = p->next)
if (strEQ(p->var, var))
break;
/* if no matching entry exists, add new node to list */
if (p == NULL) {
p = new_node(len+1); /* +1 for \0 */
New(0, p->var, strlen(var)+1, text);
strcpy(p->var, var);
if (c->bfirst == NULL)
c->bfirst = p;
else
c->blast->next = p;
c->blast = p;
}
/* make sure buffer is big enough */
if (len+1 > p->bufsize) {
Renew(p->buf, len+1, text);
p->bufsize = len + 1;
}
/* set entry to val or reference */
if (p->ref)
SvREFCNT_dec(p->ref);
if (SvROK(ST(2))) {
p->ref = ST(2);
SvREFCNT_inc(ST(2));
SvGROW(SvRV(ST(2)), len);
} else {
strncpy(p->buf, val, min(len, strlen(val)));
p->buf[len] = '\0';
p->ref = NULL;
}
skip_it:
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# open
#
int
oraopen(c)
CURSOR * c
CODE:
{
if (bind_vars(c) == 0)
oexec(&c->cur);
RETVAL = (c->cur.rc == 0);
set_oerr(c->cur.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# fetch
#
void
orafetch(c)
CURSOR * c
PPCODE:
{
NODE *p;
ofetch(&c->cur);
if (c->cur.rc != 0) {
set_oerr(c->cur.rc);
XPUSHs(sv_2mortal(newSVnv(0)));
} else {
XPUSHs(sv_2mortal(newSVnv(1)));
for (p = c->sfirst; p; p = p->next) {
if (p->ind == BIND_NULL)
p->buf[0] = '\0';
XPUSHs(sv_2mortal(newSVpv(p->buf, strlen(p->buf))));
}
}
}
#-----------------------------------------------------------
# close
#
int
oraclose(c)
CURSOR * c
CODE:
{
ocan(&c->cur);
RETVAL = (c->cur.rc == 0);
set_oerr(c->cur.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# commit
#
int
oracommit()
CODE:
{
ocom(&lda);
RETVAL = (lda.rc == 0);
set_oerr(lda.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
# rollback
#
int
orarollback()
CODE:
{
orol(&lda);
RETVAL = (lda.rc == 0);
set_oerr(lda.rc);
}
OUTPUT:
RETVAL
#-----------------------------------------------------------
MODULE = Oci PACKAGE = CURSORPtr
void
DESTROY(c)
CURSOR * c
CODE:
{
if (c != (CURSOR *) &sv_undef) {
oclose(&c->cur);
free_cursor(c);
}
}
|
