/* 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; }