// Retrieve a combined bits value
UINT association_bits ( Association * assoc,
ENGid engine,
TERM term )
{
char Value [ 512 ] ;
unsigned int Flags = 0 ;
register int status ;
// Get first list element
status = lsPopList ( engine, & term, cSTR, Value ) ;
// Then cycle through the list until last element has been processed
while ( status == OK )
{
// Get the flag value
Flags |= association_value ( assoc, Value ) ;
// Process next item
status = lsPopList ( engine, & term, cSTR, Value ) ;
}
return ( Flags ) ;
}
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;
}
