Respect writer option. #44

R/config.r

@@ -184,6 +184,7 @@ default_config <- function() {
       cainfo = cert
     ),
     user_agent(default_ua()),
+    write_memory(),
     getOption("httr_config")
   )
 }

R/http--request.r

@@ -22,11 +22,11 @@ make_request <- function(method, handle, url, config = NULL, body = NULL,
   }
 
   # Extract writer object
-  writer <- opts$writer %||% write_memory()
+  writer <- opts$writer
   opts$writer <- NULL
 
   # Perform request and capture output
-  req <- perform(handle, method, opts, body)
+  req <- perform(handle, writer, method, opts, body)
 
   needs_refresh <- refresh && req$status == 401L &&
     !is.null(config$token) && config$token$can_refresh()

R/perform.R

@@ -1,6 +1,6 @@
 # Abstract over the differences in RCurl API depending on whether or not
 # you send a body.
-perform <- function(handle, method, opts, body) {
+perform <- function(handle, writer, method, opts, body) {
   # Must always override headerfunction and writefunction
   # FIXME: throw error if these are set already
   headers <- character()
@@ -9,10 +9,9 @@ perform <- function(handle, method, opts, body) {
     nchar(text, "bytes")
   }
   opts$headerfunction <- add_header
-  buffer <- RCurl::binaryBuffer()
-  opts$writefunction <-
-    getNativeSymbolInfo("R_curl_write_binary_data")$address
-  opts$writedata <- buffer@ref
+
+  writer <- write_init(writer)
+  opts <- modifyList(opts, write_opts(writer))
 
   opts <- modify_config(opts, body$config)
   # Ensure config always gets reset
@@ -29,7 +28,7 @@ perform <- function(handle, method, opts, body) {
   }
 
   headers <- parse_headers(headers)
-  content <- methods::as(buffer, "raw")
+  content <- write_term(writer)
 
   response(
     method = toupper(method),

R/write-function.R

@@ -56,7 +56,7 @@ write_disk <- function(path, overwrite = FALSE) {
 }
 #' @export
 write_init.write_disk <- function(x) {
-  x$file <- RCurl::CFILE(path, "wb")
+  x$file <- RCurl::CFILE(x$path, "wb")
   x
 }
 #' @export
@@ -68,7 +68,7 @@ write_opts.write_disk <- function(x) {
 }
 #' @export
 write_term.write_disk <- function(x) {
-  close(x$file)
+  .Call("R_closeCFILE", x$file@ref, PACKAGE = "RCurl")
   x$file <- NULL
   path(x$path)
 }