/*
* Class: amzi_ls_ARulesLogicServer
* Method: UnifyParm
* Signature: (IJ)Z
*/
JNIEXPORT jboolean JNICALL Java_amzi_ls_ARulesLogicServer_UnifyParm
(JNIEnv * jenv, jobject jobj, jint iarg, jlong term)
{
TF tf;
GET_EID(e);
tf = lsUnifyParm(e, (int)iarg, cTERM, &term);
switch(tf)
{
case TRUE:
case FALSE:
return (jboolean)tf;
default: amzi_error(jenv, e, "UnifyParm"); return 0;
}
}
TF EXPFUNC p_db_connect(ENGid eid)
{
HDBC hdbc;
char szDataSource[80];
char szUserID[40];
char szPassword[40];
if (pVAR != lsGetParmType(eid, 1))
{
lsErrRaise(eid, "db_connect instantiation error: arg 1 must be var");
return FALSE;
}
g_lsRC = lsGetParm(eid, 2, cSTR, szDataSource);
if (g_lsRC != OK) goto LS_ERROR;
g_lsRC = lsGetParm(eid, 3, cSTR, szUserID);
if (g_lsRC != OK) goto LS_ERROR;
g_lsRC = lsGetParm(eid, 4, cSTR, szPassword);
if (g_lsRC != OK) goto LS_ERROR;
g_RC = SQLAllocConnect(g_hEnv, &hdbc);
/* set up error handler */
g_hDBC = hdbc;
g_hSTMT = SQL_NULL_HSTMT;
g_eid = eid;
ERROR_CHK("SQLAllocConnect");
// Added this line to get around erroneous messages:
// S1010:[Microsoft][ODBC SQL Server Driver]Function sequence error
// Fix from MS Knowledge Article 179226
// SQL_PRESERVE_CURSORS - note new name in actual call
// This only applies to SQL Server, so hopefully, nothing bad will
// happen if it fails.
g_RC = SQLSetConnectOption(hdbc, SQL_COPT_SS_PRESERVE_CURSORS, NULL);
g_RC = SQLConnect(hdbc,
(UCHAR*)szDataSource, SQL_NTS,
(UCHAR*)szUserID, SQL_NTS,
(UCHAR*)szPassword, SQL_NTS);
ERROR_CHK("SQLConnect");
lsUnifyParm(eid, 1, cADDR, &hdbc);
return TRUE;
LS_ERROR:
return(lserror());
ODBC_ERROR:
return FALSE;
}
/*
* Class: amzi_ls_ARulesLogicServer
* Method: UnifyAtomParm
* Signature: (ILjava/lang/String;)Z
*/
JNIEXPORT jboolean JNICALL Java_amzi_ls_ARulesLogicServer_UnifyAtomParm
(JNIEnv * jenv, jobject jobj, jint iarg, jstring jstr)
{
TF tf;
aCHAR* str;
GET_EID(e);
str = JtoC(jenv, jstr);
tf = lsUnifyParm(e, (int)iarg, cWATOM, str);
delete[] str;
switch(tf)
{
case TRUE:
case FALSE:
return (jboolean)tf;
default: amzi_error(jenv, e, "UnifyAtomParm"); return 0;
}
}
AMZIFUNC cv_string_file ( ENGid Engine )
{
char * String ;
characters FileName [ 1024 ] ;
int Length ;
register FILE * fp ;
// Retrieve the filename
lsGetParm ( Engine, 2, cSTR, FileName ) ;
// Open the file (in binary mode, otherwise file length will be greater
// than bytes read, since CRLF are converted)
if ( ( fp = fopen( FileName, "rb" ) ) == NULL )
return( FALSE ) ;
Length = FileLength( fp ) ;
String = ( char * ) malloc( Length + 1 ) ;
// Check if we are running out of memory
if ( String == NULL )
{
fclose ( fp ) ;
return ( FALSE ) ;
}
// Read the file then unify the result
fread( String, 1, Length, fp ) ;
fclose( fp ) ;
String [ Length ] = '\0' ;
lsUnifyParm ( Engine, 1, cSTR, String ) ;
free( String ) ;
return( TRUE ) ;
}
TF EXPFUNC p_db_fetch(ENGid eid)
{
QUERY* pq;
HSTMT hstmt;
TERM tcols;
TERM t;
COL* pCol;
#ifdef _DEBUG
TERM xt1, xt2;
char xbuf1[512], xbuf2[512];
#endif
if (pVAR != lsGetParmType(eid, 2))
{
lsErrRaise(eid, "db_fetch instantiation error: arg 2 must be var");
return FALSE;
}
g_lsRC = lsGetParm(eid, 1, cADDR, &pq);
if (g_lsRC != OK) goto LS_ERROR;
hstmt = pq->hstmt;
/* set up error handler */
g_hSTMT = hstmt;
g_eid = eid;
if ( SQL_NO_DATA_FOUND == (g_RC = SQLFetch(hstmt)) )
{
DUMPLOG("no data found");
query_del(pq);
return FALSE;
}
ERROR_CHK("SQLFetch");
DUMPLOG("found data");
g_lsRC = lsMakeList(eid, &tcols);
if (g_lsRC != OK) goto LS_ERROR;
for (pCol = pq->clist; pCol != NULL; pCol = pCol->next)
{
switch(pCol->pdtype)
{
case pdATOM:
g_lsRC = lsMakeAtom(eid, &t, pCol->s);
if (g_lsRC != OK) goto LS_ERROR;
break;
case pdSTR:
g_lsRC = lsMakeStr(eid, &t, pCol->s);
if (g_lsRC != OK) goto LS_ERROR;
break;
case pdINT:
g_lsRC = lsMakeInt(eid, &t, pCol->i);
if (g_lsRC != OK) goto LS_ERROR;
break;
case pdFLOAT:
g_lsRC = lsMakeFloat(eid, &t, pCol->f);
if (g_lsRC != OK) goto LS_ERROR;
break;
case pdDOUBLE:
g_lsRC = lsMakeFloat(eid, &t, pCol->g);
if (g_lsRC != OK) goto LS_ERROR;
break;
case pdDATE:
g_lsRC = lsMakeFA(eid, &t, "date", 3);
if (g_lsRC != OK) goto LS_ERROR;
lsUnifyArg(eid, &t, 1, cSHORT, &(pCol->d->year));
lsUnifyArg(eid, &t, 2, cSHORT, &(pCol->d->month));
lsUnifyArg(eid, &t, 3, cSHORT, &(pCol->d->day));
break;
case pdTIME:
g_lsRC = lsMakeFA(eid, &t, "time", 3);
if (g_lsRC != OK) goto LS_ERROR;
lsUnifyArg(eid, &t, 1, cSHORT, &(pCol->t->hour));
lsUnifyArg(eid, &t, 2, cSHORT, &(pCol->t->minute));
lsUnifyArg(eid, &t, 3, cSHORT, &(pCol->t->second));
break;
default:
messout("Unsupported Prolog type for ODBC fetch");
}
g_lsRC = lsPushList(eid, &tcols, t);
if (g_lsRC != OK) return(lserror());
}
/* #ifdef _DEBUG
lsGetParm(eid, 2, cTERM, &xt1);
lsTermToStrQ(eid, xt1, xbuf1, 500);
lsTermToStrQ(eid, xt2, xbuf2, 500);
#endif */
lsUnifyParm(eid, 2, cTERM, &tcols);
return TRUE;
LS_ERROR:
return(lserror());
ODBC_ERROR:
return FALSE;
}
TF EXPFUNC p_db_query(ENGid eid)
/* db_query/5
ex.
db_query(HConnect, PQuery,
$select mother, father from person where name = ?$,
['Someones Name'],
[string, string]). */
{
HSTMT hstmt;
HDBC hdbc;
char* sQ = NULL;
int iParm = 1;
int iCol = 1;
TERM tParms, tCols;
char* sBuf = NULL;
char sType[80];
TERM t;
pTYPE ptyp;
QUERY* pq;
char* s;
long len;
long* pl;
float* pf;
double* pd;
long i;
//float f;
double g;
DATE_STRUCT* pdate;
TIME_STRUCT* ptime;
char sMsg[512];
#ifdef _DEBUG
char xbuf1[512], xbuf2[512];
#endif
if (pVAR != lsGetParmType(eid, 2))
{
lsErrRaise(eid, "db_query instantiation error: arg 2 must be var");
return FALSE;
}
/* create stmt structure */
pq = query_new();
/* add stmt handle to structure */
g_lsRC = lsGetParm(eid, 1, cADDR, &hdbc);
if (g_lsRC != OK) goto LS_ERROR;
/* #ifdef _DEBUG
xtest(hdbc);
#endif */
g_RC = SQLAllocStmt(hdbc, &hstmt);
/* set up error handler */
g_hDBC = hdbc;
g_hSTMT = hstmt;
g_eid = eid;
ERROR_CHK("SQLAllocStmt");
pq->hstmt = hstmt;
/* get query string from Prolog */
sQ = (char*)malloc(lsStrParmLen(eid, 3)+1);
g_lsRC = lsGetParm(eid, 3, cSTR, sQ);
if (g_lsRC != OK) goto LS_ERROR;
/* prepare SQL query */
//g_RC = SQLPrepare(hstmt, (UCHAR*)sQ, SQL_NTS);
//errchk("lsODBC");
/* get parameter list from Prolog */
g_lsRC = lsGetParm(eid, 4, cTERM, &tParms);
if (g_lsRC != OK) goto LS_ERROR;
#ifdef _DEBUG
lsTermToStrQ(eid, tParms, xbuf1, 500);
#endif
/* walk input list */
while (OK == lsPopList(eid, &tParms, cTERM, &t))
{
/* bind parameter for each */
ptyp = lsGetTermType(eid, t);
switch(ptyp)
{
case pATOM:
case pSTR:
sBuf = (char*)malloc(lsStrTermLen(eid, t) + 1);
g_lsRC = lsGetTerm(eid, t, cSTR, sBuf);
if (g_lsRC != OK) goto LS_ERROR;
len = strlen(sBuf) + 1;
s = query_addstrparm(pq, sBuf);
g_ParmSize = SQL_NTS;
g_RC = SQLBindParameter(hstmt, (UWORD)iParm, SQL_PARAM_INPUT, SQL_C_CHAR,
SQL_CHAR, (UDWORD)len, 0, s, (SDWORD)len, &g_ParmSize);
ERROR_CHK("SQLBindParameter");
break;
case pINT:
g_lsRC = lsGetTerm(eid, t, cLONG, &i);
if (g_lsRC != OK) goto LS_ERROR;
pl = query_addintparm(pq, i);
g_ParmSize = 0;
g_RC = SQLBindParameter(hstmt, (UWORD)iParm, SQL_PARAM_INPUT, SQL_C_SLONG,
SQL_INTEGER, 4, 0, pl, 4, &g_ParmSize);
ERROR_CHK("SQLBindParameter");
break;
case pFLOAT:
g_lsRC = lsGetTerm(eid, t, cDOUBLE, &g);
if (g_lsRC != OK) goto LS_ERROR;
pd = query_adddoubleparm(pq, g);
g_ParmSize = 0;
g_RC = SQLBindParameter(hstmt, (UWORD)iParm, SQL_PARAM_INPUT, SQL_C_DOUBLE,
SQL_DOUBLE, 8, 0, pd, 8, &g_ParmSize);
ERROR_CHK("SQLBindParameter");
break;
default:
messout("Unsupported Prolog type for ODBC input");
}
iParm++;
}
/* get column list from Prolog */
g_lsRC = lsGetParm(eid, 5, cTERM, &tCols);
if (g_lsRC != OK) goto LS_ERROR;
#ifdef _DEBUG
lsTermToStrQ(eid, tCols, xbuf2, 500);
#endif
/* walk output list */
while (OK == lsPopList(eid, &tCols, cSTR, sType))
{
/* bind col for each */
switch(sType[0])
{
case 'a':
len = 1 + atol(&sType[1]);
s = query_addstrcol(pq, pdATOM, len);
g_ColSize = SQL_NO_TOTAL;
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_CHAR, s,
len, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 's':
len = 1 + atol(&sType[1]);
s = query_addstrcol(pq, pdSTR, len);
g_ColSize = SQL_NO_TOTAL;
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_CHAR, s,
len, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 'i':
pl = query_addintcol(pq);
g_ColSize = 0;
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_SLONG, pl,
4, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 'f':
pf = query_addfloatcol(pq);
g_ColSize = 0;
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_FLOAT, pf,
4, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 'g':
pd = query_adddoublecol(pq);
g_ColSize = 0;
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_DOUBLE, pd,
8, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 'd':
pdate = query_adddatecol(pq);
g_ColSize = 0; // ignored for date
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_DATE, pdate,
6, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
case 't':
ptime = query_addtimecol(pq);
g_RC = SQLBindCol(hstmt, (UWORD)iCol, SQL_C_TIME, ptime,
6, &g_ColSize);
ERROR_CHK("SQLBindCol");
break;
default:
sprintf(sMsg,
"Unsupported Prolog type '%c' for ODBC output", sType[0]);
messout(sMsg);
}
iCol++;
}
/* execute query and return pointer to query */
//g_RC = SQLExecute(hstmt);
//errchk("lsODBC");
g_RC = SQLExecDirect(hstmt, (UCHAR*)sQ, SQL_NTS);
ERROR_CHK("SQLExecDirect");
lsUnifyParm(eid, 2, cADDR, &pq);
if (sQ != NULL) free(sQ);
if (sBuf != NULL) free(sBuf);
return TRUE;
LS_ERROR:
if (sQ != NULL) free(sQ);
if (sBuf != NULL) free(sBuf);
return(lserror());
ODBC_ERROR:
if (sQ != NULL) free(sQ);
if (sBuf != NULL) free(sBuf);
return FALSE;
}
