shiny session closes when writing out rsqlite file

Dear Support, sorry to duplicate a stackoverflow post here, I did not find this place in time

I have a shiny app below that shows a file content from a server-side sqlite file I want to overwrite the sqlite every week on my shiny server from a csv upload and filter it through the App

  • When I update the sqlite file from within the shiny ran in RStudio I get new content OK and am able to work with it and upload multiple new content as expected

  • When I run the same app on the shiny server (same machine) in my browser, I get disconnected from the server as soon as I click on the 'Upload' button after uploading the new csv with 'Browse' (which succeeds).

Can someone please explain this behaviour

I suspect something off in the button part below of in what it triggers :

  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: it is not the 'shinyalert' as the issue remains after commenting it out

my full App code :

# 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)

session info:

R version 3.6.0 (2019-04-26)
Platform: x86_64-redhat-linux-gnu (64-bit)
Running under: RHEL

Matrix products: default
BLAS/LAPACK: /usr/lib64/R/lib/libRblas.so

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
 [4] LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
[10] LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] rclipboard_0.1.2    clipr_0.7.0         shinyalert_1.1      shinyjs_1.1         shinyBS_0.61       
 [6] openxlsx_4.1.5      DT_0.15             forcats_0.5.0       stringr_1.4.0       purrr_0.3.4        
[11] tidyr_1.1.2         tibble_3.0.3        tidyverse_1.3.0     stringi_1.4.6       hflights_0.1       
[16] RSQLite_2.2.0       lubridate_1.7.9     dplyr_1.0.2         readr_1.3.1         nloptr_1.2.2.2     
[21] ggplot2_3.3.2       shinythemes_1.1.2   shiny_1.5.0         BiocManager_1.30.10

loaded via a namespace (and not attached):
 [1] httr_1.4.2        bit64_4.0.5       jsonlite_1.7.0    modelr_0.1.8      assertthat_0.2.1 
 [6] blob_1.2.1        cellranger_1.1.0  yaml_2.2.1        pillar_1.4.6      backports_1.1.9  
[11] glue_1.4.2        digest_0.6.25     promises_1.1.1    rvest_0.3.6       colorspace_1.4-1 
[16] htmltools_0.5.0   httpuv_1.5.4      pkgconfig_2.0.3   broom_0.7.0       haven_2.3.1      
[21] xtable_1.8-4      scales_1.1.1      later_1.1.0.1     generics_0.0.2    ellipsis_0.3.1   
[26] withr_2.2.0       cli_2.0.2         magrittr_1.5      crayon_1.3.4      readxl_1.3.1     
[31] mime_0.9          memoise_1.1.0     fs_1.5.0          fansi_0.4.1       xml2_1.3.2       
[36] tools_3.6.0       hms_0.5.3         lifecycle_0.2.0   munsell_0.5.0     reprex_0.3.0     
[41] zip_2.1.1         compiler_3.6.0    rlang_0.4.7       grid_3.6.0        rstudioapi_0.11  
[46] htmlwidgets_1.5.1 gtable_0.3.0      DBI_1.1.0         R6_2.4.1          fastmap_1.0.1    
[51] bit_4.0.4         Rcpp_1.0.5        vctrs_0.3.4       dbplyr_1.4.4      tidyselect_1.1.0 

I found my flaw. I did not load the package "readr" which loads as default in RStudio. Adding the library call line fixed it.

The error did not reach to the shiny session log file and I never got a chance to read it.

For others, I could spot the issue by running from RStudio in window as a background job, which gave me the jobs window to see the error message displayed.

1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.