Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Implement arbitrary file downloads

  • Loading branch information...
commit ae9bd868f19a51cf732ee501ed5eba7a89872219 1 parent a887012
@jcheng5 jcheng5 authored
View
2  DESCRIPTION
@@ -29,7 +29,7 @@ URL: https://github.com/rstudio/shiny, http://rstudio.github.com/shiny/tutorial
BugReports: https://github.com/rstudio/shiny/issues
Collate:
'map.R'
- 'random.R'
+ 'utils.R'
'timer.R'
'tags.R'
'cache.R'
View
3  NAMESPACE
@@ -8,6 +8,9 @@ export(checkboxInput)
export(code)
export(conditionalPanel)
export(div)
+export(downloadButton)
+export(downloadHandler)
+export(downloadLink)
export(em)
export(fileInput)
export(h1)
View
44 R/bootstrap.R
@@ -793,3 +793,47 @@ htmlOutput <- function(outputId) {
uiOutput <- function(outputId) {
htmlOutput(outputId)
}
+
+#' Create a download button or link
+#'
+#' Use these functions to create a download button or link; when clicked, it
+#' will initiate a browser download. The filename and contents are specified by
+#' the corresponding \code{\link{downloadHandler}} defined in the server
+#' function.
+#'
+#' @examples
+#' \dontrun{
+#' # In server.R:
+#' output$downloadData <- downloadHandler(
+#' filename = function() {
+#' paste('data-', Sys.Date(), '.csv', sep='')
+#' },
+#' content = function(con) {
+#' write.csv(data, con)
+#' }
+#' )
+#'
+#' # In ui.R:
+#' downloadLink('downloadData', 'Download')
+#' }
+#'
+#' @aliases downloadLink
+#' @seealso downloadHandler
+#' @export
+downloadButton <- function(outputId, label="Download", class=NULL) {
+ tags$a(id=outputId,
+ class=paste(c('btn shiny-download-link', class), collapse=" "),
+ href='',
+ target='_blank',
+ label)
+}
+
+#' @rdname downloadButton
+#' @export
+downloadLink <- function(outputId, label="Download", class=NULL) {
+ tags$a(id=outputId,
+ class=paste(c('shiny-download-link', class), collapse=" "),
+ href='',
+ target='_blank',
+ label)
+}
View
6 R/map.R
@@ -28,6 +28,12 @@ Map <- setRefClass(
assign(key, value, pos=.env, inherits=FALSE)
return(value)
},
+ mset = function(...) {
+ args <- list(...)
+ for (key in names(args))
+ set(key, args[[key]])
+ return()
+ },
remove = function(key) {
if (.self$containsKey(key)) {
result <- .self$get(key)
View
41 R/random.R
@@ -1,41 +0,0 @@
-#' Make a random number generator repeatable
-#'
-#' Given a function that generates random data, returns a wrapped version of
-#' that function that always uses the same seed when called. The seed to use can
-#' be passed in explicitly if desired; otherwise, a random number is used.
-#'
-#' @param rngfunc The function that is affected by the R session's seed.
-#' @param seed The seed to set every time the resulting function is called.
-#' @return A repeatable version of the function that was passed in.
-#'
-#' @note When called, the returned function attempts to preserve the R session's
-#' current seed by snapshotting and restoring
-#' \code{\link[base]{.Random.seed}}.
-#'
-#' @examples
-#' rnormA <- repeatable(rnorm)
-#' rnormB <- repeatable(rnorm)
-#' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111
-#' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111
-#' rnormA(5) # [1] 1.8285879 -0.7468041 -0.4639111 -1.6510126 -1.4686924
-#' rnormB(5) # [1] -0.7946034 0.2568374 -0.6567597 1.2451387 -0.8375699
-#'
-#' @export
-repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
- force(seed)
-
- function(...) {
- # When we exit, restore the seed to its original state
- if (exists('.Random.seed', where=globalenv())) {
- currentSeed <- get('.Random.seed', pos=globalenv())
- on.exit(assign('.Random.seed', currentSeed, pos=globalenv()))
- }
- else {
- on.exit(rm('.Random.seed', pos=globalenv()))
- }
-
- set.seed(seed)
-
- do.call(rngfunc, list(...))
- }
-}
View
129 R/shiny.R
@@ -23,6 +23,7 @@ ShinyApp <- setRefClass(
session = 'Values',
token = 'character', # Used to identify this instance in URLs
plots = 'Map',
+ downloads = 'Map',
allowDataUriScheme = 'logical'
),
methods = list(
@@ -191,21 +192,98 @@ ShinyApp <- setRefClass(
return(httpResponse(400, 'text/html', '<h1>Bad Request</h1>'))
if (matches[2] == 'plot') {
- savedPlot <- plots$get(matches[3])
+ savedPlot <- plots$get(utils::URLdecode(matches[3]))
if (is.null(savedPlot))
return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
return(httpResponse(200, savedPlot$contentType, savedPlot$data))
}
+ if (matches[2] == 'download') {
+
+ # A bunch of ugliness here. Filenames can be dynamically generated by
+ # the user code, so we don't know what they'll be in advance. But the
+ # most reliable way to use non-ASCII filenames for downloads is to
+ # put the actual filename in the URL. So we will start with URLs in
+ # the form:
+ #
+ # /session/$TOKEN/download/$NAME
+ #
+ # When a request matching that pattern is received, we will calculate
+ # the filename and see if it's non-ASCII; if so, we'll redirect to
+ #
+ # /session/$TOKEN/download/$NAME/$FILENAME
+ #
+ # And when that pattern is received, we will actually return the file.
+ # Note that this means the filename and contents could be determined
+ # a few moments apart from each other (an HTTP roundtrip basically),
+ # hopefully that won't be enough to matter for anyone.
+
+ dlmatches <- regmatches(matches[3],
+ regexec("^([^/]+)(/[^/]+)?$",
+ matches[3]))[[1]]
+ dlname <- utils::URLdecode(dlmatches[2])
+ download <- downloads$get(dlname)
+ if (is.null(download))
+ return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
+
+ filename <- ifelse(is.function(download$filename),
+ Context$new()$run(download$filename),
+ download$filename)
+
+ # If the URL does not contain the filename, and the desired filename
+ # contains non-ASCII characters, then do a redirect with the desired
+ # name tacked on the end.
+ if (dlmatches[3] == '' && grepl('[^ -~]', filename)) {
+
+ return(httpResponse(302, 'text/html', '<h1>Found</h1>', c(
+ 'Location' = sprintf('%s/%s',
+ utils::URLencode(dlname, TRUE),
+ utils::URLencode(filename, TRUE)),
+ 'Cache-Control' = 'no-cache')))
+ }
+
+ tmpdata <- tempfile()
+ on.exit(unlink(tmpdata))
+ conn <- file(tmpdata, open = 'wb')
+ result <- try(Context$new()$run(function() { download$func(conn) }))
+ if (is(result, 'try-error')) {
+ return(httpResponse(500, 'text/plain',
+ attr(result, 'condition')$message))
+ }
+ close(conn)
+ return(httpResponse(
+ 200,
+ download$contentType %OR% getContentType(tools::file_ext(filename)),
+ readBin(tmpdata, 'raw', n=file.info(tmpdata)$size),
+ c(
+ 'Content-Disposition' = ifelse(
+ dlmatches[3] == '',
+ 'attachment; filename="' %.%
+ gsub('(["\\\\])', '\\\\\\1', filename) %.% # yes, that many \'s
+ '"',
+ 'attachment'
+ ),
+ 'Cache-Control'='no-cache')))
+ }
+
return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
},
savePlot = function(name, data, contentType) {
plots$set(name, list(data=data, contentType=contentType))
return(sprintf('session/%s/plot/%s?%s',
- URLencode(token),
- URLencode(name),
+ URLencode(token, TRUE),
+ URLencode(name, TRUE),
createUniqueId(8)))
+ },
+ registerDownload = function(name, filename, contentType, func) {
+
+ downloads$set(name, list(filename = filename,
+ contentType = contentType,
+ func = func))
+ return(sprintf('session/%s/download/%s',
+ URLencode(token, TRUE),
+ URLencode(name, TRUE)))
}
)
)
@@ -361,50 +439,7 @@ staticHandler <- function(root) {
return(NULL)
ext <- tools::file_ext(abs.path)
- content.type <- switch(
- ext,
- html='text/html; charset=UTF-8',
- htm='text/html; charset=UTF-8',
- js='text/javascript',
- css='text/css',
- png='image/png',
- jpg='image/jpeg',
- jpeg='image/jpeg',
- gif='image/gif',
- svg='image/svg+xml',
- txt='text/plain',
- pdf='application/pdf',
- ps='application/postscript',
- xml='application/xml',
- m3u='audio/x-mpegurl',
- m4a='audio/mp4a-latm',
- m4b='audio/mp4a-latm',
- m4p='audio/mp4a-latm',
- mp3='audio/mpeg',
- wav='audio/x-wav',
- m4u='video/vnd.mpegurl',
- m4v='video/x-m4v',
- mp4='video/mp4',
- mpeg='video/mpeg',
- mpg='video/mpeg',
- avi='video/x-msvideo',
- mov='video/quicktime',
- ogg='application/ogg',
- swf='application/x-shockwave-flash',
- doc='application/msword',
- xls='application/vnd.ms-excel',
- ppt='application/vnd.ms-powerpoint',
- xlsx='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
- xltx='application/vnd.openxmlformats-officedocument.spreadsheetml.template',
- potx='application/vnd.openxmlformats-officedocument.presentationml.template',
- ppsx='application/vnd.openxmlformats-officedocument.presentationml.slideshow',
- pptx='application/vnd.openxmlformats-officedocument.presentationml.presentation',
- sldx='application/vnd.openxmlformats-officedocument.presentationml.slide',
- docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document',
- dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template',
- xlam='application/vnd.ms-excel.addin.macroEnabled.12',
- xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12',
- 'application/octet-stream')
+ content.type <- getContentType(ext)
response.content <- readBin(abs.path, 'raw', n=file.info(abs.path)$size)
return(httpResponse(200, content.type, response.content))
})
View
47 R/shinywrappers.R
@@ -184,3 +184,50 @@ reactiveUI <- function(func) {
return(as.character(result))
})
}
+
+#' File Downloads
+#'
+#' Allows content from the Shiny application to be made available to the user as
+#' file downloads (for example, downloading the currently visible data as a CSV
+#' file). Both filename and contents can be calculated dynamically at the time
+#' the user initiates the download. Assign the return value to a slot on
+#' \code{output} in your server function, and in the UI use
+#' \code{\link{downloadButton}} or \code{\link{downloadLink}} to make the
+#' download available.
+#'
+#' @param filename A string of the filename, including extension, that the
+#' user's web browser should default to when downloading the file; or a
+#' function that returns such a string. (Reactive values and functions may be
+#' used from this function.)
+#' @param content A function that takes a single argument \code{con} that is a
+#' file connection opened in mode \code{wb}, and writes the content of the
+#' download into the connection. (Reactive values and functions may be used
+#' from this function.)
+#' @param contentType A string of the download's
+#' \href{http://en.wikipedia.org/wiki/Internet_media_type}{content type}, for
+#' example \code{"text/csv"} or \code{"image/png"}. If \code{NULL} or
+#' \code{NA}, the content type will be guessed based on the filename
+#' extension, or \code{application/octet-stream} if the extension is unknown.
+#'
+#' @examples
+#' \dontrun{
+#' # In server.R:
+#' output$downloadData <- downloadHandler(
+#' filename = function() {
+#' paste('data-', Sys.Date(), '.csv', sep='')
+#' },
+#' content = function(con) {
+#' write.csv(data, con)
+#' }
+#' )
+#'
+#' # In ui.R:
+#' downloadLink('downloadData', 'Download')
+#' }
+#'
+#' @export
+downloadHandler <- function(filename, content, contentType=NA) {
+ return(function(shinyapp, name, ...) {
+ shinyapp$registerDownload(name, filename, contentType, content)
+ })
+}
View
104 R/utils.R
@@ -0,0 +1,104 @@
+#' Make a random number generator repeatable
+#'
+#' Given a function that generates random data, returns a wrapped version of
+#' that function that always uses the same seed when called. The seed to use can
+#' be passed in explicitly if desired; otherwise, a random number is used.
+#'
+#' @param rngfunc The function that is affected by the R session's seed.
+#' @param seed The seed to set every time the resulting function is called.
+#' @return A repeatable version of the function that was passed in.
+#'
+#' @note When called, the returned function attempts to preserve the R session's
+#' current seed by snapshotting and restoring
+#' \code{\link[base]{.Random.seed}}.
+#'
+#' @examples
+#' rnormA <- repeatable(rnorm)
+#' rnormB <- repeatable(rnorm)
+#' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111
+#' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111
+#' rnormA(5) # [1] 1.8285879 -0.7468041 -0.4639111 -1.6510126 -1.4686924
+#' rnormB(5) # [1] -0.7946034 0.2568374 -0.6567597 1.2451387 -0.8375699
+#'
+#' @export
+repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
+ force(seed)
+
+ function(...) {
+ # When we exit, restore the seed to its original state
+ if (exists('.Random.seed', where=globalenv())) {
+ currentSeed <- get('.Random.seed', pos=globalenv())
+ on.exit(assign('.Random.seed', currentSeed, pos=globalenv()))
+ }
+ else {
+ on.exit(rm('.Random.seed', pos=globalenv()))
+ }
+
+ set.seed(seed)
+
+ do.call(rngfunc, list(...))
+ }
+}
+
+`%OR%` <- function(x, y) {
+ ifelse(is.null(x) || is.na(x), y, x)
+}
+
+`%AND%` <- function(x, y) {
+ if (!is.null(x) && !is.na(x))
+ if (!is.null(y) && !is.na(y))
+ return(y)
+ return(NULL)
+}
+
+`%.%` <- function(x, y) {
+ paste(x, y, sep='')
+}
+
+knownContentTypes <- Map$new()
+knownContentTypes$mset(
+ html='text/html; charset=UTF-8',
+ htm='text/html; charset=UTF-8',
+ js='text/javascript',
+ css='text/css',
+ png='image/png',
+ jpg='image/jpeg',
+ jpeg='image/jpeg',
+ gif='image/gif',
+ svg='image/svg+xml',
+ txt='text/plain',
+ pdf='application/pdf',
+ ps='application/postscript',
+ xml='application/xml',
+ m3u='audio/x-mpegurl',
+ m4a='audio/mp4a-latm',
+ m4b='audio/mp4a-latm',
+ m4p='audio/mp4a-latm',
+ mp3='audio/mpeg',
+ wav='audio/x-wav',
+ m4u='video/vnd.mpegurl',
+ m4v='video/x-m4v',
+ mp4='video/mp4',
+ mpeg='video/mpeg',
+ mpg='video/mpeg',
+ avi='video/x-msvideo',
+ mov='video/quicktime',
+ ogg='application/ogg',
+ swf='application/x-shockwave-flash',
+ doc='application/msword',
+ xls='application/vnd.ms-excel',
+ ppt='application/vnd.ms-powerpoint',
+ xlsx='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
+ xltx='application/vnd.openxmlformats-officedocument.spreadsheetml.template',
+ potx='application/vnd.openxmlformats-officedocument.presentationml.template',
+ ppsx='application/vnd.openxmlformats-officedocument.presentationml.slideshow',
+ pptx='application/vnd.openxmlformats-officedocument.presentationml.presentation',
+ sldx='application/vnd.openxmlformats-officedocument.presentationml.slide',
+ docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document',
+ dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template',
+ xlam='application/vnd.ms-excel.addin.macroEnabled.12',
+ xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12')
+
+getContentType <- function(ext, defaultType='application/octet-stream') {
+ knownContentTypes$get(tolower(ext)) %OR% defaultType
+}
View
18 inst/examples/10_download/server.R
@@ -0,0 +1,18 @@
+shinyServer(function(input, output) {
+ datasetInput <- reactive(function() {
+ switch(input$dataset,
+ "rock" = rock,
+ "pressure" = pressure,
+ "cars" = cars)
+ })
+
+ output$table <- reactiveTable(function() {
+ datasetInput()
+ })
+
+ output$downloadData <- downloadHandler(
+ filename = function() { paste(input$dataset, '.csv', sep='') },
+ content = function(conn) {
+ write.csv(datasetInput(), conn)
+ })
+})
View
11 inst/examples/10_download/ui.R
@@ -0,0 +1,11 @@
+shinyUI(pageWithSidebar(
+ headerPanel('Download Example'),
+ sidebarPanel(
+ selectInput("dataset", "Choose a dataset:",
+ choices = c("rock", "pressure", "cars")),
+ downloadButton('downloadData', 'Download')
+ ),
+ mainPanel(
+ tableOutput('table')
+ )
+))
View
11 inst/www/shared/shiny.js
@@ -910,6 +910,17 @@
}
});
outputBindings.register(htmlOutputBinding, 'shiny.htmlOutput');
+
+ var downloadLinkOutputBinding = new OutputBinding();
+ $.extend(downloadLinkOutputBinding, {
+ find: function(scope) {
+ return $(scope).find('a.shiny-download-link');
+ },
+ renderValue: function(el, data) {
+ $(el).attr('href', data);
+ }
+ })
+ outputBindings.register(downloadLinkOutputBinding, 'shiny.downloadLink');
var InputBinding = exports.InputBinding = function() {
View
37 man/downloadButton.Rd
@@ -0,0 +1,37 @@
+\name{downloadButton}
+\alias{downloadButton}
+\alias{downloadLink}
+\title{Create a download button or link}
+\usage{
+ downloadButton(outputId, label = "Download",
+ class = NULL)
+
+ downloadLink(outputId, label = "Download", class = NULL)
+}
+\description{
+ Use these functions to create a download button or link;
+ when clicked, it will initiate a browser download. The
+ filename and contents are specified by the corresponding
+ \code{\link{downloadHandler}} defined in the server
+ function.
+}
+\examples{
+\dontrun{
+# In server.R:
+output$downloadData <- downloadHandler(
+ filename = function() {
+ paste('data-', Sys.Date(), '.csv', sep='')
+ },
+ content = function(con) {
+ write.csv(data, con)
+ }
+)
+
+# In ui.R:
+downloadLink('downloadData', 'Download')
+}
+}
+\seealso{
+ downloadHandler
+}
+
View
55 man/downloadHandler.Rd
@@ -0,0 +1,55 @@
+\name{downloadHandler}
+\alias{downloadHandler}
+\title{File Downloads}
+\usage{
+ downloadHandler(filename, content, contentType = NA)
+}
+\arguments{
+ \item{filename}{A string of the filename, including
+ extension, that the user's web browser should default to
+ when downloading the file; or a function that returns
+ such a string. (Reactive values and functions may be used
+ from this function.)}
+
+ \item{content}{A function that takes a single argument
+ \code{con} that is a file connection opened in mode
+ \code{wb}, and writes the content of the download into
+ the connection. (Reactive values and functions may be
+ used from this function.)}
+
+ \item{contentType}{A string of the download's
+ \href{http://en.wikipedia.org/wiki/Internet_media_type}{content
+ type}, for example \code{"text/csv"} or
+ \code{"image/png"}. If \code{NULL} or \code{NA}, the
+ content type will be guessed based on the filename
+ extension, or \code{application/octet-stream} if the
+ extension is unknown.}
+}
+\description{
+ Allows content from the Shiny application to be made
+ available to the user as file downloads (for example,
+ downloading the currently visible data as a CSV file).
+ Both filename and contents can be calculated dynamically
+ at the time the user initiates the download. Assign the
+ return value to a slot on \code{output} in your server
+ function, and in the UI use \code{\link{downloadButton}}
+ or \code{\link{downloadLink}} to make the download
+ available.
+}
+\examples{
+\dontrun{
+# In server.R:
+output$downloadData <- downloadHandler(
+ filename = function() {
+ paste('data-', Sys.Date(), '.csv', sep='')
+ },
+ content = function(con) {
+ write.csv(data, con)
+ }
+)
+
+# In ui.R:
+downloadLink('downloadData', 'Download')
+}
+}
+
View
10 man/reactivePlot.Rd
@@ -9,11 +9,17 @@
\item{width}{The width of the rendered plot, in pixels;
or \code{'auto'} to use the \code{offsetWidth} of the
- HTML element that is bound to this plot.}
+ HTML element that is bound to this plot. You can also
+ pass in a function that returns the width in pixels or
+ \code{'auto'}; in the body of the function you may
+ reference reactive values and functions.}
\item{height}{The height of the rendered plot, in pixels;
or \code{'auto'} to use the \code{offsetHeight} of the
- HTML element that is bound to this plot.}
+ HTML element that is bound to this plot. You can also
+ pass in a function that returns the width in pixels or
+ \code{'auto'}; in the body of the function you may
+ reference reactive values and functions.}
\item{...}{Arguments to be passed through to
\code{\link[grDevices]{png}}. These can be used to set
View
3  man/reactiveTable.Rd
@@ -9,7 +9,8 @@
be used with \code{\link[xtable]{xtable}}.}
\item{...}{Arguments to be passed through to
- \code{\link[xtable]{xtable}}.}
+ \code{\link[xtable]{xtable}} and
+ \code{\link[xtable]{print.xtable}}.}
}
\description{
Creates a reactive table that is suitable for assigning
Please sign in to comment.
Something went wrong with that request. Please try again.