showDcf <- function(df) {
write.dcf(df, stdout())
invisible()
}
# last HTTP request made
httpLastRequest <- list()
# HTTP function which just saves the result for analysis
httpTestRecorder <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
file = NULL,
certificate = NULL,
writer = NULL,
timeout = NULL) {
httpLastRequest <<- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path,
headers = headers,
contentType = contentType,
file = file,
certificate = certificate,
writer = writer,
timeout = timeout
)
list(status = 200, content = "", contentType = "plain/text")
}
local_http_recorder <- function(env = caller_env()) {
withr::local_options(rsconnect.http = httpTestRecorder, .local_envir = env)
}
# Create and use a directory as temporary replacement for R_USER_CONFIG_DIR to
# avoid having tests overwrite the "official" configuration locations.
local_temp_config <- function(env = caller_env()) {
path <- withr::local_tempdir(.local_envir = env)
withr::local_envvar(R_USER_CONFIG_DIR = path, .local_envir = env)
}
local_temp_app <- function(files = list(), env = caller_env()) {
dir <- withr::local_tempdir(.local_envir = env)
for (name in names(files)) {
content <- files[[name]]
hier <- dirname(name)
if (!hier == ".") {
dir.create(file.path(dir, hier), recursive = TRUE)
}
writeLines(content, file.path(dir, name))
}
dir
}
local_shiny_bundle <- function(appName, appDir, appPrimaryDoc, python = NULL) {
appFiles <- bundleFiles(appDir)
appMetadata <- appMetadata(appDir, appFiles, appPrimaryDoc = appPrimaryDoc)
tarfile <- bundleApp(
appName,
appDir,
appFiles = appFiles,
appMetadata = appMetadata,
pythonConfig = pythonConfigurator(python),
quiet = TRUE
)
bundleTempDir <- tempfile()
utils::untar(tarfile, exdir = bundleTempDir)
unlink(tarfile)
defer(unlink(bundleTempDir, recursive = TRUE), env = caller_env())
bundleTempDir
}
# Servers and accounts ----------------------------------------------------
addTestAccount <- function(account = "ron", server = "example.com", userId = account) {
registerAccount(server, account, userId, apiKey = "123")
invisible()
}
addTestServer <- function(name = NULL, url = "https://example.com", certificate = NULL) {
if (is.null(name)) {
serverUrl <- parseHttpUrl(url)
name <- serverUrl$host
}
registerServer(
url = url,
name = name,
certificate = certificate
)
invisible()
}
addTestDeployment <- function(path,
appName = "test",
appTitle = "",
appId = "123",
account = "ron",
envVars = NULL,
username = account,
server = "example.com",
url = paste0("https://", server, "/", username, "/", appId),
hostUrl = NULL,
version = deploymentRecordVersion,
metadata = list()) {
saveDeployment(
path,
createDeployment(
appName = appName,
appTitle = appTitle,
appId = appId,
envVars = envVars,
account = account,
username = username,
server = server,
version = version
),
application = list(id = appId, url = url),
hostUrl = hostUrl,
metadata = metadata,
addToHistory = FALSE
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.