Parse multipart form data
Description
Parses multipart form data, including file uploads, and returns the parsed fields as a list.
Usage
parse_multipart(req, ...)
parse_multipart(req, ...)
Arguments
req |
The request object.
|
... |
Additional parameters passed to the parser function.
|
Details
If a field is a file upload it is returned as a named list with:
-
value: Raw vector representing the file contents. You must
process this further (eg. convert to data.frame). See the examples section.
-
content_disposition: Typically "form-data", indicating how the content
is meant to be handled.
-
content_type: MIME type of the uploaded file (e.g., "image/png" or "application/pdf").
-
name: Name of the form input field.
-
filename: Original name of the uploaded file.
If no body data, an empty list is returned.
Overriding Default Parser
By default, parse_multipart() uses webutils::parse_http() internally.
You can override this globally by setting the AMBIORIX_MULTIPART_FORM_DATA_PARSER option:
options(AMBIORIX_MULTIPART_FORM_DATA_PARSER = my_custom_parser)
Your custom parser function must accept the following parameters:
-
body: Raw vector containing the form data.
-
content_type: The 'Content-Type' header of the request as defined by the client.
-
...: Additional optional parameters.
Value
Named list.
See Also
parse_form_urlencoded(), parse_json()
Examples
if (interactive()) {
library(ambiorix)
library(htmltools)
library(readxl)
page_links <- function() {
Map(
f = function(href, label) {
tags$a(href = href, label)
},
c("/", "/about", "/contact"),
c("Home", "About", "Contact")
)
}
forms <- function() {
form1 <- tags$form(
action = "/url-form-encoded",
method = "POST",
enctype = "application/x-www-form-urlencoded",
tags$h4("form-url-encoded:"),
tags$label(`for` = "first_name", "First Name"),
tags$input(id = "first_name", name = "first_name", value = "John"),
tags$label(`for` = "last_name", "Last Name"),
tags$input(id = "last_name", name = "last_name", value = "Coene"),
tags$button(type = "submit", "Submit")
)
form2 <- tags$form(
action = "/multipart-form-data",
method = "POST",
enctype = "multipart/form-data",
tags$h4("multipart/form-data:"),
tags$label(`for` = "email", "Email"),
tags$input(id = "email", name = "email", value = "[email protected]"),
tags$label(`for` = "framework", "Framework"),
tags$input(id = "framework", name = "framework", value = "ambiorix"),
tags$label(`for` = "file", "Upload CSV file"),
tags$input(type = "file", id = "file", name = "file", accept = ".csv"),
tags$label(`for` = "file2", "Upload xlsx file"),
tags$input(type = "file", id = "file2", name = "file2", accept = ".xlsx"),
tags$button(type = "submit", "Submit")
)
tagList(form1, form2)
}
home_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("hello, world!"),
forms()
)
res$send(html)
}
home_post <- function(req, res) {
body <- parse_json(req)
# print(body)
response <- list(
code = 200L,
msg = "hello, world"
)
res$json(response)
}
url_form_encoded_post <- function(req, res) {
body <- parse_form_urlencoded(req)
# print(body)
list_items <- lapply(
X = names(body),
FUN = function(nm) {
tags$li(
nm,
":",
body[[nm]]
)
}
)
input_vals <- tags$ul(list_items)
html <- tagList(
page_links(),
tags$h3("Request processed"),
input_vals
)
res$send(html)
}
multipart_form_data_post <- function(req, res) {
body <- parse_multipart(req)
list_items <- lapply(
X = names(body),
FUN = function(nm) {
field <- body[[nm]]
# if 'field' is a file, parse it & print on console:
is_file <- "filename" %in% names(field)
is_csv <- is_file && identical(field[["content_type"]], "text/csv")
is_xlsx <- is_file &&
identical(
field[["content_type"]],
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
)
if (is_file) {
file_path <- tempfile()
writeBin(object = field$value, con = file_path)
on.exit(unlink(x = file_path))
}
if (is_csv) {
# print(read.csv(file = file_path))
}
if (is_xlsx) {
# print(readxl::read_xlsx(path = file_path))
}
tags$li(
nm,
":",
if (is_file) "printed on console" else field
)
}
)
input_vals <- tags$ul(list_items)
html <- tagList(
page_links(),
tags$h3("Request processed"),
input_vals
)
res$send(html)
}
about_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("About Us")
)
res$send(html)
}
contact_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("Get In Touch!")
)
res$send(html)
}
app <- Ambiorix$new(port = 5000L)
app$
get("/", home_get)$
post("/", home_post)$
get("/about", about_get)$
get("/contact", contact_get)$
post("/url-form-encoded", url_form_encoded_post)$
post("/multipart-form-data", multipart_form_data_post)
app$start()
}
if (interactive()) {
library(ambiorix)
library(htmltools)
library(readxl)
page_links <- function() {
Map(
f = function(href, label) {
tags$a(href = href, label)
},
c("/", "/about", "/contact"),
c("Home", "About", "Contact")
)
}
forms <- function() {
form1 <- tags$form(
action = "/url-form-encoded",
method = "POST",
enctype = "application/x-www-form-urlencoded",
tags$h4("form-url-encoded:"),
tags$label(`for` = "first_name", "First Name"),
tags$input(id = "first_name", name = "first_name", value = "John"),
tags$label(`for` = "last_name", "Last Name"),
tags$input(id = "last_name", name = "last_name", value = "Coene"),
tags$button(type = "submit", "Submit")
)
form2 <- tags$form(
action = "/multipart-form-data",
method = "POST",
enctype = "multipart/form-data",
tags$h4("multipart/form-data:"),
tags$label(`for` = "email", "Email"),
tags$input(id = "email", name = "email", value = "[email protected]"),
tags$label(`for` = "framework", "Framework"),
tags$input(id = "framework", name = "framework", value = "ambiorix"),
tags$label(`for` = "file", "Upload CSV file"),
tags$input(type = "file", id = "file", name = "file", accept = ".csv"),
tags$label(`for` = "file2", "Upload xlsx file"),
tags$input(type = "file", id = "file2", name = "file2", accept = ".xlsx"),
tags$button(type = "submit", "Submit")
)
tagList(form1, form2)
}
home_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("hello, world!"),
forms()
)
res$send(html)
}
home_post <- function(req, res) {
body <- parse_json(req)
response <- list(
code = 200L,
msg = "hello, world"
)
res$json(response)
}
url_form_encoded_post <- function(req, res) {
body <- parse_form_urlencoded(req)
list_items <- lapply(
X = names(body),
FUN = function(nm) {
tags$li(
nm,
":",
body[[nm]]
)
}
)
input_vals <- tags$ul(list_items)
html <- tagList(
page_links(),
tags$h3("Request processed"),
input_vals
)
res$send(html)
}
multipart_form_data_post <- function(req, res) {
body <- parse_multipart(req)
list_items <- lapply(
X = names(body),
FUN = function(nm) {
field <- body[[nm]]
is_file <- "filename" %in% names(field)
is_csv <- is_file && identical(field[["content_type"]], "text/csv")
is_xlsx <- is_file &&
identical(
field[["content_type"]],
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
)
if (is_file) {
file_path <- tempfile()
writeBin(object = field$value, con = file_path)
on.exit(unlink(x = file_path))
}
if (is_csv) {
}
if (is_xlsx) {
}
tags$li(
nm,
":",
if (is_file) "printed on console" else field
)
}
)
input_vals <- tags$ul(list_items)
html <- tagList(
page_links(),
tags$h3("Request processed"),
input_vals
)
res$send(html)
}
about_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("About Us")
)
res$send(html)
}
contact_get <- function(req, res) {
html <- tagList(
page_links(),
tags$h3("Get In Touch!")
)
res$send(html)
}
app <- Ambiorix$new(port = 5000L)
app$
get("/", home_get)$
post("/", home_post)$
get("/about", about_get)$
get("/contact", contact_get)$
post("/url-form-encoded", url_form_encoded_post)$
post("/multipart-form-data", multipart_form_data_post)
app$start()
}