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
|
#' File Upload Control
#'
#' Create a file upload control that can be used to upload one or more files.
#'
#' Whenever a file upload completes, the corresponding input variable is set
#' to a dataframe. See the `Server value` section.
#'
#' @family input elements
#'
#' @inheritParams textInput
#' @param multiple Whether the user should be allowed to select and upload
#' multiple files at once. **Does not work on older browsers, including
#' Internet Explorer 9 and earlier.**
#' @param accept A character vector of "unique file type specifiers" which
#' gives the browser a hint as to the type of file the server expects.
#' Many browsers use this prevent the user from selecting an invalid file.
#'
#' A unique file type specifier can be:
#' * A case insensitive extension like `.csv` or `.rds`.
#' * A valid MIME type, like `text/plain` or `application/pdf`
#' * One of `audio/*`, `video/*`, or `image/*` meaning any audio, video,
#' or image type, respectively.
#' @param buttonLabel The label used on the button. Can be text or an HTML tag
#' object.
#' @param placeholder The text to show before a file has been uploaded.
#'
#' @examples
#' ## Only run examples in interactive R sessions
#' if (interactive()) {
#'
#' ui <- fluidPage(
#' sidebarLayout(
#' sidebarPanel(
#' fileInput("file1", "Choose CSV File", accept = ".csv"),
#' checkboxInput("header", "Header", TRUE)
#' ),
#' mainPanel(
#' tableOutput("contents")
#' )
#' )
#' )
#'
#' server <- function(input, output) {
#' output$contents <- renderTable({
#' file <- input$file1
#' ext <- tools::file_ext(file$datapath)
#'
#' req(file)
#' validate(need(ext == "csv", "Please upload a csv file"))
#'
#' read.csv(file$datapath, header = input$header)
#' })
#' }
#'
#' shinyApp(ui, server)
#' }
#'
#' @section Server value:
#' A `data.frame` that contains one row for each selected file, and following columns:
#' \describe{
#' \item{`name`}{The filename provided by the web browser. This is
#' **not** the path to read to get at the actual data that was uploaded
#' (see
#' `datapath` column).}
#' \item{`size`}{The size of the uploaded data, in
#' bytes.}
#' \item{`type`}{The MIME type reported by the browser (for example,
#' `text/plain`), or empty string if the browser didn't know.}
#' \item{`datapath`}{The path to a temp file that contains the data that was
#' uploaded. This file may be deleted if the user performs another upload
#' operation.}
#' }
#'
#' @export
fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
restoredValue <- restoreInput(id = inputId, default = NULL)
# Catch potential edge case - ensure that it's either NULL or a data frame.
if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
warning("Restored value for ", inputId, " has incorrect format.")
restoredValue <- NULL
}
if (!is.null(restoredValue)) {
restoredValue <- toJSON(restoredValue, strict_atomic = FALSE)
}
inputTag <- tags$input(
id = inputId,
name = inputId,
type = "file",
style = "display: none;",
`data-restore` = restoredValue
)
if (multiple)
inputTag$attribs$multiple <- "multiple"
if (length(accept) > 0)
inputTag$attribs$accept <- paste(accept, collapse=',')
div(class = "form-group shiny-input-container",
style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
shinyInputLabel(inputId, label),
div(class = "input-group",
# input-group-prepend is for bootstrap 4 compat
tags$label(class = "input-group-btn input-group-prepend",
span(class = "btn btn-default btn-file",
buttonLabel,
inputTag
)
),
tags$input(type = "text", class = "form-control",
placeholder = placeholder, readonly = "readonly"
)
),
tags$div(
id=paste(inputId, "_progress", sep=""),
class="progress active shiny-file-input-progress",
tags$div(class="progress-bar")
)
)
}
|
