1if(FALSE) { 2setClass("CurlOptions", 3 representation(ids="integer", 4 values="list")) 5 6curlOptions = 7function(..., .opts = list()) 8{ 9 .args = rev(list(...)) # Why rev()? 10 11 if(length(.args) == 0) 12 return(NULL) 13 14 dups = duplicated(names(.args)) 15 if(any(dups)) { 16 warning("Duplicated curl options: ", paste(names(.args)[dups], collapse = ", ")) 17 .args = .args[!dup] 18 } 19 20 if(length(names(.args)) == 0) 21 stop("curl options with no names") 22 else if(any(names(.args) == "")) 23 stop("unnamed curl option(s): ", .args[names(.args) == "" ]) 24 25 opts = mapCurlOptNames(names(.args)) 26 27 o = new("CurlOptions") 28 o@ids = opts 29 o@values = .args 30 31 o 32} 33} # FALSE 34 35 36 37if(FALSE) { 38 # Try to get these using GccTranslationUnit. 39 # Yes. See CodeGeneration. 40CurlConstants = 41 c(file = 1, 42 writedata = 1, 43 url = 2, 44 port = 3, 45 proxy = 4, 46 userpwd = 5, 47 proxyuserpwd = 6, 48 range = 7, 49 infile = 9, 50 errorbufffer = 10, 51 writefunction = 11, 52 readfunction = 12, 53 timeout = 13, 54 infilesize = 14, 55 postfields = 15, 56 referer = 16, 57 ftpport = 17, 58 useragent = 18, 59 low.speed.limit = 19, 60 low.speed.time = 20, 61 resume.from = 21, 62 cookie = 22, 63 httpheader = 23, 64 httppost = 24, 65 sslcert =25, 66 67 68 verbose = 26, 69 followlocation=27, 70 71 netrc = 28, 72 httpauth=29, 73 cookiefile=30, 74 crlf=31, 75 headerfunction=32, 76 sslversion=33, # long 77 customerequest = 34, # string 78 interface = 35, # string 79 krb4level = 36, # "string" 80 ssl.verifypeer = 37, # long 81 cainfo = 38, # string 82 capath = 39, # string 83 passwdfunction = 40, # function 84 filetime=41, # long 85 maxredirs = 42, # long 86 maxconnects = 43, # long 87 88fresh.connect = 44, #long 89forbid.reuse = 45, # long 90egdsocket = 46, # string 91connecttimeout = 47, # long 92httpget = 48, # long 93ssl.verifyhost = 49, # long 94cookiejar = 50, # string 95ssl.cipher.list = 51, # string (colon separated) 96http.version = 52, # enum (long) 97 98dns.cache.timeout = 53, # long 99dns.use.global.cache = 54 , # long 100debugfunction = 55 # function 101) 102 103} # FALSE 104 105 106CurlNetrc = c(ignored = 0, optional = 1, required = 2) 107mode(CurlNetrc) = "integer" 108class(CurlNetrc) = c("CurlNetrcEnum", "Enum") 109 110 111setClass("Enum", contains = "integer") 112setMethod("show", "Enum", function(object) show(paste(names(object), " (", object, ")", sep = ""))) 113 114 115setClass("NetrcEnum", contains = "Enum") 116setMethod("coerce", c("numeric", "NetrcEnum"), 117 function(from, to, strict = TRUE) { 118 asEnum(from, CurlNetrc, "NetrcEnum") 119 }) 120 121 122asEnum = 123function(val, def, className) 124{ 125 idx = ifelse(is.character(val), pmatch(val, names(def)), match(val, def)) 126 127 if(is.na(idx)) 128 stop("no match for enumeration value ", val, " of type ", className) 129 130 new(className, .Data = def[idx]) 131} 132 133 134listCurlOptions = 135function() 136{ 137 sort(names(getCurlOptionsConstants())) 138} 139 140getCurlOptionsConstants = 141function() 142{ 143 x = .Call("R_getCURLOptionEnum", PACKAGE = "RCurl") 144 names(x) = gsub("_", ".", tolower(names(x))) 145 146 x 147} 148 149getCurlOptionTypes = 150function(opts = getCurlOptionsConstants()) 151{ 152 typeName = c("integer/logical", "string/pointer", "function", "large number") 153 type = floor(opts / 10000) 154 structure(typeName[type + 1], names = names(opts)) 155} 156 157 158mapCurlOptNames = 159function(ids, asNames = FALSE, error = FALSE) 160{ 161 const = getCurlOptionsConstants() 162 ids = tolower(ids) 163 # Could use charmatch and differentiate between multiple matches 164 # e.g. head matching header and headerfunction. 165 w = pmatch(ids, names(const)) 166 167 if(any(is.na(w))) { 168 (if(error) stop else warning) ("Unrecognized CURL options: ", paste(ids[is.na(w)], collapse = ", ")) 169 # w = w[!is.na(w)] 170 } 171 172 if(asNames) 173 return(names(const)[w]) 174 175 as.integer(const[w]) 176} 177 178 179curlOptions = 180function(..., .opts = list()) 181{ 182 .els = rev(merge(list(...), .opts)) 183 184 dups = duplicated(names(.els)) 185 if(any(dups)) { 186 warning("Duplicated curl options: ", paste(names(.els)[dups], collapse = ", ")) 187 .els = .els[!dups] 188 } 189 190 if(length(.els)) { 191 if(any(names(.els) == "")) 192 stop("unnamed curl option(s): ", .els[names(.els) == "" ]) 193 names(.els) <- mapCurlOptNames(names(.els), asNames = TRUE) 194 195 .els = .els[!is.na(names(.els))] 196 } 197 else 198 .els = list() 199 200 201 class(.els) = "CURLOptions" 202 203 .els 204} 205 206merge.list <- 207function(x, y, ...) 208{ 209 if(length(x) == 0) 210 return(y) 211 212 if(length(y) == 0) 213 return(x) 214 215 i = match(names(y), names(x)) 216 i = is.na(i) 217 if(any(i)) 218 x[names(y)[which(i)]] = y[which(i)] 219 220 x 221} 222 223 224"[<-.CURLOptions" <- 225function(x, i, value) 226{ 227 if(is.character(i)) 228 i = mapCurlOptNames(i, asNames = TRUE) 229 230 NextMethod("[<-") 231} 232 233"[[<-.CURLOptions" <- 234function(x, i, value) 235{ 236 if(is.character(i)) 237 i = mapCurlOptNames(i, asNames = TRUE) 238 239 NextMethod("[[<-") 240} 241 242 243 244if(FALSE) { 245 246 setCurlHeaders = 247 # 248 # This can be done via the setCurlOpt 249 # 250 # Do we want a ... To specialized a function for general interactive use. 251 # 252 function(headers, curl) 253 { 254 headers = paste(names(headers), headers, sep = ": ") 255 .Call("R_curl_set_header", curl, headers, FALSE, PACKAGE = "RCurl") 256 } 257 258} 259