如何在 Shiny 应用程序结束时终止所有进程?

How does one terminate all processes upon Shiny app end?

我在安装本地服务器的情况下使用 Shiny。

我的 Shiny 应用程序 运行 是一个使用 system/system2/processx::运行 的重型本地程序。我正在 运行 同步它 (wait=T)。如果用户关闭 Shiny 的浏览器 window,我希望这个繁重的程序结束。如果用户重新打开浏览器 window,我希望 Shiny 应用再次准备好执行本地程序。

如何实现?

当我使用 system/system2/processx::运行 时,应用程序似乎在等待繁重的程序完成并且在关闭时不会停止它。

代表:

library(shiny)
library(processx)

ui <- fluidPage(
  actionButton("runBtn", label="Run a program that consumes many resources") ,
)

server <- function(input, output, session) {
  observeEvent(input$runBtn,
      run("sleep", "240"))
}
shinyApp(ui, server)

当我用 reprex 关闭浏览器 window,然后尝试重新打开它时,过程结束需要一些时间。我希望它或多或少立即可用。

P.S。我正在使用 Linux;系统特定的 hack 很好。

@PorkChop 的评论指向了正确的方向。但是,我建议使用 processx::process 而不是 run,因为它为我们提供了从 R 内部控制启动进程的方法。参见 ?process。 (run顺便说一句也是基于过程class。)

这里的主要问题是,运行同步进程 (wait=TRUE) 阻塞了 R 会话。因此 onStop 在 R 重新控制之前不会触发。 因此,一旦浏览器 window 关闭,您将无法触发任何东西,因为 shiny-session 会继续 运行 直到外部程序完成并且 R 可以关闭 shiny-session。

在会话结束时,以下代码检查异步启动的进程是否仍然存在并在必要时将其杀死(仅在 windows 上测试)。

library(shiny)
library(processx)

ui <- fluidPage(
  actionButton("runBtn", label="Run a program that consumes many resources"),
  actionButton("stopSession", "Stop session")
)

server <- function(input, output, session) {
  
  myProcess <- NULL
  
  observeEvent(input$stopSession, {
    cat(sprintf("Closing session %s\n", session$token))
    session$close()
  })
  
  observeEvent(input$runBtn,
               {
                 if(Sys.info()[["sysname"]]=="Windows"){
                   writeLines(text = c("ping 127.0.0.1 -n 60 > nul"), con = "sleep.bat")
                   myProcess <<- process$new("cmd.exe", c("/c", "call", "sleep.bat"), supervise = TRUE, stdout = "")
                 } else {
                   myProcess <<- process$new("sleep", "60", supervise = TRUE, stdout = "")
                 }
                 # myProcess$wait() # wait for the process to finish
               })
  
  onStop(function(){
    cat(sprintf("Session %s was closed\n", session$token))
    if(!is.null(myProcess)){
      if(myProcess$is_alive()){
        myProcess$kill()
      }
    }
    
  })
}

shinyApp(ui, server)

关于不同的会话回调函数,请参阅此 related post


根据此处的要求,该过程包含在 reactiveVal:

library(shiny)
library(processx)

ui <- fluidPage(
  actionButton("runBtn", label="Run a program that consumes many resources"),
  actionButton("stopSession", "Stop session")
)

server <- function(input, output, session) {
  
  myProcess <- reactiveVal(NULL)
  
  observeEvent(input$stopSession, {
    cat(sprintf("Closing session %s\n", session$token))
    session$close()
  })
  
  observeEvent(input$runBtn,
               {
                 if(Sys.info()[["sysname"]]=="Windows"){
                   writeLines(text = c("ping 127.0.0.1 -n 60 > nul"), con = "sleep.bat")
                   myProcess(process$new("cmd.exe", c("/c", "call", "sleep.bat"), supervise = TRUE, stdout = ""))
                 } else {
                   myProcess(process$new("sleep", "60", supervise = TRUE, stdout = ""))
                 }
                 # myProcess()$wait() # wait for the process to finish
               })
  
  onStop(function(){
    cat(sprintf("Session %s was closed\n", session$token))
    if(!is.null(isolate(myProcess()))){
      if(isolate(myProcess()$is_alive())){
        isolate(myProcess()$kill())
      }
    }
    
  })
}

shinyApp(ui, server)