/
phantom.R
74 lines (62 loc) · 2.19 KB
/
phantom.R
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
#' Checks for/installs dependencies
#'
#' `dependenciesInstalled()` that all the required system dependency,
#' PhantomJS, is installed, and `installDependencies()` installs it if needed.
#' For more information about where PhantomJS will be installed
#' see [webdriver::install_phantomjs()].
#'
#' @return `TRUE` when all dependencies are fulfilled; otherwise, `FALSE`.
#' @export
#' @rdname installDependencies
dependenciesInstalled <- function() {
!is.null(find_phantom(quiet = TRUE))
}
#' @rdname installDependencies
#' @export
installDependencies <- function() {
if (is.null(find_phantom(quiet = TRUE))) {
webdriver::install_phantomjs()
}
}
# Find PhantomJS from PATH, APPDATA, system.file('webdriver'), ~/bin, etc
find_phantom <- function(quiet = FALSE) {
path <- Sys.which( "phantomjs" )
if (path != "") return(path)
for (d in phantom_paths()) {
exec <- if (is_windows()) "phantomjs.exe" else "phantomjs"
path <- file.path(d, exec)
if (utils::file_test("-x", path)) break else path <- ""
}
if (path == "") {
if (!quiet) {
# It would make the most sense to throw an error here. However, that would
# cause problems with CRAN. The CRAN checking systems may not have phantomjs
# and may not be capable of installing phantomjs (like on Solaris), and any
# packages which use webdriver in their R CMD check (in examples or vignettes)
# will get an ERROR. We'll issue a message and return NULL; other
inform(c(
"shinytest requires PhantomJS to record and run tests.",
"To install it, run shinytest::installDependencies()",
"If it is installed, please check it is available on the PATH"
))
}
return(NULL)
}
path.expand(path)
}
phantom_env <- new.env()
#' @importFrom webdriver run_phantomjs
get_phantomPort <- function(timeout = 5000) {
if (! is_phantom_alive()) {
ph <- run_phantomjs(timeout = timeout)
phantom_env$process <- ph$process
phantom_env$port <- ph$port
}
phantom_env$port
}
#' @importFrom pingr ping_port
is_phantom_alive <- function() {
! is.null(phantom_env$process) &&
! is.null(phantom_env$port) &&
! is.na(ping_port("127.0.0.1", port = phantom_env$port, count = 1))
}