SEXP RS_DBI_createNamedList(char **names, SEXPTYPE *types, int *lengths, int n) {
SEXP output, output_names, obj = R_NilValue;
int num_elem;
int j;
PROTECT(output = NEW_LIST(n));
PROTECT(output_names = NEW_CHARACTER(n));
for(j = 0; j < n; j++){
num_elem = lengths[j];
switch((int)types[j]){
case LGLSXP:
PROTECT(obj = NEW_LOGICAL(num_elem));
break;
case INTSXP:
PROTECT(obj = NEW_INTEGER(num_elem));
break;
case REALSXP:
PROTECT(obj = NEW_NUMERIC(num_elem));
break;
case STRSXP:
PROTECT(obj = NEW_CHARACTER(num_elem));
break;
case VECSXP:
PROTECT(obj = NEW_LIST(num_elem));
break;
default:
error("unsupported data type");
}
SET_ELEMENT(output, (int)j, obj);
SET_CHR_EL(output_names, j, mkChar(names[j]));
}
SET_NAMES(output, output_names);
UNPROTECT(n+2);
return(output);
}
/* open a connection with the same parameters used for in
* conHandle
*/
Con_Handle *
RS_PostgreSQL_cloneConnection(Con_Handle * conHandle)
{
S_EVALUATOR Mgr_Handle * mgrHandle;
RS_DBI_connection *con;
RS_PostgreSQL_conParams *conParams;
s_object *con_params;
/* get connection params used to open existing connection */
con = RS_DBI_getConnection(conHandle);
conParams = con->conParams;
mgrHandle = RS_DBI_asMgrHandle(MGR_ID(conHandle));
/* Connection parameters need to be put into a 8-element character
* vector to be passed to the RS_PostgreSQL_newConnection() function.
*/
MEM_PROTECT(con_params = NEW_CHARACTER((Sint) 7));
SET_CHR_EL(con_params, 0, C_S_CPY(conParams->user));
SET_CHR_EL(con_params, 1, C_S_CPY(conParams->password));
SET_CHR_EL(con_params, 2, C_S_CPY(conParams->host));
SET_CHR_EL(con_params, 3, C_S_CPY(conParams->dbname));
SET_CHR_EL(con_params, 4, C_S_CPY(conParams->port));
SET_CHR_EL(con_params, 5, C_S_CPY(conParams->tty));
SET_CHR_EL(con_params, 6, C_S_CPY(conParams->options));
MEM_UNPROTECT(1);
return RS_PostgreSQL_newConnection(mgrHandle, con_params);
}
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;
}
SEXP rmysql_driver_info() {
MySQLDriver *mgr = rmysql_driver();
// Allocate output
SEXP output = PROTECT(allocVector(VECSXP, 6));
SEXP output_nms = PROTECT(allocVector(STRSXP, 6));
SET_NAMES(output, output_nms);
UNPROTECT(1);
SET_CHR_EL(output_nms, 0, mkChar("connectionIds"));
SEXP cons = PROTECT(allocVector(INTSXP, mgr->num_con));
RS_DBI_listEntries(mgr->connectionIds, mgr->num_con, INTEGER(cons));
SET_VECTOR_ELT(output, 0, cons);
UNPROTECT(1);
SET_CHR_EL(output_nms, 1, mkChar("fetch_default_rec"));
SET_VECTOR_ELT(output, 1, ScalarInteger(mgr->fetch_default_rec));
SET_CHR_EL(output_nms, 2, mkChar("length"));
SET_VECTOR_ELT(output, 2, ScalarInteger(mgr->length));
SET_CHR_EL(output_nms, 3, mkChar("num_con"));
SET_VECTOR_ELT(output, 3, ScalarInteger(mgr->num_con));
SET_CHR_EL(output_nms, 4, mkChar("counter"));
SET_VECTOR_ELT(output, 4, ScalarInteger(mgr->counter));
SET_CHR_EL(output_nms, 5, mkChar("clientVersion"));
SET_VECTOR_ELT(output, 5, mkString(mysql_get_client_info()));
UNPROTECT(1);
return output;
}
