SEXP R_handle_setopt(SEXP ptr, SEXP keys, SEXP values){
CURL *handle = get_handle(ptr);
SEXP optnames = getAttrib(values, R_NamesSymbol);
if(!isInteger(keys))
error("keys` must be an integer");
if(!isVector(values))
error("`values` must be a list");
for(int i = 0; i < length(keys); i++){
int key = INTEGER(keys)[i];
const char* optname = CHAR(STRING_ELT(optnames, i));
SEXP val = VECTOR_ELT(values, i);
if(val == R_NilValue){
assert(curl_easy_setopt(handle, key, NULL));
} else if (key == CURLOPT_PROGRESSFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_PROGRESSFUNCTION,
(curl_progress_callback) R_curl_callback_progress));
assert(curl_easy_setopt(handle, CURLOPT_PROGRESSDATA, val));
} else if (key == CURLOPT_READFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_READFUNCTION,
(curl_read_callback) R_curl_callback_read));
assert(curl_easy_setopt(handle, CURLOPT_READDATA, val));
} else if (key == CURLOPT_DEBUGFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_DEBUGFUNCTION,
(curl_debug_callback) R_curl_callback_debug));
assert(curl_easy_setopt(handle, CURLOPT_DEBUGDATA, val));
} else if (opt_is_linked_list(key)) {
error("Option %s (%d) not supported.", optname, key);
} else if(key < 10000){
if(!isNumeric(val) || length(val) != 1) {
error("Value for option %s (%d) must be a number.", optname, key);
}
assert(curl_easy_setopt(handle, key, (long) asInteger(val)));
} else if(key < 20000){
switch (TYPEOF(val)) {
case RAWSXP:
assert(curl_easy_setopt(handle, key, RAW(val)));
break;
case STRSXP:
if (length(val) != 1)
error("Value for option %s (%d) must be length-1 string", optname, key);
assert(curl_easy_setopt(handle, key, CHAR(STRING_ELT(val, 0))));
break;
default:
error("Value for option %s (%d) must be a string or raw vector.", optname, key);
}
} else if(key >= 30000 && key < 40000){
if(!isNumeric(val) || length(val) != 1) {
error("Value for option %s (%d) must be a number.", optname, key);
}
assert(curl_easy_setopt(handle, key, (curl_off_t) asReal(val)));
} else {
error("Option %s (%d) not supported.", optname, key);
}
}
return ScalarLogical(1);
}
SEXP R_handle_setopt(SEXP ptr, SEXP keys, SEXP values){
CURL *handle = get_handle(ptr);
SEXP prot = R_ExternalPtrProtected(ptr);
SEXP optnames = PROTECT(getAttrib(values, R_NamesSymbol));
if(!isInteger(keys))
error("keys` must be an integer");
if(!isVector(values))
error("`values` must be a list");
for(int i = 0; i < length(keys); i++){
int key = INTEGER(keys)[i];
const char* optname = CHAR(STRING_ELT(optnames, i));
SEXP val = VECTOR_ELT(values, i);
if(val == R_NilValue){
assert(curl_easy_setopt(handle, key, NULL));
#ifdef HAS_XFERINFOFUNCTION
} else if (key == CURLOPT_XFERINFOFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_XFERINFOFUNCTION,
(curl_progress_callback) R_curl_callback_xferinfo));
assert(curl_easy_setopt(handle, CURLOPT_XFERINFODATA, val));
assert(curl_easy_setopt(handle, CURLOPT_NOPROGRESS, 0));
SET_VECTOR_ELT(prot, 1, val); //protect gc
#endif
} else if (key == CURLOPT_PROGRESSFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_PROGRESSFUNCTION,
(curl_progress_callback) R_curl_callback_progress));
assert(curl_easy_setopt(handle, CURLOPT_PROGRESSDATA, val));
assert(curl_easy_setopt(handle, CURLOPT_NOPROGRESS, 0));
SET_VECTOR_ELT(prot, 2, val); //protect gc
} else if (key == CURLOPT_READFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_READFUNCTION,
(curl_read_callback) R_curl_callback_read));
assert(curl_easy_setopt(handle, CURLOPT_READDATA, val));
SET_VECTOR_ELT(prot, 3, val); //protect gc
} else if (key == CURLOPT_DEBUGFUNCTION) {
if (TYPEOF(val) != CLOSXP)
error("Value for option %s (%d) must be a function.", optname, key);
assert(curl_easy_setopt(handle, CURLOPT_DEBUGFUNCTION,
(curl_debug_callback) R_curl_callback_debug));
assert(curl_easy_setopt(handle, CURLOPT_DEBUGDATA, val));
SET_VECTOR_ELT(prot, 4, val); //protect gc
} else if (key == CURLOPT_URL) {
/* always use utf-8 for urls */
const char * url_utf8 = translateCharUTF8(STRING_ELT(val, 0));
assert(curl_easy_setopt(handle, CURLOPT_URL, url_utf8));
} else if (opt_is_linked_list(key)) {
error("Option %s (%d) not supported.", optname, key);
} else if(key < 10000){
if(!isNumeric(val) || length(val) != 1) {
error("Value for option %s (%d) must be a number.", optname, key);
}
assert(curl_easy_setopt(handle, key, (long) asInteger(val)));
} else if(key < 20000){
switch (TYPEOF(val)) {
case RAWSXP:
if(key == CURLOPT_POSTFIELDS || key == CURLOPT_COPYPOSTFIELDS)
assert(curl_easy_setopt(handle, CURLOPT_POSTFIELDSIZE_LARGE, (curl_off_t) Rf_length(val)));
assert(curl_easy_setopt(handle, key, RAW(val)));
break;
case STRSXP:
if (length(val) != 1)
error("Value for option %s (%d) must be length-1 string", optname, key);
assert(curl_easy_setopt(handle, key, CHAR(STRING_ELT(val, 0))));
break;
default:
error("Value for option %s (%d) must be a string or raw vector.", optname, key);
}
} else if(key >= 30000 && key < 40000){
if(!isNumeric(val) || length(val) != 1) {
error("Value for option %s (%d) must be a number.", optname, key);
}
assert(curl_easy_setopt(handle, key, (curl_off_t) asReal(val)));
} else {
error("Option %s (%d) not supported.", optname, key);
}
}
UNPROTECT(1);
return ScalarLogical(1);
}
