mirror of
https://github.com/rstudio/shiny.git
synced 2026-01-29 08:48:13 -05:00
3a0b11b89d
This feature is currently pretty rough. It only works in the most modern browsers (depends on HTML5 File API, including Blob.slice) and doesn't show upload progress.
96 lines
2.7 KiB
R
96 lines
2.7 KiB
R
# For HTML5-capable browsers, file uploads happen through a series of requests.
|
|
#
|
|
# 1. Client tells server that one or more files are about to be uploaded; the
|
|
# server responds with a "job ID" that the client should use for the rest of
|
|
# the upload.
|
|
#
|
|
# 2. For each file (sequentially):
|
|
# a. Client tells server the name, size, and type of the file.
|
|
# b. Client sends server a small-ish blob of data.
|
|
# c. Repeat 2b until the entire file has been uploaded.
|
|
# d. Client tells server that the current file is done.
|
|
#
|
|
# 3. Repeat 2 until all files have been uploaded.
|
|
#
|
|
# 4. Client tells server that all files have been uploaded, along with the
|
|
# input ID that this data should be associated with.
|
|
#
|
|
# Unfortunately this approach will not work for browsers that don't support
|
|
# HTML5 File API, but the fallback approach we would like to use (multipart
|
|
# form upload, i.e. traditional HTTP POST-based file upload) doesn't work with
|
|
# the websockets package's HTTP server at the moment.
|
|
|
|
FileUploadOperation <- setRefClass(
|
|
'FileUploadOperation',
|
|
fields = list(
|
|
.parent = 'ANY',
|
|
.id = 'character',
|
|
.files = 'data.frame',
|
|
.dir = 'character',
|
|
.currentFileInfo = 'list',
|
|
.currentFileData = 'ANY'
|
|
),
|
|
methods = list(
|
|
initialize = function(parent, id, dir) {
|
|
.parent <<- parent
|
|
.id <<- id
|
|
.dir <<- dir
|
|
},
|
|
fileBegin = function(file) {
|
|
.currentFileInfo <<- file
|
|
|
|
filename <- file.path(.dir, as.character(length(.files)))
|
|
row <- data.frame(name=file$name, size=file$size, type=file$type,
|
|
datapath=filename, stringsAsFactors=F)
|
|
|
|
if (length(.files) == 0)
|
|
.files <<- row
|
|
else
|
|
.files <<- rbind(.files, row)
|
|
|
|
.currentFileData <<- file(filename, open='wb')
|
|
},
|
|
fileChunk = function(rawdata) {
|
|
writeBin(rawdata, .currentFileData)
|
|
},
|
|
fileEnd = function() {
|
|
close(.currentFileData)
|
|
},
|
|
finish = function() {
|
|
.parent$onJobFinished(.id)
|
|
return(.files)
|
|
}
|
|
)
|
|
)
|
|
|
|
FileUploadContext <- setRefClass(
|
|
'FileUploadContext',
|
|
fields = list(
|
|
.basedir = 'character',
|
|
.operations = 'Map'
|
|
),
|
|
methods = list(
|
|
initialize = function(dir=tempdir()) {
|
|
.basedir <<- dir
|
|
},
|
|
createUploadOperation = function() {
|
|
while (T) {
|
|
id <- paste(as.raw(runif(12, min=0, max=0xFF)), collapse='')
|
|
dir <- file.path(.basedir, id)
|
|
if (!dir.create(dir))
|
|
next
|
|
|
|
op <- FileUploadOperation$new(.self, id, dir)
|
|
.operations$set(id, op)
|
|
return(id)
|
|
}
|
|
},
|
|
getUploadOperation = function(jobId) {
|
|
.operations$get(jobId)
|
|
},
|
|
onJobFinished = function(jobId) {
|
|
.operations$remove(jobId)
|
|
}
|
|
)
|
|
)
|