1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
|
# 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 <- R6Class(
'FileUploadOperation',
portable = FALSE,
class = FALSE,
public = list(
.parent = NULL,
.id = character(0),
.files = data.frame(),
.dir = character(0),
.currentFileInfo = list(),
.currentFileData = NULL,
.pendingFileInfos = list(),
initialize = function(parent, id, dir, fileInfos) {
.parent <<- parent
.id <<- id
.files <<- data.frame(name=character(),
size=numeric(),
type=character(),
datapath=character(),
stringsAsFactors=FALSE)
.dir <<- dir
.pendingFileInfos <<- fileInfos
},
fileBegin = function() {
if (length(.pendingFileInfos) < 1)
stop("fileBegin called too many times")
file <- .pendingFileInfos[[1]]
.currentFileInfo <<- file
.pendingFileInfos <<- tail(.pendingFileInfos, -1)
filename <- file.path(.dir, as.character(length(.files$name)))
row <- data.frame(name=file$name, size=file$size, type=file$type,
datapath=filename, stringsAsFactors=FALSE)
if (length(.files$name) == 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() {
if (length(.pendingFileInfos) > 0)
stop("File upload job was stopped prematurely")
.parent$onJobFinished(.id)
return(.files)
}
)
)
#' @include map.R
FileUploadContext <- R6Class(
'FileUploadContext',
class = FALSE,
private = list(
basedir = character(0),
operations = 'Map',
ids = character(0) # Keep track of all ids used for file uploads
),
public = list(
initialize = function(dir=tempdir()) {
private$basedir <- dir
private$operations <- Map$new()
},
createUploadOperation = function(fileInfos) {
while (TRUE) {
id <- createUniqueId(12)
private$ids <- c(private$ids, id)
dir <- file.path(private$basedir, id)
if (!dir.create(dir))
next
op <- FileUploadOperation$new(self, id, dir, fileInfos)
private$operations$set(id, op)
return(id)
}
},
getUploadOperation = function(jobId) {
private$operations$get(jobId)
},
onJobFinished = function(jobId) {
private$operations$remove(jobId)
},
# Remove the directories containing file uploads; this is to be called when
# a session ends.
rmUploadDirs = function() {
# Make sure all_paths is underneath the tempdir()
if (!grepl(normalizePath(tempdir()), normalizePath(private$basedir), fixed = TRUE)) {
stop("Won't remove upload path ", private$basedir,
"because it is not under tempdir(): ", tempdir())
}
all_paths <- file.path(private$basedir, private$ids)
unlink(all_paths, recursive = TRUE)
}
)
)
|