Nothing
# utility script to get the w3c specs to create the functions in seleniumPipes
# assummed ran from the project base
DOCUMENT <- FALSE
library(xml2)
library(httr)
library(rvest)
library(data.table)
library(rapportools)
library(whisker)
appURL <- "https://w3c.github.io/webdriver/webdriver-spec.html"
doc <- read_html(appURL)
tabXpath <- "//section[h3[text()='List of Endpoints']]//table"
methPaths <- html_table(xml_find_all(doc, tabXpath))[[1]]
setDT(methPaths)
setnames(methPaths, names(methPaths), tocamel(tolower(names(methPaths))))
methPaths[,command := tocamel(tolower(command))]
oldSelMethods <- list(
data.frame(method = "GET", uriTemplate = "/session/{session id}/window_handle",
command = "getWindowHandleOld", stringsAsFactors = FALSE),
data.frame(method = "GET", uriTemplate = "/session/{session id}/window_handles",
command = "getWindowHandlesOld", stringsAsFactors = FALSE),
data.frame(method = "GET", uriTemplate = "/session/{sessionId}/window/{windowHandle}/size",
command = "getWindowSizeOld", stringsAsFactors = FALSE),
data.frame(method = "GET", uriTemplate = "/session/{sessionId}/window/{windowHandle}/position",
command = "getWindowPositionOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{sessionId}/window/{windowHandle}/size",
command = "setWindowSizeOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{sessionId}/window/{windowHandle}/position",
command = "setWindowPositionOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{sessionId}/window/{windowHandle}/maximize",
command = "maximizeWindowOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{session id}/execute",
command = "executeScriptOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{session id}/execute_async",
command = "executeAsyncScriptOld", stringsAsFactors = FALSE),
data.frame(method = "GET", uriTemplate = "/session/{session id}/alert_text",
command = "getAlertTextOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{session id}/alert_text",
command = "sendAlertTextOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{session id}/alert_accept",
command = "acceptAlertOld", stringsAsFactors = FALSE),
data.frame(method = "POST", uriTemplate = "/session/{session id}/alert_dismiss",
command = "dismissAlertOld", stringsAsFactors = FALSE)
)
methPaths <- rbindlist(list(methPaths, rbindlist(oldSelMethods)))
methPaths[, uriTemplate := gsub("/session/\\{session id)/cookie", "/session/\\{session id\\}/cookie", uriTemplate)]
methPaths[, uriTemplate := gsub("session id", "sessionId", uriTemplate)]
methPaths[, uriTemplate := gsub("element id", "elementId", uriTemplate)]
methPaths[, uriTemplate := gsub("\\{property name\\}", "\\{propertyName\\}", uriTemplate)]
methPaths[, uriTemplate := gsub("\\{", "\\{\\{", uriTemplate)]
methPaths[, uriTemplate := gsub("\\}", "\\}\\}", uriTemplate)]
methPaths[, elemInd := grepl("\\{elementId\\}", uriTemplate)]
methPaths[, Arg := ifelse(elemInd, "webElem", "remDr")]
methGroups <- list(
sessions = c("newSession", "deleteSession", "setTimeout"),
navigation = c("go", "getCurrentUrl", "back", "forward", "refresh", "getTitle"),
commandContexts = c("getWindowHandle", "closeWindow", "switchToWindow", "getWindowHandles"
, "switchToFrame", "switchToParentFrame", "getWindowSize", "setWindowSize"
, "getWindowPosition", "setWindowPosition", "maximizeWindow", "fullscreenWindow"),
elementRetrieval = c("getActiveElement", "findElement", "findElements", "findElementFromElement"
, "findElementsFromElement"),
elementState = c("isElementSelected", "getElementAttribute", "getElementProperty", "getElementCssValue"
, "getElementText", "getElementTagName", "getElementRect", "isElementEnabled"),
elementInteraction = c("elementClick", "elementClear", "elementSendKeys"),
documentHandling = c("getPageSource", "executeScript", "executeAsyncScript"),
cookies = c("getAllCookies", "getNamedCookie", "addCookie", "deleteCookie", "deleteAllCookies"),
interactions = c("performActions", "releasingActions"),
userPrompts = c("dismissAlert", "acceptAlert", "getAlertText", "sendAlertText"),
screenCapture = c("takeScreenshot", "takeElementScreenshot"),
oldMethods = c("getWindowHandleOld", "getWindowHandlesOld", "getWindowPositionOld", "getWindowSizeOld"
, "setWindowSizeOld", "setWindowPositionOld", "maximizeWindowOld"
, "executeScriptOld", "executeAsyncScriptOld"
, "getAlertTextOld", "sendAlertTextOld", "acceptAlertOld", "dismissAlertOld")
)
methGroups <- lapply(names(methGroups), function(x){
expand.grid(group = x, command = methGroups[[x]], stringsAsFactors = FALSE)
}
)
methGroups <- rbindlist(methGroups)
methPaths <- merge(methPaths, methGroups, by = "command")
funcTemp <- list(
remDr = list( roxy = "#' {{command}}
#'
#'{{codecommand}}
#'
#' @template remDr
{{roxyArgs}}
#' @family {{group}} functions
#' @template {{rettype}}
#' @export
#'
#' @example /inst/examples/docs/{{group}}.R
#' @name {{command}}
NULL
",
fbody = "
#' @rdname {{command}}
{{command}} <- function({{Arg}}, {{{addArgs}}}...){
obj <- {{Arg}}
obj$sessionId <- {{Arg}}$sessionId({{Arg}}$drvID)
{{{JSON_command}}}
pathTemplate <- whisker.render(\"{{uriTemplate}}\", data = obj)
pathURL <- {{Arg}}[['remServAdd']]
pathURL[['path']] <- paste0(pathURL[['path']], pathTemplate)
res <- queryDriver(verb = {{method}}, url = build_url(pathURL), source = \"{{command}}\", drvID = {{Arg}}$drvID, json = {{JSON}},...)
{{{return}}}
}
"
),
webElem = list(roxy = "#' {{command}}
#'
#'{{codecommand}}
#'
#' @template webElem
{{roxyArgs}}
#' @family {{group}} functions
#' @template {{rettype}}
#' @export
#'
#' @example /inst/examples/docs/{{group}}.R
#' @name {{command}}
NULL
",
fbody = "
#' @rdname {{command}}
{{command}} <- function({{Arg}}, {{{addArgs}}}...){
obj <- {{Arg}}
obj$sessionId <- {{Arg}}$sessionId({{Arg}}$remDr$drvID)
obj$elementId <- {{Arg}}$elementId$ELEMENT
{{{JSON_command}}}
pathTemplate <- whisker.render(\"{{uriTemplate}}\", data = obj)
pathURL <- {{Arg}}[['remDr']][['remServAdd']]
pathURL[['path']] <- paste0(pathURL[['path']], pathTemplate)
res <- queryDriver(verb = {{method}}, url = build_url(pathURL), source = \"{{command}}\", drvID = {{Arg}}$remDr$drvID, json = {{JSON}},...)
{{{return}}}
}
"))
# configure returns
selReturn <- list(
ret1 = "invisible(remDr)"
, ret2 = "res$value"
, ret3 = "read_html(res$value)"
, ret4 = "invisible(wbElement(res$value, remDr))"
, ret5 = "invisible(lapply(res$value, wbElement, remDr = remDr))"
, ret6 = "if(replace){testWebElement(res$value, remDr)}else{res$value}"
, ret7 = "invisible(webElem)"
, ret8 = "remDr$sessionInfo <- res$value;invisible(remDr)"
, ret9 = ".e$sessionId[[remDr$drvID]] <- NULL;invisible(remDr)"
, ret10 = "invisible(wbElement(res$value, webElem$remDr))"
, ret11 = "invisible(lapply(res$value, wbElement, remDr = webElem$remDr))"
, ret12 =
"b64png <- base64_dec(res$value)
if(display){
tmp <- file.path(tempdir(), 'tmpScreenShot.png')
writeBin(b64png, tmp)
viewer <- getOption(\"viewer\")
if (useViewer){
viewer(tmp)
}else{
utils::browseURL(tmp)
}
}
if(!is.null(file)){
writeBin(b64png, file)
}
if(returnPNG){
b64png
}else{
invisible(remDr)
}
", ret13 =
"b64png <- base64_dec(res$value)
if(display){
tmp <- file.path(tempdir(), 'tmpElementScreenShot.png')
writeBin(b64png, tmp)
viewer <- getOption(\"viewer\")
if (useViewer){
viewer(tmp)
}else{
utils::browseURL(tmp)
}
}
if(!is.null(file)){
writeBin(b64png, file)
}
if(returnPNG){
b64png
}else{
invisible(webElem)
}
"
)
# list of POST type JSON commands
JCommands <- list(
newSession = list( com = "
# Add function specific JSON to post
jsonBody <- toJSON(list(
desiredCapabilities =c(remDr$desiredCapabilities, remDr$extraCapabilities)
), auto_unbox = TRUE)
", type = "ret8"),
deleteSession = list(type = "ret9"),
go = list(com = "
# Add function specific JSON to post
jsonBody <- toJSON(list(
url = url
), auto_unbox = TRUE)
", args = list(url = NA)
, type = "ret1"),
getCurrentUrl = list(type = "ret2"),
back = list(com = "
# Add function specific JSON to post
jsonBody <- NULL
", type = "ret1"),
forward = list(com = "
# Add function specific JSON to post
jsonBody <- NULL
", type = "ret1"),
refresh = list(com = "
# Add function specific JSON to post
jsonBody <- NULL
", type = "ret1"),
default = list(com = "
# Add function specific JSON to post
jsonBody <- toJSON(list(
), auto_unbox = TRUE)
", type = "ret1"),
getPageSource = list(type = "ret3"),
getTitle = list(type = "ret2"),
getWindowHandle = list(type = "ret2"),
getWindowHandleOld = list(type = "ret2"),
closeWindow = list(type = "ret1"),
switchToWindow = list(
com = "
# Add function specific JSON to post
jsonBody <- toJSON(list(
name = name
), auto_unbox = TRUE)
", args = list(name = NA)
, type = "ret1"
),
getWindowHandles = list(type = "ret2"),
getWindowHandlesOld = list(type = "ret2"),
getWindowPosition = list(type = "ret2"),
getWindowPositionOld = list(com = "obj$windowHandle <- handle"
, args = list(handle = "\"current\""), type = "ret2"
),
getWindowSize = list(type = "ret2"),
getWindowSizeOld = list(com = "obj$windowHandle <- handle"
, args = list(handle = "\"current\""), type = "ret2"
),
setWindowSize = list(com = "
jsonBody <- toJSON(list(
width = width, height = height
), auto_unbox = TRUE)"
, args = list(width = NA, height = NA), type = "ret1"),
setWindowSizeOld = list(com = "obj$windowHandle <- handle
jsonBody <- toJSON(list(
width = width, height = height
), auto_unbox = TRUE)"
, args = list(width = NA, height = NA, handle = "\"current\"")
, type = "ret1"
),
setWindowPosition = list(com = "
jsonBody <- toJSON(list(
x = x, y = y
), auto_unbox = TRUE)"
, args = list(x = NA, y = NA), type = "ret1"),
setWindowPositionOld = list(com = "obj$windowHandle <- handle
jsonBody <- toJSON(list(
x = x, y = y
), auto_unbox = TRUE)"
, args = list(x = NA, y = NA, handle = "\"current\"")
, type = "ret1"
),
maximizeWindow = list(com = "jsonBody <- NULL\n", type = "ret1"),
maximizeWindowOld = list(com = "jsonBody <- NULL\nobj$windowHandle <- handle"
, args = list(handle = "\"current\""), type = "ret1"
),
switchToFrame = list(
com = "
# Add function specific JSON to post
if(\"wElement\" %in% class(Id)){
# pass the webElement as Json to SS
Id <- Id$elementId
}
jsonBody <- toJSON(list(
id = Id
), auto_unbox = TRUE, null = \"null\")
", args = list(Id = "NULL")
, type = "ret1"
),
switchToParentFrame = list(com = "
# Add function specific JSON to post
jsonBody <- NULL
",type = "ret1"),
findElement = list(
com = "
# Add function specific JSON to post
using <- match.arg(using)
jsonBody <- toJSON(list(
using = using, value = value
), auto_unbox = TRUE)
", args = list(using = "c(\"xpath\", \"css selector\", \"id\", \"name\", \"tag name\", \"class name\", \"link text\", \"partial link text\")"
, value = NA)
, type = "ret4"
),
findElementFromElement = list(
com = "
# Add function specific JSON to post
using <- match.arg(using)
jsonBody <- toJSON(list(
using = using, value = value
), auto_unbox = TRUE)
" , args = list(using = "c(\"xpath\", \"css selector\", \"id\", \"name\", \"tag name\", \"class name\", \"link text\", \"partial link text\")"
, value = NA)
, type = "ret10"
),
findElements = list(
com = "
# Add function specific JSON to post
using <- match.arg(using)
jsonBody <- toJSON(list(
using = using, value = value
), auto_unbox = TRUE)
" , args = list(using = "c(\"xpath\", \"css selector\", \"id\", \"name\", \"tag name\", \"class name\", \"link text\", \"partial link text\")"
, value = NA)
, type = "ret5"
),
findElementsFromElement = list(
com = "
# Add function specific JSON to post
using <- match.arg(using)
jsonBody <- toJSON(list(
using = using, value = value
), auto_unbox = TRUE)
" , args = list(using = "c(\"xpath\", \"css selector\", \"id\", \"name\", \"tag name\", \"class name\", \"link text\", \"partial link text\")"
, value = NA)
, type = "ret11"
),
getActiveElement = list(type = "ret4"),
isElementSelected = list(type = "ret2"),
getElementAttribute = list(
com = "obj$name <- attribute"
, args = list(attribute =NA), type = "ret2"),
getElementProperty = list(
com = "obj$name <- property"
, args = list(property = NA), type = "ret2"),
getElementCssValue = list(
com = "obj$propertyName <- propertyName"
, args = list(propertyName = NA), type = "ret2"),
getElementText = list(type = "ret2"),
getElementTagName = list(type = "ret2"),
getElementRect = list(type = "ret2"),
isElementEnabled = list(type = "ret2"),
elementClear = list(com = "jsonBody <- NULL", type = "ret7"),
elementClick = list(com = "jsonBody <- NULL", type = "ret7"),
elementSendKeys = list(
com = "sendKeys <- list(...)
jsonBody <- toJSON(list(value = matchSelKeys(sendKeys)), auto_unbox = TRUE)"
, type = "ret7"),
executeScript = list(
com = "
args <- lapply(args, function(x){
if('wElement' %in% class(x)){
x$elementId
}else{
x
}
})
jsonBody <- toJSON(list(
script = script, args = args
), auto_unbox = TRUE)
"
, args = list(script = NA, args = "list()", replace = "TRUE")
, type = "ret6"
),
executeScriptOld = list(
com = "
args <- lapply(args, function(x){
if('wElement' %in% class(x)){
x$elementId
}else{
x
}
})
jsonBody <- toJSON(list(
script = script, args = args
), auto_unbox = TRUE)
"
, args = list(script = NA, args = "list()", replace = "TRUE")
, type = "ret6"
),
executeAsyncScript = list(
com = "
args <- lapply(args, function(x){
if('wElement' %in% class(x)){
x$elementId
}else{
x
}
})
jsonBody <- toJSON(list(
script = script, args = args
), auto_unbox = TRUE)
"
, args = list(script = NA, args = "list()", replace = "TRUE")
, type = "ret6"
),
executeAsyncScriptOld = list(
com = "
args <- lapply(args, function(x){
if('wElement' %in% class(x)){
x$elementId
}else{
x
}
})
jsonBody <- toJSON(list(
script = script, args = args
), auto_unbox = TRUE)
"
, args = list(script = NA, args = "list()", replace = "TRUE")
, type = "ret6"
),
getAllCookies = list(type = "ret2"),
getNamedCookie = list(
com = "obj$name <- name"
, args = list(name = "NULL")
, type = "ret2"),
addCookie = list(
com = "
cookie <- list(name = name, value = value, path = path, domain = domain
, secure = secure, httpOnly = httpOnly, expiry = expiry)
cookie <- cookie[!sapply(cookie, is.null)]
jsonBody <- toJSON(list(cookie = cookie), null = \"null\", auto_unbox = TRUE)"
, args = list(name = NA, value = NA, path = "NULL", domain = "NULL", secure = "FALSE"
, httpOnly = "NULL", expiry = "NULL")
, type = "ret1"),
deleteCookie = list(
com = "obj$name <- name"
, args = list(name = "NULL")
, type = "ret1"),
deleteAllCookies = list(type = "ret1"),
dismissAlert = list(com = "jsonBody <- NULL", type = "ret1"),
dismissAlertOld = list(com = "jsonBody <- NULL", type = "ret1"),
acceptAlert = list(com = "jsonBody <- NULL", type = "ret1"),
acceptAlertOld = list(com = "jsonBody <- NULL", type = "ret1"),
getAlertText = list(type = "ret2"),
getAlertTextOld = list(type = "ret2"),
sendAlertText = list(
com = "
jsonBody <- toJSON(list(text = text), auto_unbox = TRUE)"
, args = list(text = "\"\"")
, type = "ret1"),
sendAlertTextOld = list(
com = "
jsonBody <- toJSON(list(text = text), auto_unbox = TRUE)"
, args = list(text = "\"\"")
, type = "ret1"),
setTimeout = list(
com = "
jsonBody <- toJSON(list(type = type, ms = milliseconds), auto_unbox = TRUE)"
, args = list(type = '\"page load\"', milliseconds = 10000)
, type = "ret1"),
takeScreenshot = list(
args = list(file = "NULL", display = 'getOption("seleniumPipes_display_screenshot")',
useViewer = '!is.null(getOption("viewer"))', returnPNG = "FALSE")
, type = "ret12"),
takeElementScreenshot = list(
args = list(file = "NULL", display = 'getOption("seleniumPipes_display_screenshot")',
useViewer = '!is.null(getOption("viewer"))', returnPNG = "FALSE")
, type = "ret13")
)
selPipeFuncs <- lapply(rowSplit(methPaths), function(x){
appFunc <- JCommands[[x[["command"]]]]
appCommand <- appFunc[["com"]]
if(identical(x[["method"]], "POST")){
defCommand <- JCommands[["default"]][["com"]]
x[["JSON_command"]] <- ifelse(!is.null(appCommand), appCommand, defCommand)
x[["JSON"]] <- "jsonBody"
}else{
x[["JSON_command"]] <- if(!is.null(appCommand)){appCommand
}else{
NULL
}
x[["JSON"]] <- "NULL"
}
args <- JCommands[[x[["command"]]]][["args"]]
if(!is.null(args)){
x[["addArgs"]] <- paste(paste0(lapply(name(args), function(x){if(is.na(args[[x]])){
paste0(x, ", ")
}else{
paste0(x," = ",args[[x]],", ")
}
}
)), collapse = "")
x[["roxyArgs"]] <- paste(c(paste0("#' @param ",name(args), "\n"), "#'"), collapse = "")
}else{
x[["roxyArgs"]] <- "#'"
}
type <- if(is.null(appFunc)){
JCommands[["default"]][["type"]]
}else{
appFunc[["type"]]
}
x[["return"]] <- selReturn[[type]]
x[["rettype"]] <- type
x[["codecommand"]] <- paste0("\\code{", x[["command"]], "}")
list(fbody = whisker.render(funcTemp[[x$Arg]][["fbody"]], x)
, roxy = whisker.render(funcTemp[[x$Arg]][["roxy"]], x))
}
)
methPaths[["selFuncs"]] <- sapply(selPipeFuncs, "[[", "fbody")
methPaths[["selRoxy"]] <- sapply(selPipeFuncs, "[[", "roxy")
# remDrFuncs <- paste(selPipeFuncs[!grepl("\\{elementId\\}", selPipeFuncs)], collapse = "")
# webElemFuncs <- paste(selPipeFuncs[grepl("\\{elementId\\}", selPipeFuncs)], collapse = "")
# write(remDrFuncs, "R/remoteDriver.R")
# write(webElemFuncs, "R/webElement.R")
# write the functions to file based on the groups they are in
methPaths[,write(file = paste0("R/", group, ".R"), paste(selFuncs, collapse = "")), by = group]
# add documentation
if(DOCUMENT){
methPaths[,write(file = paste0("R/", group, "Doc.R"), paste(selRoxy, collapse = "")), by = group]
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.