Реактивный бассейнЗакрыть в r блестящий

Question

Я использую пул для подключения к базе данных, но пытаюсь сделать его реактивным. Я передаю входной $ Server для моей разработки, бета-тестирования и производства, чтобы установить мое соединение. Есть ли способ закрыть реактивный пул?

library(shiny)
library(shinydashboard) #to access dashboard
library(DBI)
library(RMySQL)
library(dplyr)
library(dbplyr)
library(pool)
library(DT) #to build datatables in R use DT library
library(rhandsontable)

ui <- 
  dashboardPage(skin="red", 
                dashboardHeader(title = "Error Limits"),
                dashboardSidebar(
                sidebarMenu(                    
                    uiOutput("ServerSelect"),
                    uiOutput("RFOSelect"),
                    uiOutput("surveySelect"),
                    uiOutput("sdateSelect"),
                    selectInput(inputId = "Report", label = "Select Report", 
                                choices=c('',"Edit Limits")),
                    actionButton("go", "Run"),
                    downloadButton('downloadData', 'Download', class = "butt1"),
                    actionButton("savebutton", "Save Updates"),
                    tags$head(tags$style(".butt1{background-color:black;} .butt1{color: black;} .butt1{font-family: Courier New} .butt1{margin: 15px}"))
                  )
                )
                ,
                dashboardBody(tags$head(
                  tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
                ),
                DT::dataTableOutput("table"))
  )

server <- function(input, output, session) {
  
  #Set the host variable based on a user's selection
  mydb <- reactive({        
    if (input$Server == "Dev") {
      ServerPick <- c("mysqldev")
    }
    else if (input$Server == "Beta") {
      ServerPick <- c("mysqlbeta")
    }
    else if (input$Server == "Prod") {
      ServerPick <- c("mysqlprod")
    }
  })
  
  #Here is where I'm setting the host based on what MySQL server is picked
  pool <- reactive({
    if (!is.null(input$Server)) {    
      rpool <- dbPool (drv = RMySQL::MySQL(),
                       dbname = "dummy",
                       host = mydb(),
                       username = "dummy_user",
                       password = "dummy!")
      return(rpool)}
  })  
  
  #Here is where I attempt to close onStop ... my earlier question
  onStop(function()
    reactive({
      poolClose(pool())
    }))
  
  #Perhaps a fix for pool leaking?
  con <- reactive ({pool()})  
  
  #I am querying a table to allow a user to select from a geographic 
  #location list and closing the pool connection 
  RFOList <- reactive({
    #Added a length statement to only query when server has been selected.  
    if (length(input$Server) > 0) 
    {
      df <- dbGetQuery(pool(),"SELECT 'US' AS RFOAbbrev, 999 As RFOCode 
                       union
                       SELECT DISTINCT rfo_abbrev As RFOAbbrev, rfo_code 
                       As RFOCode FROM dummy.regional_field_offices;")
      return(df)
      #close connection since I no longer need to have open
      dbDisconnect(pool())
    }
  })

  #I am querying a table to allow a user to select from a survey list and 
  #closing the pool connection
  choices_sinfo <- reactive({
    if (length(input$Server) > 0) 
    {
      sl <- dbGetQuery(pool(),"select DM_Key, Survey_Desc, SDate, 
            BDIX_Name, DMId from dummy.SURVEYINFO S, dummy.DataModel D 
            where S.DM_Key=D.DMKey and S.Survey_abbrev is null order by 
            Survey_desc;")
      return(sl)
      #close connection since i no longer need to have open
      dbDisconnect(pool())
    }
  })
  
  choices_surveys <- reactive({choices_sinfo()$Survey_Desc})
  
  getSurvey <- reactive({input$Survey})
  
  outRFOAbbrev <- reactive({
    varRFOAbbrev <- c('',RFOList()$RFOAbbrev)
    return(varRFOAbbrev)
  })
  
  outRFOId <- reactive({
    if (input$RFO != 'US') {
        varRFOId <- paste("=",RFOList()$RFOCode[RFOList()$RFOAbbrev ==       input$RFO],sep=" ")}
    else {varRFOId <- paste("<",RFOList()$RFOCode[RFOList()$RFOAbbrev ==          input$RFO],sep=" ")}
    return(varRFOId)
  })
  
  RFONum <- reactive({
      varRFONum <- RFOList()$RFOCode[RFOList()$RFOAbbrev == input$RFO]
      return(varRFONum)
  })
  
  outDate <- reactive({
      sinfosorted <- choices_sinfo()$SDate[choices_sinfo()$Survey_Desc == 
      getSurvey()]
      newdata <- sort(sinfosorted, decreasing = TRUE)
      varDate <- c('', newdata)
      return(varDate)
  })
  
  outDMName <- reactive({
      varBDIX <- choices_sinfo()$BDIX_Name[(choices_sinfo()$Survey_Desc == 
      input$Survey) & (choices_sinfo()$SDate == input$SDate)]  
      return(varBDIX)
  })
  
  outDMKey <- reactive({
      varDMKey<-choices_sinfo()$DM_Key[(choices_sinfo()$Survey_Desc == 
      input$Survey) & (choices_sinfo()$SDate == input$SDate)]
      return(varDMKey)
  })
  
  outInstId <- reactive({
      varInstId<-choices_sinfo()$DMId[(choices_sinfo()$DM_Key == 
    outDMKey())]
    return(varInstId)
  })
  
  output$ServerSelect <- 
 

renderUI ({selectInput ("Server", "Server:", choices = c ('', "Dev", "Beta", "Prod"), selected = NULL, multiple = FALSE, selectize = TRUE, width = NULL, size = NULL)})

  output$RFOSelect <-renderUI(
      {selectInput("RFO","RFO:",choices=c('',outRFOAbbrev()), selected = 
      NULL, multiple = FALSE,
      selectize = TRUE, width = NULL, size = NULL)}
  )
  
  output$surveySelect <-  
  renderUI({selectInput("Survey","Survey:",choices=c('',choices_surveys()), 

selected = NULL, multiple = FALSE, selectize = TRUE, width = NULL, size = NULL)})

  output$sdateSelect <- renderUI({selectInput("SDate","SDate:",choices = c('',outDate()) , selected = NULL, multiple = FALSE,
                                              selectize = TRUE, width = NULL, size = NULL)})
  
  output$RFOId <- renderUI({textInput("RFOId","RFOId of Survey:", value <- outRFOId())})
  
  tbl_selection <- eventReactive(input$go, {
    
    if ((input$Report) == "Edit Limits") {
      query <- paste0("SELECT State, 
                      MasterVarname, 
                      LowerWarning, 
                      UpperWarning, 
                      LowerCritical, 
                      UpperCritical, 
                      Date_stamp 
                      FROM `dummy`.`ErrorLimit`
                      where State = 6 and Folder_Name ='", 
                      isolate(outDMName()), "';")
    }     
    
    suppressWarnings(query)
    suppressMessages(query)
    dbGetQuery(con(), query)
    
    })
  
  output$table <- DT::renderDataTable({
      tbl_selection()}, selection="multiple", rownames=F, 
      options=list(autoWidth=TRUE,pageLength=25), editable = list(target = 
      "row", disable = list(columns = c(0, 1, 6))))
    
   
    
  output$downloadData <- downloadHandler(
      filename = function() {
      paste('data-', Sys.Date(), '.csv', sep='')
      #paste("status", sep = ".", "csv")
    },
    content = function(file) {
      write.csv(tbl_selection(), file, row.names = TRUE)
    }
  )
  
  #Here is where I am closing pool upon ending application
  session$onSessionEnded(function() {poolClose(isolate(pool()))})
  }

  shinyApp(ui, server)