Nothing
curlGlobalInit =
function(flags = c("ssl", "win32")) # This is the same as all.
{
status = .Call("R_curl_global_init", setBitIndicators(flags, CurlGlobalBits), PACKAGE = "RCurl")
asCurlErrorCode(status)
}
curlGlobalCleanup =
function()
{
.Call("R_curl_global_cleanup", PACKAGE = "RCurl")
}
asCurlErrorCode =
function(val)
{
defs =.Call("R_getCURLErrorEnum", PACKAGE = "RCurl")
defs[defs == val]
}
debugGatherer =
function()
{
els = NULL
info = NULL
update = function(msg, type, curl) {
els[[type + 1]] <<- c(els[[type + 1]], msg)
info[[length(info) + 1]] <<- msg
names(info)[length(info)] <<- names(type)
0
}
reset = function() { els <<-
list(text=character(),
headerIn = character(),
headerOut = character(),
dataIn = character(),
dataOut = character(),
sslDataIn = character(),
sslDataOut = character())
info <<- list()
}
ans = list(update = update,
value = function(collapse = "", ordered = FALSE, ...) {
if(ordered)
return(info)
if(is.null(collapse))
return(els)
sapply(els, function(x) paste(x, collapse = collapse, ...))
},
reset = reset)
class(ans) <- c("RCurlDebugHandler", "RCurlCallbackFunction")
ans$reset()
ans
}
basicTextGatherer =
#
# This is a function that is used to create a closure (i.e. a function with its own local variables
# whose values persist across invocations). This is called to provide an instance of a function that is
# called when the libcurl engine has some text to be processed as it is reading the HTTP response from the
# server.
# The function that reads the text can do whatever it wants with it. This one simply
# cumulates it and makes it available via a second function.
#
function(txt = character(), max = NA, value = NULL, .mapUnicode = TRUE)
{
update = function(str) {
txt <<- c(txt, str)
if(!is.na(max) && nchar(txt) >= max)
return(0)
nchar(str, "bytes") # use bytes rather than chars as for UTF-8, etc. we may have fewer characters,
# but the C code for libcurl works in bytes. If we report chars and < bytes,
# libcurl terminates the download.
}
reset = function() { txt <<- character() }
val = if(missing(value))
function(collapse = "", ...) {
if(!is.null(collapse))
txt = paste(txt, collapse = collapse)
if(.mapUnicode)
txt = mapUnicodeEscapes(txt)
return(txt)
}
else
function(collapse = "") {
if(!is.null(collapse))
txt = paste(txt, collapse = collapse)
if(.mapUnicode)
txt = mapUnicodeEscapes(txt)
value(txt)
}
ans = list(update = update,
value = val,
reset = reset)
class(ans) <- c("RCurlTextHandler", "RCurlCallbackFunction")
ans$reset()
ans
}
basicHeaderGatherer =
function(txt = character(), max = NA)
basicTextGatherer(txt, max, parseHTTPHeader)
getURL = getURI =
#
# initializes a curl handle, populates its settings
#
function(url, ..., .opts = list(), write = basicTextGatherer(.mapUnicode = .mapUnicode), curl = getCurlHandle(),
async = length(url) > 1, .encoding = integer(), .mapUnicode = TRUE)
{
# write = getNativeSymbolInfo("R_curl_write_data", PACKAGE = "RCurl")$address
url = as.character(url)
if(async) {
if(missing(write))
write = multiTextGatherer(url)
return(getURIAsynchronous(url, ..., .opts = .opts, write = write, curl = curl, .encoding = .encoding))
}
if(length(url) > 1) {
# typically will go to async. But if async is explicitly set to FALSE
# then the caller wants to use a serialized sequence of requests and collect
# the results into a single string if write is specified and as a character vector
# of strings otherwise.
# If write wasn't specified, then
dupWriter = FALSE
if(missing(write))
dupWriter = TRUE
return(sapply(url, function(u) {
if(dupWriter)
write = basicTextGatherer()
getURI(u, ..., .opts = .opts, write = write, curl = curl, async = FALSE, .encoding = .encoding)
}))
}
returnWriter = FALSE
if(missing(write) || inherits(write, "RCurlCallbackFunction")) {
writeFun = write$update
} else {
writeFun = write
returnWriter = TRUE
}
# Don't set them, just compute them.
opts = curlOptions(URL = url, writefunction = writeFun, ..., .opts = .opts)
status = curlPerform(curl = curl, .opts = opts, .encoding = .encoding)
if(returnWriter)
return(write)
write$value()
}
curlPerform =
function(..., .opts = list(), curl = getCurlHandle(), .encoding = integer())
{
isProtected = missing(curl)
.encoding = getEncodingValue(.encoding)
.opts = curlSetOpt(..., .opts = .opts, curl = NULL, .encoding = .encoding)
# The 3rd argument - TRUE - is just so that we don't need to create it in the
# C code to pass to R_curl_easy_setopt.
status = .Call("R_curl_easy_perform", curl, .opts, isProtected, .encoding, PACKAGE = "RCurl")
asCurlErrorCode(status)
}
CE_NATIVE = 0L
CE_UTF8 = 1L
CE_LATIN1 = 2L
CE_SYMBOL = 5L
getEncodingValue =
function(val)
{
if(length(val) == 0)
return(val)
if(is.character(val))
switch(val, "UTF-8" =, "utf-8" = CE_UTF8, "ISO-8859-1" =, "iso-8859-1" = CE_LATIN1, CE_NATIVE)
else
as.integer(val)
}
curlSetOpt =
#
# This is used when setting the values globally.
#
# No sense in generating a default CURL handle and then throwing
# it way. It is only here to allow people to create it in a call
# when they set the options.
# This could go as most people will call this having already created
# the CURL object.
function(..., .opts = list(), curl = getCurlHandle(), .encoding = integer(), .forceHeaderNames = FALSE,
.isProtected = FALSE)
{
.opts = curlOptions(..., .opts = .opts)
if("httpheader" %in% names(.opts)) {
tmp = .opts[["httpheader"]]
# paste the name and value together if
# a) we have names, and b) not all entries have a : at the start.
# We have to be careful here. We got caught with a date having a :
# and there being only one element in the header.
# Also tripped up if a header entry is http:... or ftp:... since the : gets caught, but only
# if there is one.
if(length(names(tmp)) && (.forceHeaderNames || (length( grep("^[^[:space:]]+:", gsub("(ftp|http):", "", tmp))) != length(tmp))))
.opts[["httpheader"]] = paste(names(tmp), tmp, sep = ": ")
}
.encoding = getEncodingValue(.encoding)
if(length(.opts) || length(.encoding)) {
optIds = mapCurlOptNames(names(.opts))
# Check the types and do coercion if necessary
idx = match(names(.opts), names(optionConverters))
if(!all(is.na(idx))) {
i = names(.opts)[!is.na(idx)]
.opts[i] = lapply(i, function(x)
optionConverters[[x]](.opts[[x]]))
}
if(!is.null(curl)) {
.isProtected = rep(.isProtected, length(.opts))
status = .Call("R_curl_easy_setopt", curl, .opts, optIds, .isProtected, as.integer(.encoding), PACKAGE = "RCurl")
return(curl)
}
} else
optIds = integer()
tmp = list(ids = optIds, values = .opts)
class(tmp) <- "ResolvedCURLOptions"
tmp
}
optionConverters =
list("netrc" = function(x) asEnum(x, CurlNetrc, "NetrcEnum")
)
getCurlHandle =
function(..., .opts = NULL, .encoding = integer(),
.defaults = getOption("RCurlOptions"))
{
h = .Call("R_curl_easy_init", PACKAGE = "RCurl")
if(length(.defaults)) {
i = match(names(.defaults), names(.opts))
.opts[names(.defaults)[is.na(i)]] = .defaults[is.na(i)]
}
curlSetOpt(..., .opts = .opts, curl = h, .encoding = .encoding)
h
}
dupCurlHandle =
function(curl, ..., .opts = NULL, .encoding = integer())
{
h = .Call("R_curl_easy_duphandle", curl, PACKAGE = "RCurl")
curlSetOpt(..., .opts = .opts, curl = h, .encoding = .encoding)
h
}
setGeneric("reset",
function(x, ...)
standardGeneric("reset"))
setMethod("reset", "CURLHandle",
function(x, ...) {
.Call("R_curl_easy_reset", x, PACKAGE = "RCurl")
})
curlEscape =
function(urls)
{
.Call("R_curl_escape", as.character(urls), TRUE, PACKAGE = "RCurl")
}
curlUnescape =
function(urls)
{
.Call("R_curl_escape", as.character(urls), FALSE, PACKAGE = "RCurl")
}
if(FALSE) {
tbls = readHTMLTable("http://en.wikipedia.org/wiki/Percent-encoding", stringsAsFactors = FALSE)
tt = tbls[[5]]
PercentCodes = structure(as.character(tt[2,]), names = as.character(tt[1,]))
cat(paste(sQuote(names(PercentCodes)), dQuote(PercentCodes), sep = " = ", collapse = ",\n\t"))
}
PercentCodes = c(
'%' = "%25", # this has to go first.
'!' = "%21",
'*' = "%2A",
'"' = "%22",
'\'' = "%27",
'(' = "%28",
')' = "%29",
';' = "%3B",
':' = "%3A",
'@' = "%40",
'&' = "%26",
'=' = "%3D",
'+' = "%2B",
'$' = "%24",
',' = "%2C",
'/' = "%2F",
'?' = "%3F",
'#' = "%23",
'[' = "%5B",
']' = "%5D",
'{' = "%7B",
'}' = "%7D",
' ' = '%20',
'\r' = '%0D',
'\n' = '%0A')
curlPercentEncode =
function(x, amp = TRUE, codes = PercentCodes, post.amp = FALSE)
{
if(!amp) {
i = match("&", names(codes))
if(!is.na(i))
codes = codes[ - i ]
}
for(i in seq(along = codes)) {
x = gsub(names(codes)[i], codes[i], x, fixed = TRUE)
}
if(post.amp)
x = gsub("%", "%25", x, fixed = TRUE)
x
}
esc =
#
# An alternative approach.
#
function(x, codes = PercentCodes)
{
els = strsplit(x, "")[[1]]
i = match(els, names(codes), 0L)
els[ i != 0 ] = codes[ i ]
paste(els, collapse = "")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.