home *** CD-ROM | disk | FTP | other *** search
- /* oracle.mus
- *
- * User subroutine interface to Oracle functions
- */
- /* Copyright 1991 Kevin Stock.
- *
- * You may copy this under the terms of the GNU General Public License,
- * a copy of which should have accompanied your Perl kit.
- */
-
- #include "EXTERN.h"
- #include "perl.h"
- #include "orafns.h"
-
-
- static enum uservars {
- #ifdef DEBUGGING
- UV_ora_debug,
- #endif
- UV_ora_errno,
- UV_ora_errstr,
- };
-
- static enum usersubs {
- US_ora_login,
- US_ora_open,
- US_ora_fetch,
- US_ora_close,
- US_ora_logoff,
- };
-
- static int usersub();
- static int userset();
- static int userval();
-
- int
- init_oracle()
- {
- struct ufuncs uf;
- char *filename = "oracle.c";
-
- uf.uf_set = userset;
- uf.uf_val = userval;
-
- #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
-
- #ifdef DEBUGGING
- MAGICVAR("ora_debug", UV_ora_debug);
- #endif
- MAGICVAR("ora_errno", UV_ora_errno);
- MAGICVAR("ora_errstr", UV_ora_errstr);
-
- make_usub("ora_login", US_ora_login, usersub, filename);
- make_usub("ora_open", US_ora_open, usersub, filename);
- make_usub("ora_fetch", US_ora_fetch, usersub, filename);
- make_usub("ora_close", US_ora_close, usersub, filename);
- make_usub("ora_logoff", US_ora_logoff, usersub, filename);
- };
-
-
- static int
- usersub(ix, sp, items)
- int ix;
- register int sp;
- register int items;
- {
- STR **st = stack->ary_array + sp;
- register int i;
- register char *tmps;
- register STR *Str; /* used in str_get and str_gnum macros */
-
- switch (ix) {
-
- CASE char * ora_login
- I char * database
- I char * name
- I char * password
- END
-
- CASE char * ora_open
- I char * lda
- I char * stmt
- END
-
- case US_ora_fetch:
- if (items != 1)
- fatal("Usage: @array = &ora_fetch($csr)");
- else {
- char *csr = (char *) str_get(st[1]);
-
- if (curcsv->wantarray) { /* in array context, return the data */
- int retval;
- char *tmps;
-
- retval = ora_fetch(csr);
- astore(stack, sp + retval, Nullstr);
- st = stack->ary_array + sp;
- for (i = 0 ; i < retval ; i++) {
- tmps = ora_result[i];
- st[i] = str_2mortal(str_make(tmps, strlen(tmps)));
- }
- return sp + retval - 1;
- } else { /* in scalar context, return the number of fields */
- struct cursor *csrp;
- extern int check_csr();
-
- csrp = (struct cursor *) strtol(csr, (char *) NULL, 0);
- if (check_csr(csrp))
- str_numset(st[0], (double) csrp->nfields);
- else
- str_set(st[0], (char *) NULL);
- return sp;
- }
- }
- /* NOTREACHED */
-
- CASE char * ora_close
- I char * csr
- END
-
- CASE char * ora_logoff
- I char * lda
- END
-
- default:
- fatal("Unimplemented user-defined subroutine");
- }
- return sp;
- }
-
-
- static int
- userset(ix, str)
- int ix;
- STR *str;
- {
- switch (ix) {
- #ifdef DEBUGGING
- case UV_ora_debug:
- ora_debug = (int)str_gnum(str);
- break;
- #endif
-
- case UV_ora_errno:
- fatal("ora_errno is read-only");
- break;
-
- case UV_ora_errstr:
- fatal("ora_errstr is read-only");
- break;
- }
- return 0;
- }
-
-
- static int
- userval(ix, str)
- int ix;
- STR *str;
- {
- switch (ix) {
- #ifdef DEBUGGING
- case UV_ora_debug:
- str_numset(str, (double) ora_debug);
- break;
- #endif
-
- case UV_ora_errno:
- str_numset(str, (double) ora_errno);
- break;
-
- case UV_ora_errstr:
- {
- int len;
- char ertxt[132];
-
- if (ora_errno < ORAP_ERRMIN)
- {
- oermsg(ora_errno, ertxt);
- if (ertxt[len = (strlen(ertxt) - 1)] == '\n')
- {
- ertxt[len] = '\0';
- }
- str_set(str, ertxt);
- }
- else
- {
- switch (ora_errno)
- {
- case ORAP_NOMEM:
- str_set(str, "insufficient memory");
- break;
-
- case ORAP_INVCSR:
- str_set(str, "invalid cursor");
- break;
-
- case ORAP_INVLDA:
- str_set(str, "invalid login data area");
- break;
-
- case ORAP_NOSID:
- str_set(str, "couldn't set ORACLE_SID");
- break;
-
- default:
- {
- char tmp[30];
-
- sprintf(tmp, "unknown oraperl error %d",
- ora_errno);
- str_set(str, tmp);
- }
- }
- }
- }
- break;
- }
- return 0;
- }
-