.packageName <- "RCurl"

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
  
  update = function(msg, type, curl)  {
    els[[type + 1]] <<- c(els[[type + 1]], msg)
    0
  }

  reset = function() { els <<-
                         list(text=character(),
                              headerIn = character(),
                              headerOut = character(),
                              dataIn = character(),
                              dataOut = character())
                     }

  ans = list(update = update,
             value = function(collapse="", ...) {
                         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)
{
  update = function(str) {
    txt <<-   c(txt, str)
    if(!is.na(max) && nchar(txt) >= max)
      return(0)
    
    nchar(str)
  }

  reset = function() {  txt <<- character() }

  ans = list(update = update,
             value = function(collapse="", ...) {
                         if(is.null(collapse))
                             return(txt)
                                  
                         paste(txt, collapse = collapse, ...)
                      },
              reset = reset)

  class(ans) <- c("RCurlTextHandler", "RCurlCallbackFunction")
  
  ans$reset()
  
  ans
}

getURL =
  #
  # initializes a curl handle, populates its settings
  #
  #
function(url, ..., write = basicTextGatherer(), curl = getCurlHandle())
{
#    write = getNativeSymbolInfo("R_curl_write_data", PACKAGE = "httpClient")$address

  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, ...)

  status = curlPerform(curl = curl, .opts = opts)

  if(returnWriter)
    return(write)
  
  write$value()
}

curlPerform =
function(..., .opts = list(), curl = getCurlHandle())
{
  isProtected = missing(curl)

  .opts = curlSetOpt(..., .opts = .opts, curl = NULL)

    # 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, PACKAGE = "RCurl")

  asCurlErrorCode(status)
}  

  

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())
{
 .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 :
    if(length(names(tmp)) && length(grep(":", tmp)) != length(tmp))
      .opts[["httpheader"]] = paste(names(tmp), tmp, sep = ": ")
  }
 
  if(length(.opts)) {
     optIds = mapCurlOptNames(names(.opts))

          # Check the types

     if(!is.null(curl)) {
       status = .Call("R_curl_easy_setopt", curl, .opts, optIds, FALSE, PACKAGE = "RCurl")
       return(curl)
     }
  } else
     optIds = integer()

 
 tmp = list(ids = optIds, values = .opts)
 class(tmp) <- "ResolvedCURLOptions"
 tmp
}


getCurlHandle =
function(..., .opts = NULL)
{
 h = .Call("R_curl_easy_init", PACKAGE = "RCurl")

 curlSetOpt(..., .opts = .opts, curl = h)
 
 h
}

dupCurlHandle =
function(curl, ..., .opts = NULL)
{
 h = .Call("R_curl_easy_duphandle", curl, PACKAGE = "RCurl")

 curlSetOpt(..., .opts = .opts, curl = h)

 h
}


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")
}   

curlVersion <-
function(id = 0)
{
  x = .Call("R_curl_version_info", as.integer(id), PACKAGE = "RCurl")

   # Now break up the features.
  x$features = getBitIndicators(x$features, CurlFeatureBits)
  
  x
}  


CurlFeatureBits = as.integer(2^(0:10))
names(CurlFeatureBits) = c("ipv6", "kerberos4", "ssl", "libz", "ntlm", "gssnegotiate",
                           "debug", "asynchdns", "spnego", "largefile")
class(CurlFeatureBits) = c("CurlFeatureBits", "BitIndicator")



CurlGlobalBits = as.integer(c(0, 1, 2, 3))
names(CurlGlobalBits) = c("none", "ssl", "win32", "all")
class(CurlGlobalBits) = c("CurlGlobalBits", "BitIndicator")


setBitIndicators =
  #
  # if the caller gives an integer, sum them
  # if the give a vector of strings, resolve them relative to the
  # names in defs and then sum those.
  #
  #
  # If we hand this a value that is a composition of flags,
  # we don't do the right thing.
  #
function(vals, defs)
{
  if(is.character(vals)) {
    i = match(vals, names(defs))
    if(any(is.na(i)))
      stop("Unmatched bit field names ", paste(vals[is.na(i)], collapse=", "))

     vals = defs[i]
  }

  as.integer(sum(vals))
}



getBitIndicators =
function(val, defs)
{
  n = length(defs)
  ans = .C("R_check_bits", as.integer(val), as.integer(defs), ans = logical(n), n, PACKAGE = "RCurl")$ans

  defs[ans]
}  
getForm =
  #
  # The ... here are for the arguments to the form, not the curl options.
  #
  #
function(uri, ..., .params = character(), curlOptions = list(), curl = getCurlHandle())  
{
    # should we merge params with ....
    # for now just one or the other.  
  if(missing(.params)) {
    .params = list(...)
  }

  if(length(.params) == 0)
    warning("No inputs passed to form")
  
    # Convert the arguments into a URL string.
  els = sapply(names(.params), function(n) {
                              # turn name=c("a", "b") into
                              #  name=a&name=b
                                paste(n, .params[[n]], sep="=", collapse="&")
                               })

   args = paste(els, collapse="&")

   uri = paste(uri, args, sep="?")

   getURL(uri, .opts = curlOptions)
}



postForm =
  #
  # The ... here are for the arguments to the form, not the curl options.
  #
  #
function(uri, ..., .params = list(), .opts = curlOptions(url = uri), curl = getCurlHandle())  
{
  isProtected = missing(curl)
  write = NULL
  
   # merge the two sources of inputs
  .params = merge(list(...), .params)

  # Need to organize the types here into a structure.


 if(!"writefunction" %in% names(.opts)) {
   write = basicTextGatherer()
   .opts[["writefunction"]] = write[[1]]
 }

  # Force the curlOptions to be resolved at this point, but not set.

  .opts = curlSetOpt(url = uri, .opts = .opts, curl = NULL)

  
#  curlOptions[["httpost"]] <- .params
#  curlPerform(curl, .opts = curlOptions)

  .params = as.list(.params)

  if(length(.params) == 0)
    warning("No inputs passed to form")
  
  status = .Call("R_post_form", curl, .opts, .params, TRUE,  PACKAGE = "RCurl")

  if(!isProtected) {
     # Reset the httppost field to NULL so we can release the values.
     # curlSetOpt(httpget = TRUE, cur = curl)
     curlSetOpt(httppost = NULL, cur = curl)
  }
  
  if(!is.null(write)) {
    write[[2]]()
  }
}  


getCurlInfo =
function(curl, which = getCurlInfoConstants())
{
  rnames = character()

  if(is.character(which)) {
    const = getCurlInfoConstants()          
    i = pmatch(tolower(which), names(const))
    if(any(is.na(i)))
      stop("Invalid curl info name", names(which)[is.na(i)])

    which = getCurlInfoConstants()[i]
  }
  
  x = .Call("R_curl_easy_getinfo", curl, as.integer(which), PACKAGE = "RCurl")

# put the names back on.  
  names(x) = names(which)
  
  x
}


getCurlInfoConstants =
function()
{
  x = .Call("R_getCURLInfoEnum", PACKAGE = "RCurl")
  names(x) = tolower(gsub("_", ".", names(x)))

  x
}

if(FALSE) {
setClass("CurlOptions",
         representation(ids="integer",
                        values="list"))



curlOptions =
function(...)
{
    .args = list(...)
    opts = mapCurlOptNames(names(.args))

    o = new("CurlOptions")
    o@ids = opts
    o@values = .args

    o
}  
} # FALSE



if(FALSE) {
  # Try to get these using GccTranslationUnit.
CurlConstants =
 c(file = 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

#XXX Check.
CurlNetrc = c(optional = 0, ignored = 1, required = 2)
class(CurlNetrc) = c("CurlNetrcEnum", "Enum")


getCurlOptionsConstants =
function()
{
 x = .Call("R_getCURLOptionEnum", PACKAGE = "RCurl")
 names(x) = gsub("_", ".", tolower(names(x)))

 x
}  

mapCurlOptNames =
function(ids, asNames = 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)))
     stop("Unrecognized CURL options: ", paste(ids[is.na(w)], collapse = ", "))

   if(asNames)
     return(names(const)[w])
   
   as.integer(const[w])
}  


curlOptions =
function(..., .opts = list())
{
  .els = merge(list(...),.opts)

  if(length(.els))
      names(.els) <- mapCurlOptNames(names(.els), asNames = TRUE)
  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")
 }  

}
