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