是否可以从服务器端 R Shiny 应用程序更改本地文件？

Question

问题

我正在制作一个应用程序，允许人们将数据添加到 csv 文件。为了避免我的同事看到任何代码，我希望这个应用程序是服务器端的，例如在shinyapps.io 上。目前，我已经尝试过

fileinput()

和

shinyFiles

：当我的应用程序位于本地 PC 上时（请参阅 MWE），这些可以工作，但当我将其部署到shinyapps.io 时则不行。

这可以工作吗？或者从服务器写入本地目录总是会出现问题？

MWE

fileinput()

library(shiny)
library(shinyWidgets)
library(dplyr) # For bind_rows

# Define UI
ui = fluidPage(
    fileInput("my_file", "Add to Master Sheet", accept = ".csv"), # File upload
    actionButton("submit_btn", "Submit data") # Submit button
)

# Define Server Logic
server = function(input, output) {
    observeEvent(input$submit_btn, {
        my_data = read.csv(input$my_file$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, input$my_file$name) # Write the updated file
        stopApp() # Close app
    })
    
}

# Run the application
shinyApp(ui, server)

当应用程序位于我的本地计算机上时，此示例有效，但即使如此，它也仅将新的 .csv 文件保存到与应用程序相同的位置。使用

input$my_file$datapath

不起作用。当应用程序位于shinyapps.io 上时，不会更新任何文件。

MWE

shinyFiles()

library(shiny)
library(shinyFiles)
library(shinyWidgets)
library(dplyr)

# Define UI
ui = fluidPage(
    shinyFilesButton("file_upload", "Choose a CSV file", title = "Upload", multiple = FALSE),
    verbatimTextOutput("file_status", placeholder = TRUE),  # Placeholder text will be shown until a file is uploaded
    actionButton("submit_btn", "Submit data"),
)

server <- function(input, output, session) {
    
    volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
    shinyFileChoose(input, "file_upload", roots = volumes, filetypes = c('', 'csv'), session = session)
    observe({
        if (!is.null(input$file_upload)) {
            file_info <- parseFilePaths(volumes, input$file_upload)
            output$file_status <- renderText(paste("Selected file:", file_info$name))
        }
    })

    observeEvent(input$submit_btn, {
        infile = parseFilePaths(volumes, input$file_upload)
        my_data = read.csv(infile$datapath) # Read in my data
        my_new_data = bind_rows(my_data, data.frame(5)) # Add new data
        write.csv(my_new_data, infile$datapath) # Write the updated file
        stopApp() # Close app
    })
}

shinyApp(ui, server)

这在我的本地电脑上同样有效，但在shinyapps.io上，当我单击“文件上传”时，我的系统的大部分文件都不会显示。

Answer 1

服务器有权访问用户的本地文件系统/驱动器的概念与大多数安全态势相反，即使服务器支持它，大多数浏览器也不会（不应该！）允许它。相反，让用户上传他们的数据（一个或多个文件），您对其执行一些操作（可能是交互方式），然后让他们下载结果。

数据设置：

write.csv(mtcars, "mt.csv", row.names=FALSE)

从这里开始，一个简单的应用程序：

library(shiny)
ui <- fluidPage(
  shinyjs::useShinyjs(),  # Set up shinyjs
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      fileInput("infile", "Upload something!"),
      actionButton("act", "Do something to it!"),
      downloadButton("dwnld", "Get it back!")
    ),
    mainPanel(
      DT::DTOutput("tbl")
    )
  )
)
server <- function(input, output, session) {
  shinyjs::disable("act")
  shinyjs::disable("dwnld")
  userdata <- reactiveVal(NULL)
  observeEvent(input$infile, {
    req(file.exists(input$infile$datapath))
    tmp <- tryCatch(
      read.csv(input$infile$datapath),
      error = function(e) e)
    validate(
      need(!inherits(tmp, "error"), "Error reading file")
    )
    shinyjs::enable("act")
    shinyjs::enable("dwnld")
    userdata(tmp)
  })
  observeEvent(input$act, {
    req(userdata())
    dat <- userdata()
    dat[[1]] <- dat[[1]] + 100
    userdata(dat)
  })
  output$tbl <- DT::renderDT({
    req(userdata())
  })
  output$dwnld <- downloadHandler(
    filename = function() {
      sprintf("%s_updated_%s.csv", tools::file_path_sans_ext(input$infile$name),
              format(Sys.Date(), format = "%Y%m%d"))
    },
    content = function(file) {
      write.csv(userdata(), file, row.names = FALSE)
    }
  )
}
shinyApp(ui, server)

我仅使用

shinyjs

来禁用“执行某些操作”和“下载”按钮；不是必需的，但我发现建议我可以在上传内容之前下载内容的界面可能会出现问题。

从这里开始，我们从：

点击“浏览”并上传我们上面的

mt.csv

，

我点击了几次“做某事”（这只是为了展示，不是严格要求），注意

mpg

增加了：

单击

Get it back!

下载按钮，您将获得一个新文件名。我花了一些功夫“聪明地”重命名该文件，你可以随意命名。