/*********************************************************************************
 * Package   : c-sqld-oracle.c
 * Author    : Hans Oesterholt-Dijkema.
 * Copyright : HOD 2004/2005.
 * License   : The Elemental Programming Artistic License.
 * CVS       : $Id: c-sqld-oracle.c,v 1.14 2006/01/08 20:14:32 HansOesterholt Exp $
 *********************************************************************************/

/* We're not yet changing the Oracle Driver to use threads with mzscheme 
 * It looks like this driver will handle mzscheme threads just fine. 
 * The query/fetch model is completely different from postgresql or sqlite.
 */

#include "sqlid.h"

#ifdef MZSCHEME
#include <escheme.h>
#include "c-threads.c"
#endif

#include <sqlora.h>
#include <ctype.h>
#include <string.h>

#ifdef BIGLOO
#include <bigloo.h>
#endif

#define DEBUG 0

#if (DEBUG==1)
#include <stdarg.h>
static
void dbg(const char *format,...)
{
  va_list ap;
  va_start(ap,format);
  vprintf(format,ap);
  va_end(ap);
  fflush(stdout);
}
#define LOG(a)   dbg("%s:%s[%d]",__FILE__,__FUNCTION__,__LINE__);a;dbg("\n");
#else
#define LOG(a)
#endif
#define DBG(a)   LOG(a)


/***************************************************************
 * Some contants
 ***************************************************************/

#define MAX_OPEN_DB_CONNECTIONS          1024
#define MAX_OPEN_CURSORS_PER_CONNECTION  1024
#define STRIP_RESULT_STRINGS             1
#define TYPE_CONNECTION                  1
#define TYPE_CONNECT                     TYPE_CONNECTION
#define TYPE_QUERY                       2

/***************************************************************
 * typedefs
 ***************************************************************/

typedef struct {
  int                type;
  sqlo_stmt_handle_t sth;
  char             **errorMsg;
  unsigned int       prows;
  char             **values;
  unsigned short    *lens;
  int                fetch_result;
  int                columns;
} oracle_query_t;

typedef struct {
  int              type;
  sqlo_db_handle_t dbh;
  char            *errorMsg;
  oracle_query_t  *current_associated_query;
  char            *empty_string;
} oracle_connect_t;

/***************************************************************
 * supportive functions
 ***************************************************************/

#ifndef MZSCHEME

static
void *scheme_malloc(int size)
{
  return GC_MALLOC(size);
}
#endif

static 
char *gc_strdup(const char *s)
{
  char *r;
  r=(char *) scheme_malloc(strlen(s)+1);
  strcpy(r,s);
  return r;
}

/***************************************************************
 * Library functions for this driver
 ***************************************************************/

static
sqlo_stmt_handle_t (*mysqlo_open) __P((sqlo_db_handle_t dbh, 
				       CONST char * stmt, 
				       int argc, 
				       CONST char ** argv));


static
int (*mysqlo_fetch) __P((sqlo_stmt_handle_t sth, unsigned int nrows));


static
int (*mysqlo_ncols) __P((sqlo_stmt_handle_t sth, int in));

static
CONST char ** (*mysqlo_values) __P(( sqlo_stmt_handle_t sth, int * num, int dostrip ));

static
CONST unsigned short * (*mysqlo_value_lens) __P(( sqlo_stmt_handle_t sth, int * num));

static
int (*mysqlo_connect) __P(( sqlo_db_handle_t * dbhp, CONST char * cstr ));

static
int (*mysqlo_close) __P(( sqlo_stmt_handle_t sth ));

static
int (*mysqlo_finish) __P((sqlo_db_handle_t dbh ));

static
int (*mysqlo_open2) __P((sqlo_stmt_handle_t * sthp, 
			 sqlo_db_handle_t dbh, 
			 CONST char * stmt, 
			 int argc, 
			 CONST char ** argv));

static
CONST char * (*mysqlo_geterror) __P(( sqlo_db_handle_t dbh ));

static
int (*mysqlo_prows) __P(( sqlo_stmt_handle_t sth ));

static
int (*mysqlo_set_autocommit) __P((sqlo_db_handle_t dbh, int on));

static
int (*mysqlo_server_version) __P((sqlo_db_handle_t dbh, char *bufp, unsigned int buflen));

static
int (*mysqlo_init) __P((int threaded_mode, unsigned int max_db, unsigned int max_cursors));

#ifdef WIN32
static
void *myGetProcAddress(HINSTANCE lib,char *func)
{
  void *p=GetProcAddress(lib,func);
  DBG(printf("got %p for %s",p,func));
  if (p==NULL) {
    scheme_signal_error("Cannot runtime link function %s from sqlora8.dll",func);
  }
  return p;
}
#define DFUNC(f)  #f
#define LA(l,g,f) (void *) g = (void *) myGetProcAddress(l,DFUNC(f))
#else
#define LA(l,g,f) g=f
#endif


static
void initializeSQLORA8(void) {
  static int initialized=0;
  if (!initialized) {
#ifdef WIN32
    HINSTANCE lib;
    lib=LoadLibrary("sqlora8.dll");
    if (lib!=NULL) {
#else
      void *lib=NULL;
#endif
      LA(lib,mysqlo_open,sqlo_open);
      LA(lib,mysqlo_fetch,sqlo_fetch);
      LA(lib,mysqlo_ncols,sqlo_ncols);
      LA(lib,mysqlo_values,sqlo_values);
      LA(lib,mysqlo_value_lens,sqlo_value_lens);
      LA(lib,mysqlo_connect,sqlo_connect);
      LA(lib,mysqlo_close,sqlo_close);
      LA(lib,mysqlo_finish,sqlo_finish);
      LA(lib,mysqlo_open2,sqlo_open2);
      LA(lib,mysqlo_geterror,sqlo_geterror);
      LA(lib,mysqlo_prows,sqlo_prows);
      LA(lib,mysqlo_set_autocommit,sqlo_set_autocommit);
      LA(lib,mysqlo_server_version,sqlo_server_version);
      LA(lib,mysqlo_init,sqlo_init);
#ifdef WIN32
    }
    else {
      scheme_signal_error("Cannot initialize ORACLE Driver, sqlora8.dll or OCI.dll not found");
    }
#endif

    mysqlo_init(SQLO_ON,MAX_OPEN_DB_CONNECTIONS,MAX_OPEN_CURSORS_PER_CONNECTION);

    initialized=1;
  }
}

/***************************************************************
 * Driver functions for oracle interfacing
 ***************************************************************/

static
int fetch(oracle_query_t *q)
{
  q->fetch_result=mysqlo_fetch(q->sth,1);
  if (q->fetch_result<0 || q->fetch_result==SQLO_NO_DATA) {
    q->values=NULL;
    q->lens=NULL;
  }
  else if (mysqlo_ncols(q->sth,0)<=0) {
    q->values=NULL;
    q->lens=NULL;
    q->fetch_result=SQLO_NO_DATA;
  }
  else  {
    const char **values;
    const unsigned short *lens;

    values=mysqlo_values(q->sth,&q->columns,STRIP_RESULT_STRINGS);
    lens=mysqlo_value_lens(q->sth,NULL);
    
    {
      int i,N=q->columns;

      q->values=scheme_malloc(sizeof(char *)*N);
      q->lens=scheme_malloc(sizeof(unsigned short)*N);

      for(i=0;i<N;i++) {
	char *buf=scheme_malloc(lens[i]+1);
	strncpy(buf,values[i],lens[i]);
	buf[lens[i]]='\0';

	q->values[i]=buf;
	q->lens[i]=lens[i];
      }
    }
  }

  return q->fetch_result;
}

static
oracle_connect_t *oracle_open(const char *connection_string)
{
  oracle_connect_t *h=scheme_malloc(sizeof(oracle_connect_t));

  LOG(dbg("h=%p",h));

  h->type=TYPE_CONNECTION;
  h->empty_string=gc_strdup("");

  if (strlen(connection_string)==0) {
    connection_string="_";
  }

  if (SQLO_SUCCESS!=mysqlo_connect(&h->dbh,connection_string)) {
    char *msg=scheme_malloc(strlen(connection_string)+100);
    sprintf(msg,
	    "c-sqld-oracle: cannot connect and/or login with '%s'",
	    connection_string
	    );

    h->errorMsg=msg;
  }
  else {
    h->errorMsg=h->empty_string;
  }

  LOG(dbg("h->dbh=%d, h->errorMsg=%s",h->dbh,h->errorMsg));

  h->current_associated_query=NULL;

  LOG(dbg("h->current_associated_query=%p",h->current_associated_query));

  return h;
}

static
void oracle_close(oracle_connect_t *h)
{
  if (h->current_associated_query!=NULL) {
    oracle_query_t *q=h->current_associated_query;
    mysqlo_close(q->sth);
    h->current_associated_query=NULL;
  }
  
  mysqlo_finish(h->dbh);
}



#define allocate        scheme_malloc
#define a_strdup(a,s)   a=gc_strdup(s)

static
oracle_query_t *oracle_query(oracle_connect_t *h,char *_query)
{
  oracle_query_t *q;
  int ok,end,i,N,in_string,k,dotcomma;
  char *query=strdup(_query);

  LOG(dbg("1"));
  if (h->current_associated_query!=NULL) {
    q=h->current_associated_query;
    mysqlo_close(q->sth);
    h->current_associated_query=NULL;
  }

  LOG(dbg("2"));
  q=(oracle_query_t *) allocate(sizeof(oracle_query_t));
  q->type=TYPE_QUERY;
  q->sth=SQLO_STH_INIT;
  q->errorMsg=&h->errorMsg;

  /* We're able to process ';' in queries? Yes, but not between single quotes! */

  LOG(dbg("3"));
  end=(1==0);ok=(1==1);k=i=0;in_string=(1==0);
  for(N=strlen(query)-1;N>=0 && (isspace(query[N]) || query[N]==';');N--);
  N+=1;
  if (N<=0) { 
    end=(1==1); 
    ok=(1==0);
    a_strdup(h->errorMsg,"Empty query given");
    q->fetch_result=-1;
  }

  LOG(dbg("4 (N=%d,i=%d,ok=%d,end=%d)",N,i,ok,end));
  while (ok && !end) {
    for(;i<N && !(query[i]==';' && !in_string) && query[i]!='\0';i++) {
      if (query[i]=='\'') { in_string=!in_string; }
    }
    
    if (i==N) { end=(1==1); }

    dotcomma=(query[i]==';');

    LOG(dbg("4a: i=%d,N=%d,end=%d,query=%s",i,N,end,query));

    query[i]='\0';

    LOG(dbg("5"));
    if (mysqlo_open2(&q->sth,h->dbh,&query[k],0,NULL)<0) {
      a_strdup(h->errorMsg,mysqlo_geterror(h->dbh));
      ok=(1==0);
    }
    else {
      h->errorMsg=h->empty_string;
    }

    LOG(dbg("6"));
    if (ok) {
      if (fetch(q)<0) {
	a_strdup(h->errorMsg,mysqlo_geterror(h->dbh));
	ok=(1==0);
      }
    }

    LOG(dbg("7"));
    if (!end) { 
      if (dotcomma) { query[i]=';'; }
      if (ok) { 
	mysqlo_close(q->sth); 
      }
      i+=1;
    }
    k=i;
  }

  LOG(dbg("8"));
  if (ok) {
    q->prows=mysqlo_prows(q->sth);
    h->current_associated_query=q;
  }
  else {
    q->prows=-1;
    h->current_associated_query=NULL;
  }

  LOG(dbg("9"));

  free(query);

  return q;
}

static
int oracle_prows(oracle_query_t *q)
{
  return q->prows;
}

static
int oracle_eoq(oracle_query_t *q)
{
  return q->fetch_result!=SQLO_SUCCESS;
}

static 
char *oracle_dbh_lasterr(oracle_connect_t *h)
{
  return h->errorMsg;
}

static
char *oracle_sth_lasterr(oracle_query_t *q)
{
  return q->errorMsg[0];
}

static
int oracle_columns(oracle_query_t *q)
{
  return q->columns;
}

static
oracle_query_t * oracle_fetch(oracle_query_t *q)
{
  if (q->fetch_result==SQLO_SUCCESS) {
    fetch(q);
  }
  return q;
}

static
char *oracle_field(oracle_query_t *q,int c)
{
  int N=q->columns;
  if (c>=N) { 
    return NULL; 
  }
  else {
    return q->values[c];
  }
}

static
int oracle_autocommit(oracle_connect_t *h,int on)
{
  int result;
  LOG(dbg("h=%p,on=%d",h,on));
  if (on) {
    result=mysqlo_set_autocommit(h->dbh,SQLO_ON);
  }
  else { 
    result=mysqlo_set_autocommit(h->dbh,SQLO_OFF);
  }
  LOG(dbg("result=%d",result));
  if (result<0) {
    h->errorMsg=gc_strdup(mysqlo_geterror(h->dbh));
  }
  else {
    h->errorMsg=h->empty_string;
  }
  LOG(dbg("msg=%s",h->errorMsg));
  return result==SQLO_SUCCESS;
}

static
char *oracle_escape(char *s)
{
  char *S;
  int   N,extend,i,k;

  /* Determine needed length */

  for(i=0,N=strlen(s),extend=2;i<N;i++) {
    if (s[i]=='\'') { extend+=1; }
  }

  /* Escape */

  S=(char *) scheme_malloc(N+extend+1);
  S[0]='\'';
  for(i=0,k=1;i<N;i++,k++) {
    if (s[i]=='\'') { S[k++]='\''; }
    S[k]=s[i];
  }
  S[k++]='\'';
  S[k]='\0';

  /* return made string */

  return S;
}

static
int oracle_version(void)
{
  return SQLORA8_MAJOR_VERSION*10000+
    SQLORA8_MINOR_VERSION*100+
    SQLORA8_MICRO_VERSION;
}

static
char *oracle_server_version(oracle_connect_t *c)
{
  char *buf=(char *) scheme_malloc(1024);
  memset(buf,0,1024);
  mysqlo_server_version(c->dbh,buf,1023);
  return buf;
}

static
int handle_type(void *handle)
{
  return ((oracle_connect_t *) handle)->type;
}

/***************************************************************
 * BIGLOO implementation
 ***************************************************************/

#ifdef BIGLOO

void *c_oracle_open(char *cs)
{
  static int do_init=1;  /* This is not thread safe! */

  if (do_init) { 
    do_init=0;
    initializeSQLORA8();
  }
  
  return (void *) oracle_open(cs);
}

void *c_oracle_close(void *c)
{
  oracle_close((oracle_connect_t *) c);
  return NULL;
}

void *c_oracle_query(void *c,char *q)
{
  return (void *) oracle_query((oracle_connect_t *) c,q);
}

int c_oracle_prows(void *q)
{
  return oracle_prows((oracle_query_t *) q);
}

char *c_oracle_lasterr(void *q)
{
  if (handle_type(q)==TYPE_CONNECT) {
    LOG(dbg("c_oracle_lasterr: oracle_dbh_lasterr, h->errorMsg=%s",
	    ((oracle_connect_t *) q)->errorMsg));
    return oracle_dbh_lasterr(q);
  }
  else {
    LOG(dbg("c_oracle_lasterr: oracle_sth_lasterr, h->errorMsg=%s",
	    ((oracle_query_t *) q)->errorMsg));
    return oracle_sth_lasterr(q);
  }
}

int c_oracle_eoq(void *q)
{
  return oracle_eoq((oracle_query_t *) q);
}

int c_oracle_columns(void *q)
{
  return oracle_columns((oracle_query_t *) q);
}

void *c_oracle_fetch(void *q)
{
  return (void *) oracle_fetch((oracle_query_t *) q);
}

char *c_oracle_field(void *q,int c)
{
  return oracle_field((oracle_query_t *) q,c);
}

int c_oracle_autocommit_on(void *h)
{
  return oracle_autocommit((oracle_connect_t *) h,1);
}

int c_oracle_autocommit_off(void *h)
{
  return oracle_autocommit((oracle_connect_t *) h,0);
}

char *c_oracle_escape(char *s)
{
  return oracle_escape(s);
}

int c_oracle_version(void)
{
  return oracle_version();
}

char *c_oracle_server_version(void *h)
{
  return oracle_server_version((oracle_connect_t *) h);
}

#endif

/***************************************************************
 * MZScheme implementation
 ***************************************************************/

#ifdef MZSCHEME

#ifndef SCHEME_STR_VAL /* This is mzscheme 30x */
#  define MZSCHEME3
#  define SCHEME_STR_VAL(obj) SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(obj))
#  define EQ_CTYPE(cobj,type) (SCHEME_CPTR_TYPE(cobj)==type)
#  define NEQ_CTYPE(cobj,type) !(EQ_CTYPE(cobj,type)) 
#  define IS_STRINGP(obj)  SCHEME_CHAR_STRINGP(obj)
#else /* this is mzscheme 20x */
#  define EQ_CTYPE(cobj,type) strcmp(SCHEME_CPTR_TYPE(cobj),type)==0
#  define NEQ_CTYPE(cobj,type) !(EQ_CTYPE(cobj,type)) 
#  define IS_STRINGP(obj)  SCHEME_STRINGP(obj)
#endif

#ifdef MZSCHEME3
static Scheme_Object *oracle_connect_ct=NULL;
static Scheme_Object *oracle_query_ct=NULL;
#else
static char *oracle_connect_ct="oracle_connect_t";
static char *oracle_query_ct="oracle_query_t";
#endif

#define init_types() \
  if (oracle_connect_ct==NULL) { \
    initializeSQLORA8(); \
    oracle_connect_ct=scheme_make_byte_string("oracle_connect_t"); \
    oracle_query_ct=scheme_make_byte_string("oracle_query_t"); \
  } 

static
Scheme_Object *c_oracle_open(int argc,Scheme_Object **argv)
{
  init_types();

  if (!IS_STRINGP(argv[0])) {
    scheme_wrong_type("c-oracle-open","string",0,argc,argv);
  }

  {
    Scheme_Object *obj=scheme_make_cptr(oracle_open(SCHEME_STR_VAL(argv[0])),
					oracle_connect_ct);
    /*LOG(dbg("obj=%p,%s",obj,SCHEME_CPTR_TYPE(obj)));*/
    return obj;
  }
}

static
Scheme_Object *c_oracle_close(int argc,Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-close","oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-close","oracle_connect_t",0,argc,argv);
  }

  oracle_close(SCHEME_CPTR_VAL(argv[0]));
  return scheme_void;
}


static
Scheme_Object *c_oracle_query(int argc,Scheme_Object **argv)
{
  oracle_query_t *res;

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-query","oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-query","oracle_connect_t",0,argc,argv);
  }
  if (!IS_STRINGP(argv[1])) {
    scheme_wrong_type("c-oracle-query","string",1,argc,argv);
  }

  {
    oracle_query_t *res=oracle_query(SCHEME_CPTR_VAL(argv[0]),SCHEME_STR_VAL(argv[1]));
    return scheme_make_cptr(res,oracle_query_ct);
  }
}

static
Scheme_Object *c_oracle_prows(int argc,Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-prows","oracle_query_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)) {
    scheme_wrong_type("c-oracle-prows","oracle_query_t",0,argc,argv);
  }

  return scheme_make_integer(oracle_prows(SCHEME_CPTR_VAL(argv[0])));
}

static
Scheme_Object *c_oracle_lasterr(int argc,Scheme_Object **argv)
{
  char *msg;

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-lasterr","oracle_query_t/oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)
	   &&
	   NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-lasterr","oracle_query_t/oracle_connect_t",0,argc,argv);
  }

  if (EQ_CTYPE(argv[0],oracle_query_ct)) {
    msg=oracle_sth_lasterr(SCHEME_CPTR_VAL(argv[0]));
  }
  else {
    msg=oracle_dbh_lasterr(SCHEME_CPTR_VAL(argv[0]));
  }

  LOG(dbg("msg=%s",msg));

#ifdef MZSCHEME3
  return scheme_make_utf8_string(msg);
#else
  return scheme_make_string_without_copying(msg);
#endif
}

static
Scheme_Object *c_oracle_eoq(int argc, Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-eoq","oracle_query_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)) {
    scheme_wrong_type("c-oracle-eoq","oracle_query_t",0,argc,argv);
  }

  if (oracle_eoq(SCHEME_CPTR_VAL(argv[0]))) {
    return scheme_true;
  }
  else {
    return scheme_false;
  }
}

static
Scheme_Object *c_oracle_columns(int argc, Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-columns","oracle_query_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)) {
    scheme_wrong_type("c-oracle-columns","oracle_query_t",0,argc,argv);
  }

  return scheme_make_integer(oracle_columns(SCHEME_CPTR_VAL(argv[0])));
}

static
Scheme_Object *c_oracle_fetch(int argc, Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-fetch","oracle_query_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)) {
    scheme_wrong_type("c-oracle-fetch","oracle_query_t",0,argc,argv);
  }

  oracle_fetch(SCHEME_CPTR_VAL(argv[0]));
  return argv[0];
}

static
Scheme_Object *c_oracle_fields(int argc, Scheme_Object **argv)
{
  oracle_query_t *q;

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-field","oracle_query_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_query_ct)) {
    scheme_wrong_type("c-oracle-field","oracle_query_t",0,argc,argv);
  }

  q=SCHEME_CPTR_VAL(argv[0]);

  if (oracle_eoq(q)) {
    return scheme_make_symbol("eoq");
  }
  else {
    int i,N=oracle_columns(q);
    Scheme_Object **list=scheme_malloc(sizeof(Scheme_Object *)*N);
    for(i=0;i<N;i++) {
#ifdef MZSCHEME3
      list[i]=scheme_make_utf8_string(oracle_field(q,i));
#else
      list[i]=scheme_make_string_without_copying(oracle_field(q,i));
#endif
    }
    return scheme_build_list(N,list);
  }
}

static
Scheme_Object *c_oracle_autocommit_on(int argc,Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-autocommit-on","oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-autocommit-on","oracle_connect_t",0,argc,argv);
  }

  if (oracle_autocommit(SCHEME_CPTR_VAL(argv[0]),1)<0) {
    return scheme_false;
  }
  else {
    return scheme_true;
  }
}

static
Scheme_Object *c_oracle_autocommit_off(int argc,Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-autocommit-off","oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-autocommit-off","oracle_connect_t",0,argc,argv);
  }

  if (oracle_autocommit(SCHEME_CPTR_VAL(argv[0]),0)) {
    return scheme_true;
  }
  else {
    return scheme_false;
  }
}

static
Scheme_Object *c_oracle_escape(int argc,Scheme_Object **argv)
{
  if (!IS_STRINGP(argv[0])) {
    scheme_wrong_type("c-oracle-escape","string",0,argc,argv);
  }
#ifdef MZSCHEME3
  return scheme_make_utf8_string(
	      oracle_escape(SCHEME_STR_VAL(argv[0]))
	      );
#else
  return scheme_make_string_without_copying(
              oracle_escape(SCHEME_STR_VAL(argv[0]))
	      );
#endif
}

static
Scheme_Object *c_oracle_version(int argc,Scheme_Object **argv)
{
  return scheme_make_integer(oracle_version());
}

static
Scheme_Object *c_oracle_server_version(int argc,Scheme_Object **argv)
{
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type("c-oracle-query","oracle_connect_t",0,argc,argv);
  }
  else if (NEQ_CTYPE(argv[0],oracle_connect_ct)) {
    scheme_wrong_type("c-oracle-query","oracle_connect_t",0,argc,argv);
  }

#ifdef MZSCHEME3
  return scheme_make_utf8_string(
            oracle_server_version(SCHEME_CPTR_VAL(argv[0]))
	    );
#else
  return scheme_make_string_without_copying(
            oracle_server_version(SCHEME_CPTR_VAL(argv[0]))
	    );
#endif
}

Scheme_Object *scheme_reload(Scheme_Env *env)
{
  Scheme_Env *menv;
  Scheme_Object *proc;

  menv = scheme_primitive_module(scheme_intern_symbol("c-sqld-oracle"),env);

  proc = scheme_make_prim_w_arity(c_oracle_version, "c-oracle-version", 0, 0);
  scheme_add_global("c-oracle-version", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_server_version, "c-oracle-server-version", 1, 1);
  scheme_add_global("c-oracle-server-version", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_open, "c-oracle-open", 1, 1);
  scheme_add_global("c-oracle-open", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_close, "c-oracle-close", 1, 1);
  scheme_add_global("c-oracle-close", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_query, "c-oracle-query", 2, 2);
  scheme_add_global("c-oracle-query", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_fetch, "c-oracle-fetch", 1, 1);
  scheme_add_global("c-oracle-fetch", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_eoq, "c-oracle-eoq", 1, 1);
  scheme_add_global("c-oracle-eoq", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_fields, "c-oracle-fields", 1, 1);
  scheme_add_global("c-oracle-fields", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_prows, "c-oracle-prows", 1, 1);
  scheme_add_global("c-oracle-prows", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_columns, "c-oracle-columns", 1, 1);
  scheme_add_global("c-oracle-columns", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_lasterr, "c-oracle-lasterr", 1, 1);
  scheme_add_global("c-oracle-lasterr", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_autocommit_on, "c-oracle-autocommit-on", 1, 1);
  scheme_add_global("c-oracle-autocommit-on", proc, menv);
  proc = scheme_make_prim_w_arity(c_oracle_autocommit_off, "c-oracle-autocommit-off", 1, 1);
  scheme_add_global("c-oracle-autocommit-off", proc, menv);

  proc = scheme_make_prim_w_arity(c_oracle_escape, "c-oracle-escape", 1, 1);
  scheme_add_global("c-oracle-escape", proc, menv);

  scheme_finish_primitive_module(menv);

  return scheme_void;
}


Scheme_Object *scheme_initialize(Scheme_Env *env)
{
  /* Do we need to register an SIGINT handler here? */

  return scheme_reload(env);
}

Scheme_Object *scheme_module_name(void)
{
  return scheme_intern_symbol("c-sqld-oracle");
}

#endif