/********************************************************************************* * 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.2 2006/01/04 20:15:18 HansOesterholt Exp $ *********************************************************************************/ #include "sqlid.h" #include #include #include #ifdef MZSCHEME # include # include "c-threads.c" #endif //#include #include #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.2 2006/01/04 20:15:18 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 /******************************************************************************/ /* 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 (SQLGetDiagRec(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) /******************************************************************************/ 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) { \ 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=SQLAllocHandle(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=SQLSetEnvAttr(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=SQLAllocHandle(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=SQLConnect(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=SQLFreeHandle(SQL_HANDLE_STMT,handle->hstmt); } cliRC=SQLDisconnect(handle->hdbc); dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg); if (rc==0) { cliRC=SQLFreeHandle(SQL_HANDLE_DBC,handle->hdbc); dbc_handle_check(handle->hdbc,cliRC,rc,handle->errmsg); if (rc==0) { cliRC=SQLFreeHandle(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=SQLSetConnectAttr(handle->hdbc,SQL_ATTR_AUTOCOMMIT, (SQLPOINTER)SQL_AUTOCOMMIT_OFF, SQL_NTS ); } else { cliRC=SQLSetConnectAttr(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=SQLAllocHandle(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 && ihandle->hstmt,SQL_CLOSE); stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg); if (R==0) { cliRC=SQLExecDirect(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=SQLFreeStmt(H->handle->hstmt,SQL_CLOSE); stmt_handle_check(H->handle->hstmt,cliRC,R,H->handle->errmsg); if (R==0) { cliRC=SQLExecDirect(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=SQLNumResultCols(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=SQLFetch(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"); } SQLGetData(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); SQLGetData(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) { return scheme_reload(env); } Scheme_Object *scheme_module_name(void) { return scheme_intern_symbol("c-sqld-db2"); } /*=verbatim =cut */