SEXP graph_bitarray_getEdgeAttrOrder(SEXP _bits, SEXP _from, SEXP _to) {
unsigned char *bits = (unsigned char*) RAW(_bits);
int ns = asInteger(getAttrib(_bits, install("nbitset")));
int len = length(_from);
int *from = INTEGER(_from);
int *to = INTEGER(_to);
int dim = NROW(_bits);
int byteIndex, bitIndex, shft, indx, intIndx, i, j;
int oindx=0, nindx=0, attrIndx=0, setCount=0;
SEXP origRightPos, origLeftPos, newRightPos, newLeftPos, res, namesres;
PROTECT(origRightPos = allocVector(INTSXP, ns)); //index into orig attr
PROTECT(origLeftPos = allocVector(INTSXP, ns));
PROTECT(newRightPos = allocVector(INTSXP, len));
PROTECT(newLeftPos = allocVector(INTSXP, len));
setCount =1;
for(j =0; j < dim ; j ++) {
for(i =0; i < dim; i++){
indx = COORD_TO_INDEX(i, j , dim);
byteIndex = indx / 8;
bitIndex = indx % 8;
shft = 1 << bitIndex;
intIndx = COORD_TO_INDEX(from[attrIndx]-1, to[attrIndx]-1, dim);
if(bits[byteIndex] & (shft) ) {
INTEGER(origRightPos)[oindx] = oindx + 1 ;
INTEGER(origLeftPos)[oindx] = setCount ;
oindx++;
if(intIndx != indx){
setCount++;
}
}
if(intIndx == indx) {
INTEGER(newRightPos)[nindx] = nindx + 1;
INTEGER(newLeftPos)[nindx] = setCount ;
nindx++;
if(attrIndx < len-1){
attrIndx++;
}
setCount++;
}
}
}
SET_LENGTH(newRightPos, nindx);
SET_LENGTH(newLeftPos, nindx);
PROTECT(res = allocVector(VECSXP, 4));
SET_VECTOR_ELT(res, 0, newLeftPos);
SET_VECTOR_ELT(res, 1, newRightPos);
SET_VECTOR_ELT(res, 2, origLeftPos);
SET_VECTOR_ELT(res, 3, origRightPos);
PROTECT(namesres = allocVector(STRSXP, 4));
SET_STRING_ELT(namesres, 0, mkChar("newLeftPos"));
SET_STRING_ELT(namesres, 1, mkChar("newRightPos"));
SET_STRING_ELT(namesres, 2, mkChar("origLeftPos"));
SET_STRING_ELT(namesres, 3, mkChar("origRightPos"));
setAttrib(res, R_NamesSymbol, namesres);
UNPROTECT(6);
return(res);
}
/**
* abstracts some of the content of the add to binary tree function.
* specifically the part where location to add the new node is found and
* the current node takes the values of the node to be added.
* @param node_to_add
* @param return_competitor a pointer to a competitor * so that we can set the
* values of it and pass them back out of the function
* @return the appropriate flags for any errors that occur
*/
int set_current(competitor * node_to_add,
competitor ** return_competitor){
competitor * current = calloc(1, sizeof(competitor));
if(current == NULL) return MEMORY_ALLOCATION_FAILURE;
current->left = current->right = NULL;
/* macros used, just to simplify repeated code */
SET_LENGTH(bean_length);
SET_LENGTH(carrot_length);
SET_LENGTH(cucumber_length);
current->name = node_to_add->name;
current->address = node_to_add->address;
current->phone_number = node_to_add->phone_number;
current->ID = node_to_add->ID;
(*return_competitor) = current;
return 0;
}
TInt DISICLTransceiver::SendCommIsaEntityNotReachableResp(
TDes8& aNotDeliveredMessage
)
{
C_TRACE( ( _T( "DISICLTransceiver::SendCommIsaEntityNotReachableResp 0x%x>" ), &aNotDeliveredMessage ) );
const TUint8* notDeliveredMsgPtr( aNotDeliveredMessage.Ptr() );
TInt error = KErrAlreadyExists;
// Avoid COMM_ISA_ENTITY_NOT_REACHABLE_RESP loop.
if( ( notDeliveredMsgPtr[ ISI_HEADER_OFFSET_MESSAGEID ] == COMMON_MESSAGE ) &&
( ( notDeliveredMsgPtr[ ISI_HEADER_OFFSET_SUBMESSAGEID ] == COMM_ISA_ENTITY_NOT_REACHABLE_RESP ) ||
( notDeliveredMsgPtr[ ISI_HEADER_OFFSET_SUBMESSAGEID ] == COMM_SERVICE_NOT_IDENTIFIED_RESP ) ) )
{
C_TRACE( ( _T( "DISICLTransceiver Not sending another CommIsaEntityNotReachableResp 0x%x 0x%x" ), &aNotDeliveredMessage, notDeliveredMsgPtr[ ISI_HEADER_OFFSET_SUBMESSAGEID ] ) );
}
else
{
// Follows COMM specification: 000.031
TUint8 length( ISI_HEADER_SIZE + SIZE_COMMON_MESSAGE_COMM_ISA_ENTITY_NOT_REACHABLE_RESP );
TDes8& respMsg = MemApi::AllocBlock( length );
ASSERT_RESET_ALWAYS( length > ISI_HEADER_OFFSET_MESSAGEID, ( EISICLTransceiverOverTheLimits | EDISICLTransceiverTraceId << KClassIdentifierShift ) );
TUint8* respMsgPtr = const_cast<TUint8*>( respMsg.Ptr() );
// We start to append from transaction id.
respMsg.SetLength( ISI_HEADER_OFFSET_TRANSID );
// Get the header until messageid from prev. message.
// Just turn receiver and sender device and object vice versa.
respMsgPtr[ ISI_HEADER_OFFSET_MEDIA ] = notDeliveredMsgPtr[ ISI_HEADER_OFFSET_MEDIA ];
SET_RECEIVER_DEV( respMsgPtr, GET_SENDER_DEV( aNotDeliveredMessage ) );
SET_SENDER_DEV ( respMsgPtr, GET_RECEIVER_DEV( aNotDeliveredMessage ) );
respMsgPtr[ ISI_HEADER_OFFSET_RESOURCEID ] = notDeliveredMsgPtr[ ISI_HEADER_OFFSET_RESOURCEID ];
SET_LENGTH( respMsgPtr, ( length - PN_HEADER_SIZE ) );
SET_RECEIVER_OBJ( respMsgPtr, GET_SENDER_OBJ( aNotDeliveredMessage ) );
SET_SENDER_OBJ( respMsgPtr, GET_RECEIVER_OBJ( aNotDeliveredMessage ) );
// Set from undelivered message
respMsg.Append( notDeliveredMsgPtr[ ISI_HEADER_OFFSET_TRANSID ] );
// Message Identifier
respMsg.Append( COMMON_MESSAGE );
// Sub message Identifier.
respMsg.Append( COMM_ISA_ENTITY_NOT_REACHABLE_RESP );
// Not Delivered Message from original message.
respMsg.Append( notDeliveredMsgPtr[ ISI_HEADER_OFFSET_MESSAGEID ] );
// Status
respMsg.Append( COMM_ISA_ENTITY_NOT_AVAILABLE );// different status in a case of device not existing
// Filler
const TUint8 KFiller( 0x00 );
respMsg.Append( KFiller );
// Filler
respMsg.Append( KFiller );
// Filler
respMsg.Append( KFiller );
error = RouteISIMessage( respMsg, EFalse );
// Programming error in this function if below assert is raised
ASSERT_RESET_ALWAYS( KErrNone == error, ( EISICLTransceiverCommIsaEntityNotReachableResp | EDISICLTransceiverTraceId << KClassIdentifierShift ) );
}
MemApi::DeallocBlock( aNotDeliveredMessage );
C_TRACE( ( _T( "DISICLTransceiver::SendCommIsaEntityNotReachableResp 0x%x<" ), &aNotDeliveredMessage ) );
return error;
}
/*
#define xts_IndexSymbol install("index")
#define xts_ClassSymbol install(".CLASS")
#define xts_IndexFormatSymbol install(".indexFORMAT")
#define xts_IndexClassSymbol install(".indexCLASS")
#define xts_ATTRIB(x) coerceVector(do_xtsAttributes(x),LISTSXP)
*/
SEXP do_xtsAttributes(SEXP x)
{
SEXP a, values, names;
int i=0, P=0;
a = ATTRIB(x);
if(length(a) <= 0)
return R_NilValue;
PROTECT(a); P++; /* all attributes */
PROTECT(values = allocVector(VECSXP, length(a))); P++;
PROTECT(names = allocVector(STRSXP, length(a))); P++;
/*
CAR gets the first element of the dotted pair list
CDR gets the rest of the dotted pair list
TAG gets the symbol/name of the first element of dotted pair list
*/
for( /* a=ATTRIB(a) */; a != R_NilValue; a = CDR(a) ) {
if(TAG(a) != xts_IndexSymbol &&
TAG(a) != xts_ClassSymbol &&
TAG(a) != xts_IndexFormatSymbol &&
TAG(a) != xts_IndexClassSymbol &&
TAG(a) != xts_IndexTZSymbol &&
TAG(a) != R_ClassSymbol &&
TAG(a) != R_DimSymbol &&
TAG(a) != R_DimNamesSymbol &&
TAG(a) != R_NamesSymbol)
{
SET_VECTOR_ELT(values, i, CAR(a));
SET_STRING_ELT(names, i, PRINTNAME(TAG(a)));
i++;
}
}
if(i == 0) {
UNPROTECT(P);
return R_NilValue;
}
SET_LENGTH(values, i); /* truncate list back to i-size */
SET_LENGTH(names, i);
setAttrib(values, R_NamesSymbol, names);
UNPROTECT(P);
return values;
}
void RS_DBI_allocOutput(SEXP output, RMySQLFields* flds, int num_rec, int expand) {
SEXP names, s_tmp;
int j;
int num_fields;
SEXPTYPE *fld_Sclass;
PROTECT(output);
num_fields = flds->num_fields;
if(expand){
for(j = 0; j < (int) num_fields; j++){
/* Note that in R-1.2.3 (at least) we need to protect SET_LENGTH */
s_tmp = LST_EL(output,j);
PROTECT(SET_LENGTH(s_tmp, num_rec));
SET_ELEMENT(output, j, s_tmp);
UNPROTECT(1);
}
UNPROTECT(1);
return;
}
fld_Sclass = flds->Sclass;
for(j = 0; j < (int) num_fields; j++){
switch((int)fld_Sclass[j]){
case LGLSXP:
SET_ELEMENT(output, j, NEW_LOGICAL(num_rec));
break;
case STRSXP:
SET_ELEMENT(output, j, NEW_CHARACTER(num_rec));
break;
case INTSXP:
SET_ELEMENT(output, j, NEW_INTEGER(num_rec));
break;
case REALSXP:
SET_ELEMENT(output, j, NEW_NUMERIC(num_rec));
break;
case VECSXP:
SET_ELEMENT(output, j, NEW_LIST(num_rec));
break;
default:
error("unsupported data type");
}
}
PROTECT(names = NEW_CHARACTER((int) num_fields));
for(j = 0; j< (int) num_fields; j++){
SET_CHR_EL(names,j, mkChar(flds->name[j]));
}
SET_NAMES(output, names);
UNPROTECT(2);
return;
}
void rsqlite_output_expand(SEXP output, SQLiteFields* flds, int num_rec) {
PROTECT(output);
int p = flds->num_fields;
for (int j = 0; j < p; j++) {
/* Note that in R-1.2.3 (at least) we need to protect SET_LENGTH */
SEXP s_tmp = VECTOR_ELT(output, j);
PROTECT(SET_LENGTH(s_tmp, num_rec));
SET_VECTOR_ELT(output, j, s_tmp);
UNPROTECT(1);
}
UNPROTECT(1);
}
void
R_tarCollectContents(const char *fname, char *bytes, unsigned int numBytes, unsigned int remaining, void *data)
{
RTarCallInfo *cb = (RTarCallInfo *)data;
int len = 0;
if(numBytes < 1) {
/* Invoke the function to signal the completion of a file. */
/* Need to make this have the correct length, i.e. cb->offset */
SEXP tmp = cb->rawData;
if(GET_LENGTH(cb->rawData) > cb->offset) {
tmp = allocVector(RAWSXP, cb->offset); /* shouldn't need to protect. */
memcpy(RAW(tmp), RAW(cb->rawData), cb->offset);
}
SETCAR(CDR(cb->e), tmp);
SETCAR(CDR(CDR(cb->e)), mkString(fname));
Rf_eval(cb->e, R_GlobalEnv);
cb->offset = 0;
return;
}
/* If we don't preallocate rawData, then this will continue
to grow the vector just enough to fit the new bytes.*/
if(cb->rawData == R_NilValue)
cb->rawData = allocVector(RAWSXP, numBytes);
else {
len = LENGTH(cb->rawData);
if(len - cb->offset < numBytes) {
SET_LENGTH(cb->rawData, len + numBytes);
PROTECT(cb->rawData);
cb->numProtects++;
}
}
memcpy(RAW(cb->rawData) + cb->offset, bytes, numBytes);
cb->offset += numBytes;
}
/*#define DEBUG 1*/
SEXP locate_byte_sequences(SEXP buf, SEXP match, SEXP len, SEXP key, SEXP max)
{
/*
* locate_byte_sequences() = function to be used for e.g. nortek adp / adv files
* buf = buffer to be scanned
* match = set of bytes that mark start of sequences
* len = length of sequence
* key = key added to checksum, and to be checked against last 2 bytes of sequence
* max = 0 to use whole buffer, positive integer to limit to that many matches
*/
/*
R CMD SHLIB bitwise.c
*/
/*
library(oce)
f <- "/Users/kelley/data/archive/sleiwex/2008/moorings/m06/adv/nortek_1943/raw/adv_nortek_1943.vec"
buf <- readBin(f, what="raw", n=1e6)
vvd.start <- matchBytes(buf, 0xa5, 0x10)
dyn.load("~/src/R-kelley/oce/src/bitwise.so")
s <- .Call("locate_byte_sequences",buf, c(0xa5, 0x10), 24, c(0xb5, 0x8c), 0)
print(s)
print(vvd.start)
*/
unsigned char *pbuf, *pmatch, *pkey;
PROTECT(buf = AS_RAW(buf));
PROTECT(match = AS_RAW(match));
PROTECT(len = AS_INTEGER(len));
PROTECT(key = AS_RAW(key));
PROTECT(max = AS_INTEGER(max));
/* FIXME: check lengths of match and key */
pbuf = RAW_POINTER(buf);
pmatch = RAW_POINTER(match);
pkey = RAW_POINTER(key);
int lsequence = *INTEGER_POINTER(len);
int max_lres = *INTEGER_POINTER(max);
#ifdef DEBUG
Rprintf("lsequence=%d\n",lsequence);
#endif
int lmatch = LENGTH(match);
int lbuf = LENGTH(buf);
int lkey = LENGTH(key);
if (lkey != 2) error("key length must be 2");
int ires = 0, lres = (int)(lbuf / lsequence + 3); /* get some extra space; fill some with NA */
SEXP res;
#ifdef DEBUG
Rprintf("lsequence=%d, lres=%d\n",lsequence,lres);
#endif
/* Rprintf("max_lres=%d\n", max_lres); */
if (max_lres > 0)
lres = max_lres;
PROTECT(res = NEW_INTEGER(lres));
int *pres = INTEGER_POINTER(res);
/* Count matches, so we can allocate the right length */
short lsequence2 = lsequence / 2;
for (int i = 0; i < lbuf - lsequence; i++) {
short check_value = (((short)pkey[0]) << 8) | (short)pkey[1];
int found = 0;
for (int m = 0; m < lmatch; m++) {
if (pbuf[i+m] == pmatch[m])
found++;
else
break;
}
if (found == lmatch) {
/* FIXME: should bit-twiddle this to work on all endian types */
short *check = (short*)(pbuf+i);
/*Rprintf(" %d", check_value);*/
for (int cc = 0; cc < lsequence2 - 1; cc++) { /* last 2-byte chunk is the test value */
check_value += *check++;
/*Rprintf(" %d", check_value);*/
}
short check_sum = (((short)pbuf[i+lsequence-1]) << 8) | (short)pbuf[i+lsequence-2];
#ifdef DEBUG
Rprintf("i=%d lbuf=%d ires=%d lres=%d check_value=%d vs check_sum %d match=%d\n", i, lbuf, ires, lres, check_value, check_sum, check_value==check_sum);
#endif
if (check_value == check_sum) {
pres[ires++] = i + 1;
i += lsequence - lmatch; /* no need to check within sequence */
}
if (ires >= lres)
break;
}
i += lmatch - 1; /* skip over matched bytes */
if (i > (lbuf - lsequence))
break; /* FIXME: can this ever happen? */
}
SET_LENGTH(res, ires);
UNPROTECT(6);
return(res);
}
/*#define DEBUG 1*/
SEXP locate_vector_imu_sequences(SEXP buf)
{
/*
* imu = Inertial Motion Unit (system-integrator-manual_Dec2014_jan.pdf p30-32)
*
* *(buf) 0xa5
* *(buf+1) 0x71
* *(buf+2,3) int, # bytes in structure
* There are 3 possibilities, keyed by *(buf+6), "K", say
*
* Case | K | Contents
* =====|======|=====================================================================
* A | 0xc2 | ?
* B | 0xcc | Acceleration, Angular Rate, Magnetometer Vectors, Orientation Matrix
* C | 0xd2 | Gyro-stabilized Acceleration, Angular Rate, Magnetometer Vectors
* D | 0xd3 | DeltaAngle, DeltaVelocity, Magnetometer Vectors
*
* QUESTION: what is AHRSchecksum? do we check that? And what is
* this second 'Checksum'?
* Case A has checksum starting at offset 84 (sum of all words in structure)
*/
/*
library(oce)
system("R CMD SHLIB bitwise.c")
dyn.load("bitwise.so")
f <- "/Users/kelley/src/dolfyn/example_data/vector_data_imu01.VEC"
buf <- readBin(f, what="raw", n=1e5)
a <- .Call("locate_vector_imu_sequences", buf)
for (aa in a[1:10]) {
message(paste(paste("0x", buf[aa+seq.int(0, 6L)], sep=""), collapse=" "))
}
ensembleCounter <- as.numeric(buf[a + 4])
plot(seq_along(a), ensembleCounter, type='l')
*/
PROTECT(buf = AS_RAW(buf));
unsigned char *bufp;
bufp = RAW_POINTER(buf);
int bufn = LENGTH(buf);
SEXP res;
PROTECT(res = NEW_INTEGER(bufn)); // definitely more than enough space
int *resp = INTEGER_POINTER(res);
int resn = 0;
//int check=10; // check this many instance of 0xa5,0x71
// We check 5 bytes, on the assumption that false positives will be
// effectively zero then (1e-12, if independent random numbers
// in range 0 to 255).
// FIXME: test the checksum, but SIG2 does not state how.
for (int i = 0; i < bufn-1; i++) {
if (bufp[i] == 0xa5 && bufp[i+1] == 0x71) {
//if (check-- > 0) Rprintf("IMU test: buf[%d]=0x%02x, buf[%d+2]=0x%02x, buf[%d+5]=0x%02x\n", i, bufp[i], i, bufp[i+2], i, bufp[i+5]);
// Check at offset=5, which must be 1 of 3 choices.
if (bufp[i+5] == 0xc3) {
// FIXME: should verify this length check, which I got by inspecting dolfyn code
// and a file provided privately in March 2016.
if (bufp[i+2] == 0x24 && bufp[i+3] == 0x00) {
resp[resn++] = i + 1; // add 1 for R notation
i++; //FIXME: skip to end, when we really trust identification
}
} else if (bufp[i+5] == 0xcc) {
// length indication should be 0x2b=43=86/2 (SIG2, top of page 31)
if (bufp[i+2] == 0x2b && bufp[i+3] == 0x00) {
resp[resn++] = i + 1; // add 1 for R notation
i++; //FIXME: skip to end, when we really trust identification
}
} else if (bufp[i+5] == 0xd2) { // decimal 210
// length indication should be 0x19=25=50/2 (SIG2, middle of page 31)
if (bufp[i+2] == 0x19 && bufp[i+3] == 0x00) {
resp[resn++] = i + 1; // add 1 for R notation
i++; //FIXME: skip to end, when we really trust identification
}
} else if (bufp[i+5] ==0xd3) { // decimal 211
// length indication should be 0x19=25=50/2 (SIG2, page 32)
if (bufp[i+2] == 0x19 && bufp[i+3] == 0x00) {
resp[resn++] = i + 1; // add 1 for R notation
i++; //FIXME: skip to end, when we really trust identification
}
}
}
}
SET_LENGTH(res, resn);
UNPROTECT(2);
return(res);
}
/* Return a data.frame containing the requested number of rows from
the resultset.
We try to determine the correct R type for each column in the
result. Currently, type detection happens only for the first fetch
on a given resultset and the first row of the resultset is used for
type interpolation. If a NULL value appears in the first row of
the resultset and the column corresponds to a DB table column, we
guess the type based on the DB schema definition for the column.
If the NULL value does not correspond to a table column, then we
force character.
*/
SEXP rsqlite_query_fetch(SEXP handle, SEXP max_rec) {
SQLiteResult* res = rsqlite_result_from_handle(handle);
if (res->isSelect != 1) {
warning("resultSet does not correspond to a SELECT statement");
return R_NilValue;
}
if (res->completed == 1) {
return R_NilValue;
}
/* We need to step once to be able to create the data mappings */
int row_idx = 0;
int state = do_select_step(res, row_idx);
sqlite3_stmt* db_statement = (sqlite3_stmt*) res->drvResultSet;
if (state != SQLITE_ROW && state != SQLITE_DONE) {
error("rsqlite_query_fetch: failed first step: %s",
sqlite3_errmsg(sqlite3_db_handle(db_statement)));
}
SQLiteFields* flds = rsqlite_result_fields(res);
int num_fields = flds->num_fields;
int num_rec = asInteger(max_rec);
int expand = (num_rec < 0); /* dyn expand output to accommodate all rows*/
if (expand || num_rec == 0) {
num_rec = rsqlite_driver()->fetch_default_rec;
}
SEXP output = PROTECT(NEW_LIST(num_fields));
rsqlite_output_alloc(output, flds, num_rec);
while (state != SQLITE_DONE) {
fill_one_row(db_statement, output, row_idx, flds);
row_idx++;
if (row_idx == num_rec) { /* request satisfied or exhausted allocated space */
if (expand) { /* do we extend or return the records fetched so far*/
num_rec = 1.5 * num_rec;
rsqlite_output_expand(output, flds, num_rec);
} else {
break; /* okay, no more fetching for now */
}
}
state = do_select_step(res, row_idx);
if (state != SQLITE_ROW && state != SQLITE_DONE) {
error("rsqlite_query_fetch: failed: %s",
sqlite3_errmsg(sqlite3_db_handle(db_statement)));
}
} /* end row loop */
if (state == SQLITE_DONE) {
res->completed = 1;
}
/* size to actual number of records fetched */
if (row_idx < num_rec) {
num_rec = row_idx;
/* adjust the length of each of the members in the output_list */
for (int j = 0; j < num_fields; j++) {
SEXP s_tmp = VECTOR_ELT(output, j);
PROTECT(SET_LENGTH(s_tmp, num_rec));
SET_VECTOR_ELT(output, j, s_tmp);
UNPROTECT(1);
}
}
res->rowCount += num_rec;
UNPROTECT(1);
return output;
}
// output is a named list
SEXP RS_MySQL_fetch(SEXP rsHandle, SEXP max_rec) {
MySQLDriver *mgr;
RS_DBI_resultSet *result;
RMySQLFields* flds;
MYSQL_RES *my_result;
MYSQL_ROW row;
SEXP output, s_tmp;
unsigned long *lens;
int i, j, null_item, expand;
int completed;
SEXPTYPE *fld_Sclass;
int num_rec;
int num_fields;
result = RS_DBI_getResultSet(rsHandle);
flds = result->fields;
if(!flds)
error("corrupt resultSet, missing fieldDescription");
num_rec = asInteger(max_rec);
expand = (num_rec < 0); // dyn expand output to accommodate all rows
if(expand || num_rec == 0){
mgr = rmysql_driver();
num_rec = mgr->fetch_default_rec;
}
num_fields = flds->num_fields;
PROTECT(output = NEW_LIST((int) num_fields));
RS_DBI_allocOutput(output, flds, num_rec, 0);
fld_Sclass = flds->Sclass;
// actual fetching....
my_result = (MYSQL_RES *) result->drvResultSet;
completed = (int) 0;
for(i = 0; ; i++){
if(i==num_rec){ // exhausted the allocated space
if(expand){ // do we extend or return the records fetched so far
num_rec = 2 * num_rec;
RS_DBI_allocOutput(output, flds, num_rec, expand);
}
else
break; // okay, no more fetching for now
}
row = mysql_fetch_row(my_result);
if(row==NULL){ // either we finish or we encounter an error
unsigned int err_no;
RS_DBI_connection *con;
con = RS_DBI_getConnection(rsHandle);
err_no = mysql_errno((MYSQL *) con->drvConnection);
completed = (int) (err_no ? -1 : 1);
break;
}
lens = mysql_fetch_lengths(my_result);
for(j = 0; j < num_fields; j++){
null_item = (row[j] == NULL);
switch((int)fld_Sclass[j]){
case INTSXP:
if(null_item)
NA_SET(&(LST_INT_EL(output,j,i)), INTSXP);
else
LST_INT_EL(output,j,i) = (int) atol(row[j]);
break;
case STRSXP:
// BUG: I need to verify that a TEXT field (which is stored as
// a BLOB by MySQL!) is indeed char and not a true
// Binary obj (MySQL does not truly distinguish them). This
// test is very gross.
if(null_item)
SET_LST_CHR_EL(output,j,i,NA_STRING);
else {
if((size_t) lens[j] != strlen(row[j])){
warning("internal error: row %d field %d truncated", i, j);
}
SET_LST_CHR_EL(output,j,i,mkChar(row[j]));
}
break;
case REALSXP:
if(null_item)
NA_SET(&(LST_NUM_EL(output,j,i)), REALSXP);
else
LST_NUM_EL(output,j,i) = (double) atof(row[j]);
break;
default: // error, but we'll try the field as character (!)
if(null_item)
SET_LST_CHR_EL(output,j,i, NA_STRING);
else {
warning("unrecognized field type %d in column %d", fld_Sclass[j], j);
SET_LST_CHR_EL(output,j,i,mkChar(row[j]));
}
break;
}
}
}
// actual number of records fetched
if(i < num_rec){
num_rec = i;
// adjust the length of each of the members in the output_list
for(j = 0; j<num_fields; j++){
s_tmp = LST_EL(output,j);
PROTECT(SET_LENGTH(s_tmp, num_rec));
SET_ELEMENT(output, j, s_tmp);
UNPROTECT(1);
}
}
if(completed < 0)
warning("error while fetching rows");
result->rowCount += num_rec;
result->completed = (int) completed;
UNPROTECT(1);
return output;
}
