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

Question

我正在使用安装了本地服务器的 Shiny。

我的 Shiny 应用程序使用

system

/

system2

/

processx::run

运行一个繁重的本地程序。我正在同步运行它（

wait=T

）。如果用户关闭 Shiny 的浏览器窗口，我希望繁重的程序能够结束。如果用户重新打开浏览器窗口，我希望 Shiny 应用程序再次准备好执行本地程序。

如何实现这一目标？

当我使用

system

/

system2

/

processx::run

时，应用程序似乎等待繁重的程序完成，并且在关闭时不会停止它。

代表：

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 的浏览器窗口，然后尝试重新打开它时，需要一些时间才能结束该过程。我希望它或多或少立即可用。

附注我正在使用Linux；特定于系统的 hack 就可以了。

Answer 1

@PorkChop 的评论指向了正确的方向。但是，我建议使用

processx::process

而不是

run

，因为它为我们提供了从 R 内部控制启动进程的方法。请参阅

?process

。 （

run

顺便说一句也是基于进程类的。）

这里的主要问题是，同步运行进程 (

wait=TRUE

) 会阻塞 R 会话。因此，在 R 重新控制之前，

onStop

不会触发。 因此，一旦浏览器窗口关闭，您就无法触发任何内容，因为闪亮会话会继续运行，直到外部程序完成并且 R 可以关闭闪亮会话。

在会话结束时，以下代码检查异步启动的进程是否仍然存在，并在必要时终止它（仅在 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)

关于不同的会话回调函数请参阅此相关帖子。

---

按照此处的要求，该过程被包装在

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)