if(FALSE) { setClass("CurlOptions", representation(ids="integer", values="list")) curlOptions = function(..., .opts = list()) { .args = rev(list(...)) # Why rev()? if(length(.args) == 0) return(NULL) dups = duplicated(names(.args)) if(any(dups)) { warning("Duplicated curl options: ", paste(names(.args)[dups], collapse = ", ")) .args = .args[!dup] } if(length(names(.args)) == 0) stop("curl options with no names") else if(any(names(.args) == "")) stop("unnamed curl option(s): ", .args[names(.args) == "" ]) opts = mapCurlOptNames(names(.args)) o = new("CurlOptions") o@ids = opts o@values = .args o } } # FALSE if(FALSE) { # Try to get these using GccTranslationUnit. # Yes. See CodeGeneration. CurlConstants = c(file = 1, writedata = 1, url = 2, port = 3, proxy = 4, userpwd = 5, proxyuserpwd = 6, range = 7, infile = 9, errorbufffer = 10, writefunction = 11, readfunction = 12, timeout = 13, infilesize = 14, postfields = 15, referer = 16, ftpport = 17, useragent = 18, low.speed.limit = 19, low.speed.time = 20, resume.from = 21, cookie = 22, httpheader = 23, httppost = 24, sslcert =25, verbose = 26, followlocation=27, netrc = 28, httpauth=29, cookiefile=30, crlf=31, headerfunction=32, sslversion=33, # long customerequest = 34, # string interface = 35, # string krb4level = 36, # "string" ssl.verifypeer = 37, # long cainfo = 38, # string capath = 39, # string passwdfunction = 40, # function filetime=41, # long maxredirs = 42, # long maxconnects = 43, # long fresh.connect = 44, #long forbid.reuse = 45, # long egdsocket = 46, # string connecttimeout = 47, # long httpget = 48, # long ssl.verifyhost = 49, # long cookiejar = 50, # string ssl.cipher.list = 51, # string (colon separated) http.version = 52, # enum (long) dns.cache.timeout = 53, # long dns.use.global.cache = 54 , # long debugfunction = 55 # function ) } # FALSE CurlNetrc = c(ignored = 0, optional = 1, required = 2) mode(CurlNetrc) = "integer" class(CurlNetrc) = c("CurlNetrcEnum", "Enum") setClass("Enum", contains = "integer") setMethod("show", "Enum", function(object) show(paste(names(object), " (", object, ")", sep = ""))) setClass("NetrcEnum", contains = "Enum") setMethod("coerce", c("numeric", "NetrcEnum"), function(from, to, strict = TRUE) { asEnum(from, CurlNetrc, "NetrcEnum") }) asEnum = function(val, def, className) { idx = ifelse(is.character(val), pmatch(val, names(def)), match(val, def)) if(is.na(idx)) stop("no match for enumeration value ", val, " of type ", className) new(className, .Data = def[idx]) } listCurlOptions = function() { sort(names(getCurlOptionsConstants())) } getCurlOptionsConstants = function() { x = .Call("R_getCURLOptionEnum", PACKAGE = "RCurl") names(x) = gsub("_", ".", tolower(names(x))) x } getCurlOptionTypes = function(opts = getCurlOptionsConstants()) { typeName = c("integer/logical", "string/pointer", "function", "large number") type = floor(opts / 10000) structure(typeName[type + 1], names = names(opts)) } mapCurlOptNames = function(ids, asNames = FALSE, error = FALSE) { const = getCurlOptionsConstants() ids = tolower(ids) # Could use charmatch and differentiate between multiple matches # e.g. head matching header and headerfunction. w = pmatch(ids, names(const)) if(any(is.na(w))) { (if(error) stop else warning) ("Unrecognized CURL options: ", paste(ids[is.na(w)], collapse = ", ")) # w = w[!is.na(w)] } if(asNames) return(names(const)[w]) as.integer(const[w]) } curlOptions = function(..., .opts = list()) { .els = rev(merge(list(...), .opts)) dups = duplicated(names(.els)) if(any(dups)) { warning("Duplicated curl options: ", paste(names(.els)[dups], collapse = ", ")) .els = .els[!dups] } if(length(.els)) { if(any(names(.els) == "")) stop("unnamed curl option(s): ", .els[names(.els) == "" ]) names(.els) <- mapCurlOptNames(names(.els), asNames = TRUE) .els = .els[!is.na(names(.els))] } else .els = list() class(.els) = "CURLOptions" .els } merge.list <- function(x, y, ...) { if(length(x) == 0) return(y) if(length(y) == 0) return(x) i = match(names(y), names(x)) i = is.na(i) if(any(i)) x[names(y)[which(i)]] = y[which(i)] x } "[<-.CURLOptions" <- function(x, i, value) { if(is.character(i)) i = mapCurlOptNames(i, asNames = TRUE) NextMethod("[<-") } "[[<-.CURLOptions" <- function(x, i, value) { if(is.character(i)) i = mapCurlOptNames(i, asNames = TRUE) NextMethod("[[<-") } if(FALSE) { setCurlHeaders = # # This can be done via the setCurlOpt # # Do we want a ... To specialized a function for general interactive use. # function(headers, curl) { headers = paste(names(headers), headers, sep = ": ") .Call("R_curl_set_header", curl, headers, FALSE, PACKAGE = "RCurl") } }