1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
#' Take a screenshot of a Shiny app
#'
#' \code{appshot} performs a \code{\link{webshot}} using two different methods
#' depending upon the object provided. If a 'character' is provided (pointing to
#' an app.R file or app directory) an isolated background R process is launched
#' to run the Shiny application. The current R process then captures the
#' \code{\link{webshot}}. When a Shiny application object is supplied to
#' \code{appshot}, it is reversed: the Shiny application runs in the current R
#' process and an isolated background R process is launched to capture a
#' \code{\link{webshot}}. The reason it is reversed in the second case has to do
#' with scoping: although it would be preferable to run the Shiny application in
#' a background process and call \code{webshot} from the current process, with
#' Shiny application objects, there are potential scoping errors when run this
#' way.
#'
#' @inheritParams webshot
#' @param app A Shiny app object, or a string naming an app directory.
#' @param port Port that Shiny will listen on.
#' @param envvars A named character vector or named list of environment
#' variables and values to set for the Shiny app's R process. These will be
#' unset after the process exits. This can be used to pass configuration
#' information to a Shiny app.
#' @param webshot_timeout The maximum number of seconds the phantom application
#' is allowed to run before killing the process. If a delay argument is
#' supplied (in \code{...}), the delay value is added to the timeout value.
#'
#' @param ... Other arguments to pass on to \code{\link{webshot}}.
#'
#' @rdname appshot
#' @examples
#' if (interactive()) {
#' appdir <- system.file("examples", "01_hello", package="shiny")
#'
#' # With a Shiny directory
#' appshot(appdir, "01_hello.png")
#'
#' # With a Shiny App object
#' shinyapp <- shiny::shinyAppDir(appdir)
#' appshot(shinyapp, "01_hello_app.png")
#' }
#'
#' @export
appshot <- function(app, file = "webshot.png", ...,
port = getOption("shiny.port"), envvars = NULL) {
UseMethod("appshot")
}
#' @rdname appshot
#' @export
appshot.character <- function(
app,
file = "webshot.png", ...,
port = getOption("shiny.port"),
envvars = NULL
) {
port <- available_port(port)
url <- shiny_url(port)
# Run app in background with envvars
p <- r_background_process(
function(...) {
shiny::runApp(...)
},
args = list(
appDir = app,
port = port,
display.mode = "normal",
launch.browser = FALSE
),
envvars = envvars
)
on.exit({
p$kill()
})
# Wait for app to start
wait_until_server_exists(url)
# Get screenshot
fileout <- webshot(url, file = file, ...)
invisible(fileout)
}
#' @rdname appshot
#' @export
appshot.shiny.appobj <- function(
app,
file = "webshot.png", ...,
port = getOption("shiny.port"),
envvars = NULL,
webshot_timeout = 60
) {
port <- available_port(port)
url <- shiny_url(port)
args <- list(
url = url,
file = file,
...,
timeout = webshot_app_timeout()
)
p <- r_background_process(
function(url, file, ..., timeout) {
# Wait for app to start
wait <- utils::getFromNamespace("wait_until_server_exists", "webshot")
wait(url, timeout = timeout)
webshot::webshot(url = url, file = file, ...)
},
args,
envvars = envvars
)
on.exit({
p$kill()
})
# add a delay to the webshot_timeout if it exists
if(!is.null(args$delay)) {
webshot_timeout <- webshot_timeout + args$delay
}
start_time <- as.numeric(Sys.time())
# Add a shiny app observer which checks every 200ms to see if the background r session is alive
shiny::observe({
# check the r session rather than the file to avoid race cases or random issues
if (p$is_alive()) {
if ((as.numeric(Sys.time()) - start_time) <= webshot_timeout) {
# try again later
shiny::invalidateLater(200)
} else {
# timeout has occured. close the app and R session
message("webshot timed out")
p$kill()
shiny::stopApp()
}
} else {
# r_bg session has stopped, close the app
shiny::stopApp()
}
return()
})
# run the app
shiny::runApp(app, port = port, display.mode = "normal", launch.browser = FALSE)
# return webshot::webshot file value
invisible(p$get_result()) # safe to call as the r_bg must have ended
}
|
