Permalink
Browse files

Implement full range of body options for PUT

  • Loading branch information...
hadley committed May 5, 2012
1 parent d92df73 commit 3b39bbeb1d9515301255160c63d0b46a32f55cbe
Showing with 93 additions and 48 deletions.
  1. +13 −5 R/http-post.r
  2. +11 −23 R/http-put.r
  3. +42 −0 inst/tests/test-PUT-POST.r
  4. +0 −13 inst/tests/test-request.r
  5. +7 −3 man/POST.Rd
  6. +20 −4 man/PUT.Rd
View
@@ -1,8 +1,13 @@
#' Post file to a server.
#'
#' @inheritParams GET
-#' @param body Named of list of elements to go in the body of the post file.
-#' Use \code{\link[RCurl]{fileUpload}} to upload files.
+#' @param body Use \code{NULL} for an empty body, a length-one character or
+# raw vector, or a named of list of elements to go in the body of the post
+#' file. Each component should either be a character value or the object
+#' returned by \code{\link[RCurl]{fileUpload}} (if you want to upload a
+#' file). If \code{multipart} is \code{FALSE} elements will be escaped
+#' automatically - if the values have already been escaped, then use
+#' `I` to prevent double-escaping.
#' @param multipart Should the form be send as multipart/form-data
#' (\code{TRUE}), or application/x-www-form-urlencoded (\code{FALSE}).
#' Files can not be uploaded when \code{FALSE}.
@@ -26,7 +31,11 @@ POST <- function(url = NULL, config = list(), body = NULL, multipart = TRUE, ...
multipart = multipart, config = config)
}
-post_request <- function (handle, url, body = NULL, opts = list(), multipart = TRUE, encoding = integer()) {
+post_request <- function(...) {
+ send_data("POST", ...)
+}
+
+send_data <- function (method, handle, url, body = NULL, opts = list(), multipart = TRUE, encoding = integer()) {
stopifnot(is.handle(handle))
stopifnot(is.character(url), length(url) == 1)
@@ -36,16 +45,15 @@ post_request <- function (handle, url, body = NULL, opts = list(), multipart = T
opts$writefunction <-
getNativeSymbolInfo("R_curl_write_binary_data")$address
opts$writedata <- buffer@ref
+ opts$customrequest <- method
if (is.null(body)) {
- opts$post <- 1L
opts$postfieldsize <- 0L
body <- ""
} else if (is.character(body) || is.raw(body)) {
if (is.character(body)) {
body <- charToRaw(paste(body, collapse = "\n"))
}
- opts$customrequest <- "POST"
opts$readfunction <- body
opts$upload <- TRUE
opts$infilesize <- length(body)
View
@@ -1,7 +1,6 @@
#' Send PUT to request server.
#'
-#' @inheritParams GET
-#' @param content Content, if any, to send to server.
+#' @inheritParams POST
#' @export
#' @examples
#' b <- new_bin()
@@ -11,28 +10,17 @@
#' PUT("http://httpbin.org/put")
#' PUT("http://httpbin.org/put", content = "some body content")
#' PUT("http://httpbin.org/put", content = list(a = 1, b = 2))
-PUT <- function(url = NULL, config = list(), content = NULL, ..., handle = NULL) {
+#'
+#' b2 <- "http://httpbin.org/put"
+#' PUT(b2, body = "A simple text string")
+#' PUT(b2, body = list(x = "A simple text string"))
+#' PUT(b2, body = list(y = fileUpload(system.file("CITATION"))))
+PUT <- function(url = NULL, config = list(), body = NULL, multipart = TRUE, ..., handle = NULL) {
hu <- handle_url(handle, url, ...)
- make_request("put", hu$handle, hu$url, content = content,
- config = config)
+ make_request("put", hu$handle, hu$url, body = body,
+ multipart = multipart, config = config)
}
-put_request <- function(handle, url, content, opts) {
- opts$customrequest <- "PUT"
-
- if (is.null(content)) {
- opts$nobody <- 1L
- } else {
- if (is.list(content)) {
- content <- compose_query(content)
- }
- if (is.character(content)) {
- content <- charToRaw(paste(content, collapse = "\n"))
- }
- opts$readfunction <- content
- opts$upload <- TRUE
- opts$infilesize <- length(content)
- }
-
- get_request(handle, url, opts)
+put_request <- function(...) {
+ send_data("PUT", ...)
}
View
@@ -0,0 +1,42 @@
+context("Send data")
+
+round_trip <- function(method, body = NULL, ...) {
+ url <- str_c("http://httpbin.org/", tolower(method))
+ request <- match.fun(toupper(method))
+ parsed_content(request(url, body = body, ...))
+}
+methods <- c("POST", "PUT")
+
+citation <- fileUpload(system.file("CITATION"))
+citation_val <- c(readLines(system.file("CITATION")), "")
+
+test_that("empty body gives empty data element", {
+ for(method in methods) {
+ out <- round_trip(method)
+ expect_equal(out$data, "", info = method)
+ }
+})
+
+test_that("string in body gives same string in data element", {
+ for(method in methods) {
+ out <- round_trip(method, "test")
+ expect_equal(out$data, "test", info = method)
+ }
+})
+
+test_that("named list matches form results", {
+ for(method in methods) {
+ out <- round_trip(method, list(a = 1, b = 2))
+ expect_equal(out$form$a, "1", info = method)
+ expect_equal(out$form$b, "2", info = method)
+ }
+})
+
+test_that("file and form vals mixed give form and data elements", {
+ for(method in methods) {
+ out <- round_trip(method, list(y = citation, a = 1))
+ expect_equal(out$form$a, "1", info = method)
+ expect_equal(str_split(out$file$y, "\n")[[1]], citation_val,
+ info = method)
+ }
+})
View
@@ -34,16 +34,3 @@ test_that("headers returned as expected", {
-test_that("bare post requests work", {
- round_trip <- function(body) {
- req <- POST("http://httpbin.org/post", body = body)
- parsed_content(req)
- }
- expect_equal(round_trip(NULL)$data, "")
- expect_equal(round_trip("abc")$data, "abc")
- expect_equal(round_trip(list(a = 1))$form$a, "1")
-
- citation <- fileUpload(system.file("CITATION"))
- expect_equal(round_trip(list(a = citation))$file$a,
- str_c(readLines(system.file("CITATION")), "\n", collapse = ""))
-})
View
@@ -6,9 +6,13 @@
multipart = TRUE, ..., handle = NULL)
}
\arguments{
- \item{body}{Named of list of elements to go in the body
- of the post file. Use \code{\link[RCurl]{fileUpload}} to
- upload files.}
+ \item{body}{Use \code{NULL} for an empty body, a
+ length-one character or file. Each component should
+ either be a character value or the object returned by
+ \code{\link[RCurl]{fileUpload}} (if you want to upload a
+ file). If \code{multipart} is \code{FALSE} elements will
+ be escaped automatically - if the values have already
+ been escaped, then use `I` to prevent double-escaping.}
\item{multipart}{Should the form be send as
multipart/form-data (\code{TRUE}), or
View
@@ -2,12 +2,10 @@
\alias{PUT}
\title{Send PUT to request server.}
\usage{
- PUT(url = NULL, config = list(), content = NULL, ...,
- handle = NULL)
+ PUT(url = NULL, config = list(), body = NULL,
+ multipart = TRUE, ..., handle = NULL)
}
\arguments{
- \item{content}{Content, if any, to send to server.}
-
\item{url}{the url of the page to retrieve}
\item{config}{Additional configuration settings such as
@@ -17,6 +15,19 @@
\code{\link{config}} for full details and list of
helpers.}
+ \item{body}{Use \code{NULL} for an empty body, a
+ length-one character or file. Each component should
+ either be a character value or the object returned by
+ \code{\link[RCurl]{fileUpload}} (if you want to upload a
+ file). If \code{multipart} is \code{FALSE} elements will
+ be escaped automatically - if the values have already
+ been escaped, then use `I` to prevent double-escaping.}
+
+ \item{multipart}{Should the form be send as
+ multipart/form-data (\code{TRUE}), or
+ application/x-www-form-urlencoded (\code{FALSE}). Files
+ can not be uploaded when \code{FALSE}.}
+
\item{...}{Further parameters, such as \code{query},
\code{path}, etc, passed on to \code{\link{modify_url}}.
These parameters must be named.}
@@ -41,5 +52,10 @@ POST("http://httpbin.org/put")
PUT("http://httpbin.org/put")
PUT("http://httpbin.org/put", content = "some body content")
PUT("http://httpbin.org/put", content = list(a = 1, b = 2))
+
+b2 <- "http://httpbin.org/put"
+PUT(b2, body = "A simple text string")
+PUT(b2, body = list(x = "A simple text string"))
+PUT(b2, body = list(y = fileUpload(system.file("CITATION"))))
}

0 comments on commit 3b39bbe

Please sign in to comment.