/* utility to cleanup e.g. after interrpts */
static void wt_cleanup(void *data)
{
wt_info *ld = data;
if(!ld->wasopen) ld->con->close(ld->con);
R_FreeStringBuffer(ld->buf);
R_print.digits = ld->savedigits;
}
/* This may return a R_alloc-ed result, so the caller has to manage the
R_alloc stack */
const char *translateCharUTF8(SEXP x)
{
void *obj;
const char *inbuf, *ans = CHAR(x);
char *outbuf, *p;
size_t inb, outb, res;
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
if(TYPEOF(x) != CHARSXP)
error(_("'%s' must be called on a CHARSXP"), "translateCharUTF8");
if(x == NA_STRING) return ans;
if(IS_UTF8(x)) return ans;
if(IS_ASCII(x)) return ans;
if(IS_BYTES(x))
error(_("translating strings with \"bytes\" encoding is not allowed"));
obj = Riconv_open("UTF-8", IS_LATIN1(x) ? "latin1" : "");
if(obj == (void *)(-1))
#ifdef Win32
error(_("unsupported conversion from '%s' in codepage %d"),
"latin1", localeCP);
#else
error(_("unsupported conversion from '%s' to '%s'"), "latin1", "UTF-8");
#endif
R_AllocStringBuffer(0, &cbuff);
top_of_loop:
inbuf = ans; inb = strlen(inbuf);
outbuf = cbuff.data; outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && (errno == EILSEQ || errno == EINVAL)) {
if(outb < 5) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
goto next_char;
}
*outbuf = '\0';
Riconv_close(obj);
res = strlen(cbuff.data) + 1;
p = R_alloc(res, 1);
memcpy(p, cbuff.data, res);
R_FreeStringBuffer(&cbuff);
return p;
}
SEXP installTrChar(SEXP x)
{
void * obj;
const char *inbuf, *ans = CHAR(x);
char *outbuf;
size_t inb, outb, res;
cetype_t ienc = getCharCE(x);
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
if(TYPEOF(x) != CHARSXP)
error(_("'%s' must be called on a CHARSXP"), "installTrChar");
if(x == NA_STRING || !(ENC_KNOWN(x))) return install(ans);
if(IS_BYTES(x))
error(_("translating strings with \"bytes\" encoding is not allowed"));
if(utf8locale && IS_UTF8(x)) return install(ans);
if(latin1locale && IS_LATIN1(x)) return install(ans);
if(IS_ASCII(x)) return install(ans);
if(IS_LATIN1(x)) {
if(!latin1_obj) {
obj = Riconv_open("", "latin1");
/* should never happen */
if(obj == (void *)(-1))
#ifdef Win32
error(_("unsupported conversion from '%s' in codepage %d"),
"latin1", localeCP);
#else
error(_("unsupported conversion from '%s' to '%s'"),
"latin1", "");
#endif
latin1_obj = obj;
}
obj = latin1_obj;
} else {
if(!utf8_obj) {
obj = Riconv_open("", "UTF-8");
/* should never happen */
if(obj == (void *)(-1))
#ifdef Win32
error(_("unsupported conversion from '%s' in codepage %d"),
"latin1", localeCP);
#else
error(_("unsupported conversion from '%s' to '%s'"),
"latin1", "");
#endif
utf8_obj = obj;
}
obj = utf8_obj;
}
R_AllocStringBuffer(0, &cbuff);
top_of_loop:
inbuf = ans; inb = strlen(inbuf);
outbuf = cbuff.data; outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && (errno == EILSEQ || errno == EINVAL)) {
if(outb < 13) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
if (ienc == CE_UTF8) {
/* if starting in UTF-8, use \uxxxx */
/* This must be the first byte */
size_t clen;
wchar_t wc;
clen = utf8toucs(&wc, inbuf);
if(clen > 0 && inb >= clen) {
inbuf += clen; inb -= clen;
# ifndef Win32
if((unsigned int) wc < 65536) {
# endif
snprintf(outbuf, 9, "<U+%04X>", (unsigned int) wc);
outbuf += 8; outb -= 8;
# ifndef Win32
} else {
snprintf(outbuf, 13, "<U+%08X>", (unsigned int) wc);
outbuf += 12; outb -= 12;
}
# endif
} else {
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
}
} else {
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
}
goto next_char;
}
*outbuf = '\0';
SEXP Sans = install(cbuff.data);
R_FreeStringBuffer(&cbuff);
return Sans;
}
/* iconv(x, from, to, sub, mark) */
SEXP attribute_hidden do_iconv(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP ans, x = CAR(args), si;
void * obj;
const char *inbuf;
char *outbuf;
const char *sub;
size_t inb, outb, res;
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
Rboolean isRawlist = FALSE;
checkArity(op, args);
if(isNull(x)) { /* list locales */
#ifdef HAVE_ICONVLIST
cnt = 0;
iconvlist(count_one, NULL);
PROTECT(ans = allocVector(STRSXP, cnt));
cnt = 0;
iconvlist(write_one, (void *)ans);
#else
PROTECT(ans = R_NilValue);
#endif
} else {
int mark, toRaw;
const char *from, *to;
Rboolean isLatin1 = FALSE, isUTF8 = FALSE;
args = CDR(args);
if(!isString(CAR(args)) || length(CAR(args)) != 1)
error(_("invalid '%s' argument"), "from");
from = CHAR(STRING_ELT(CAR(args), 0)); /* ASCII */
args = CDR(args);
if(!isString(CAR(args)) || length(CAR(args)) != 1)
error(_("invalid '%s' argument"), "to");
to = CHAR(STRING_ELT(CAR(args), 0));
args = CDR(args);
if(!isString(CAR(args)) || length(CAR(args)) != 1)
error(_("invalid '%s' argument"), "sub");
if(STRING_ELT(CAR(args), 0) == NA_STRING) sub = NULL;
else sub = translateChar(STRING_ELT(CAR(args), 0));
args = CDR(args);
mark = asLogical(CAR(args));
if(mark == NA_LOGICAL)
error(_("invalid '%s' argument"), "mark");
args = CDR(args);
toRaw = asLogical(CAR(args));
if(toRaw == NA_LOGICAL)
error(_("invalid '%s' argument"), "toRaw");
/* some iconv's allow "UTF8", but libiconv does not */
if(streql(from, "UTF8") || streql(from, "utf8") ) from = "UTF-8";
if(streql(to, "UTF8") || streql(to, "utf8") ) to = "UTF-8";
/* Should we do something about marked CHARSXPs in 'from = ""'? */
if(streql(to, "UTF-8")) isUTF8 = TRUE;
if(streql(to, "latin1") || streql(to, "ISO_8859-1")
|| streql(to, "CP1252")) isLatin1 = TRUE;
if(streql(to, "") && known_to_be_latin1) isLatin1 = TRUE;
if(streql(to, "") && known_to_be_utf8) isUTF8 = TRUE;
obj = Riconv_open(to, from);
if(obj == (iconv_t)(-1))
#ifdef Win32
error(_("unsupported conversion from '%s' to '%s' in codepage %d"),
from, to, localeCP);
#else
error(_("unsupported conversion from '%s' to '%s'"), from, to);
#endif
isRawlist = (TYPEOF(x) == VECSXP);
if(isRawlist) {
if(toRaw)
PROTECT(ans = duplicate(x));
else {
PROTECT(ans = allocVector(STRSXP, LENGTH(x)));
DUPLICATE_ATTRIB(ans, x);
}
} else {
if(TYPEOF(x) != STRSXP)
error(_("'x' must be a character vector"));
if(toRaw) {
PROTECT(ans = allocVector(VECSXP, LENGTH(x)));
DUPLICATE_ATTRIB(ans, x);
} else
PROTECT(ans = duplicate(x));
}
R_AllocStringBuffer(0, &cbuff); /* 0 -> default */
for(R_xlen_t i = 0; i < XLENGTH(x); i++) {
if (isRawlist) {
si = VECTOR_ELT(x, i);
if (TYPEOF(si) == NILSXP) {
if (!toRaw) SET_STRING_ELT(ans, i, NA_STRING);
continue;
} else if (TYPEOF(si) != RAWSXP)
error(_("'x' must be a list of NULL or raw vectors"));
} else {
si = STRING_ELT(x, i);
if (si == NA_STRING) {
if(!toRaw) SET_STRING_ELT(ans, i, NA_STRING);
continue;
}
}
top_of_loop:
inbuf = isRawlist ? (const char *) RAW(si) : CHAR(si);
inb = LENGTH(si);
outbuf = cbuff.data; outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
*outbuf = '\0';
/* other possible error conditions are incomplete
and invalid multibyte chars */
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && sub &&
(errno == EILSEQ || errno == EINVAL)) {
/* it seems this gets thrown for non-convertible input too */
if(strcmp(sub, "byte") == 0) {
if(outb < 5) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
} else {
size_t j;
if(outb < strlen(sub)) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
memcpy(outbuf, sub, j = strlen(sub));
outbuf += j;
outb -= j;
}
inbuf++; inb--;
goto next_char;
}
if(toRaw) {
if(res != -1 && inb == 0) {
size_t nout = cbuff.bufsize - 1 - outb;
SEXP el = allocVector(RAWSXP, nout);
memcpy(RAW(el), cbuff.data, nout);
SET_VECTOR_ELT(ans, i, el);
} /* otherwise is already NULL */
} else {
if(res != -1 && inb == 0) {
cetype_t ienc = CE_NATIVE;
size_t nout = cbuff.bufsize - 1 - outb;
if(mark) {
if(isLatin1) ienc = CE_LATIN1;
else if(isUTF8) ienc = CE_UTF8;
}
SET_STRING_ELT(ans, i,
mkCharLenCE(cbuff.data, (int) nout, ienc));
} else SET_STRING_ELT(ans, i, NA_STRING);
}
}
Riconv_close(obj);
R_FreeStringBuffer(&cbuff);
}
UNPROTECT(1);
return ans;
}
/* A version avoiding R_alloc for use in the Rgui editor */
void reEnc2(const char *x, char *y, int ny,
cetype_t ce_in, cetype_t ce_out, int subst)
{
void * obj;
const char *inbuf;
char *outbuf;
size_t inb, outb, res, top;
char *tocode = NULL, *fromcode = NULL;
char buf[20];
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
strncpy(y, x, ny);
y[ny - 1] = '\0';
if(ce_in == ce_out || ce_in == CE_ANY || ce_out == CE_ANY) return;
if(utf8locale && ce_in == CE_NATIVE && ce_out == CE_UTF8) return;
if(utf8locale && ce_out == CE_NATIVE && ce_in == CE_UTF8) return;
if(latin1locale && ce_in == CE_NATIVE && ce_out == CE_LATIN1) return;
if(latin1locale && ce_out == CE_NATIVE && ce_in == CE_LATIN1) return;
if(strIsASCII(x)) return;
switch(ce_in) {
case CE_NATIVE:
{
/* Looks like CP1252 is treated as Latin-1 by iconv */
snprintf(buf, 20, "CP%d", localeCP);
fromcode = buf;
break;
}
case CE_LATIN1: fromcode = "CP1252"; break;
case CE_UTF8: fromcode = "UTF-8"; break;
default: return;
}
switch(ce_out) {
case CE_NATIVE:
{
/* avoid possible misidentification of CP1250 as LATIN-2 */
snprintf(buf, 20, "CP%d", localeCP);
tocode = buf;
break;
}
case CE_LATIN1: tocode = "latin1"; break;
case CE_UTF8: tocode = "UTF-8"; break;
default: return;
}
obj = Riconv_open(tocode, fromcode);
if(obj == (void *)(-1)) return;
R_AllocStringBuffer(0, &cbuff);
top_of_loop:
inbuf = x; inb = strlen(inbuf);
outbuf = cbuff.data; top = outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && (errno == EILSEQ || errno == EINVAL)) {
switch(subst) {
case 1: /* substitute hex */
if(outb < 5) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
goto next_char;
break;
case 2: /* substitute . */
if(outb < 1) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
*outbuf++ = '.'; inbuf++; outb--; inb--;
goto next_char;
break;
case 3: /* substitute ? */
if(outb < 1) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
*outbuf++ = '?'; inbuf++; outb--; inb--;
goto next_char;
break;
default: /* skip byte */
inbuf++; inb--;
goto next_char;
}
}
Riconv_close(obj);
*outbuf = '\0';
res = (top-outb)+1; /* strlen(cbuff.data) + 1; */
if (res > ny) error("converted string too long for buffer");
memcpy(y, cbuff.data, res);
R_FreeStringBuffer(&cbuff);
}
/* This may return a R_alloc-ed result, so the caller has to manage the
R_alloc stack */
const char *reEnc(const char *x, cetype_t ce_in, cetype_t ce_out, int subst)
{
void * obj;
const char *inbuf;
char *outbuf, *p;
size_t inb, outb, res, top;
char *tocode = NULL, *fromcode = NULL;
#ifdef Win32
char buf[20];
#endif
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
/* We can only encode from Symbol to UTF-8 */
if(ce_in == ce_out || ce_out == CE_SYMBOL ||
ce_in == CE_ANY || ce_out == CE_ANY) return x;
if(ce_in == CE_SYMBOL) {
if(ce_out == CE_UTF8) {
size_t nc = 3*strlen(x)+1; /* all in BMP */
p = R_alloc(nc, 1);
Rf_AdobeSymbol2utf8(p, x, nc);
return p;
} else return x;
}
if(utf8locale && ce_in == CE_NATIVE && ce_out == CE_UTF8) return x;
if(utf8locale && ce_out == CE_NATIVE && ce_in == CE_UTF8) return x;
if(latin1locale && ce_in == CE_NATIVE && ce_out == CE_LATIN1) return x;
if(latin1locale && ce_out == CE_NATIVE && ce_in == CE_LATIN1) return x;
if(strIsASCII(x)) return x;
switch(ce_in) {
#ifdef Win32
case CE_NATIVE:
{
/* Looks like CP1252 is treated as Latin-1 by iconv */
snprintf(buf, 20, "CP%d", localeCP);
fromcode = buf;
break;
}
case CE_LATIN1: fromcode = "CP1252"; break;
#else
case CE_NATIVE: fromcode = ""; break;
case CE_LATIN1: fromcode = "latin1"; break;
#endif
case CE_UTF8: fromcode = "UTF-8"; break;
default: return x;
}
switch(ce_out) {
#ifdef Win32
case CE_NATIVE:
{
/* avoid possible misidentification of CP1250 as LATIN-2 */
snprintf(buf, 20, "CP%d", localeCP);
tocode = buf;
break;
}
#else
case CE_NATIVE: tocode = ""; break;
#endif
case CE_LATIN1: tocode = "latin1"; break;
case CE_UTF8: tocode = "UTF-8"; break;
default: return x;
}
obj = Riconv_open(tocode, fromcode);
if(obj == (void *)(-1)) return x;
R_AllocStringBuffer(0, &cbuff);
top_of_loop:
inbuf = x; inb = strlen(inbuf);
outbuf = cbuff.data; top = outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && (errno == EILSEQ || errno == EINVAL)) {
switch(subst) {
case 1: /* substitute hex */
if(outb < 5) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
goto next_char;
break;
case 2: /* substitute . */
if(outb < 1) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
*outbuf++ = '.'; inbuf++; outb--; inb--;
goto next_char;
break;
case 3: /* substitute ? */
if(outb < 1) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
*outbuf++ = '?'; inbuf++; outb--; inb--;
goto next_char;
break;
default: /* skip byte */
inbuf++; inb--;
goto next_char;
}
}
Riconv_close(obj);
*outbuf = '\0';
res = (top-outb)+1; /* strlen(cbuff.data) + 1; */
p = R_alloc(res, 1);
memcpy(p, cbuff.data, res);
R_FreeStringBuffer(&cbuff);
return p;
}
/* This may return a R_alloc-ed result, so the caller has to manage the
R_alloc stack */
attribute_hidden /* but not hidden on Windows, where it was used in tcltk.c */
const wchar_t *wtransChar(SEXP x)
{
void * obj;
const char *inbuf, *ans = CHAR(x);
char *outbuf;
wchar_t *p;
size_t inb, outb, res, top;
Rboolean knownEnc = FALSE;
R_StringBuffer cbuff = {NULL, 0, MAXELTSIZE};
if(TYPEOF(x) != CHARSXP)
error(_("'%s' must be called on a CHARSXP"), "wtransChar");
if(IS_BYTES(x))
error(_("translating strings with \"bytes\" encoding is not allowed"));
if(IS_LATIN1(x)) {
if(!latin1_wobj) {
obj = Riconv_open(TO_WCHAR, "latin1");
if(obj == (void *)(-1))
error(_("unsupported conversion from '%s' to '%s'"),
"latin1", TO_WCHAR);
latin1_wobj = obj;
} else
obj = latin1_wobj;
knownEnc = TRUE;
} else if(IS_UTF8(x)) {
if(!utf8_wobj) {
obj = Riconv_open(TO_WCHAR, "UTF-8");
if(obj == (void *)(-1))
error(_("unsupported conversion from '%s' to '%s'"),
"latin1", TO_WCHAR);
utf8_wobj = obj;
} else
obj = utf8_wobj;
knownEnc = TRUE;
} else {
obj = Riconv_open(TO_WCHAR, "");
if(obj == (void *)(-1))
#ifdef Win32
error(_("unsupported conversion to '%s' from codepage %d"),
TO_WCHAR, localeCP);
#else
error(_("unsupported conversion from '%s' to '%s'"), "", TO_WCHAR);
#endif
}
R_AllocStringBuffer(0, &cbuff);
top_of_loop:
inbuf = ans; inb = strlen(inbuf);
outbuf = cbuff.data; top = outb = cbuff.bufsize - 1;
/* First initialize output */
Riconv (obj, NULL, NULL, &outbuf, &outb);
next_char:
/* Then convert input */
res = Riconv(obj, &inbuf , &inb, &outbuf, &outb);
if(res == -1 && errno == E2BIG) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
} else if(res == -1 && (errno == EILSEQ || errno == EINVAL)) {
if(outb < 5) {
R_AllocStringBuffer(2*cbuff.bufsize, &cbuff);
goto top_of_loop;
}
snprintf(outbuf, 5, "<%02x>", (unsigned char)*inbuf);
outbuf += 4; outb -= 4;
inbuf++; inb--;
goto next_char;
/* if(!knownEnc) Riconv_close(obj);
error(_("invalid input in wtransChar")); */
}
if(!knownEnc) Riconv_close(obj);
res = (top - outb);
/* terminator is 2 or 4 null bytes */
p = (wchar_t *) R_alloc(res+4, 1);
memset(p, 0, res+4);
memcpy(p, cbuff.data, res);
R_FreeStringBuffer(&cbuff);
return p;
}
SEXP
RS_PostgreSQL_CopyInDataframe(Con_Handle * conHandle, SEXP x, SEXP nrow, SEXP ncol)
{
S_EVALUATOR RS_DBI_connection * con;
int nr, nc, i, j;
const char *cna ="\\N", *tmp=NULL /* -Wall */;
char cdec = '.';
PGconn *my_connection;
int pqretcode;
nr = asInteger(nrow);
nc = asInteger(ncol);
const int buff_threshold = 8000;
con = RS_DBI_getConnection(conHandle);
my_connection = (PGconn *) con->drvConnection;
if(isVectorList(x)) { /* A data frame */
R_StringBuffer rstrbuf = {NULL, 0, 10000};
char *strBuf = Calloc(buff_threshold * 2 + 2, char); /* + 2 for '\t' or '\n' plus '\0'*/
char *strendp = strBuf;
SEXP *levels;
*strendp = '\0';
R_AllocStringBuffer(10000, &rstrbuf);
/* handle factors internally, check integrity */
levels = (SEXP *) R_alloc(nc, sizeof(SEXP));
for(j = 0; j < nc; j++) {
SEXP xj;
xj = VECTOR_ELT(x, j);
if(LENGTH(xj) != nr)
error(("corrupt data frame -- length of column %d does not not match nrows"), j+1);
if(inherits(xj, "factor")) {
levels[j] = getAttrib(xj, R_LevelsSymbol);
} else levels[j] = R_NilValue;
}
for(i = 0; i < nr; i++) {
for(j = 0; j < nc; j++) {
SEXP xj;
xj = VECTOR_ELT(x, j);
if(j > 0){
*strendp++ = '\t';/*need no size count check here*/
}
if(isna(xj, i)) tmp = cna;
else {
if(!isNull(levels[j])) {
/* We cannot assume factors have integer levels */
if(TYPEOF(xj) == INTSXP){
tmp = EncodeElementS(levels[j], INTEGER(xj)[i] - 1,
&rstrbuf, cdec);
}else if(TYPEOF(xj) == REALSXP){
tmp = EncodeElementS(levels[j], REAL(xj)[i] - 1,
&rstrbuf, cdec);
}else
error("column %s claims to be a factor but does not have numeric codes", j+1);
} else {
tmp = EncodeElementS(xj, i,
&rstrbuf, cdec);
}
}
{
size_t n;
size_t len = strendp - strBuf;
n = strlen(tmp);
if (len + n < buff_threshold){
memcpy(strendp, tmp, n);/* we already know the length */
strendp += n;
}else if(n < buff_threshold){ /*copy and flush*/
memcpy(strendp, tmp, n);/* we already know the length */
pqretcode = PQputCopyData(my_connection, strBuf, len + n);
chkpqcopydataerr(my_connection, pqretcode);
strendp = strBuf;
}else{ /*flush and copy current*/
if(len > 0){
pqretcode = PQputCopyData(my_connection, strBuf, len);
chkpqcopydataerr(my_connection, pqretcode);
strendp = strBuf;
}
pqretcode = PQputCopyData(my_connection, tmp, n);
chkpqcopydataerr(my_connection, pqretcode);
}
}
}
*strendp = '\n'; strendp +=1; *strendp='\0';
}
pqretcode = PQputCopyData(my_connection, strBuf, strendp - strBuf);
chkpqcopydataerr(my_connection, pqretcode);
Free(strBuf);
R_FreeStringBuffer(&rstrbuf);
}
PQputCopyEnd(my_connection, NULL);
return R_NilValue;
}
static SEXP scanVector(SEXPTYPE type, int maxitems, int maxlines,
int flush, SEXP stripwhite, int blskip, LocalData *d)
{
SEXP ans, bns;
int blocksize, c, i, n, linesread, nprev,strip, bch;
char *buffer;
R_StringBuffer strBuf = {NULL, 0, MAXELTSIZE};
if (maxitems > 0) blocksize = maxitems;
else blocksize = SCAN_BLOCKSIZE;
R_AllocStringBuffer(0, &strBuf);
PROTECT(ans = allocVector(type, blocksize));
nprev = 0; n = 0; linesread = 0; bch = 1;
if (d->ttyflag) sprintf(ConsolePrompt, "1: ");
strip = asLogical(stripwhite);
for (;;) {
if(n % 10000 == 9999) R_CheckUserInterrupt();
if (bch == R_EOF) {
if (d->ttyflag) R_ClearerrConsole();
break;
}
else if (bch == '\n') {
linesread++;
if (linesread == maxlines)
break;
if (d->ttyflag) sprintf(ConsolePrompt, "%d: ", n + 1);
nprev = n;
}
if (n == blocksize) {
/* enlarge the vector*/
bns = ans;
if(blocksize > INT_MAX/2) error(_("too many items"));
blocksize = 2 * blocksize;
ans = allocVector(type, blocksize);
UNPROTECT(1);
PROTECT(ans);
copyVector(ans, bns);
}
buffer = fillBuffer(type, strip, &bch, d, &strBuf);
if (nprev == n && strlen(buffer)==0 &&
((blskip && bch =='\n') || bch == R_EOF)) {
if (d->ttyflag || bch == R_EOF)
break;
}
else {
extractItem(buffer, ans, n, d);
if (++n == maxitems) {
if (d->ttyflag && bch != '\n') { /* MBCS-safe */
while ((c = scanchar(FALSE, d)) != '\n')
;
}
break;
}
}
if (flush && (bch != '\n') && (bch != R_EOF)) { /* MBCS-safe */
while ((c = scanchar(FALSE, d)) != '\n' && (c != R_EOF));
bch = c;
}
}
if (!d->quiet) REprintf("Read %d item%s\n", n, (n == 1) ? "" : "s");
if (d->ttyflag) ConsolePrompt[0] = '\0';
if (n == 0) {
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return allocVector(type,0);
}
if (n == maxitems) {
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return ans;
}
bns = allocVector(type, n);
switch (type) {
case LGLSXP:
case INTSXP:
for (i = 0; i < n; i++)
INTEGER(bns)[i] = INTEGER(ans)[i];
break;
case REALSXP:
for (i = 0; i < n; i++)
REAL(bns)[i] = REAL(ans)[i];
break;
case CPLXSXP:
for (i = 0; i < n; i++)
COMPLEX(bns)[i] = COMPLEX(ans)[i];
break;
case STRSXP:
for (i = 0; i < n; i++)
SET_STRING_ELT(bns, i, STRING_ELT(ans, i));
break;
case RAWSXP:
for (i = 0; i < n; i++)
RAW(bns)[i] = RAW(ans)[i];
break;
default:
UNIMPLEMENTED_TYPEt("scanVector", type);
}
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return bns;
}
