从服务器运行时,闪亮的会话消失了

问题描述 投票:0回答:1

我下面有一个闪亮的应用程序,它显示服务器端 sqlite 文件的文件内容 我想每周在我闪亮的服务器上通过 csv 上传覆盖 sqlite 并通过应用程序过滤它

  • 当我从 RStudio 中的闪亮运行中更新 sqlite 文件时,我可以正常获取新内容,并且能够使用它并按预期上传多个新内容
  • 当我在浏览器中的闪亮服务器上运行相同的应用程序时,使用“浏览”上传新的 csv(成功)后,一旦单击“上传”按钮,我就会与服务器断开连接。

有人可以解释一下这种行为吗

我怀疑有什么问题:

  observeEvent(input$Upload, {
    if(is.null(input$Browse))
    {
      return(NULL)
    }
    else
    {
      file <- input$Browse
      createDB(file$datapath, basename(file$name), dbfile)
      shinyalert(paste(basename(file$name), "database uploaded, please refresh the session", sep=" "), type = "success", timer=2000)
    }
  }) 

REM:但这不是闪亮警报

我的完整应用程序代码:

# accounts.shinyapp
# R/shiny tool to filter the weekly accounts_filtered.csv

library("shiny")
library("shinyBS")
library("shinyalert")
library("RSQLite")
library("DT")

# you may un-comment the next line to allow 10MB input files
options(shiny.maxRequestSize=10*1024^2)
# the following test checks if we are running on shinnyapps.io to limit file size dynamically
# ref: https://stackoverflow.com/questions/31423144/how-to-know-if-the-app-is-running-at-local-or-on-server-r-shiny/31425801#31425801
#if ( Sys.getenv('SHINY_PORT') == "" ) { options(shiny.maxRequestSize=1000*1024^2) }

# App defaults
app.name <- "accounts"
script.version <- "1.0b"
version <- "NA"
names <- c("Last","First","Email","Phone","Level","DeptNum","Code","Short","Logon","Location")

# database functions
createDB <- function(filepath, filename, dbfile){
  data <- read_csv(filepath, 
                      locale = locale(encoding = "ISO-8859-2",
                                      asciify = TRUE))
  # give proper english names to columns
  colnames(data) <- names
  data$Email <- tolower(data$Email)
  version <- data.frame(version=filename)
  
  # create sqlite and save
  mydb <- dbConnect(RSQLite::SQLite(), dbfile)
  dbWriteTable(mydb, "data", data, overwrite=TRUE)
  dbWriteTable(mydb, "version", version, overwrite=TRUE)  
  dbDisconnect(mydb)
}

loadDB <- function(dbfile){
  mydb <- dbConnect(RSQLite::SQLite(), dbfile)
  data <- dbReadTable(mydb, "data")
  version <- dbReadTable(mydb, "version")
  dbDisconnect(mydb)
  # return resulting data.frame
  return(list(data = as.data.frame(data), version = as.data.frame(version)))
}

# initial DB creation
# infile <- "Data/ori_accounts_filtered.csv"
# createDB(infile, basename(infile), dbfile)

#############################
# Define UI for application # 
#############################

ui <- fluidPage(
  
  useShinyalert(),
  
  HTML('<style type="text/css">
       .row-fluid { width: 25%; }
       .well { background-color: #99CCFF; }
       .shiny-html-output { font-size: 14px; line-height: 15px; }
       </style>'),
  
  # Application header
  headerPanel("Filter the weekly accounts list"),
  
  # Application title
  titlePanel(
    windowTitle = "accounts",
    tags$a(href="https://http://someIP:8787/accounts", target="_blank",
           img(src='logo.png', align = "right", 
               width="150", height="58.5", alt="myApp"))
  ),
  
  sidebarLayout(
    # show file import weekly update csv data
    sidebarPanel(
  
      tags$h5(paste(app.name, " version: ", script.version, sep="")),
      
      tipify(fileInput("Browse", 
                       "Choose new Weekly update:", 
                       accept = ".csv"), 
             "a accounts_filtered.csv file"),
      
      tipify(actionButton("Upload", "Upload new table"),
             "This will replace the current database content!"),

      hr(),

      checkboxGroupInput("show_vars", 
                         "Check columns to be shown:",
                         names, 
                         selected = names[c(1:4,6)]),

      hr(),

      tipify(actionButton("Refresh", "Refresh Session"),
             "This will reload the database content!")

    ),
    
    mainPanel(
      
      htmlOutput("version_tag"),
      hr(),
      dataTableOutput('dataTable')
      
    )
  )
)

#######################
# Define server logic #
#######################

server <- function(input, output, session) {

  # initialize content at startup
  dbfile <- "Data/data.sqlite"
  # load both data and version
  mydat <- loadDB(dbfile)
  version <- mydat$version[1,1]
  accounts <- mydat$data
  names <- colnames(accounts)

  output$version_tag <- renderText({
    paste("<b>Data file: ", version, "</b>")
    })

  observeEvent(input$Refresh, {
    session$reload()
    })
  
  observeEvent(input$Upload, {
    if(is.null(input$Browse))
    {
      return(NULL)
    }
    else
    {
      file <- input$Browse
      createDB(file$datapath, basename(file$name), dbfile)
      shinyalert(paste(basename(file$name), "database uploaded, please refresh the session", sep=" "), type = "success", timer=2000)
    }
  })
  
  output$dataTable <- renderDT(
        accounts[,input$show_vars], # data
        class = "display nowrap compact", # style
        filter = "top", # location of column filters
        options = list(pageLength = 20, autoWidth = TRUE),
        rownames= FALSE
        )

}

# Run the application 
shinyApp(ui = ui, server = server)
r shiny shiny-reactivity
1个回答
0
投票

这个不见了。

library("readr")
© www.soinside.com 2019 - 2024. All rights reserved.