/*********************************************************************************
 * Package   : c-sqld-mysql.c
 * Author    : Hans Oesterholt-Dijkema.
 * Copyright : HOD 2004/2005.
 * License   : The Elemental Programming Artistic License.
 * CVS       : $Id: c-sqld-db2.c,v 1.4 2006/01/07 01:37:49 HansOesterholt Exp $
 *********************************************************************************/

#include "sqlid.h"

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

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

//#include <sqlcli.h>
#include <sqlcli1.h>

#define DEBUG 0

#if (DEBUG==1)
#define DBG(a) a
#else
#define DBG(a) 
#endif

/* 
=head1 Name

SQLD-MYSQL - C Part

=head1 Author

Hans Oesterholt-Dijkema

=head1 Copyright/License

(c) 2004 Hans Oesterholt-Dijkema, LGPL.

=head1 Version

$Id: c-sqld-db2.c,v 1.4 2006/01/07 01:37:49 HansOesterholt Exp $
*/

typedef struct {
  SQLHENV        henv;
  SQLHDBC        hdbc;
  SQLHSTMT       hstmt;
  char          *errmsg;
  /*Scheme_Object *errmsg;*/
  int            valid;
  char          *buffer;
  int            buffersize;
} db2_t;

typedef struct {
  db2_t           *handle;
  int              nrows;
  int              nfields;
  Scheme_Object  **fields;
} db2_query_t;


#ifdef WIN32
#define ALLOCA(a)         _alloca(a)
#define FREE_ALLOCA(p)
#else
#define ALLOCA(a)         _alloca(a)
#define FREE_ALLOCA(p)
#endif

static SQLRETURN  (SQL_API_FN *mySQLGetDiagRec) (SQLSMALLINT fHandleType,
				      SQLHANDLE hHandle,
				      SQLSMALLINT iRecNumber,
				      SQLCHAR * pszSqlState,
				      SQLINTEGER * pfNativeError,
				      SQLCHAR * pszErrorMsg,
				      SQLSMALLINT cbErrorMsgMax,
				      SQLSMALLINT * pcbErrorMsg
				      );

static SQLRETURN (SQL_API_FN *mySQLAllocHandle) (SQLSMALLINT fHandleType,
				      SQLHANDLE hInput,
				      SQLHANDLE * phOutput
				      );

static SQLRETURN (SQL_API_FN *mySQLSetEnvAttr)   (SQLHENV            hEnv,
				       SQLINTEGER         fAttribute,
				       SQLPOINTER         pParam,
				       SQLINTEGER         cbParam );

static SQLRETURN (SQL_API_FN *mySQLConnect)      (SQLHDBC           hdbc,
				       SQLCHAR     FAR   *szDSN,
				       SQLSMALLINT       cbDSN,
				       SQLCHAR     FAR   *szUID,
				       SQLSMALLINT       cbUID,
				       SQLCHAR     FAR   *szAuthStr,
				       SQLSMALLINT       cbAuthStr);

static SQLRETURN (SQL_API_FN *mySQLFreeHandle)   (SQLSMALLINT fHandleType,
				       SQLHANDLE hHandle);

static SQLRETURN (SQL_API_FN *mySQLDisconnect)   (SQLHDBC           hdbc);

static SQLRETURN (SQL_API_FN *mySQLSetConnectAttr)(SQLHDBC           hdbc,
					SQLINTEGER        fOption,
					SQLPOINTER        pvParam,
					SQLINTEGER        fStrLen);

static SQLRETURN (SQL_API_FN *mySQLFreeStmt)     (SQLHSTMT          hstmt,
				       SQLUSMALLINT      fOption);

static SQLRETURN (SQL_API_FN *mySQLExecDirect)   (SQLHSTMT          hstmt,
				       SQLCHAR     FAR   *szSqlStr,
				       SQLINTEGER        cbSqlStr);

static SQLRETURN (SQL_API_FN *mySQLNumResultCols)(SQLHSTMT          hstmt,
				       SQLSMALLINT FAR   *pccol);

static SQLRETURN (SQL_API_FN *mySQLFetch)        (SQLHSTMT          hstmt);

static SQLRETURN (SQL_API_FN *mySQLGetData)      (SQLHSTMT          hstmt,
				       SQLUSMALLINT      icol,
				       SQLSMALLINT       fCType,
				       SQLPOINTER        rgbValue,
				       SQLLEN            cbValueMax,
				       SQLLEN      FAR   *pcbValue);


/******************************************************************************/
/* Some rebuild IBM Support funcs */
/******************************************************************************/


static
char *HandleLocationPrint(SQLRETURN cliRC, int line, char *file,char *message)
{
  sprintf(message,"cliRC=%d, line=%d,file=%s",cliRC,line,file);
  return message;
} 

static
char *HandleDiagnosticsPrint(SQLSMALLINT htype, /* handle type identifier */
			     SQLHANDLE hndl, /* handle */ 
			     char *msg)
{
  char *m=msg;
  SQLCHAR message[SQL_MAX_MESSAGE_LENGTH + 1];
  SQLCHAR sqlstate[SQL_SQLSTATE_SIZE + 1];
  SQLINTEGER sqlcode;
  SQLSMALLINT length, i;
  int          bytes;

  i = 1;
  

  /* get multiple field settings of diagnostic record */
  while (mySQLGetDiagRec(htype,
                       hndl,
                       i,
                       sqlstate,
                       &sqlcode,
                       message,
                       SQL_MAX_MESSAGE_LENGTH + 1,
                       &length) == SQL_SUCCESS)
  {
    DBG(printf("SQLSTATE=%s\nErrorCode=%d\n%s\n",sqlstate,sqlcode,message));
    bytes=sprintf(msg,"SQLSTATE=%s\nErrorCode=%d\n%s\n",sqlstate,sqlcode,message);
    msg+=bytes;
    i++;
  }

  DBG(printf("errormessage=%s\n",m));

  return m;
}

static
char *HandleInfoPrint(SQLSMALLINT htype, /* handle type identifier */
		      SQLHANDLE hndl, /* handle used by the CLI function */
		      SQLRETURN cliRC, /* return code of the CLI function */
		      int line,
		      char *file,
		      int * _rc,
		      char *msg)
{
  int rc = 0;
  strcpy(msg,"");

  switch (cliRC)
  {
    case SQL_SUCCESS:
      rc = 0;
      break;
    case SQL_INVALID_HANDLE:
      HandleLocationPrint(cliRC, line, file,msg);
      rc = 1;
      break;
    case SQL_ERROR:
      {
	char location[512];
	char message[10240];
	HandleLocationPrint(cliRC, line, file,location);
	HandleDiagnosticsPrint(htype, hndl,message);
	sprintf(msg,"%s\n%s",location,message);
	DBG(printf("errmsg will be %s\n",msg));
      }
      rc = 2;
      break;
    case SQL_SUCCESS_WITH_INFO:
      rc = 0;
      break;
    case SQL_STILL_EXECUTING:
      rc = 0;
      break;
    case SQL_NEED_DATA:
      rc = 0;
      break;
    case SQL_NO_DATA_FOUND:
      rc = 0;
      break;
    default:
      HandleLocationPrint(cliRC, line, file,msg);
      rc = 3;
      break;
  }

  *_rc=rc;

  return msg;
} 


/******************************************************************************/

#define env_handle_check(henv,clIRC,rc,msg) \
     HandleInfoPrint(SQL_HANDLE_ENV,henv,clIRC,__LINE__,__FILE__,&rc,msg)

#define dbc_handle_check(hdbc,clIRC,rc,msg) \
     HandleInfoPrint(SQL_HANDLE_DBC,hdbc,clIRC,__LINE__,__FILE__,&rc,msg)

#define stmt_handle_check(hstmt,cliRC,rc,msg) \
     HandleInfoPrint(SQL_HANDLE_STMT,hstmt,cliRC,__LINE__,__FILE__,&rc,msg)

/******************************************************************************/

#ifdef WIN32
static
void *myGetProcAddress(HINSTANCE lib,char *func)
{
  void *p=GetProcAddress(lib,func);
  DBG(printf("got %p for %s\n",p,func));
  if (p==NULL) {
    scheme_signal_error("Cannot runtime link function %s from DB2CLI.DLL",func);
  }
  return p;
}
#endif

#define DFUNC(f) #f

static
void initializeDB2CLI(void) {
  static int initialized=0;
  if (!initialized) {
#ifdef WIN32
  /* RunTime Load the DB2CLI Library */
  HINSTANCE lib;
  lib=LoadLibrary("DB2CLI.DLL");
  if (lib!=NULL) {
    (void*) mySQLGetDiagRec     =(void*) myGetProcAddress(lib,DFUNC(SQLGetDiagRec));
    (void*) mySQLAllocHandle    =(void*) myGetProcAddress(lib,DFUNC(SQLAllocHandle));
    (void*) mySQLSetEnvAttr     =(void*) myGetProcAddress(lib,DFUNC(SQLSetEnvAttr));
    (void*) mySQLConnect        =(void*) myGetProcAddress(lib,DFUNC(SQLConnect));
    (void*) mySQLFreeHandle     =(void*) myGetProcAddress(lib,DFUNC(SQLFreeHandle));
    (void*) mySQLDisconnect     =(void*) myGetProcAddress(lib,DFUNC(SQLDisconnect));
    (void*) mySQLSetConnectAttr =(void*) myGetProcAddress(lib,DFUNC(SQLSetConnectAttr));
    (void*) mySQLFreeStmt       =(void*) myGetProcAddress(lib,DFUNC(SQLFreeStmt));
    (void*) mySQLExecDirect     =(void*) myGetProcAddress(lib,DFUNC(SQLExecDirect));
    (void*) mySQLNumResultCols  =(void*) myGetProcAddress(lib,DFUNC(SQLNumResultCols));
    (void*) mySQLFetch          =(void*) myGetProcAddress(lib,DFUNC(SQLFetch));
    (void*) mySQLGetData        =(void*) myGetProcAddress(lib,DFUNC(SQLGetData));

  }
  else {
    scheme_signal_error("Cannot initialize DB2 Driver, no DB2CLI.DLL Library found");
  }
#else
  mySQLGetDiagRec     =SQLGetDiagRec;
  mySQLAllocHandle    =SQLAllocHandle;
  mySQLSetEnvAttr     =SQLSetEnvAttr;
  mySQLConnect        =SQLConnect;
  mySQLFreeHandle     =SQLFreeHandle;
  mySQLDisconnect     =SQLDisconnect;
  mySQLSetConnectAttr =SQLSetConnectAttr;
  mySQLFreeStmt       =SQLFreeStmt;
  mySQLExecDirect     =SQLExecDirect;
  mySQLNumResultCols  =SQLNumResultCols;
  mySQLFetch          =SQLFetch;
  mySQLGetData        =SQLGetData;
#endif
  initialized=1;
  }
}

/******************************************************************************/

static Scheme_Object *gc_strdup(char *s) /* utf8 s */
{
  if (s==NULL) { s=""; }
  return scheme_make_utf8_string(s);
}

static Scheme_Object *DB2_Type=NULL;
static Scheme_Object *Query_Type=NULL;


#define init_types() \
  if (DB2_Type==NULL) { \
     initializeDB2CLI(); \
     DB2_Type=scheme_make_byte_string("DB2"); \
     Query_Type=scheme_make_byte_string("DB2_Query"); \
  }

#define SCHEME_STR_VAL(a)   SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(a))
#define STRVAL(a)           SCHEME_STR_VAL(a)
#define EQ_CTYPE(cobj,type) (SCHEME_CPTR_TYPE(cobj)==type)
#define IS_STRINGP(obj)     SCHEME_CHAR_STRINGP(obj)


char *get_dsn_part(char *part,char *dsn)
{
  char *p=strstr(dsn,part);
  char *val=NULL;
  if (p!=NULL) {
    p+=strlen(part);
    if (p[0]=='\0' || isspace(p[0])) {
    }
    else {
      char *b=p;
      val=p;
      for(;p[0]!='\0' && !isspace(p[0]);p++);
      { 
	char c=p[0];
	p[0]='\0';
	val=(char *) scheme_malloc((strlen(b)+1)*sizeof(char));
	strcpy(val,b);
	p[0]=c;
      }
    }
  }

  return val;
}
 


#define FUNC "c_db2_open"
static
Scheme_Object *c_db2_open(int argc, Scheme_Object **argv)
{
  db2_t *handle=(db2_t *) scheme_malloc(sizeof(db2_t));
  Scheme_Object *obj;

  handle->errmsg=(char *) scheme_malloc(10240*sizeof(char));
  strcpy(handle->errmsg,"");
  handle->valid=(1==0);
  handle->henv=SQL_NULL_HENV;
  handle->hdbc=SQL_NULL_HDBC;
  handle->hstmt=SQL_NULL_HSTMT;
  handle->buffer=(char *) scheme_malloc(10240*sizeof(char));
  handle->buffersize=10240;

  DBG(printf("handle=%p\n",handle));

  init_types();

  if (!IS_STRINGP(argv[0])) {
    scheme_wrong_type(FUNC,"string",0,argc,argv);
  }

  {
    char *alias=NULL;
    char *user=NULL;
    char *passwd=NULL;
    char *dsn=STRVAL(argv[0]);
    SQLHENV henv=SQL_NULL_HENV;

    alias=get_dsn_part("alias=",dsn);
    user=get_dsn_part("user=",dsn);
    passwd=get_dsn_part("passwd=",dsn);

    DBG(printf("dsn=%s\n",dsn));
    DBG(printf("alias=%s, user=%s, passwd=%s\n",alias,user,passwd));

    {
      SQLRETURN cliRC;
      cliRC=mySQLAllocHandle(SQL_HANDLE_ENV,SQL_NULL_HANDLE,&henv);
      if (cliRC != SQL_SUCCESS) {
	scheme_signal_error(FUNC ": Cannot allocate environment handle using SQLAllocHandle");
      }
    }

    handle->henv=henv;

    DBG(printf("environment handle allocated\n"));

    {
      SQLRETURN cliRC;
      int       rc=0;

      cliRC=mySQLSetEnvAttr(handle->henv,SQL_ATTR_ODBC_VERSION,(void *) SQL_OV_ODBC3,0);
      env_handle_check(handle->henv,cliRC,rc,handle->errmsg);

      DBG(printf("ODBC3: rc=%d\n",rc));

      if (rc==0) {
	SQLRETURN cliRC;
	int       rc=0;
	SQLHDBC   hdbc=SQL_NULL_HDBC;

	cliRC=mySQLAllocHandle(SQL_HANDLE_DBC,handle->henv,&hdbc);
	env_handle_check(handle->henv,cliRC,rc,handle->errmsg);

	handle->hdbc=hdbc;

	DBG(printf("DBC Handle: rc=%d\n",rc));

	if (rc==0) {
	  cliRC=mySQLConnect(handle->hdbc,
			   (SQLCHAR *) alias,SQL_NTS,
			   (SQLCHAR *) user,SQL_NTS,
			   (SQLCHAR *) passwd,SQL_NTS
			   );
	  dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg);

	  DBG(printf("Connect: rc=%d\n",rc));

	  if (rc==0) { handle->valid=(1==1); }
	}
      }
    }

  }

  DBG(printf("Make and return cptr of %p, %p\n",handle,DB2_Type));

  obj=scheme_make_cptr(handle,DB2_Type);

  DBG(printf("Returning obj=%p\n",obj));

  return obj;
}
#undef FUNC

#define FUNC "c_db2_close"
static
Scheme_Object *c_db2_close(int argc, Scheme_Object **argv)
{
  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }

  {
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    {
      int       rc;
      SQLRETURN cliRC;
      
      if (handle->hstmt!=SQL_NULL_HSTMT) {
	cliRC=mySQLFreeHandle(SQL_HANDLE_STMT,handle->hstmt);
      }
      
      cliRC=mySQLDisconnect(handle->hdbc);
      dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg);
      
      if (rc==0) {
	cliRC=mySQLFreeHandle(SQL_HANDLE_DBC,handle->hdbc);
	dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg);

	if (rc==0) {
	  cliRC=mySQLFreeHandle(SQL_HANDLE_ENV,handle->henv);
	  env_handle_check(handle->henv,cliRC,rc,handle->errmsg);
	}

      }

      handle->valid=(1==0);
    }
  }

  return scheme_void;
}
#undef FUNC


#define FUNC "c_db2_autocommit"
static
Scheme_Object *c_db2_autocommit(int argc,Scheme_Object **argv)
{
  SQLRETURN cliRC;

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }

  if (!SCHEME_BOOLP(argv[1])) {
    scheme_wrong_type(FUNC,"boolean",1,argc,argv);
  }

  {
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    if (SCHEME_FALSEP(argv[1])) {
      cliRC=mySQLSetConnectAttr(handle->hdbc,SQL_ATTR_AUTOCOMMIT,
			   (SQLPOINTER)SQL_AUTOCOMMIT_OFF,
			   SQL_NTS
			   );
    }
    else {
      cliRC=mySQLSetConnectAttr(handle->hdbc,SQL_ATTR_AUTOCOMMIT,
			   (SQLPOINTER)SQL_AUTOCOMMIT_ON,
			   SQL_NTS
			   );
    }
    {
      int rc;
      dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg);
    }
  }

  return scheme_void;
}
#undef FUNC
  

#define FUNC "c_db2_escape"
static
Scheme_Object *c_db2_escape(int argc, Scheme_Object **argv)
{
  Scheme_Object *obj;

  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }


  if (!IS_STRINGP(argv[1])) {
    scheme_wrong_type(FUNC,"string",1,argc,argv);
  }

  {
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);
    char  *str=STRVAL(argv[1]);

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid db2 handle");
    }

    {
      SQLRETURN   cliRC;
      int         L=strlen(str);
      SQLINTEGER  TL=0;
      char       *buf=scheme_malloc((L+1)*2*sizeof(char));
      int         i,k;

      for(i=0,k=0;str[i]!='\0';i++,k++) {
	buf[k]=str[i];
	if (str[i]=='\'') {
	  buf[++k]=str[i];
	}
      }
      buf[k]='\0';

      obj=gc_strdup(buf);
    }
  }

  return obj;
}
#undef FUNC

static
char *trim(char *s)
{
  int N=strlen(s)-1;

  for(;N>=0 && isspace(s[N]);N--);
  s[N+1]='\0';

  {
    char *p=s;
    for(;p[0]!='\0' && isspace(p[0]);p++);
    return p;
  }
}

typedef struct {
  db2_t       *handle;
  char        *query;
  int          result;
  int          ready;
} db2_exec_t;


static
int query(void *data)
{
  db2_exec_t *H=(db2_exec_t *) data;
  SQLRETURN cliRC;
  int       rc;

  
  if (H->handle->hstmt==SQL_NULL_HSTMT) {
    cliRC=mySQLAllocHandle(SQL_HANDLE_STMT,H->handle->hdbc,&H->handle->hstmt);
    dbc_handle_check(H->handle->hdbc,cliRC,rc,H->handle->errmsg);
  }
  
  {
    char *query=H->query;
    int   i;
    int   N=strlen(query);
    char *q;
    char *b;
    int   in_string=0;
    int   R;
      
    b=q=trim(query);
    R=0;
      
    for(i=0;R==0 && i<N;i++) {
      if (q[i]=='\'') { in_string=!in_string; }
      if (q[i]==';' && !in_string) {
	char c=q[i];
	
	q[i]='\0';
	DBG(printf("Executing direct %s\n",b));
	
	cliRC=mySQLFreeStmt(H->handle->hstmt,SQL_CLOSE);
	stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg);

	if (R==0) {
	  cliRC=mySQLExecDirect(H->handle->hstmt,b,SQL_NTS);
	  stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg);
	}
	q[i]=c;
	b=&q[i+1];
      }
    }
    
    if (R==0 && b!=&q[i]) {
      DBG(printf("Executing direct %s\n",b));

      cliRC=mySQLFreeStmt(H->handle->hstmt,SQL_CLOSE);
      stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg);

      if (R==0) {
	cliRC=mySQLExecDirect(H->handle->hstmt,b,SQL_NTS);
	stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg);
      }
    }

    H->result=R;
  }

  DBG(printf("H->result=%d\n",H->result));

  H->ready=(1==1);

  return 0;
}

static
int query_ready(Scheme_Object *data)
{
  db2_exec_t *H=(db2_exec_t *) data;
  return H->ready;
}


#define FUNC "c_db2_query"
static
Scheme_Object *c_db2_query(int argc, Scheme_Object **argv) //void *db,char *query)
{
  Scheme_Object *obj;

  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }


  if (!IS_STRINGP(argv[1])) {
    scheme_wrong_type(FUNC,"string",1,argc,argv);
  }

  {
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid db2 handle");
    }

    {
      int R;
      {
	db2_exec_t *H=(db2_exec_t *) malloc(sizeof(db2_exec_t));
	H->handle=handle;
	H->query=SCHEME_STR_VAL(argv[1]);
	H->result=0;
	H->ready=0;
	
	{
	  t_c_thread_id id;
	  
	  id=c_thread_create(query,(void *) H);
	  scheme_block_until(query_ready,NULL,(Scheme_Object *) H,-1);
	  c_thread_join(id);
	}
	
	R=H->result;
	
	free(H);
      }
    }

  }

  obj=argv[0];

  return obj;
}
#undef FUNC


#define FUNC "c_db2_nfields"
static
Scheme_Object *c_db2_nfields(int argc, Scheme_Object **argv)
{
  Scheme_Object *obj;

  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }

  {
    SQLSMALLINT n=0;
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);
    SQLRETURN cliRC;
    int       rc;

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    cliRC=mySQLNumResultCols(handle->hstmt,&n);
    stmt_handle_check(handle->hstmt,cliRC,rc,handle->errmsg);

    {
      int N=n;
      obj=scheme_make_integer(N);
    }
  }

  return obj;
}
#undef FUNC

#define FUNC "c_db2_fetch"
static
Scheme_Object *c_db2_fetch(int argc, Scheme_Object **argv)
{
  Scheme_Object *obj;

  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }

  {
    db2_t     *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);
    SQLRETURN  cliRC;
    int        rc;

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    cliRC=mySQLFetch(handle->hstmt);
    stmt_handle_check(handle->hstmt,cliRC,rc,handle->errmsg);

    if (cliRC==SQL_SUCCESS) {
      return scheme_true;
    }
    else {
      return scheme_false;
    }
  }
}
#undef FUNC


#define FUNC "c_db2_field"
static
Scheme_Object *c_db2_field(int argc, Scheme_Object **argv)
{
  Scheme_Object *obj;

  init_types();

  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }

  if (!SCHEME_INTP(argv[1])) {
    scheme_wrong_type("c-db2-field","integer",1,argc,argv);
  }

  {
    db2_t     *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);
    int        field=SCHEME_INT_VAL(argv[1]);
    SQLRETURN  cliRC;
    int        rc;
    SQLINTEGER len;

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }
    
    mySQLGetData(handle->hstmt,field,SQL_C_CHAR,handle->buffer,handle->buffersize,&len);
    if (len>handle->buffersize) {
      if (len%2==1) { len+=1; }
      handle->buffer=(char *) scheme_malloc((len+2)*sizeof(char));
      handle->buffersize=len*sizeof(char);
      mySQLGetData(handle->hstmt,field,SQL_C_CHAR,handle->buffer,handle->buffersize,&len);
    }

    if (len==SQL_NULL_DATA) {
      obj=gc_strdup("");
    }
    else {
      handle->buffer[len]='\0';
      obj=gc_strdup(handle->buffer);
    }
  }

  return obj;
}
#undef FUNC


#define FUNC "c_db2_lasterr"
static
Scheme_Object *c_db2_lasterr(int argc, Scheme_Object **argv)
{
  Scheme_Object *obj;

  init_types();
  
  if (!SCHEME_CPTRP(argv[0])) {
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }
  else if (!EQ_CTYPE(argv[0],DB2_Type) && !EQ_CTYPE(argv[0],Query_Type)) { 
    scheme_wrong_type(FUNC,"DB2",0,argc,argv);
  }



  if (EQ_CTYPE(argv[0],DB2_Type)) {
    db2_t *handle=(db2_t *) SCHEME_CPTR_VAL(argv[0]);

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    obj=gc_strdup(handle->errmsg);
  }
  else {
    db2_query_t *q=SCHEME_CPTR_VAL(argv[0]);
    db2_t       *handle=q->handle;

    if (!handle->valid) {
      scheme_signal_error(FUNC ": Invalid DB2 handle");
    }

    obj=gc_strdup(handle->errmsg);
  }
    
  return obj;
}
#undef FUNC


static 
Scheme_Object *c_db2_version(int argc, Scheme_Object **argv)
{
  return scheme_make_integer(100);
}


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

  menv = scheme_primitive_module(scheme_intern_symbol("c-sqld-db2"),env);
  proc = scheme_make_prim_w_arity(c_db2_version, "c-db2-version", 0, 0);
  scheme_add_global("c-db2-version", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_open, "c-db2-open", 1, 1);
  scheme_add_global("c-db2-open", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_close, "c-db2-close", 1, 1);
  scheme_add_global("c-db2-close", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_query, "c-db2-query", 2, 2);
  scheme_add_global("c-db2-query", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_nfields, "c-db2-nfields", 1, 1);
  scheme_add_global("c-db2-nfields", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_field, "c-db2-field", 2, 2);
  scheme_add_global("c-db2-field", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_lasterr, "c-db2-lasterr", 1, 1);
  scheme_add_global("c-db2-lasterr", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_escape, "c-db2-escape", 2, 2);
  scheme_add_global("c-db2-escape", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_autocommit, "c-db2-autocommit", 2, 2);
  scheme_add_global("c-db2-autocommit", proc, menv);
  proc = scheme_make_prim_w_arity(c_db2_fetch, "c-db2-fetch", 1, 1);
  scheme_add_global("c-db2-fetch", proc, menv);
  scheme_finish_primitive_module(menv);

  return scheme_void;
}


Scheme_Object *scheme_initialize(Scheme_Env *env)
{
  /* Create the scheme bindings */
  //initializeDB2CLI();
  return scheme_reload(env);
}

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

/*=verbatim

=cut
*/