fileInput: If possible, retain uploaded file extensions on the server. (#1706)

DESCRIPTION

@@ -71,7 +71,8 @@ Imports:
     digest,
     htmltools (>= 0.3.5),
     R6 (>= 2.0),
-    sourcetools
+    sourcetools,
+    tools
 Suggests:
     datasets,
     Cairo (>= 1.5-5),

NEWS.md

@@ -9,6 +9,8 @@ shiny 1.0.3.9000
 
 ### Minor new features and improvements
 
+Addressed [#1501](https://github.com/rstudio/shiny/issues/1501): The `fileInput` control now retains uploaded file extensions on the server. This fixes [readxl](https://github.com/tidyverse/readxl)'s `readxl::read_excel` and other functions that must recognize a file's extension in order to work. ([#1706](https://github.com/rstudio/shiny/pull/1706))
+
 ### Bug fixes
 
 Fixed [#1701](https://github.com/rstudio/shiny/issues/1701): There was a partial argument match in the `generateOptions` function. ([#1702](https://github.com/rstudio/shiny/pull/1702))

R/fileupload.R

@@ -20,6 +20,18 @@
 # form upload, i.e. traditional HTTP POST-based file upload) doesn't work with
 # the websockets package's HTTP server at the moment.
 
+# @description Returns a file's extension, with a leading dot, if one can be
+#   found. A valid extension contains only alphanumeric characters. If there is
+#   no extension, or if it contains non-alphanumeric characters, an empty
+#   string is returned.
+# @param x character vector giving file paths.
+# @return The extension of \code{x}, with a leading dot, if one was found.
+#   Otherwise, an empty character vector.
+maybeGetExtension <- function(x) {
+  ext <- tools::file_ext(x)
+  ifelse(ext == "", ext, paste0(".", ext))
+}
+
 FileUploadOperation <- R6Class(
   'FileUploadOperation',
   portable = FALSE,
@@ -52,8 +64,9 @@ FileUploadOperation <- R6Class(
       .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,
+      fileBasename <- basename(.currentFileInfo$name)
+      filename <- file.path(.dir, paste0(as.character(length(.files$name)), maybeGetExtension(fileBasename)))
+      row <- data.frame(name=fileBasename, size=file$size, type=file$type,
                         datapath=filename, stringsAsFactors=FALSE)
 
       if (length(.files$name) == 0)

tests/testthat/test-get-extension.R

@@ -0,0 +1,11 @@
+context("get-extension")
+
+test_that("Valid extensions are preserved", {
+  expect_equal(maybeGetExtension("report.csv"), ".csv")
+  expect_equal(maybeGetExtension("data.tar.bz2"), ".bz2")
+})
+
+test_that("Invalid extensions are discarded", {
+  expect_equal(maybeGetExtension("report. ℒ  裸 邏 ℓo "), "")
+  expect_equal(maybeGetExtension("data"), "")
+})