├── .Rbuildignore ├── .github ├── ISSUE_TEMPLATE └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── RSelenium.R ├── errorHandler.R ├── remoteDriver.R ├── rsDriver.R ├── selKeys-data.R ├── sysdata.rda ├── util.R └── webElement.R ├── README.md ├── RSelenium.Rproj ├── _pkgdown.yml ├── codemeta.json ├── cran-comments.md ├── demo ├── 00Index ├── PhantomJSUserAgent.R ├── apps │ └── shinytestapp │ │ ├── global.R │ │ ├── reqcontrols.R │ │ ├── reqplots.R │ │ ├── server.R │ │ └── ui.R ├── selDownloadZip.R ├── selExecJSexample.R ├── selExecJSexample2.R ├── selFileUpload.R ├── selJavascriptButtons.R ├── selPhantomJSexample.R └── shinyDiscussScrape.R ├── inst ├── apps │ └── shinytestapp │ │ ├── global.R │ │ ├── reqcontrols.R │ │ ├── reqplots.R │ │ ├── server.R │ │ ├── tests-saucelabs │ │ ├── runtest.R │ │ ├── setup.r │ │ ├── test-basic.r │ │ ├── test-checkbox.r │ │ ├── test-daterangeinput.r │ │ ├── test-numericinput.r │ │ ├── test-output.r │ │ ├── test-selectinput.r │ │ └── test-sliderinput.r │ │ ├── tests │ │ ├── test-basic.r │ │ ├── test-checkbox.r │ │ ├── test-daterangeinput.r │ │ ├── test-numericinput.r │ │ ├── test-output.r │ │ ├── test-selectinput.r │ │ └── test-sliderinput.r │ │ └── ui.R └── sauceTests │ ├── Readme.txt │ ├── cleanBuild.R │ ├── runtest.R │ ├── setup.r │ ├── test-alerts.r │ └── test-api-example.r ├── man ├── RSelenium-package.Rd ├── errorHandler-class.Rd ├── getChromeProfile.Rd ├── getFirefoxProfile.Rd ├── makeFirefoxProfile.Rd ├── remoteDriver-class.Rd ├── rsDriver.Rd ├── selKeys.Rd └── webElement-class.Rd ├── tests ├── README.md ├── testthat.R └── testthat │ ├── helper.R │ ├── test-alerts_tests.R │ ├── test-api_example_tests.R │ ├── test-cookie_tests.R │ ├── test-errorHandler.R │ ├── test-executing_javascript_tests.R │ ├── test-misc_remoteDriver_methods_tests.R │ ├── test-misc_webElement_methods_tests.R │ ├── test-page_loading_tests.R │ ├── test-takes_screenshots_tests.R │ └── test-util_function_tests.R └── vignettes ├── basics.Rmd ├── docker.Rmd ├── internetexplorer.Rmd └── saucelabs.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | inst/www 4 | ^web$ 5 | docs 6 | ^\.github$ 7 | ^_pkgdown.yml$ 8 | ^codemeta\.json$ 9 | ^cran-comments\.md$ 10 | .DS_Store 11 | ^CRAN-SUBMISSION$ 12 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE: -------------------------------------------------------------------------------- 1 | Since Firefox version 48, Mozilla requires all add-ons to be signed. Until 2 | recently, Firefox support in Selenium was exclusively provided by an add-on. 3 | As this add-on is not currently signed, this solution does not work with the 4 | latest Firefox releases. As an alternative, Mozilla are working on a WebDriver 5 | specification compliant implementation named GeckoDriver. Please note that the specification is not complete, and that Selenium itself does not comply with 6 | the specification at this time. This means that features previously available 7 | through Selenium will not be available using GeckoDriver. 8 | 9 | Currently we would advise against using the latest firefox/geckodriver with selenium untill the w3c webdriver specification 10 | is complete. If you wish to use firefox we would advise using an older version via a Docker image. See the RSelenium 11 | Docker vignette for more detail: 12 | 13 | https://docs.ropensci.org/RSelenium/articles/docker.html 14 | 15 | If your issue is not with geckodriver/firefox please fill out the template 16 | 17 | ### Operating System 18 | 19 | ### Selenium Server version (selenium-server-standalone-3.0.1.jar etc.) 20 | 21 | ### Browser version (firefox 50.1.0, chrome 54.0.2840.100 (64-bit) etc.) 22 | 23 | ### Other driver version (chromedriver 2.27, geckodriver v0.11.1, iedriver x64_3.0.0, PhantomJS 2.1.1 etc.) 24 | 25 | ### Expected behaviour 26 | 27 | ### Actual behaviour 28 | 29 | ### Steps to reproduce the behaviour 30 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | workflow_dispatch: 5 | push: 6 | branches: [main, master] 7 | pull_request: 8 | branches: [main, master] 9 | 10 | name: R-CMD-check 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ubuntu-latest 15 | 16 | name: ${{ matrix.browser }} (${{ matrix.version }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | browser: [chrome, firefox] 22 | version: [2.53.1, 3.141.59, latest] 23 | 24 | env: 25 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 26 | R_KEEP_PKG_SOURCE: yes 27 | 28 | services: 29 | selenium: 30 | image: selenium/standalone-${{ matrix.browser }}:${{ matrix.version }} 31 | ports: 32 | - 4444:4444 33 | volumes: 34 | - /dev/shm:/dev/shm 35 | test-server: 36 | image: juyeongkim/test-server 37 | 38 | steps: 39 | - uses: actions/checkout@v2 40 | 41 | - uses: r-lib/actions/setup-r@v1 42 | with: 43 | use-public-rspm: true 44 | 45 | - uses: r-lib/actions/setup-r-dependencies@v1 46 | with: 47 | extra-packages: rcmdcheck 48 | 49 | - uses: r-lib/actions/check-r-package@v1 50 | env: 51 | SELENIUM_BROWSER: ${{ matrix.browser }} 52 | TEST_SERVER: http://test-server:8080 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | CRAN-SUBMISSION 6 | data/selKeys.rda 7 | demo/apps/shinytestapp/global.R 8 | demo/apps/shinytestapp/reqcontrols.R 9 | demo/apps/shinytestapp/reqplots.R 10 | demo/apps/shinytestapp/server.R 11 | demo/apps/shinytestapp/ui.R 12 | inst/doc/RProject.png 13 | inst/doc/STA-highres.png 14 | inst/doc/shinytestapp.png 15 | inst/doc/tmpScreenShot.png 16 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RSelenium 2 | Type: Package 3 | Title: R Bindings for 'Selenium WebDriver' 4 | Version: 1.7.9 5 | Authors@R: c( 6 | person("John", "Harrison", , "johndharrison0@gmail.com", role = "aut", 7 | comment = "original author"), 8 | person("Ju Yeong", "Kim", , "jkim2345@fredhutch.org", role = "aut", 9 | comment = "rOpenSci maintainer"), 10 | person("Jonathan", "Völkle", , "jonathan.voelkle@web.de", role = c("aut", "cre")), 11 | person("Indranil", "Gayen", , "nil.gayen@gmail.com", role = "ctb") 12 | ) 13 | Description: Provides a set of R bindings for the 'Selenium 2.0 WebDriver' 14 | (see 15 | for more information) using the 'JsonWireProtocol' (see 16 | for more 17 | information). 'Selenium 2.0 WebDriver' allows driving a web browser 18 | natively as a user would either locally or on a remote machine using 19 | the Selenium server it marks a leap forward in terms of web browser 20 | automation. Selenium automates web browsers (commonly referred to as 21 | browsers). Using RSelenium you can automate browsers locally or 22 | remotely. 23 | License: AGPL-3 24 | URL: https://docs.ropensci.org/RSelenium/ 25 | BugReports: https://github.com/ropensci/RSelenium/issues 26 | Depends: 27 | R (>= 3.0.0) 28 | Imports: 29 | methods, 30 | caTools, 31 | utils, 32 | httr, 33 | wdman(>= 0.2.2) 34 | Suggests: 35 | binman, 36 | XML, 37 | testthat, 38 | knitr, 39 | covr, 40 | rmarkdown 41 | VignetteBuilder: knitr 42 | Collate: 43 | 'RSelenium.R' 44 | 'errorHandler.R' 45 | 'remoteDriver.R' 46 | 'rsDriver.R' 47 | 'selKeys-data.R' 48 | 'util.R' 49 | 'webElement.R' 50 | Encoding: UTF-8 51 | RoxygenNote: 7.2.1 52 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(.DollarNames,errorHandler) 4 | S3method(.DollarNames,remoteDriver) 5 | S3method(.DollarNames,webElement) 6 | S3method(print,rsClientServer) 7 | export(errorHandler) 8 | export(getChromeProfile) 9 | export(getFirefoxProfile) 10 | export(makeFirefoxProfile) 11 | export(remoteDriver) 12 | export(rsDriver) 13 | export(selKeys) 14 | export(webElement) 15 | exportClasses(errorHandler) 16 | exportClasses(remoteDriver) 17 | exportClasses(webElement) 18 | importFrom(caTools,base64decode) 19 | importFrom(caTools,base64encode) 20 | importFrom(httr,build_url) 21 | importFrom(httr,parse_url) 22 | importFrom(methods,new) 23 | importFrom(methods,setRefClass) 24 | importFrom(utils,.DollarNames) 25 | importFrom(utils,head) 26 | importFrom(utils,tail) 27 | importFrom(utils,zip) 28 | importFrom(wdman,selenium) 29 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # RSelenium 1.7.9 2 | * Remove images in vignettes (addressing #260) 3 | * Remove dependency on `Rcompression` (addressing #251 #256) 4 | * Remove the defunct functions: `phantom`, `checkForServer`, and `startServer` 5 | * Use `caTools::base64decode` instead of `openssl::base64_decode` to decode the base64 encoded PNG screenshot 6 | 7 | # RSelenium 1.7.7 8 | * Moved testing to GitHub Actions 9 | 10 | # RSelenium 1.7.6 11 | * No functional changes in this version (need to re-submit to CRAN for being archived) 12 | * Fixed typos in vignettes and documentation 13 | * Styled the package with `styler` package following the tidyverse formatting rules 14 | 15 | # RSelenium 1.7.5 16 | * Fix switchToWindow issue in fiefox (#143) 17 | * Add a tutorial to allow running RSelenium Tests in Internet Explorer (thanks @zappingseb #193) 18 | * Updated vignettes and documentation 19 | 20 | # RSelenium 1.7.4 21 | * `executeScript` now passes a dummy argument 22 | * Defunct `phantom()` function 23 | * Updated unit tests and test environment 24 | * Updated vignettes and documentation 25 | 26 | # RSelenium 1.7.3 27 | * Address issue with user/pass credentials being exposed using SauceLabs (thanks @jstockwin #131) 28 | * Cache packages on TRAVIS to reduce runtime (thanks @jstockwin #132) 29 | 30 | # RSelenium 1.7.2 31 | * Fixed issue where rsDriver client when failing to open didn't catch error 32 | * Correctly pass the check argument in rsDriver to wdman (thanks @bourdieu #123) 33 | 34 | # RSelenium 1.7.1 35 | * Fixed issue where rsDriver was not passing additional arguments via ... 36 | * Fixed issue with rsDriver and Win/Firefox 37 | * serverURL field in remoteDriver class is now set in initialize method 38 | 39 | # RSelenium 1.7.0 40 | * Basic vignette update with appendix on using rsDriver 41 | * Print method added for environment returned by rsDriver 42 | * Default PhantomJS version switched to 2.1.1 (2.5.0-beta has old 43 | version of ghostdriver) 44 | 45 | # RSelenium 1.6.6 46 | * phantom is marked as deprecated. To drive PhantomJS via selenium use the 47 | rsDriver function. To drive directly use wdman::phantomjs 48 | 49 | # RSelenium 1.6.5 50 | * checkForServer and startServer are now defunct. rsDriver is marked as a 51 | dual replacement. Docker is recommended to run a selenium server/browser. 52 | 53 | # RSelenium 1.6.4 54 | * Add a rsDriver function to return a Selenium/webdriver server and a 55 | browser client. 56 | 57 | # RSelenium 1.6.3 58 | * Return a selected value with the selectTag method. 59 | 60 | # RSelenium 1.6.1 61 | * Added a selectTag method to the webElement class see #108. 62 | * RSelenium Basics vignette was updated/revised. 63 | 64 | # RSelenium 1.6.0 65 | * Moved http package from RCurl to httr see #106. 66 | * Removed dependence on rjson. httr incorporates jsonlite. 67 | * Import base64_decode from openssl. 68 | * Fixed issue with attributes.Selenium not firing error see #109 69 | 70 | # RSelenium 1.5.1 71 | * Added a path argument to the remoteDriver class. 72 | 73 | # RSelenium 1.4.9 74 | * Fix .DollarNames to correct issues running under recent RStudio version. 75 | 76 | # RSelenium 1.4.8 77 | * Added tests for executeScript 78 | * Fixed issue in executeScript/executeAsyncScript with returning nested 79 | web elements 80 | 81 | # RSelenium 1.4.7 82 | * Code tidied up 83 | * statCodes added as an internal data.frame 84 | * tidy up imports. importFrom instead of import 85 | 86 | # RSelenium 1.4.6 87 | * Replace calls to cat with message when error 88 | 89 | # RSelenium 1.4.5 90 | * Use canonical form for referring to r-project 91 | 92 | # RSelenium 1.4.4 93 | * Deprecate startServer and checkForServer (look at processx to manage process) 94 | * Use message rather than print (thanks Dean Attali #88) in checkForServer. Fix typo in startServer (thanks Charles Thompson #85) 95 | * Copy startServer and checkForServer to examples/serverUtils 96 | 97 | # RSelenium 1.4.3 98 | * Moved testing to TRAVIS 99 | * Switch to rjson from RJSONIO as issue with RJSONIO and TRAVIS/covr 100 | * Ported api tests to TRAVIS 101 | 102 | # RSelenium 1.4.2 103 | * Add vignette on RSelenium and Docker containers. 104 | 105 | # RSelenium 1.4.1 106 | * Add option to pass arguments to JVM in startServer. 107 | * In startServer look for multiple copies of selenium binary in selDIR 108 | * Make renaming selenium binary optional in checkForServer 109 | * Add option to download beta releases in checkForServer 110 | 111 | # RSelenium 1.4.0 112 | * startServer utility function now returns a list of function; getpid returns the process id of the 113 | started server, the stop function stops the started server using the process id. Thanks to 114 | Dan Tenenbaum #67 and Toby Dylan Hocking #72 115 | 116 | # RSelenium 1.3.7 117 | * Add fix for multiple/Beta JARS in checkForServer (Thanks Dean Attali #79) 118 | * Update reference for Selenium download (Thanks @mnel) 119 | 120 | # RSelenium 1.3.6 121 | * Allow passing of system2 arguments in startServer utility function 122 | 123 | # RSelenium 1.3.4 124 | * Fix custom path not being passed correctly to phantom utility function. 125 | * Allowing passing of commandline arguments via utility function startServer. 126 | 127 | # RSelenium 1.3.3 128 | * Add utility function makeFirefoxProfile (Thanks Shan Huang #24) 129 | * Fix phantom utility function for OSX (Thanks Carson Sievert #25) 130 | 131 | # RSelenium 1.3.2 132 | * Methods now fail with errors if the server returns an error related status code. Summary and Detail of the error are outputted as well as the associated java class. 133 | * Add a phantom utility function to enable driving of phantomjs in webdriver mode independent of Selenium Server. 134 | * Fixed file paths in startServer for windows (Thanks @mnel #22) 135 | 136 | # RSelenium 1.3.0 137 | * Add the content from OC-RUG webinar as a vignette. 138 | * Update the Driving OS/Browsers local and remote vignette. 139 | 140 | # RSelenium 1.2.5 141 | * Update reference classes to use `@field` and inline docstrings for methods 142 | * Allow partial string matching on the `using` argument of the findElement and findElements method from the remoteDriver class. 143 | * Allow partial string matching on the `using` argument of the findChildElement and findChildElements method from the webElement class. 144 | 145 | # RSelenium 1.2.4 146 | * Add getLogtypes() and log(type) methods to remoteDriver class 147 | * Fix getFirefoxProfile so useBase = TRUE works under windows. 148 | * Add additional support for encoding (thanks to Nicola Logrillo issue #16) 149 | * Add file argument to screenshot method in remoteDriver class to allow writing screenshot to file 150 | * Add a getChromeProfile utility function. 151 | 152 | # RSelenium 1.2.3 153 | * Add option to display screenshot in viewer panel if using RStudio 154 | -------------------------------------------------------------------------------- /R/RSelenium.R: -------------------------------------------------------------------------------- 1 | #' @title An R client for Selenium Remote Webdriver 2 | #' 3 | #' @description These are R bindings for the WebDriver API in Selenium 2. 4 | #' They use the JsonWireProtocol defined at 5 | #' https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol 6 | #' to communicate with a Selenium RemoteWebDriver Server. 7 | #' 8 | #' @name RSelenium-package 9 | #' @aliases RSelenium 10 | #' @author John Harrison 11 | #' @references http://seleniumhq.org/projects/webdriver/ 12 | NULL 13 | -------------------------------------------------------------------------------- /R/errorHandler.R: -------------------------------------------------------------------------------- 1 | #' CLASS errorHandler 2 | #' 3 | #' class to handle errors 4 | #' 5 | #' This class is an internal class used by remoteDriver and webElement. It 6 | #' describes how drivers may respond. With a wide range of browsers etc 7 | #' the response can be variable. 8 | #' 9 | #' @importFrom methods setRefClass new 10 | #' @importFrom httr parse_url build_url 11 | #' @field statusCodes A list with status codes and their descriptions. 12 | #' @field status A status code summarizing the result of the command. A 13 | #' non-zero value indicates that the command failed. A value of one is 14 | #' not a failure but may indicate a problem. 15 | #' @field statusclass Class associated with the java library underlying 16 | #' the server. For Example: org.openqa.selenium.remote.Response 17 | #' @field sessionid An opaque handle used by the server to determine where 18 | #' to route session-specific commands. This ID should be included in 19 | #' all future session-commands in place of the :sessionId path segment 20 | #' variable. 21 | #' @field hcode A list 22 | #' @field value A list containing detailed information regarding possible 23 | #' errors: 24 | #' \describe{ 25 | #' \item{\code{message}:}{A descriptive message for the command 26 | #' failure.} 27 | #' \item{\code{screen}:}{string (Optional) If included, a 28 | #' screenshot of the current page as a base64 encoded string.} 29 | #' \item{\code{class}:}{string (Optional) If included, specifies 30 | #' the fully qualified class name for the exception that was thrown 31 | #' when the command failed.} 32 | #' \item{\code{stackTrace}:}{array (Optional) If included, 33 | #' specifies an array of JSON objects describing the stack trace 34 | #' for the exception that was thrown when the command failed. The 35 | #' zeroth element of the array represents the top of the stack.} 36 | #' } 37 | #' @field responseheader There are two levels of error handling specified 38 | #' by the wire protocol: invalid requests and failed commands. 39 | #' Invalid Requests will probably be indicted by a status of 1. 40 | #' 41 | #' All invalid requests should result in the server returning a 4xx HTTP 42 | #' response. The response Content-Type should be set to text/plain and 43 | #' the message body should be a descriptive error message. The 44 | #' categories of invalid requests are as follows: 45 | #' \describe{ 46 | #' \item{\code{Unknown Commands}:}{ 47 | #' If the server receives a command request whose path is not mapped 48 | #' to a resource in the REST service, it should respond with a 404 49 | #' Not Found message. 50 | #' } 51 | #' \item{\code{Unimplemented Commands}:}{ 52 | #' Every server implementing the WebDriver wire protocol must 53 | #' respond to every defined command. If an individual command has 54 | #' not been implemented on the server, the server should respond 55 | #' with a 501 Not Implemented error message. Note this is the only 56 | #' error in the Invalid Request category that does not return a 4xx 57 | #' status code. 58 | #' } 59 | #' \item{\code{Variable Resource Not Found}:}{ 60 | #' If a request path maps to a variable resource, but that resource 61 | #' does not exist, then the server should respond with a 404 Not 62 | #' Found. For example, if ID my-session is not a valid session ID 63 | #' on the server, and a command is sent to GET /session/my-session 64 | #' HTTP/1.1, then the server should gracefully return a 404. 65 | #' } 66 | #' \item{\code{Invalid Command Method}:}{ 67 | #' If a request path maps to a valid resource, but that resource 68 | #' does not respond to the request method, the server should 69 | #' respond with a 405 Method Not Allowed. The response must include 70 | #' an Allows header with a list of the allowed methods for the 71 | #' requested resource. 72 | #' } 73 | #' \item{\code{Missing Command Parameters}:}{ 74 | #' If a POST/PUT command maps to a resource that expects a set of 75 | #' JSON parameters, and the response body does not include one of 76 | #' those parameters, the server should respond with a 400 Bad 77 | #' Request. The response body should list the missing parameters. 78 | #' } 79 | #' } 80 | #' @field debugheader Not currently implemented 81 | #' @export errorHandler 82 | #' @exportClass errorHandler 83 | #' @aliases errorHandler 84 | errorHandler <- 85 | setRefClass( 86 | "errorHandler", 87 | fields = list( 88 | statusCodes = "data.frame", 89 | status = "numeric", 90 | statusclass = "character", 91 | sessionid = "character", 92 | hcode = "numeric", 93 | value = "list" 94 | ), 95 | methods = list( 96 | initialize = function() { 97 | # statCodes are status codes stored in sysdata.rda 98 | statusCodes <<- statCodes 99 | status <<- 0L # initial status success 100 | statusclass <<- NA_character_ 101 | sessionid <<- NA_character_ 102 | hcode <<- NA_integer_ 103 | value <<- list() 104 | }, 105 | 106 | queryRD = function(ipAddr, method = "GET", qdata = NULL) { 107 | "A method to communicate with the remote server implementing the 108 | JSON wire protocol." 109 | getUC.params <- 110 | list(url = ipAddr, verb = method, body = qdata, encode = "json") 111 | res <- tryCatch( 112 | do.call(httr::VERB, getUC.params), 113 | error = function(e) e 114 | ) 115 | if (inherits(res, "response")) { 116 | resContent <- httr::content(res, simplifyVector = FALSE) 117 | checkStatus(resContent) 118 | } else { 119 | checkError(res) 120 | } 121 | }, 122 | 123 | checkStatus = function(resContent) { 124 | "An internal method to check the status returned by the server. If 125 | status indicates an error an appropriate error message is thrown." 126 | if (!is.null(resContent[["status"]])) { 127 | status <<- resContent[["status"]] 128 | statusclass <<- if (!is.null(resContent[["class"]])) { 129 | resContent[["class"]] 130 | } else { 131 | NA_character_ 132 | } 133 | if (!is.null(resContent[["sessionId"]])) { 134 | sessionid <<- resContent[["sessionId"]] 135 | } 136 | hcode <<- if (!is.null(resContent[["hCode"]])) { 137 | as.integer(resContent[["hCode"]]) 138 | } else { 139 | NA_integer_ 140 | } 141 | value <<- if (!is.null(resContent[["value"]])) { 142 | if (is.list(resContent[["value"]])) { 143 | resContent[["value"]] 144 | } else { 145 | list(resContent[["value"]]) 146 | } 147 | } else { 148 | list() 149 | } 150 | errId <- which( 151 | statusCodes[["Code"]] == as.integer(status) 152 | ) 153 | if (length(errId) > 0 && status > 1L) { 154 | errMessage <- statusCodes[errId, c("Summary", "Detail")] 155 | errMessage[["class"]] <- value[["class"]] 156 | errMessage <- paste( 157 | "\t", 158 | paste(names(errMessage), errMessage, sep = ": ") 159 | ) 160 | errMessage[-1] <- paste("\n", errMessage[-1]) 161 | errMessage <- 162 | c( 163 | errMessage, 164 | "\n\t Further Details: run errorDetails method" 165 | ) 166 | if (!is.null(value[["message"]])) { 167 | message("\nSelenium message:", value[["message"]], "\n") 168 | } 169 | stop(errMessage, call. = FALSE) 170 | } 171 | } else { 172 | 173 | } 174 | }, 175 | 176 | checkError = function(res) { 177 | status <<- 13L 178 | statusclass <<- NA_character_ 179 | hcode <<- NA_integer_ 180 | value <<- list() 181 | eMessage <- list( 182 | "Invalid call to server. Please check you have opened a browser.", 183 | paste0( 184 | "Couldnt connect to host on ", 185 | obscureUrlPassword(serverURL), 186 | ".\n Please ensure a Selenium server is running." 187 | ), 188 | function(x) { 189 | paste0("Undefined error in httr call. httr output: ", x) 190 | } 191 | ) 192 | err <- switch( 193 | res[["message"]], 194 | "Couldn't connect to server" = eMessage[[2]], 195 | eMessage[[3]](res[["message"]]) 196 | ) 197 | stop(err) 198 | }, 199 | 200 | errorDetails = function(type = "value") { 201 | "Return error details. Type can one of c(\"value\", \"class\", 202 | \"status\")" 203 | switch( 204 | type, 205 | value = value, 206 | class = statusclass, 207 | status = status 208 | ) 209 | }, 210 | 211 | obscureUrlPassword = function(url) { 212 | "Replaces the username and password of url with ****" 213 | parsedUrl <- parse_url(url) 214 | if (!is.null(parsedUrl$username)) { 215 | parsedUrl$username <- "****" 216 | } 217 | if (!is.null(parsedUrl$password)) { 218 | parsedUrl$password <- "****" 219 | } 220 | build_url(parsedUrl) 221 | } 222 | ) 223 | ) 224 | -------------------------------------------------------------------------------- /R/rsDriver.R: -------------------------------------------------------------------------------- 1 | #' Start a selenium server and browser 2 | #' 3 | #' @param port Port to run on 4 | #' @param browser Which browser to start 5 | #' @param version what version of Selenium Server to run. Default = "latest" 6 | #' which runs the most recent version. To see other version currently 7 | #' sourced run binman::list_versions("seleniumserver") 8 | #' @param chromever what version of Chrome driver to run. Default = "latest" 9 | #' which runs the most recent version. To see other version currently 10 | #' sourced run binman::list_versions("chromedriver"), A value of NULL 11 | #' excludes adding the chrome browser to Selenium Server. 12 | #' @param geckover what version of Gecko driver to run. Default = "latest" 13 | #' which runs the most recent version. To see other version currently 14 | #' sourced run binman::list_versions("geckodriver"), A value of NULL 15 | #' excludes adding the firefox browser to Selenium Server. 16 | #' @param phantomver what version of PhantomJS to run. Default = "2.1.1" 17 | #' which runs the most recent stable version. To see other version currently 18 | #' sourced run binman::list_versions("phantomjs"), A value of NULL 19 | #' excludes adding the PhantomJS headless browser to Selenium Server. 20 | #' @param iedrver what version of IEDriverServer to run. Default = "latest" 21 | #' which runs the most recent version. To see other version currently 22 | #' sourced run binman::list_versions("iedriverserver"), A value of NULL 23 | #' excludes adding the internet explorer browser to Selenium Server. 24 | #' NOTE this functionality is Windows OS only. 25 | #' @param verbose If TRUE, include status messages (if any) 26 | #' @param check If TRUE check the versions of selenium available and the 27 | #' versions of associated drivers (chromever, geckover, phantomver, 28 | #' iedrver). If new versions are available they will be downloaded. 29 | #' @param ... Additional arguments to pass to \code{\link{remoteDriver}} 30 | #' 31 | #' @return A list containing a server and a client. The server is the object 32 | #' returned by \code{\link[wdman]{selenium}} and the client is an object of class 33 | #' \code{\link{remoteDriver}} 34 | #' @details This function is a wrapper around \code{\link[wdman]{selenium}}. 35 | #' It provides a "shim" for the current issue running firefox on 36 | #' Windows. For a more detailed set of functions for running binaries 37 | #' relating to the Selenium/webdriver project see the 38 | #' \code{\link[wdman]{wdman}} package. Both the client and server 39 | #' are closed using a registered finalizer. 40 | #' @examples 41 | #' \dontrun{ 42 | #' # start a chrome browser 43 | #' rD <- rsDriver() 44 | #' remDr <- rD[["client"]] 45 | #' remDr$navigate("http://www.google.com/ncr") 46 | #' remDr$navigate("http://www.bbc.com") 47 | #' remDr$close() 48 | #' # stop the selenium server 49 | #' rD[["server"]]$stop() 50 | #' 51 | #' # if user forgets to stop server it will be garbage collected. 52 | #' rD <- rsDriver() 53 | #' rm(rD) 54 | #' gc(rD) 55 | #' } 56 | #' @export 57 | #' @importFrom wdman selenium 58 | rsDriver <- function( 59 | port = 4567L, 60 | browser = c("chrome", "firefox", "phantomjs", "internet explorer"), 61 | version = "latest", 62 | chromever = "latest", 63 | geckover = "latest", 64 | iedrver = NULL, 65 | phantomver = "2.1.1", 66 | verbose = TRUE, 67 | check = TRUE, ...) { 68 | browser <- match.arg(browser) 69 | if (identical(browser, "internet explorer") && 70 | !identical(.Platform[["OS.type"]], "windows")) { 71 | stop("Internet Explorer is only available on Windows.") 72 | } 73 | selServ <- wdman::selenium( 74 | port = port, 75 | verbose = verbose, 76 | version = version, 77 | chromever = chromever, 78 | geckover = geckover, 79 | iedrver = iedrver, 80 | phantomver = phantomver, 81 | check = check 82 | ) 83 | remDr <- remoteDriver(browserName = browser, port = port, ...) 84 | 85 | # check server status 86 | count <- 0L 87 | while ( 88 | inherits(res <- tryCatch(remDr$getStatus(), error = function(e) e), "error") 89 | ) { 90 | Sys.sleep(1) 91 | count <- count + 1L 92 | if (count > 5L) { 93 | warning("Could not determine server status.") 94 | break 95 | } 96 | } 97 | 98 | res <- tryCatch(remDr$open(silent = !verbose), error = function(e) e) 99 | if (inherits(res, "error")) { 100 | message("Could not open ", browser, " browser.") 101 | message("Client error message:\n", res$message) 102 | message("Check server log for further details.") 103 | } 104 | 105 | csEnv <- new.env() 106 | csEnv[["server"]] <- selServ 107 | csEnv[["client"]] <- remDr 108 | clean <- function(e) { 109 | chk <- suppressMessages( 110 | tryCatch(e[["client"]]$close(), error = function(e) e) 111 | ) 112 | e[["server"]]$stop() 113 | } 114 | reg.finalizer(csEnv, clean) 115 | class(csEnv) <- c("rsClientServer", class(csEnv)) 116 | 117 | return(csEnv) 118 | } 119 | -------------------------------------------------------------------------------- /R/selKeys-data.R: -------------------------------------------------------------------------------- 1 | #' @name selKeys 2 | #' @title Selenium key mappings 3 | #' @description This data set contains a list of selenium key mappings. 4 | #' selKeys is used when a sendKeys variable is needed. 5 | #' sendKeys is defined as a list. 6 | #' If an entry is needed from selKeys it is denoted by key. 7 | #' @docType data 8 | #' @usage selKeys 9 | #' @export selKeys 10 | #' @format A named list. The names are the descriptions of the keys. The 11 | #' values are the "UTF-8" character representations. 12 | #' @source https://www.selenium.dev/documentation/legacy/json_wire_protocol/#sessionsessionidelementidvalue 13 | selKeys <- list( 14 | null = "\uE000", 15 | cancel = "\uE001", 16 | help = "\uE002", 17 | backspace = "\uE003", 18 | tab = "\uE004", 19 | clear = "\uE005", 20 | return = "\uE006", 21 | enter = "\uE007", 22 | shift = "\uE008", 23 | control = "\uE009", 24 | alt = "\uE00A", 25 | pause = "\uE00B", 26 | escape = "\uE00C", 27 | space = "\uE00D", 28 | page_up = "\uE00E", 29 | page_down = "\uE00F", 30 | end = "\uE010", 31 | home = "\uE011", 32 | left_arrow = "\uE012", 33 | up_arrow = "\uE013", 34 | right_arrow = "\uE014", 35 | down_arrow = "\uE015", 36 | insert = "\uE016", 37 | delete = "\uE017", 38 | semicolon = "\uE018", 39 | equals = "\uE019", 40 | numpad_0 = "\uE01A", 41 | numpad_1 = "\uE01B", 42 | numpad_2 = "\uE01C", 43 | numpad_3 = "\uE01D", 44 | numpad_4 = "\uE01E", 45 | numpad_5 = "\uE01F", 46 | numpad_6 = "\uE020", 47 | numpad_7 = "\uE021", 48 | numpad_8 = "\uE022", 49 | numpad_9 = "\uE023", 50 | multiply = "\uE024", 51 | add = "\uE025", 52 | separator = "\uE026", 53 | subtract = "\uE027", 54 | decimal = "\uE028", 55 | divide = "\uE029", 56 | f1 = "\uE031", 57 | f2 = "\uE032", 58 | f3 = "\uE033", 59 | f4 = "\uE034", 60 | f5 = "\uE035", 61 | f6 = "\uE036", 62 | f7 = "\uE037", 63 | f8 = "\uE038", 64 | f9 = "\uE039", 65 | f10 = "\uE03A", 66 | f11 = "\uE03B", 67 | f12 = "\uE03C", 68 | command_meta = "\uE03D" 69 | ) 70 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/RSelenium/6071311243abe28f132e80097fd7ab3c89e27ae1/R/sysdata.rda -------------------------------------------------------------------------------- /R/util.R: -------------------------------------------------------------------------------- 1 | #' Get Firefox profile. 2 | #' 3 | #' \code{getFirefoxProfile} 4 | #' A utility function to get a firefox profile. 5 | #' @param profDir The directory in which the firefox profile resides 6 | #' @param useBase Logical indicating whether to attempt to use zip from 7 | #' utils package. Maybe easier for Windows users. 8 | #' @export 9 | #' @importFrom utils head tail zip 10 | #' @section Detail: A firefox profile directory is zipped and base64 11 | #' encoded. It can then be passed to the selenium server as a required 12 | #' capability with key firefox_profile 13 | #' @examples 14 | #' \dontrun{ 15 | #' fprof <- getFirefoxProfile("~/.mozilla/firefox/9qlj1ofd.testprofile") 16 | #' remDr <- remoteDriver(extraCapabilities = fprof) 17 | #' remDr$open() 18 | #' } 19 | getFirefoxProfile <- function(profDir, useBase = TRUE) { 20 | if (!missing("useBase")) { 21 | warning("`useBase` argument deprecated. Now using base as default.") 22 | useBase <- TRUE 23 | } 24 | tmpfile <- tempfile(fileext = ".zip") 25 | reqFiles <- list.files(profDir, recursive = TRUE) 26 | if (isTRUE(useBase)) { 27 | currWd <- getwd() 28 | setwd(profDir) 29 | on.exit(setwd(currWd)) 30 | # break the zip into chunks as windows command line has limit of 8191 31 | # characters 32 | # ignore .sqllite files 33 | reqFiles <- reqFiles[ 34 | grep("^.*\\.sqlite$", reqFiles, perl = TRUE, invert = TRUE) 35 | ] 36 | chunks <- sum(nchar(reqFiles)) %/% 8000 + 2 37 | chunks <- as.integer(seq(1, length(reqFiles), length.out = chunks)) 38 | chunks <- mapply(`:`, head(chunks, -1), 39 | tail(chunks, -1) - c(rep(1, length(chunks) - 2), 0), 40 | SIMPLIFY = FALSE 41 | ) 42 | out <- lapply(chunks, function(x) { 43 | zip(tmpfile, reqFiles[x]) 44 | }) 45 | } 46 | zz <- file(tmpfile, "rb") 47 | ar <- readBin(tmpfile, "raw", file.info(tmpfile)$size) 48 | fireprof <- base64encode(ar) 49 | close(zz) 50 | list("firefox_profile" = fireprof) 51 | } 52 | 53 | #' Get Chrome profile. 54 | #' 55 | #' \code{getChromeProfile} 56 | #' A utility function to get a Chrome profile. 57 | #' @param dataDir Specifies the user data directory, which is where the 58 | #' browser will look for all of its state. 59 | #' @param profileDir Selects directory of profile to associate with the 60 | #' first browser launched. 61 | #' @export 62 | #' @section Detail: A chrome profile directory is passed as an extraCapability. 63 | #' The data dir has a number of default locations 64 | #' \describe{ 65 | #' \item{Windows XP}{ 66 | #' Google Chrome: C:/Documents and Settings/\%USERNAME\%/Local Settings/Application Data/Google/Chrome/User Data 67 | #' } 68 | #' \item{Windows 8 or 7 or Vista}{ 69 | #' Google Chrome: C:/Users/\%USERNAME\%/AppData/Local/Google/Chrome/User Data 70 | #' } 71 | #' \item{Mac OS X}{ 72 | #' Google Chrome: ~/Library/Application Support/Google/Chrome 73 | #' } 74 | #' \item{Linux}{ 75 | #' Google Chrome: ~/.config/google-chrome 76 | #' } 77 | #' } 78 | #' The profile directory is contained in the user directory and by default 79 | #' is named "Default" 80 | #' @examples 81 | #' \dontrun{ 82 | #' # example from windows using a profile directory "Profile 1" 83 | #' cprof <- getChromeProfile( 84 | #' "C:\\Users\\john\\AppData\\Local\\Google\\Chrome\\User Data", 85 | #' "Profile 1" 86 | #' ) 87 | #' remDr <- remoteDriver(browserName = "chrome", extraCapabilities = cprof) 88 | #' } 89 | getChromeProfile <- function(dataDir, profileDir) { 90 | # see http://peter.sh/experiments/chromium-command-line-switches/ 91 | cprof <- list( 92 | chromeOptions = 93 | list( 94 | args = list( 95 | paste0("--user-data-dir=", dataDir), 96 | paste0("--profile-directory=", profileDir) 97 | ) 98 | ) 99 | ) 100 | cprof 101 | } 102 | 103 | matchSelKeys <- function(x) { 104 | if (any(names(x) == "key")) { 105 | x[names(x) == "key"] <- selKeys[match(x[names(x) == "key"], names(selKeys))] 106 | } 107 | unname(x) 108 | } 109 | 110 | #' @export 111 | #' @importFrom utils .DollarNames 112 | .DollarNames.remoteDriver <- function(x, pattern = "") { 113 | grep(pattern, getRefClass(class(x))$methods(), value = TRUE) 114 | } 115 | 116 | #' @export 117 | .DollarNames.webElement <- function(x, pattern = "") { 118 | grep(pattern, getRefClass(class(x))$methods(), value = TRUE) 119 | } 120 | 121 | #' @export 122 | .DollarNames.errorHandler <- function(x, pattern = "") { 123 | grep(pattern, getRefClass(class(x))$methods(), value = TRUE) 124 | } 125 | 126 | makePrefjs <- function(opts) { 127 | op <- options(useFancyQuotes = FALSE) 128 | on.exit(options(op)) 129 | 130 | optsQuoted <- lapply(opts, function(x) { 131 | if (is.character(x)) { 132 | dQuote(x) 133 | } else if (is.double(x)) { 134 | sprintf("%f", x) 135 | } else if (is.integer(x)) { 136 | sprintf("%d", x) 137 | } else if (is.logical(x)) { 138 | if (x) { 139 | "true" 140 | } else { 141 | "false" 142 | } 143 | } 144 | }) 145 | 146 | sprintf("user_pref(\"%s\", %s);", names(opts), optsQuoted) 147 | } 148 | 149 | #' Make Firefox profile. 150 | #' 151 | #' \code{makeFirefoxProfile} 152 | #' A utility function to make a firefox profile. 153 | #' @param opts option list of firefox 154 | #' @export 155 | #' @section Detail: A firefox profile directory is zipped and base64 156 | #' encoded. It can then be passed 157 | #' to the selenium server as a required capability with key 158 | #' firefox_profile 159 | #' @note Windows doesn't come with command-line zip capability. 160 | #' Installing rtools 161 | #' \url{https://CRAN.R-project.org/bin/windows/Rtools/index.html} is a 162 | #' straightforward way to gain this capability. 163 | #' @importFrom caTools base64encode 164 | #' @examples 165 | #' \dontrun{ 166 | #' fprof <- makeFirefoxProfile(list(browser.download.dir = "D:/temp")) 167 | #' remDr <- remoteDriver(extraCapabilities = fprof) 168 | #' remDr$open() 169 | #' } 170 | makeFirefoxProfile <- function(opts) { 171 | # make profile 172 | profDir <- file.path(tempdir(), "firefoxprofile") 173 | dir.create(profDir, showWarnings = FALSE) 174 | prefs.js <- file.path(profDir, "prefs.js") 175 | writeLines(makePrefjs(opts), con = prefs.js) 176 | 177 | # zip 178 | tmpfile <- tempfile(fileext = ".zip") 179 | utils::zip(tmpfile, prefs.js, flags = "-r9Xjq") 180 | zz <- file(tmpfile, "rb") 181 | ar <- readBin(tmpfile, "raw", file.info(tmpfile)$size) 182 | 183 | # base64 184 | fireprof <- base64encode(ar) 185 | close(zz) 186 | 187 | # output 188 | list("firefox_profile" = fireprof) 189 | } 190 | 191 | 192 | testWebElement <- function(x, remDr) { 193 | if (inherits(remDr, "webElement")) { 194 | remDr <- remDr$export("remoteDriver") 195 | } 196 | replaceWE <- function(x, remDr) { 197 | if (identical(names(x), "ELEMENT")) { 198 | webElement$ 199 | new(as.character(x))$ 200 | import(remDr) 201 | } else { 202 | x 203 | } 204 | } 205 | if (is.null(x) || identical(length(x), 0L)) { 206 | return(x) 207 | } 208 | listTest <- sum(vapply(x, inherits, logical(1), "list")) > 0 209 | if (listTest) { 210 | lapply(x, testWebElement, remDr = remDr) 211 | } else { 212 | replaceWE(x, remDr = remDr) 213 | } 214 | } 215 | 216 | #' @export 217 | print.rsClientServer <- function(x, ...) { 218 | cat("$client\n") 219 | if (length(x[["client"]]$sessionInfo) == 0L) { 220 | print("No sessionInfo. Client browser is mostly likely not opened.") 221 | } else { 222 | print( 223 | as.data.frame(x[["client"]]$sessionInfo)[c("browserName", "id")], 224 | ... 225 | ) 226 | } 227 | cat("\n$server\n") 228 | print(x[["server"]][["process"]], ...) 229 | } 230 | -------------------------------------------------------------------------------- /R/webElement.R: -------------------------------------------------------------------------------- 1 | #' CLASS webElement 2 | #' 3 | #' Selenium Webdriver represents all the HTML elements as WebElements. 4 | #' This class provides a mechanism to represent them as objects & 5 | #' perform various actions on the related elements. Typically, the 6 | #' findElement method in \code{\link{remoteDriver}} returns an object 7 | #' of class webElement. 8 | #' 9 | #' webElement is a generator object. To define a new webElement class 10 | #' method `new` is called. When a webElement class is created an 11 | #' elementId should be given. Each webElement inherits from a 12 | #' remoteDriver. webElement is not usually called by the end-user. 13 | #' 14 | #' @field elementId Object of class \code{"character"}, giving a character 15 | #' representation of the element id. 16 | #' @include remoteDriver.R 17 | #' @export webElement 18 | #' @exportClass webElement 19 | #' @aliases webElement 20 | webElement <- 21 | setRefClass( 22 | Class = "webElement", 23 | fields = list(elementId = "character"), 24 | contains = "remoteDriver", 25 | methods = list( 26 | initialize = function(elementId = "", ...) { 27 | elementId <<- elementId 28 | callSuper(...) 29 | }, 30 | 31 | show = function() { 32 | print("remoteDriver fields") 33 | callSuper() 34 | print("webElement fields") 35 | print(list(elementId = elementId)) 36 | }, 37 | 38 | findChildElement = function( 39 | using = c( 40 | "xpath", "css selector", "id", "name", "tag name", "class name", 41 | "link text", "partial link text" 42 | ), 43 | value) { 44 | "Search for an element on the page, starting from the node defined 45 | by the parent webElement. The located element will be returned as 46 | an object of webElement class. 47 | The inputs are: 48 | \\describe{ 49 | \\item{\\code{using}:}{Locator scheme to use to search the 50 | element, available schemes: {\"class name\", \"css selector\", 51 | \"id\", \"name\", \"link text\", \"partial link text\", 52 | \"tag name\", \"xpath\" }. Defaults to 'xpath'. Partial string 53 | matching is accepted.} 54 | \\item{\\code{value}:}{The search target. See examples.} 55 | }" 56 | using <- match.arg(using) 57 | qpath <- sprintf( 58 | "%s/session/%s/element/%s/element", 59 | serverURL, sessionInfo[["id"]], elementId 60 | ) 61 | queryRD(qpath, "POST", qdata = list(using = using, value = value)) 62 | elemDetails <- .self$value[[1]] 63 | webElement$ 64 | new(as.character(elemDetails))$ 65 | import(.self$export("remoteDriver")) 66 | }, 67 | 68 | findChildElements = function( 69 | using = c( 70 | "xpath", "css selector", "id", "name", "tag name", "class name", 71 | "link text", "partial link text" 72 | ), 73 | value) { 74 | "Search for multiple elements on the page, starting from the node 75 | defined by the parent webElement. The located elements will be 76 | returned as an list of objects of class WebElement. 77 | The inputs are: 78 | \\describe{ 79 | \\item{\\code{using}:}{Locator scheme to use to search the 80 | element, available schemes: {\"class name\", \"css selector\", 81 | \"id\", \"name\", \"link text\", \"partial link text\", 82 | \"tag name\", \"xpath\" }. Defaults to 'xpath'. 83 | Partial string matching is accepted.} 84 | \\item{\\code{value}:}{The search target. See examples.} 85 | }" 86 | using <- match.arg(using) 87 | qpath <- sprintf( 88 | "%s/session/%s/element/%s/elements", 89 | serverURL, sessionInfo[["id"]], elementId 90 | ) 91 | queryRD(qpath, "POST", qdata = list(using = using, value = value)) 92 | elemDetails <- .self$value 93 | lapply( 94 | elemDetails, 95 | function(x) { 96 | webElement$ 97 | new(as.character(x))$ 98 | import(.self$export("remoteDriver")) 99 | } 100 | ) 101 | }, 102 | 103 | compareElements = function(otherElem) { 104 | "Test if the current webElement and an other web element refer to 105 | the same DOM element." 106 | qpath <- sprintf( 107 | "%s/session/%s/element/%s/equals/%s", 108 | serverURL, sessionInfo[["id"]], 109 | elementId, otherElem[["elementId"]] 110 | ) 111 | queryRD(qpath) 112 | .self$value 113 | }, 114 | 115 | clickElement = function() { 116 | "Click the element." 117 | qpath <- sprintf( 118 | "%s/session/%s/element/%s/click", 119 | serverURL, sessionInfo[["id"]], elementId 120 | ) 121 | queryRD(qpath, "POST") 122 | }, 123 | 124 | submitElement = function() { 125 | "Submit a FORM element. The submit command may also be applied to 126 | any element that is a descendant of a FORM element." 127 | qpath <- sprintf( 128 | "%s/session/%s/element/%s/submit", 129 | serverURL, sessionInfo[["id"]], elementId 130 | ) 131 | queryRD(qpath, "POST") 132 | }, 133 | 134 | sendKeysToElement = function(sendKeys) { 135 | "Send a sequence of key strokes to an element. The key strokes are 136 | sent as a list. Plain text is enter as an unnamed element of the 137 | list. Keyboard entries are defined in `selKeys` and should be 138 | listed with name `key`. See the examples." 139 | sendKeys <- list(value = matchSelKeys(sendKeys)) 140 | qpath <- sprintf( 141 | "%s/session/%s/element/%s/value", 142 | serverURL, sessionInfo[["id"]], elementId 143 | ) 144 | queryRD(qpath, "POST", qdata = sendKeys) 145 | }, 146 | 147 | isElementSelected = function() { 148 | "Determine if an OPTION element, or an INPUT element of type 149 | checkbox or radiobutton is currently selected." 150 | qpath <- sprintf( 151 | "%s/session/%s/element/%s/selected", 152 | serverURL, sessionInfo[["id"]], elementId 153 | ) 154 | queryRD(qpath) 155 | .self$value 156 | }, 157 | 158 | isElementEnabled = function() { 159 | "Determine if an element is currently enabled. Obviously to enable 160 | an element just preform a click on it." 161 | qpath <- sprintf( 162 | "%s/session/%s/element/%s/enabled", 163 | serverURL, sessionInfo[["id"]], elementId 164 | ) 165 | queryRD(qpath) 166 | .self$value 167 | }, 168 | 169 | getElementLocation = function() { 170 | "Determine an element's location on the page. The point (0, 0) 171 | refers to the upper-left corner of the page." 172 | qpath <- sprintf( 173 | "%s/session/%s/element/%s/location", 174 | serverURL, sessionInfo[["id"]], elementId 175 | ) 176 | queryRD(qpath) 177 | .self$value 178 | }, 179 | 180 | getElementLocationInView = function() { 181 | "Determine an element's location on the screen once it has been 182 | scrolled into view. 183 | Note: This is considered an internal command and should only be 184 | used to determine an element's location for correctly generating 185 | native events." 186 | qpath <- sprintf( 187 | "%s/session/%s/element/%s/location_in_view", 188 | serverURL, sessionInfo[["id"]], elementId 189 | ) 190 | queryRD(qpath) 191 | .self$value 192 | }, 193 | 194 | getElementTagName = function() { 195 | "Query for an element's tag name." 196 | qpath <- sprintf( 197 | "%s/session/%s/element/%s/name", 198 | serverURL, sessionInfo[["id"]], elementId 199 | ) 200 | queryRD(qpath) 201 | .self$value 202 | }, 203 | 204 | clearElement = function() { 205 | "Clear a TEXTAREA or text INPUT element's value." 206 | qpath <- sprintf( 207 | "%s/session/%s/element/%s/clear", 208 | serverURL, sessionInfo[["id"]], elementId 209 | ) 210 | queryRD(qpath, "POST") 211 | }, 212 | 213 | getElementAttribute = function(attrName) { 214 | "Get the value of an element's attribute. See examples." 215 | qpath <- sprintf( 216 | "%s/session/%s/element/%s/attribute/%s", 217 | serverURL, sessionInfo[["id"]], elementId, attrName 218 | ) 219 | queryRD(qpath) 220 | .self$value 221 | }, 222 | 223 | isElementDisplayed = function() { 224 | "Determine if an element is currently displayed." 225 | qpath <- sprintf( 226 | "%s/session/%s/element/%s/displayed", 227 | serverURL, sessionInfo[["id"]], elementId 228 | ) 229 | queryRD(qpath) 230 | .self$value 231 | }, 232 | 233 | getElementSize = function() { 234 | "Determine an element's size in pixels. The size will be returned 235 | with width and height properties." 236 | qpath <- sprintf( 237 | "%s/session/%s/element/%s/size", 238 | serverURL, sessionInfo[["id"]], elementId 239 | ) 240 | queryRD(qpath) 241 | .self$value 242 | }, 243 | 244 | getElementText = function() { 245 | "Get the innerText of the element." 246 | qpath <- sprintf( 247 | "%s/session/%s/element/%s/text", 248 | serverURL, sessionInfo[["id"]], elementId 249 | ) 250 | queryRD(qpath) 251 | .self$value 252 | }, 253 | 254 | getElementValueOfCssProperty = function(propName) { 255 | "Query the value of an element's computed CSS property. The CSS 256 | property to query should be specified using the CSS property name, 257 | not the JavaScript property name (e.g. background-color instead of 258 | backgroundColor)." 259 | qpath <- sprintf( 260 | "%s/session/%s/element/%s/css/%s", 261 | serverURL, sessionInfo[["id"]], elementId, propName 262 | ) 263 | queryRD(qpath) 264 | .self$value 265 | }, 266 | 267 | describeElement = function() { 268 | "Describe the identified element." 269 | qpath <- sprintf( 270 | "%s/session/%s/element/%s", 271 | serverURL, sessionInfo[["id"]], elementId 272 | ) 273 | queryRD(qpath) 274 | .self$value 275 | }, 276 | 277 | setElementAttribute = function(attributeName, value) { 278 | "Utility function to set an elements attributes." 279 | if (.self$javascript) { 280 | jS <- "arguments[0].setAttribute(arguments[1], arguments[2]);" 281 | invisible(executeScript(jS, list(.self, attributeName, value))) 282 | } else { 283 | "Javascript is not enabled" 284 | } 285 | }, 286 | 287 | highlightElement = function(wait = 75 / 1000) { 288 | "Utility function to highlight current Element. Wait denotes the 289 | time in seconds between style changes on element." 290 | if (.self$javascript) { 291 | style1 <- "color: yellow; border: 5px solid yellow; 292 | background-color: black;" 293 | style2 <- "color: black; border: 5px solid black; 294 | background-color: yellow;" 295 | originalStyle <- getElementAttribute("style")[[1]] 296 | for (x in rep(c(style1, style2), 2)) { 297 | setElementAttribute("style", x) 298 | Sys.sleep(wait) 299 | } 300 | setElementAttribute("style", originalStyle) 301 | } else { 302 | "Javascript is not enabled" 303 | } 304 | }, 305 | 306 | selectTag = function() { 307 | "Utility function to return options from a select DOM node. The 308 | option nodes are returned as webElements. The option text and the 309 | value of the option attribute 'value' and whether the option is 310 | selected are returned also. If this 311 | method is called on a webElement that is not a select DOM node an 312 | error will result." 313 | if (!identical(getElementTagName()[[1]], "select")) { 314 | stop( 315 | "webElement does not appear to point to a select element in DOM." 316 | ) 317 | } 318 | script <- 319 | "function getSelect(select) { 320 | var resEl = []; 321 | var resVal = []; var resTxt = []; var resSel = []; 322 | var options = select && select.options; 323 | for (var i=0, iLen=options.length; i for more information) using the 'JsonWireProtocol' (see for more information). 'Selenium 2.0 WebDriver' allows driving a web browser natively as a user would either locally or on a remote machine using the Selenium server it marks a leap forward in terms of web browser automation. Selenium automates web browsers (commonly referred to as browsers). Using RSelenium you can automate browsers locally or remotely.", 6 | "name": "RSelenium: R Bindings for 'Selenium WebDriver'", 7 | "codeRepository": "https://github.com/ropensci/RSelenium", 8 | "issueTracker": "https://github.com/ropensci/RSelenium/issues", 9 | "license": "https://spdx.org/licenses/AGPL-3.0", 10 | "version": "1.7.9", 11 | "programmingLanguage": { 12 | "@type": "ComputerLanguage", 13 | "name": "R", 14 | "url": "https://r-project.org" 15 | }, 16 | "runtimePlatform": "R version 4.2.1 (2022-06-23)", 17 | "provider": { 18 | "@id": "https://cran.r-project.org", 19 | "@type": "Organization", 20 | "name": "Comprehensive R Archive Network (CRAN)", 21 | "url": "https://cran.r-project.org" 22 | }, 23 | "author": [ 24 | { 25 | "@type": "Person", 26 | "givenName": "John", 27 | "familyName": "Harrison", 28 | "email": "johndharrison0@gmail.com" 29 | } 30 | ], 31 | "maintainer": [ 32 | { 33 | "@type": "Person", 34 | "givenName": "Ju Yeong", 35 | "familyName": "Kim", 36 | "email": "jkim2345@fredhutch.org" 37 | } 38 | ], 39 | "softwareSuggestions": [ 40 | { 41 | "@type": "SoftwareApplication", 42 | "identifier": "binman", 43 | "name": "binman", 44 | "provider": { 45 | "@id": "https://cran.r-project.org", 46 | "@type": "Organization", 47 | "name": "Comprehensive R Archive Network (CRAN)", 48 | "url": "https://cran.r-project.org" 49 | }, 50 | "sameAs": "https://CRAN.R-project.org/package=binman" 51 | }, 52 | { 53 | "@type": "SoftwareApplication", 54 | "identifier": "XML", 55 | "name": "XML", 56 | "provider": { 57 | "@id": "https://cran.r-project.org", 58 | "@type": "Organization", 59 | "name": "Comprehensive R Archive Network (CRAN)", 60 | "url": "https://cran.r-project.org" 61 | }, 62 | "sameAs": "https://CRAN.R-project.org/package=XML" 63 | }, 64 | { 65 | "@type": "SoftwareApplication", 66 | "identifier": "testthat", 67 | "name": "testthat", 68 | "provider": { 69 | "@id": "https://cran.r-project.org", 70 | "@type": "Organization", 71 | "name": "Comprehensive R Archive Network (CRAN)", 72 | "url": "https://cran.r-project.org" 73 | }, 74 | "sameAs": "https://CRAN.R-project.org/package=testthat" 75 | }, 76 | { 77 | "@type": "SoftwareApplication", 78 | "identifier": "knitr", 79 | "name": "knitr", 80 | "provider": { 81 | "@id": "https://cran.r-project.org", 82 | "@type": "Organization", 83 | "name": "Comprehensive R Archive Network (CRAN)", 84 | "url": "https://cran.r-project.org" 85 | }, 86 | "sameAs": "https://CRAN.R-project.org/package=knitr" 87 | }, 88 | { 89 | "@type": "SoftwareApplication", 90 | "identifier": "covr", 91 | "name": "covr", 92 | "provider": { 93 | "@id": "https://cran.r-project.org", 94 | "@type": "Organization", 95 | "name": "Comprehensive R Archive Network (CRAN)", 96 | "url": "https://cran.r-project.org" 97 | }, 98 | "sameAs": "https://CRAN.R-project.org/package=covr" 99 | }, 100 | { 101 | "@type": "SoftwareApplication", 102 | "identifier": "rmarkdown", 103 | "name": "rmarkdown", 104 | "provider": { 105 | "@id": "https://cran.r-project.org", 106 | "@type": "Organization", 107 | "name": "Comprehensive R Archive Network (CRAN)", 108 | "url": "https://cran.r-project.org" 109 | }, 110 | "sameAs": "https://CRAN.R-project.org/package=rmarkdown" 111 | } 112 | ], 113 | "softwareRequirements": { 114 | "1": { 115 | "@type": "SoftwareApplication", 116 | "identifier": "R", 117 | "name": "R", 118 | "version": ">= 3.0.0" 119 | }, 120 | "2": { 121 | "@type": "SoftwareApplication", 122 | "identifier": "methods", 123 | "name": "methods" 124 | }, 125 | "3": { 126 | "@type": "SoftwareApplication", 127 | "identifier": "caTools", 128 | "name": "caTools", 129 | "provider": { 130 | "@id": "https://cran.r-project.org", 131 | "@type": "Organization", 132 | "name": "Comprehensive R Archive Network (CRAN)", 133 | "url": "https://cran.r-project.org" 134 | }, 135 | "sameAs": "https://CRAN.R-project.org/package=caTools" 136 | }, 137 | "4": { 138 | "@type": "SoftwareApplication", 139 | "identifier": "utils", 140 | "name": "utils" 141 | }, 142 | "5": { 143 | "@type": "SoftwareApplication", 144 | "identifier": "httr", 145 | "name": "httr", 146 | "provider": { 147 | "@id": "https://cran.r-project.org", 148 | "@type": "Organization", 149 | "name": "Comprehensive R Archive Network (CRAN)", 150 | "url": "https://cran.r-project.org" 151 | }, 152 | "sameAs": "https://CRAN.R-project.org/package=httr" 153 | }, 154 | "6": { 155 | "@type": "SoftwareApplication", 156 | "identifier": "wdman", 157 | "name": "wdman", 158 | "version": ">= 0.2.2", 159 | "provider": { 160 | "@id": "https://cran.r-project.org", 161 | "@type": "Organization", 162 | "name": "Comprehensive R Archive Network (CRAN)", 163 | "url": "https://cran.r-project.org" 164 | }, 165 | "sameAs": "https://CRAN.R-project.org/package=wdman" 166 | }, 167 | "SystemRequirements": null 168 | }, 169 | "fileSize": "320.553KB", 170 | "relatedLink": ["https://docs.ropensci.org/RSelenium/", "https://CRAN.R-project.org/package=RSelenium"], 171 | "releaseNotes": "https://github.com/ropensci/RSelenium/blob/master/NEWS.md", 172 | "readme": "https://github.com/ropensci/RSelenium/blob/master/README.md", 173 | "contIntegration": ["https://github.com/ropensci/RSelenium/actions", "https://app.codecov.io/gh/ropensci/RSelenium"], 174 | "keywords": ["rselenium", "webdriver", "selenium", "r", "rstats", "r-package"] 175 | } 176 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | 3 | * local R installation, R 4.2.1 4 | * ubuntu 20.04 and macOS 11 (on GitHub Actions), R 4.2.1 5 | * win-builder (devel) 6 | 7 | ## R CMD check results 8 | 9 | 0 errors | 0 warnings | 1 note 10 | 11 | * This is a new release. 12 | -------------------------------------------------------------------------------- /demo/00Index: -------------------------------------------------------------------------------- 1 | selDownloadZip Demonstration of using a firefox profile 2 | selExecJSexample Demonstration of injecting javascript 3 | selExecJSexample2 Demonstration of injecting javascript 2 4 | selJavascriptButtons Demonstration of switching frames and clicking buttons 5 | selPhantomJSexample Demonstration of using a headless browser 6 | shinyDiscussScrape Demonstration of scrolling to element 7 | PhantomJSUserAgent Demonstration of setting user agent with phantomjs 8 | selFileUpload Demonstration of uploading a file to a shiny file upload element. 9 | -------------------------------------------------------------------------------- /demo/PhantomJSUserAgent.R: -------------------------------------------------------------------------------- 1 | appURL <- "http://www.skyscanner.it/trasporti/voli/rome/it/voli-piu-economici-da-roma-per-italia.html?rtn=1&oym=1405&iym=1405" 2 | library(RSelenium) 3 | addCap <- list(phantomjs.page.settings.userAgent = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:29.0) Gecko/20120101 Firefox/29.0") 4 | remDr <- remoteDriver( 5 | browserName = "phantomjs", 6 | extraCapabilities = addCap 7 | ) 8 | remDr$open() 9 | remDr$navigate(appURL) 10 | tableElem <- remDr$findElement("id", "browse-data-table") 11 | xData <- tableElem$getElementAttribute("outerHTML")[[1]] 12 | xData <- htmlParse(xData, encoding = "UTF-8") 13 | readHTMLTable(xData) 14 | -------------------------------------------------------------------------------- /demo/apps/shinytestapp/global.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | # library(googleVis) 3 | library(scales) 4 | data(presidential) 5 | data(economics) 6 | -------------------------------------------------------------------------------- /demo/apps/shinytestapp/reqcontrols.R: -------------------------------------------------------------------------------- 1 | # render the required controls based on user selection 2 | output$reqcontrols <- renderUI({ 3 | ctrlSelect <- 1:4 %in% as.numeric(input$ctrlSelect) 4 | ctrlList <- list( 5 | selectInput("dataset", "Choose a dataset:", 6 | choices = c("rock", "pressure", "cars") 7 | ), 8 | numericInput("obs", "Observations:", 10, 9 | min = 1, max = 100 10 | ), 11 | dateRangeInput("daterange", "Date range:", 12 | start = as.character(min(economics$date)), 13 | end = as.character(max(economics$date)), 14 | min = as.character(min(economics$date)), 15 | max = as.character(max(economics$date)), 16 | format = "mm/dd/yyyy", 17 | separator = " - " 18 | ), 19 | sliderInput("range", "Select range of diamond prices:", 20 | min = 326, max = 18823, value = c(1600, 7900) 21 | ) 22 | ) 23 | ctrlList[ctrlSelect] 24 | }) 25 | -------------------------------------------------------------------------------- /demo/apps/shinytestapp/reqplots.R: -------------------------------------------------------------------------------- 1 | # render the required plots based on user selection 2 | 3 | output$reqplots <- renderUI({ 4 | ctrlSelect <- 1:4 %in% as.numeric(input$ctrlSelect) 5 | plotList <- list( 6 | verbatimTextOutput("summary"), 7 | plotOutput("distPlot"), 8 | plotOutput("ggPlot"), 9 | dataTableOutput("dttable") 10 | ) 11 | # add styles 12 | titles <- paste(c("selectInput", "numericInput", "dateRangeInput", "sliderInput"), "Output") 13 | style <- "float:left; margin:25px;" 14 | plotList <- lapply(seq_along(plotList), function(x) { 15 | tags$div(h6(titles[x]), plotList[[x]], style = style, class = "span5") 16 | }) 17 | 18 | plotList[ctrlSelect] 19 | }) 20 | 21 | # Return the requested dataset for ctrl 1 22 | datasetInput <- reactive({ 23 | switch(input$dataset, 24 | "rock" = rock, 25 | "pressure" = pressure, 26 | "cars" = cars 27 | ) 28 | }) 29 | 30 | # Generate a summary of the dataset for ctrl 1 31 | output$summary <- renderPrint({ 32 | dataset <- datasetInput() 33 | summary(dataset) 34 | }) 35 | 36 | # render plot for ctrl 2 37 | output$distPlot <- renderPlot(width = 300, { 38 | 39 | # generate an rnorm distribution and plot it 40 | dist <- rnorm(input$obs) 41 | hist(dist) 42 | }) 43 | 44 | # render ggplot2 for ctrl3 45 | # adapted from http://stackoverflow.com/questions/11687739/two-legends-based-on-different-datasets-with-ggplot2 46 | output$ggPlot <- renderPlot({ 47 | 48 | # if(is.null(input$daterange)){ 49 | # datastart <- presidential$start[1] 50 | # dataend <- presidential$end[10] 51 | # }else{ 52 | datastart <- as.numeric(cut(as.Date(input$daterange), breaks = presidential$end))[1] 53 | datastart <- presidential$start[datastart] 54 | dataend <- as.numeric(cut(as.Date(input$daterange), breaks = c(presidential$start, Inf)))[2] 55 | dataend <- presidential$end[dataend] 56 | # } 57 | economics <- economics[with(economics, date >= datastart & date <= dataend), ] 58 | presidential <- presidential[with(presidential, start >= datastart & end <= dataend), ] 59 | yrng <- range(economics$unemploy) 60 | # xrng <- range(economics$date) 61 | xrng <- range(economics$date) 62 | economics <- cbind.data.frame(economics, col = gl(2, nrow(economics) / 2)) 63 | g <- ggplot() + geom_line(aes(x = date, y = unemploy, color = col), data = economics) 64 | g <- g + geom_rect(aes(xmin = start, xmax = end, fill = party), 65 | ymin = yrng[1], ymax = yrng[2], data = presidential 66 | ) 67 | g <- g + scale_fill_manual(values = alpha(c("blue", "red"), 0.2)) 68 | g <- g + xlab("") + ylab("No. unemployed (1000s)") 69 | print(g) 70 | }) 71 | 72 | # render table for ctrl 4 73 | output$dttable <- renderDataTable( 74 | { 75 | diamonds[with(diamonds, price > input$range[1] & price < input$range[2]), 76 | c("carat", "cut", "color", "price"), 77 | drop = FALSE 78 | ] 79 | }, 80 | options = list( 81 | aLengthMenu = c(5, 30, 50), iDisplayLength = 5 82 | # , aoColumns = "[{ sWidth: '50px'},{ sWidth: '50px'},{ sWidth: '50px'},{ sWidth: '50px'}]" 83 | ) 84 | ) 85 | -------------------------------------------------------------------------------- /demo/apps/shinytestapp/server.R: -------------------------------------------------------------------------------- 1 | shinyServer(function(input, output, session) { 2 | # plots tab source code 3 | source("reqcontrols.R", local = TRUE) 4 | source("reqplots.R", local = TRUE) 5 | }) 6 | -------------------------------------------------------------------------------- /demo/apps/shinytestapp/ui.R: -------------------------------------------------------------------------------- 1 | shinyUI( 2 | navbarPage( 3 | "Shiny Test App", 4 | tabPanel("Plots", sidebarLayout( 5 | 6 | # Sidebar with a slider input 7 | sidebarPanel( 8 | checkboxGroupInput( 9 | "ctrlSelect", "Select controls required:", 10 | setNames(1:4, c("selectInput", "numericInput", "dateRangeInput", "sliderInput")) 11 | ), 12 | uiOutput("reqcontrols"), 13 | width = 3 14 | ), 15 | mainPanel( 16 | uiOutput("reqplots"), 17 | width = 9 18 | ) 19 | )) 20 | # , navbarMenu("GoogleVis", 21 | # tabPanel("Summary"), 22 | # tabPanel("Table") 23 | # ) 24 | , tabPanel("About", "A simple shiny app to illustrate testing as part of the RSelenium package.") 25 | ) 26 | ) 27 | -------------------------------------------------------------------------------- /demo/selDownloadZip.R: -------------------------------------------------------------------------------- 1 | # download with firefox 2 | # see http://stackoverflow.com/questions/21944016/download-file-from-internet-via-r-despite-the-popup/21958555#21958555 3 | 4 | require(RSelenium) 5 | fprof <- getFirefoxProfile("~/.mozilla/firefox/downloadZip/") 6 | remDr <- remoteDriver(extraCapabilities = fprof) 7 | remDr$open(silent = TRUE) 8 | remDr$navigate("https://www.chicagofed.org/applications/bhc_data/bhcdata_index.cfm") 9 | # click year 2013 10 | webElem <- remDr$findElement("name", "SelectedYear") 11 | webElems <- webElem$findChildElements("css selector", "option") 12 | webElems[[which(sapply(webElems, function(x) { 13 | x$getElementText() 14 | }) == "2012")]]$clickElement() 15 | 16 | # click required quarter 17 | 18 | webElem <- remDr$findElement("name", "SelectedQTR") 19 | webElems <- webElem$findChildElements("css selector", "option") 20 | webElems[[which(sapply(webElems, function(x) { 21 | x$getElementText() 22 | }) == "4th Quarter")]]$clickElement() 23 | 24 | # click button 25 | 26 | webElem <- remDr$findElement("name", "submitbutton") 27 | webElem$clickElement() 28 | -------------------------------------------------------------------------------- /demo/selExecJSexample.R: -------------------------------------------------------------------------------- 1 | # see http://stackoverflow.com/questions/22121006/how-to-scrape-this-squawka-page/22127054#22127054 2 | # RSelenium::startServer() # if needed 3 | require(RSelenium) 4 | remDr <- remoteDriver() 5 | remDr$open() 6 | remDr$setImplicitWaitTimeout(3000) 7 | remDr$navigate("http://epl.squawka.com/stoke-city-vs-arsenal/01-03-2014/english-barclays-premier-league/matches") 8 | squawkData <- remDr$executeScript("return XMLSerializer().serializeToString(squawkaDp.xml);", list()) 9 | require(selectr) 10 | example <- querySelectorAll(xmlParse(squawkData[[1]]), "crosses time_slice") 11 | example[[1]] 12 | # 13 | # 14 | # 73.1,87.1 15 | # 97.9,49.1 16 | # 17 | # 18 | 19 | # > xmlValue(querySelectorAll(xmlParse(squawkData[[1]]), "players #531 name")[[1]]) 20 | # [1] "Charlie Adam" 21 | # 22 | # > xmlValue(querySelectorAll(xmlParse(squawkData[[1]]), "game team#44 long_name")[[1]]) 23 | # [1] "Stoke City" 24 | -------------------------------------------------------------------------------- /demo/selExecJSexample2.R: -------------------------------------------------------------------------------- 1 | # Stackoverflow 2 | # http://stackoverflow.com/questions/22899951/scraping-issue-need-advice/22900084#22900084 3 | # simple example of returning a javascript object 4 | require(RSelenium) 5 | RSelenium::startServer() 6 | appURL <- "http://www.newlook.com/shop/womens/jackets-and-coats/navy-aztec-faux-shearling-collar-parka_286764649?tmcampid=UK_AFF_AffiliateWindow" 7 | remDr <- remoteDriver() 8 | remDr$open() 9 | remDr$navigate(appURL) 10 | inventory <- remDr$executeScript("return list;") 11 | do.call(rbind.data.frame, inventory) 12 | # > do.call(rbind.data.frame, inventory) 13 | # color listPrice popupImage skuID 14 | # 2 0 2867684 15 | # 21 0 2867685 16 | # swatchImage largeImage salePrice 17 | # 2 0 18 | # 21 0 19 | # detailImage stockLevel size 20 | # 2 75 12 21 | # 21 133 14 22 | 23 | remDr$close() 24 | remDr$closeServer() 25 | -------------------------------------------------------------------------------- /demo/selFileUpload.R: -------------------------------------------------------------------------------- 1 | # http://stackoverflow.com/questions/23949637/openfiledialog-in-r-selenium 2 | require(RSelenium) 3 | RSelenium::startServer() 4 | remDr <- remoteDriver() 5 | remDr$open() 6 | remDr$navigate("https://gallery.shinyapps.io/uploadfile") 7 | webElem <- remDr$findElement("id", "file1") 8 | # create a dummy csv 9 | testCsv <- tempfile(fileext = ".csv") 10 | x <- data.frame(a = 1:4, b = 5:8, c = letters[1:4]) 11 | write.csv(x, testCsv, row.names = FALSE) 12 | 13 | # post the file to the app 14 | webElem$sendKeysToElement(list(testCsv)) 15 | remDr$close() 16 | remDr$closeServer() 17 | -------------------------------------------------------------------------------- /demo/selJavascriptButtons.R: -------------------------------------------------------------------------------- 1 | # see http://stackoverflow.com/questions/22107674/scraping-table-from-asp-net-webpage-with-javascript-buttons-using-r/22109906#22109906 2 | 3 | require(RSelenium) 4 | # RSelenium::startServer() # if needed 5 | remDr <- remoteDriver() 6 | remDr$open() 7 | remDr$setImplicitWaitTimeout(3000) 8 | remDr$navigate("http://www.spp.org/LIP.asp") 9 | remDr$switchToFrame("content_frame") 10 | dateElem <- remDr$findElement(using = "id", "txtLIPDate") # select the date 11 | dateRequired <- "01/14/2014" 12 | dateElem$clearElement() 13 | dateElem$sendKeysToElement(list("01/14/2014", key = "enter")) # send a date to app 14 | hourElem <- remDr$findElement(using = "css selector", '#ddlHour [value="5"]') # select the 5th hour 15 | hourElem$clickElement() # select this hour 16 | buttonElem <- remDr$findElement(using = "id", "cmdView") 17 | buttonElem$clickElement() # click the view button 18 | 19 | # Sys.sleep(5) 20 | tableElem <- remDr$findElement(using = "id", "dgLIP") 21 | readHTMLTable(htmlParse(tableElem$getElementAttribute("outerHTML")[[1]])) 22 | # [1] "tableElem$getElementAttribute(\"outerHTML\")" 23 | # $dgLIP 24 | # V1 V2 V3 V4 V5 V6 25 | # 1 Publish Date Price Date PNode Price Parent PNode Settlement Location 26 | # 2 201401132252 201401132300 AECI 19.14 AECI AECI 27 | # 3 201401132252 201401132300 AMRN 18.87 AMRN AMRN 28 | # 4 201401132252 201401132300 BLKW 20.28 BLKW BLKW 29 | # 5 201401132252 201401132300 CLEC 18.99 CLEC CLEC 30 | # 6 201401132252 201401132300 CSWS_AECC_LA 19.77 CSWS_AECC_LA AECC_CSWS 31 | # 7 201401132252 201401132300 CSWS_GREEN_LIGHT_LA 18.5 CSWS_GREEN_LIGHT_LA GSEC_GL_CSWS 32 | # 8 201401132252 201401132300 CSWS_LA 19.01 CSWS_LA AEPM_CSWS 33 | # 9 201401132252 201401132300 CSWS_LA 19.01 CSWS_LA AEP_LOSS 34 | # 10 201401132252 201401132300 CSWS_OMPA_LA 18.66 CSWS_OMPA_LA OMPA_CSWS 35 | # 11 201401132252 201401132300 CSWS_TENASKA_LA 18.95 CSWS_TENASKA_LA GATEWAY_LOAD 36 | # 12 201401132252 201401132300 CSWS112_WGORLD1 18.7 CSWS_LA AEPM_CSWS 37 | # 13 201401132252 201401132300 CSWS112_WGORLD1 18.7 CSWS_LA AEP_LOSS 38 | # 14 201401132252 201401132300 CSWS116PEORILD1 18.9 CSWS_LA AEPM_CSWS 39 | # 15 201401132252 201401132300 CSWS116PEORILD1 18.9 CSWS_LA AEP_LOSS 40 | # 16 201401132252 201401132300 CSWS121EASTLDXFL1 18.92 CSWS_LA AEPM_CSWS 41 | # 17 201401132252 201401132300 CSWS121EASTLDXFL1 18.92 CSWS_LA AEP_LOSS 42 | # 18 201401132252 201401132300 CSWS121LYNN4LD1 18.91 CSWS_LA AEPM_CSWS 43 | # 19 201401132252 201401132300 CSWS121LYNN4LD1 18.91 CSWS_LA AEP_LOSS 44 | # 20 201401132252 201401132300 CSWS12TH_STLD69_12 18.92 CSWS_LA AEPM_CSWS 45 | # 21 201401132252 201401132300 CSWS12TH_STLD69_12 18.92 CSWS_LA AEP_LOSS 46 | # 22 201401132252 201401132300 CSWS12TH_STLD69_12_2 18.92 CSWS_LA AEPM_CSWS 47 | # 23 201401132252 201401132300 CSWS12TH_STLD69_12_2 18.92 CSWS_LA AEP_LOSS 48 | # 24 201401132252 201401132300 CSWS136_YALELD1 18.9 CSWS_LA AEPM_CSWS 49 | # 25 201401132252 201401132300 CSWS136_YALELD1 18.9 CSWS_LA AEP_LOSS 50 | # 26 201401132252 201401132300 CSWS141_PINELDXFMR1 19.09 CSWS_LA AEPM_CSWS 51 | # 27 < > 52 | # 53 | -------------------------------------------------------------------------------- /demo/selPhantomJSexample.R: -------------------------------------------------------------------------------- 1 | # see http://stackoverflow.com/questions/22314380/collecting-table-data-from-a-asp-webpage-over-with-a-for-loop-using-rselenium/22330362#22330362 2 | remDr <- remoteDriver$new(browserName = "phantomjs") 3 | remDr$open() 4 | remDr$setImplicitWaitTimeout(3000) 5 | remDr$navigate("http://www.censusindia.gov.in/Census_Data_2001/Village_Directory/View_data/Village_Profile.aspx") 6 | 7 | # STATES 8 | stateElem <- remDr$findElement(using = "name", "ctl00$Body_Content$drpState") 9 | states <- stateElem$getElementAttribute("outerHTML")[[1]] 10 | stateCodes <- sapply(querySelectorAll(xmlParse(states), "option"), xmlGetAttr, "value")[-1] 11 | states <- sapply(querySelectorAll(xmlParse(states), "option"), xmlValue)[-1] 12 | 13 | changeFun <- function(value, elementName, targetName, vs = FALSE) { 14 | changeElem <- remDr$findElement(using = "name", elementName) 15 | script <- paste0("arguments[0].value = '", value, "'; arguments[0].onchange();") 16 | remDr$executeScript(script, list(changeElem)) 17 | targetCodes <- c() 18 | while (length(targetCodes) == 0) { 19 | targetElem <- remDr$findElement(using = "name", targetName) 20 | target <- xmlParse(targetElem$getElementAttribute("outerHTML")[[1]]) 21 | targetCodes <- sapply(querySelectorAll(target, "option"), xmlGetAttr, "value")[-1] 22 | target <- sapply(querySelectorAll(target, "option"), xmlValue)[-1] 23 | if (length(targetCodes) == 0) { 24 | Sys.sleep(0.5) 25 | } else { 26 | if (vs) { 27 | viewSTATE <- remDr$executeScript("return __VIEWSTATE.value;")[[1]] 28 | out <- list(target, targetCodes, viewSTATE) 29 | } else { 30 | out <- list(target, targetCodes) 31 | } 32 | } 33 | } 34 | return(out) 35 | } 36 | 37 | state <- list() 38 | x <- 1 39 | # for(x in seq_along(stateCodes)){ 40 | Sys.time() 41 | district <- changeFun(stateCodes[[x]], "ctl00$Body_Content$drpState", "ctl00$Body_Content$drpDistrict") 42 | subdistrict <- lapply(district[[2]], function(y) { 43 | subdistrict <- changeFun(y, "ctl00$Body_Content$drpDistrict", "ctl00$Body_Content$drpSubDistrict") 44 | village <- lapply(subdistrict[[2]], function(z) { 45 | village <- changeFun(z, "ctl00$Body_Content$drpSubDistrict", "ctl00$Body_Content$drpVillage", vs = TRUE) 46 | village 47 | }) 48 | list(subdistrict, village) 49 | }) 50 | state[[x]] <- list(district, subdistrict) 51 | Sys.time() 52 | 53 | # } 54 | -------------------------------------------------------------------------------- /demo/shinyDiscussScrape.R: -------------------------------------------------------------------------------- 1 | 2 | remDr <- remoteDriver() 3 | remDr$open(silent = TRUE) 4 | sysDetails <- remDr$getStatus() 5 | remDr$setImplicitWaitTimeout(6000) 6 | browser <- remDr$sessionInfo$browserName 7 | appURL <- "https://groups.google.com/forum/?hl=en#!forum/shiny-discuss" 8 | 9 | remDr$navigate(appURL) 10 | webElem <- remDr$findElement("css selector", ".GNI5KIWDCL") 11 | 12 | while (grepl("of many topics", webElem$getElementText()[[1]])) { 13 | webElems <- remDr$findElements("css selector", "table.GNI5KIWDJI .GNI5KIWDEL") 14 | webElems[[length(webElems)]]$getElementLocationInView() 15 | webElem <- remDr$findElement("css selector", ".GNI5KIWDCL") 16 | while (webElem$getElementText()[[1]] == "Loading more topics...") { 17 | Sys.sleep(2) 18 | } 19 | } 20 | 21 | # get the post links 22 | 23 | webElems <- remDr$findElements("css selector", "table.GNI5KIWDJI .GNI5KIWDEL") 24 | googHTML <- remDr$getPageSource()[[1]] 25 | googHTML <- gsub("\\\\\"", "\"", googHTML) 26 | googXML <- htmlParse(googHTML) 27 | xpathSApply(googXML, "//*/a[@class='GNI5KIWDEL']", function(x) { 28 | xmlGetAttr(x, "href") 29 | }) 30 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/global.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | #library(googleVis) 3 | library(scales) 4 | data(presidential) 5 | data(economics) 6 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/reqcontrols.R: -------------------------------------------------------------------------------- 1 | # render the required controls based on user selection 2 | output$reqcontrols <- renderUI({ 3 | ctrlSelect <- 1:4 %in% as.numeric(input$ctrlSelect) 4 | ctrlList <- list(selectInput("dataset", "Choose a dataset:", 5 | choices = c("rock", "pressure", "cars")) 6 | , numericInput("obs", "Observations:", 10, 7 | min = 1, max = 100) 8 | , dateRangeInput("daterange", "Date range:", 9 | start = as.character(min(economics$date)), 10 | end = as.character(max(economics$date)), 11 | min = as.character(min(economics$date)), 12 | max = as.character(max(economics$date)), 13 | format = "mm/dd/yyyy", 14 | separator = " - ") 15 | , sliderInput("range", "Select range of diamond prices:", 16 | min = 326, max = 18823, value = c(1600,7900)) 17 | ) 18 | ctrlList[ctrlSelect] 19 | }) 20 | 21 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/reqplots.R: -------------------------------------------------------------------------------- 1 | # render the required plots based on user selection 2 | 3 | output$reqplots <- renderUI({ 4 | ctrlSelect <- 1:4 %in% as.numeric(input$ctrlSelect) 5 | plotList <- list(verbatimTextOutput("summary") 6 | , plotOutput("distPlot") 7 | , plotOutput("ggPlot") 8 | , dataTableOutput("dttable") 9 | ) 10 | # add styles 11 | titles <- paste(c("selectInput", "numericInput", "dateRangeInput", 12 | "sliderInput") , "Output") 13 | style <- "float:left; margin:25px;" 14 | plotList <- lapply(seq_along(plotList), function(x){ 15 | tags$div(h6(titles[x]), plotList[[x]], style = style, class = "span5") 16 | } 17 | ) 18 | 19 | plotList[ctrlSelect] 20 | }) 21 | 22 | # Return the requested dataset for ctrl 1 23 | datasetInput <- reactive({ 24 | switch(input$dataset, 25 | "rock" = rock, 26 | "pressure" = pressure, 27 | "cars" = cars) 28 | }) 29 | 30 | # Generate a summary of the dataset for ctrl 1 31 | output$summary <- renderPrint({ 32 | dataset <- datasetInput() 33 | summary(dataset) 34 | }) 35 | 36 | # render plot for ctrl 2 37 | output$distPlot <- renderPlot(width = 300, { 38 | 39 | # generate an rnorm distribution and plot it 40 | dist <- rnorm(input$obs) 41 | hist(dist) 42 | }) 43 | 44 | # render ggplot2 for ctrl3 45 | # adapted from http://stackoverflow.com/questions/11687739/two-legends-based-on-different-datasets-with-ggplot2 46 | output$ggPlot <- renderPlot({ 47 | 48 | # if(is.null(input$daterange)){ 49 | # datastart <- presidential$start[1] 50 | # dataend <- presidential$end[10] 51 | # }else{ 52 | datastart <- as.numeric(cut(as.Date(input$daterange), 53 | breaks = presidential$end))[1] 54 | datastart <- presidential$start[datastart] 55 | dataend <- as.numeric(cut(as.Date(input$daterange), 56 | breaks = c(presidential$start, Inf)))[2] 57 | dataend <- presidential$end[dataend] 58 | # } 59 | economics <- economics[with(economics, 60 | date >= datastart & date <= dataend), ] 61 | presidential <- presidential[with(presidential, 62 | start >= datastart & end <= dataend), ] 63 | yrng <- range(economics$unemploy) 64 | # xrng <- range(economics$date) 65 | xrng <- range(economics$date) 66 | economics <- cbind.data.frame(economics, col=gl(2, nrow(economics)/2)) 67 | g <- ggplot() + 68 | geom_line(aes(x=date, y=unemploy, color=col), data=economics) 69 | g <- g + geom_rect(aes(xmin=start, xmax=end, fill=party), 70 | ymin = yrng[1], ymax = yrng[2], data = presidential) 71 | g <- g + scale_fill_manual(values = alpha(c("blue", "red"), 0.2)) 72 | g <- g + xlab("") + ylab("No. unemployed (1000s)") 73 | print(g) 74 | }) 75 | 76 | # render table for ctrl 4 77 | output$dttable <- renderDataTable({ 78 | diamonds[with(diamonds, price > input$range[1] & price < input$range[2]) 79 | , c("carat", "cut", "color", "price"), drop = FALSE] 80 | } 81 | , options = list(aLengthMenu = c(5, 30, 50), iDisplayLength = 5 82 | 83 | )) 84 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/server.R: -------------------------------------------------------------------------------- 1 | shinyServer(function(input, output, session) { 2 | # plots tab source code 3 | source("reqcontrols.R", local = TRUE) 4 | source("reqplots.R", local = TRUE) 5 | 6 | }) -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/runtest.R: -------------------------------------------------------------------------------- 1 | user <- "rselenium0" 2 | pass <- "49953c74-5c46-4ff9-b584-cf31a4c71809" # insert appropriate key here 3 | port <- 80 4 | ip <- paste0(user, ':', pass, "@ondemand.saucelabs.com") 5 | #browser <- "safari" 6 | #browser <- "firefox" 7 | #browser <- "chrome" 8 | #browser <- "internet explorer" 9 | #browser <- "android" 10 | browser <- "safari" 11 | version <- "7" 12 | #platform <- "Windows 8.1" 13 | # platform <- "linux" 14 | platform <- "OS X 10.9" 15 | 16 | testsel <- test_env() 17 | with(testsel, 18 | {rsel.opt <- list(remoteServerAddr = ip, port = port, 19 | browserName = browser, version = version, 20 | platform = platform, 21 | extraCapabilities = list(username = user, 22 | accessKey = pass) 23 | ) 24 | sauceTest <- TRUE 25 | }) 26 | testRes <- test_dir("./inst/tests", reporter = "Tap", 27 | filter = "api-example", env = testsel) 28 | 29 | if(!any(testRes$failed) && testsel[['sauceTest']]){ 30 | # test passed rsel.opt should contain the jobid 31 | pv <- packageVersion("RSelenium") 32 | 33 | ip <- paste0(user, ':', pass, "@saucelabs.com/rest/v1/", user, "/jobs/", 34 | testsel[['rsel.opt']]$id) 35 | qdata <- toJSON( 36 | list(passed = TRUE, 37 | "custom-data" = list(release = 38 | do.call(paste, list(pv, collapse = ".")), 39 | testresult = testRes) 40 | ) 41 | ) 42 | res <- getURLContent(ip, customrequest = "PUT", 43 | httpheader = "Content-Type:text/json", 44 | postfields = qdata, isHTTP = FALSE) 45 | 46 | } 47 | 48 | 49 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/setup.r: -------------------------------------------------------------------------------- 1 | # setup some base functions etc that all tests use 2 | library(RSelenium) 3 | library(testthat) 4 | 5 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 6 | remDr <- do.call(remoteDriver, rsel.opt) 7 | }else{ 8 | remDr <- remoteDriver() 9 | } 10 | remDr$open(silent = TRUE) 11 | sysDetails <- remDr$getStatus() 12 | remDr$setImplicitWaitTimeout(3000) 13 | browser <- remDr$sessionInfo$browserName 14 | 15 | htmlSrc <- Sys.getenv("SEL_TEST_DIR") 16 | loadPage <- function(pgStr){ 17 | paste0("file://", file.path(htmlSrc, paste0(pgStr, ".html"))) 18 | } 19 | 20 | if(exists('sauceTest', where = parent.env(environment()) , inherits = FALSE)){ 21 | if(sauceTest){ 22 | # assume running /selenium/common/src/web$ python -m SimpleHTTPServer 3000 23 | # this will serve the files from the selenium project on port 3000 24 | # myname.local maps to 127.0.0.1 in hosts hopefully to allow windows to 25 | # work on sauceConnect 26 | if(browser %in% c("iPhone", "iPad", "safari")){ 27 | htmlSrc <- "localhost:3000" 28 | }else{ 29 | htmlSrc <- "myname.local:3000" 30 | } 31 | loadPage <- function(pgStr){ 32 | paste0("http://", file.path(htmlSrc, paste0(pgStr, ".html"))) 33 | } 34 | rsel.opt$id <<- remDr$sessionInfo$id 35 | } 36 | } 37 | 38 | 39 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-basic.r: -------------------------------------------------------------------------------- 1 | context("basic") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | appURL <- "http://127.0.0.1:6012" 14 | 15 | test_that("can connect to app", { 16 | remDr$navigate(appURL) 17 | appTitle <- remDr$getTitle()[[1]] 18 | expect_equal(appTitle, "Shiny Test App") 19 | }) 20 | 21 | test_that("controls are present", { 22 | webElems <- remDr$findElements("css selector", "#ctrlSelect label") 23 | appCtrlLabels <- sapply(webElems, function(x){x$getElementText()}) 24 | expect_equal(appCtrlLabels[[1]], "Select controls required:") 25 | expect_equal(appCtrlLabels[[2]], "selectInput") 26 | expect_equal(appCtrlLabels[[3]], "numericInput") 27 | expect_equal(appCtrlLabels[[4]], "dateRangeInput") 28 | expect_equal(appCtrlLabels[[5]], "sliderInput") 29 | }) 30 | 31 | test_that("tabs are present", { 32 | webElems <- remDr$findElements("css selector", ".nav a") 33 | appTabLabels <- sapply(webElems, function(x){x$getElementText()}) 34 | expect_equal(appTabLabels[[1]], "Plots") 35 | expect_equal(appTabLabels[[2]], "About") 36 | }) 37 | 38 | remDr$close() 39 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-checkbox.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | sysDetails <- remDr$getStatus() 14 | browser <- remDr$sessionInfo$browserName 15 | appURL <- "http://127.0.0.1:6012" 16 | 17 | test_that("can select/deselect checkbox 1", { 18 | remDr$navigate(appURL) 19 | webElem <- remDr$findElement("css selector", "#ctrlSelect1") 20 | initState <- webElem$isElementSelected()[[1]] 21 | # check if we can select/deselect 22 | if(browser == "internet explorer"){ 23 | webElem$sendKeysToElement(list(key = "space")) 24 | }else{ 25 | webElem$clickElement() 26 | } 27 | changeState <- webElem$isElementSelected()[[1]] 28 | expect_is(initState, "logical") 29 | expect_is(changeState, "logical") 30 | expect_false(initState == changeState) 31 | }) 32 | 33 | test_that("can select/deselect checkbox 2", { 34 | webElem <- remDr$findElement("css selector", "#ctrlSelect2") 35 | initState <- webElem$isElementSelected()[[1]] 36 | # check if we can select/deselect 37 | if(browser == "internet explorer"){ 38 | webElem$sendKeysToElement(list(key = "space")) 39 | }else{ 40 | webElem$clickElement() 41 | } 42 | changeState <- webElem$isElementSelected()[[1]] 43 | expect_is(initState, "logical") 44 | expect_is(changeState, "logical") 45 | expect_false(initState == changeState) 46 | }) 47 | 48 | test_that("can select/deselect checkbox 3", { 49 | webElem <- remDr$findElement("css selector", "#ctrlSelect3") 50 | initState <- webElem$isElementSelected()[[1]] 51 | # check if we can select/deselect 52 | if(browser == "internet explorer"){ 53 | webElem$sendKeysToElement(list(key = "space")) 54 | }else{ 55 | webElem$clickElement() 56 | } 57 | changeState <- webElem$isElementSelected()[[1]] 58 | expect_is(initState, "logical") 59 | expect_is(changeState, "logical") 60 | expect_false(initState == changeState) 61 | }) 62 | 63 | test_that("can select/deselect checkbox 4", { 64 | webElem <- remDr$findElement("css selector", "#ctrlSelect4") 65 | initState <- webElem$isElementSelected()[[1]] 66 | # check if we can select/deselect 67 | if(browser == "internet explorer"){ 68 | webElem$sendKeysToElement(list(key = "space")) 69 | }else{ 70 | webElem$clickElement() 71 | } 72 | changeState <- webElem$isElementSelected()[[1]] 73 | expect_is(initState, "logical") 74 | expect_is(changeState, "logical") 75 | expect_false(initState == changeState) 76 | }) 77 | 78 | remDr$close() 79 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-daterangeinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , 7 | inherits = FALSE)){ 8 | # print(rsel.opt) 9 | remDr <- do.call(remoteDriver, rsel.opt) 10 | }else{ 11 | remDr <- remoteDriver() 12 | } 13 | remDr$open(silent = TRUE) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("dateRangeInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect3") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'daterange']") 33 | expect_output(webElem$getElementText()[[1]], "Date range:") 34 | } 35 | ) 36 | 37 | test_that("dateRangeInput selection invokes change", { 38 | webElems <- remDr$findElements("css selector", 39 | "#reqcontrols #daterange .input-small") 40 | appMinDate <- webElems[[1]]$getElementAttribute("data-min-date")[[1]] 41 | appMaxDate <- webElems[[1]]$getElementAttribute("data-max-date")[[1]] 42 | newDates <- sort(sample(seq(as.Date(appMinDate), 43 | as.Date(appMaxDate), 1), 2)) 44 | newDates <- as.character(format(newDates, "%m/%d/%Y")) 45 | outElem <- remDr$findElement("css selector", "#ggPlot img") 46 | initOutput <- outElem$getElementAttribute("src")[[1]] 47 | 48 | webElems[[1]]$clearElement() 49 | webElems[[1]]$sendKeysToElement(list(newDates[1])) 50 | webElems[[2]]$clearElement() 51 | webElems[[2]]$sendKeysToElement(list(newDates[2])) 52 | if(browser == "phantomjs"){ 53 | Sys.sleep(1) 54 | } 55 | outElem <- suppressWarnings(remDr$findElement("css selector", 56 | "#ggPlot img")) 57 | changeOutput <- outElem$getElementAttribute("src")[[1]] 58 | 59 | expect_false(initOutput == changeOutput) 60 | 61 | } 62 | ) 63 | 64 | remDr$close() -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-numericinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , 7 | inherits = FALSE)){ 8 | # print(rsel.opt) 9 | remDr <- do.call(remoteDriver, rsel.opt) 10 | }else{ 11 | remDr <- remoteDriver() 12 | } 13 | remDr$open(silent = TRUE) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("numericInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect2") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'obs']") 33 | expect_output(webElem$getElementText()[[1]], "Observations:") 34 | } 35 | ) 36 | 37 | test_that("numericInput selection invokes change", { 38 | webElem <- remDr$findElement("css selector", "#reqcontrols #obs") 39 | outElem <- remDr$findElement("css selector", "#distPlot img") 40 | initOutput <- outElem$getElementAttribute("src")[[1]] 41 | 42 | appMin <- as.integer(webElem$getElementAttribute("min")[[1]]) 43 | appMax <- as.integer(webElem$getElementAttribute("max")[[1]]) 44 | randInt <- sample(appMin:appMax, 1) 45 | webElem$clearElement() 46 | webElem$sendKeysToElement(list(as.character(randInt))) 47 | 48 | outElem <- suppressWarnings(remDr$findElement("css selector", 49 | "#distPlot img")) 50 | # if(is.na(outElem$elementId)){ 51 | # Sys.sleep(1) 52 | # outElem <- remDr$findElement("css selector", "#distPlot img") 53 | # } 54 | changeOutput <- outElem$getElementAttribute("src")[[1]] 55 | 56 | expect_false(initOutput == changeOutput) 57 | } 58 | ) 59 | 60 | test_that("numericInput input character error", { 61 | webElem <- remDr$findElement("css selector", "#reqcontrols #obs") 62 | webElem$clearElement() 63 | webElem$sendKeysToElement(list('test')) 64 | outElem <- suppressWarnings(remDr$findElement("css selector", 65 | "#distPlot")) 66 | # if(is.na(outElem$elementId)){ 67 | # Sys.sleep(1) 68 | # outElem <- remDr$findElement("css selector", "#distPlot img") 69 | # } 70 | changeOutput <- outElem$getElementText()[[1]] 71 | expect_output(changeOutput, "invalid arguments") 72 | }) 73 | 74 | remDr$close() 75 | 76 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-output.r: -------------------------------------------------------------------------------- 1 | context("outputs") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 6 | # print(rsel.opt) 7 | remDr <- do.call(remoteDriver, rsel.opt) 8 | }else{ 9 | remDr <- remoteDriver() 10 | } 11 | remDr$open(silent = TRUE) 12 | on.exit(remDr$close()) 13 | sysDetails <- remDr$getStatus() 14 | remDr$setImplicitWaitTimeout(3000) 15 | browser <- remDr$sessionInfo$browserName 16 | appURL <- "http://127.0.0.1:6012" 17 | 18 | test_that("output object alignment correct", { 19 | remDr$navigate(appURL) 20 | webElems <- remDr$findElements("css selector", "#ctrlSelect input") 21 | lapply(webElems, function(x){ 22 | if(!x$isElementSelected()[[1]]){ 23 | if(browser != "internet explorer"){ 24 | x$clickElement() 25 | }else{ 26 | x$sendKeysToElement(list(key='space')) 27 | } 28 | } 29 | }) 30 | remDr$maxWindowSize() 31 | # will be initiated if it is not loadedd yet. 32 | webElem <- remDr$findElement("css selector", "#reqplots #dttable") 33 | webElems <- remDr$findElements("css selector", "#reqplots .span5") 34 | out <- sapply(webElems, function(x){x$getElementLocation()}) 35 | out <- out[c('x', 'y'),] 36 | #print(out) 37 | expect_equal(as.integer(out['y', 1]) - as.integer(out['y', 2]), 0) 38 | expect_equal(as.integer(out['y', 3]) - as.integer(out['y', 4]), 0) 39 | expect_equal(as.integer(out['x', 1]) - as.integer(out['x', 3]), 0) 40 | expect_equal(as.integer(out['x', 2]) - as.integer(out['x', 4]), 0) 41 | } 42 | ) 43 | 44 | test_that("output labels are correct", { 45 | 46 | webElems <- remDr$findElements("css selector", "#reqplots h6") 47 | appLabels <- unlist(sapply(webElems, function(x){x$getElementText()})) 48 | checkLabels <- appLabels %in% c("selectInput Output", 49 | "numericInput Output", 50 | "dateRangeInput Output", 51 | "sliderInput Output") 52 | expect_true(all(checkLabels)) 53 | 54 | } 55 | ) 56 | 57 | test_that("output check images", { 58 | 59 | webElems <- remDr$findElements("css selector", 60 | "#distPlot img, #ggPlot img") 61 | appImages <- sapply(webElems, function(x){x$getElementAttribute("src")}) 62 | expect_true(all(grepl("image/png;base64",appImages))) 63 | } 64 | ) 65 | 66 | test_that("output check data-table", { 67 | 68 | webElems <- remDr$findElements("css selector", "#dttable .sorting") 69 | appHeaders <- sapply(webElems, function(x){x$getElementText()}) 70 | # check a random sorting 71 | appSort <- sample(seq_along(appHeaders)[c(1,4)], 1) 72 | webElems[[appSort]]$clickElement() 73 | # check ordering of column after 1st click 74 | appSource <- remDr$getPageSource()[[1]] 75 | appSource <- htmlParse(appSource) 76 | dttable <- readHTMLTable(appSource, stringsAsFactors = FALSE) 77 | appCol <- dttable$DataTables_Table_0[[appHeaders[[appSort]]]] 78 | ordering1 <- is.unsorted(appCol) 79 | 80 | webElems[[appSort]]$clickElement() 81 | # check ordering of column after 2nd click 82 | appSource <- remDr$getPageSource()[[1]] 83 | appSource <- htmlParse(appSource) 84 | dttable <- readHTMLTable(appSource, stringsAsFactors = FALSE) 85 | appCol <- dttable$DataTables_Table_0[[appHeaders[[appSort]]]] 86 | ordering2 <- is.unsorted(appCol) 87 | 88 | expect_false(ordering1 == ordering2) 89 | } 90 | ) 91 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-selectinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | sysDetails <- remDr$getStatus() 14 | remDr$setImplicitWaitTimeout(3000) 15 | browser <- remDr$sessionInfo$browserName 16 | appURL <- "http://127.0.0.1:6012" 17 | 18 | test_that("selectInput dataSet correct", { 19 | remDr$navigate(appURL) 20 | webElem <- remDr$findElement("css selector", "#ctrlSelect1") 21 | initState <- webElem$isElementSelected()[[1]] 22 | if(!initState){ 23 | # select the checkbox 24 | if(browser == "internet explorer"){ 25 | webElem$sendKeysToElement(list(key = "space")) 26 | }else{ 27 | webElem$clickElement() 28 | } 29 | } 30 | 31 | webElem <- remDr$findElement("css selector", "#reqcontrols #dataset") 32 | # check the available datasets 33 | childElems <- webElem$findChildElements("css selector", "[value]") 34 | appDataSets <- sapply(childElems, function(x){x$getElementAttribute("value")}) 35 | expect_true(all(c("rock", "pressure", "cars") %in% appDataSets)) 36 | }) 37 | 38 | test_that("selectInput label correct", { 39 | webElem <- remDr$findElement("css selector", 40 | "#reqcontrols label[for = 'dataset']") 41 | expect_output(webElem$getElementText()[[1]], "Choose a dataset:") 42 | } 43 | ) 44 | 45 | test_that("selectInput selection invokes change", { 46 | webElem <- remDr$findElement("css selector", "#reqcontrols #dataset") 47 | childElems <- webElem$findChildElements("css selector", "[value]") 48 | ceState <- sapply(childElems, function(x){x$isElementSelected()}) 49 | newState <- sample(seq_along(ceState)[!unlist(ceState)], 1) 50 | 51 | outElem <- remDr$findElement("css selector", "#summary") 52 | initOutput <- outElem$getElementText()[[1]] 53 | 54 | # change dataset 55 | childElems[[newState]]$clickElement() 56 | outElem <- remDr$findElement("css selector", "#summary") 57 | changeOutput <- outElem$getElementText()[[1]] 58 | 59 | expect_false(initOutput == changeOutput) 60 | } 61 | ) 62 | 63 | remDr$close() 64 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests-saucelabs/test-sliderinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | if(exists('rsel.opt', where = parent.env(environment()) , 6 | inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | on.exit(remDr$close()) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("sliderInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect4") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'range']") 33 | expect_output(webElem$getElementText()[[1]], 34 | "Select range of diamond prices:") 35 | } 36 | ) 37 | 38 | test_that("sliderInput selection invokes change", { 39 | # get the slider element using siblings 40 | webElem <- remDr$findElement("css selector", "#reqcontrols #range") 41 | appMin <- as.numeric(webElem$getElementAttribute("data-from")) 42 | appMax <- as.numeric(webElem$getElementAttribute("data-to")) 43 | appValue <- webElem$getElementAttribute("value") 44 | appValue <- as.numeric(unlist(strsplit(appValue[[1]], ";"))) 45 | appStep <- as.numeric(webElem$getElementAttribute("data-step")) 46 | appRound <- as.logical(webElem$getElementAttribute("data-round")) 47 | outElem <- remDr$findElement("css selector", "#dttable") 48 | initOutput <- outElem$getElementText()[[1]] 49 | 50 | # get the slider dimensions 51 | webElem <- remDr$findElement("css selector", 52 | "#reqcontrols input#range + .jslider") 53 | sliderDim <- webElem$getElementSize() 54 | 55 | newValues <- seq(from = appMin, to = appMax, by = appStep) 56 | newValues <- sort(sample(newValues, 2)) 57 | # use siblings to get the pointers 58 | cSelect <- "#reqcontrols input#range + .jslider .jslider-pointer" 59 | webElems <- remDr$findElements("css selector", cSelect) 60 | pxToMoveSldr <- trunc(sliderDim$width * 61 | (newValues - appValue)/(appMax - appMin)) 62 | 63 | # move first slider 64 | moveOrder <- 1:2 65 | if(newValues[1] > appValue[2]){moveOrder <- rev(moveOrder)} 66 | for(x in moveOrder){ 67 | remDr$mouseMoveToLocation(webElement = webElems[[x]]) 68 | remDr$buttondown() 69 | remDr$mouseMoveToLocation(x = as.integer(pxToMoveSldr[x]), y = -1L) 70 | remDr$buttonup() 71 | } 72 | #webElem <- remDr$findElement("css selector", "#reqcontrols #range") 73 | #appValue <- webElem$getElementAttribute("value") 74 | 75 | # Shiny.onInputChange("range", [2000, 10000]) 76 | # Shiny.shinyapp.sendInput({range: [6222, 9333]}) 77 | Sys.sleep(1) 78 | outElem <- remDr$findElement("css selector", "#dttable") 79 | changeOutput <- outElem$getElementText()[[1]] 80 | 81 | expect_false(initOutput == changeOutput) 82 | 83 | } 84 | ) 85 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-basic.r: -------------------------------------------------------------------------------- 1 | context("basic") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | appURL <- "http://127.0.0.1:6012" 14 | 15 | test_that("can connect to app", { 16 | remDr$navigate(appURL) 17 | appTitle <- remDr$getTitle()[[1]] 18 | expect_equal(appTitle, "Shiny Test App") 19 | }) 20 | 21 | test_that("controls are present", { 22 | webElems <- remDr$findElements("css selector", "#ctrlSelect label") 23 | appCtrlLabels <- sapply(webElems, function(x){x$getElementText()}) 24 | expect_equal(appCtrlLabels[[1]], "Select controls required:") 25 | expect_equal(appCtrlLabels[[2]], "selectInput") 26 | expect_equal(appCtrlLabels[[3]], "numericInput") 27 | expect_equal(appCtrlLabels[[4]], "dateRangeInput") 28 | expect_equal(appCtrlLabels[[5]], "sliderInput") 29 | }) 30 | 31 | test_that("tabs are present", { 32 | webElems <- remDr$findElements("css selector", ".nav a") 33 | appTabLabels <- sapply(webElems, function(x){x$getElementText()}) 34 | expect_equal(appTabLabels[[1]], "Plots") 35 | expect_equal(appTabLabels[[2]], "About") 36 | }) 37 | 38 | remDr$close() 39 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-checkbox.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | sysDetails <- remDr$getStatus() 14 | browser <- remDr$sessionInfo$browserName 15 | appURL <- "http://127.0.0.1:6012" 16 | 17 | test_that("can select/deselect checkbox 1", { 18 | remDr$navigate(appURL) 19 | webElem <- remDr$findElement("css selector", "#ctrlSelect1") 20 | initState <- webElem$isElementSelected()[[1]] 21 | # check if we can select/deselect 22 | if(browser == "internet explorer"){ 23 | webElem$sendKeysToElement(list(key = "space")) 24 | }else{ 25 | webElem$clickElement() 26 | } 27 | changeState <- webElem$isElementSelected()[[1]] 28 | expect_is(initState, "logical") 29 | expect_is(changeState, "logical") 30 | expect_false(initState == changeState) 31 | }) 32 | 33 | test_that("can select/deselect checkbox 2", { 34 | webElem <- remDr$findElement("css selector", "#ctrlSelect2") 35 | initState <- webElem$isElementSelected()[[1]] 36 | # check if we can select/deselect 37 | if(browser == "internet explorer"){ 38 | webElem$sendKeysToElement(list(key = "space")) 39 | }else{ 40 | webElem$clickElement() 41 | } 42 | changeState <- webElem$isElementSelected()[[1]] 43 | expect_is(initState, "logical") 44 | expect_is(changeState, "logical") 45 | expect_false(initState == changeState) 46 | }) 47 | 48 | test_that("can select/deselect checkbox 3", { 49 | webElem <- remDr$findElement("css selector", "#ctrlSelect3") 50 | initState <- webElem$isElementSelected()[[1]] 51 | # check if we can select/deselect 52 | if(browser == "internet explorer"){ 53 | webElem$sendKeysToElement(list(key = "space")) 54 | }else{ 55 | webElem$clickElement() 56 | } 57 | changeState <- webElem$isElementSelected()[[1]] 58 | expect_is(initState, "logical") 59 | expect_is(changeState, "logical") 60 | expect_false(initState == changeState) 61 | }) 62 | 63 | test_that("can select/deselect checkbox 4", { 64 | webElem <- remDr$findElement("css selector", "#ctrlSelect4") 65 | initState <- webElem$isElementSelected()[[1]] 66 | # check if we can select/deselect 67 | if(browser == "internet explorer"){ 68 | webElem$sendKeysToElement(list(key = "space")) 69 | }else{ 70 | webElem$clickElement() 71 | } 72 | changeState <- webElem$isElementSelected()[[1]] 73 | expect_is(initState, "logical") 74 | expect_is(changeState, "logical") 75 | expect_false(initState == changeState) 76 | }) 77 | 78 | remDr$close() 79 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-daterangeinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , 7 | inherits = FALSE)){ 8 | # print(rsel.opt) 9 | remDr <- do.call(remoteDriver, rsel.opt) 10 | }else{ 11 | remDr <- remoteDriver() 12 | } 13 | remDr$open(silent = TRUE) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("dateRangeInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect3") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'daterange']") 33 | expect_output(webElem$getElementText()[[1]], "Date range:") 34 | } 35 | ) 36 | 37 | test_that("dateRangeInput selection invokes change", { 38 | webElems <- remDr$findElements("css selector", 39 | "#reqcontrols #daterange .input-small") 40 | appMinDate <- webElems[[1]]$getElementAttribute("data-min-date")[[1]] 41 | appMaxDate <- webElems[[1]]$getElementAttribute("data-max-date")[[1]] 42 | newDates <- sort(sample(seq(as.Date(appMinDate), 43 | as.Date(appMaxDate), 1), 2)) 44 | newDates <- as.character(format(newDates, "%m/%d/%Y")) 45 | outElem <- remDr$findElement("css selector", "#ggPlot img") 46 | initOutput <- outElem$getElementAttribute("src")[[1]] 47 | 48 | webElems[[1]]$clearElement() 49 | webElems[[1]]$sendKeysToElement(list(newDates[1])) 50 | webElems[[2]]$clearElement() 51 | webElems[[2]]$sendKeysToElement(list(newDates[2])) 52 | if(browser == "phantomjs"){ 53 | Sys.sleep(1) 54 | } 55 | outElem <- suppressWarnings(remDr$findElement("css selector", 56 | "#ggPlot img")) 57 | changeOutput <- outElem$getElementAttribute("src")[[1]] 58 | 59 | expect_false(initOutput == changeOutput) 60 | 61 | } 62 | ) 63 | 64 | remDr$close() -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-numericinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , 7 | inherits = FALSE)){ 8 | # print(rsel.opt) 9 | remDr <- do.call(remoteDriver, rsel.opt) 10 | }else{ 11 | remDr <- remoteDriver() 12 | } 13 | remDr$open(silent = TRUE) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("numericInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect2") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'obs']") 33 | expect_output(webElem$getElementText()[[1]], "Observations:") 34 | } 35 | ) 36 | 37 | test_that("numericInput selection invokes change", { 38 | webElem <- remDr$findElement("css selector", "#reqcontrols #obs") 39 | outElem <- remDr$findElement("css selector", "#distPlot img") 40 | initOutput <- outElem$getElementAttribute("src")[[1]] 41 | 42 | appMin <- as.integer(webElem$getElementAttribute("min")[[1]]) 43 | appMax <- as.integer(webElem$getElementAttribute("max")[[1]]) 44 | randInt <- sample(appMin:appMax, 1) 45 | webElem$clearElement() 46 | webElem$sendKeysToElement(list(as.character(randInt))) 47 | 48 | outElem <- suppressWarnings(remDr$findElement("css selector", 49 | "#distPlot img")) 50 | # if(is.na(outElem$elementId)){ 51 | # Sys.sleep(1) 52 | # outElem <- remDr$findElement("css selector", "#distPlot img") 53 | # } 54 | changeOutput <- outElem$getElementAttribute("src")[[1]] 55 | 56 | expect_false(initOutput == changeOutput) 57 | } 58 | ) 59 | 60 | test_that("numericInput input character error", { 61 | webElem <- remDr$findElement("css selector", "#reqcontrols #obs") 62 | webElem$clearElement() 63 | webElem$sendKeysToElement(list('test')) 64 | outElem <- suppressWarnings(remDr$findElement("css selector", 65 | "#distPlot")) 66 | # if(is.na(outElem$elementId)){ 67 | # Sys.sleep(1) 68 | # outElem <- remDr$findElement("css selector", "#distPlot img") 69 | # } 70 | changeOutput <- outElem$getElementText()[[1]] 71 | expect_output(changeOutput, "invalid arguments") 72 | }) 73 | 74 | remDr$close() 75 | 76 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-output.r: -------------------------------------------------------------------------------- 1 | context("outputs") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | if(exists('rsel.opt', where = parent.env(environment()) , 6 | inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | on.exit(remDr$close()) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("output object alignment correct", { 20 | remDr$navigate(appURL) 21 | webElems <- remDr$findElements("css selector", "#ctrlSelect input") 22 | lapply(webElems, function(x){ 23 | if(!x$isElementSelected()[[1]]){ 24 | if(browser != "internet explorer"){ 25 | x$clickElement() 26 | }else{ 27 | x$sendKeysToElement(list(key='space')) 28 | } 29 | } 30 | }) 31 | remDr$maxWindowSize() 32 | # will be initiated if it is not loadedd yet. 33 | webElem <- remDr$findElement("css selector", "#reqplots #dttable") 34 | webElems <- remDr$findElements("css selector", "#reqplots .span5") 35 | out <- sapply(webElems, function(x){x$getElementLocation()}) 36 | out <- out[c('x', 'y'),] 37 | #print(out) 38 | expect_equal(as.integer(out['y', 1]) - as.integer(out['y', 2]), 0) 39 | expect_equal(as.integer(out['y', 3]) - as.integer(out['y', 4]), 0) 40 | expect_equal(as.integer(out['x', 1]) - as.integer(out['x', 3]), 0) 41 | expect_equal(as.integer(out['x', 2]) - as.integer(out['x', 4]), 0) 42 | } 43 | ) 44 | 45 | test_that("output labels are correct", { 46 | 47 | webElems <- remDr$findElements("css selector", "#reqplots h6") 48 | appLabels <- unlist(sapply(webElems, function(x){x$getElementText()})) 49 | checkLabels <- appLabels %in% c("selectInput Output", 50 | "numericInput Output", 51 | "dateRangeInput Output", 52 | "sliderInput Output") 53 | expect_true(all(checkLabels)) 54 | 55 | } 56 | ) 57 | 58 | test_that("output check images", { 59 | 60 | webElems <- remDr$findElements("css selector", 61 | "#distPlot img, #ggPlot img") 62 | appImages <- sapply(webElems, function(x){x$getElementAttribute("src")}) 63 | expect_true(all(grepl("image/png;base64",appImages))) 64 | } 65 | ) 66 | 67 | test_that("output check data-table", { 68 | 69 | webElems <- remDr$findElements("css selector", "#dttable .sorting") 70 | appHeaders <- sapply(webElems, function(x){x$getElementText()}) 71 | # check a random sorting 72 | appSort <- sample(seq_along(appHeaders)[c(1,4)], 1) 73 | webElems[[appSort]]$clickElement() 74 | # check ordering of column after 1st click 75 | appSource <- remDr$getPageSource()[[1]] 76 | appSource <- htmlParse(appSource) 77 | dttable <- readHTMLTable(appSource, stringsAsFactors = FALSE) 78 | appCol <- dttable$DataTables_Table_0[[appHeaders[[appSort]]]] 79 | ordering1 <- is.unsorted(appCol) 80 | 81 | webElems[[appSort]]$clickElement() 82 | # check ordering of column after 2nd click 83 | appSource <- remDr$getPageSource()[[1]] 84 | appSource <- htmlParse(appSource) 85 | dttable <- readHTMLTable(appSource, stringsAsFactors = FALSE) 86 | appCol <- dttable$DataTables_Table_0[[appHeaders[[appSort]]]] 87 | ordering2 <- is.unsorted(appCol) 88 | 89 | expect_false(ordering1 == ordering2) 90 | } 91 | ) 92 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-selectinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | 6 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | sysDetails <- remDr$getStatus() 14 | remDr$setImplicitWaitTimeout(3000) 15 | browser <- remDr$sessionInfo$browserName 16 | appURL <- "http://127.0.0.1:6012" 17 | 18 | test_that("selectInput dataSet correct", { 19 | remDr$navigate(appURL) 20 | webElem <- remDr$findElement("css selector", "#ctrlSelect1") 21 | initState <- webElem$isElementSelected()[[1]] 22 | if(!initState){ 23 | # select the checkbox 24 | if(browser == "internet explorer"){ 25 | webElem$sendKeysToElement(list(key = "space")) 26 | }else{ 27 | webElem$clickElement() 28 | } 29 | } 30 | 31 | webElem <- remDr$findElement("css selector", "#reqcontrols #dataset") 32 | # check the available datasets 33 | childElems <- webElem$findChildElements("css selector", "[value]") 34 | appDataSets <- sapply(childElems, 35 | function(x){x$getElementAttribute("value")}) 36 | expect_true(all(c("rock", "pressure", "cars") %in% appDataSets)) 37 | }) 38 | 39 | test_that("selectInput label correct", { 40 | webElem <- remDr$findElement("css selector", 41 | "#reqcontrols label[for = 'dataset']") 42 | expect_output(webElem$getElementText()[[1]], "Choose a dataset:") 43 | } 44 | ) 45 | 46 | test_that("selectInput selection invokes change", { 47 | webElem <- remDr$findElement("css selector", "#reqcontrols #dataset") 48 | childElems <- webElem$findChildElements("css selector", "[value]") 49 | ceState <- sapply(childElems, function(x){x$isElementSelected()}) 50 | newState <- sample(seq_along(ceState)[!unlist(ceState)], 1) 51 | 52 | outElem <- remDr$findElement("css selector", "#summary") 53 | initOutput <- outElem$getElementText()[[1]] 54 | 55 | # change dataset 56 | childElems[[newState]]$clickElement() 57 | outElem <- remDr$findElement("css selector", "#summary") 58 | changeOutput <- outElem$getElementText()[[1]] 59 | 60 | expect_false(initOutput == changeOutput) 61 | } 62 | ) 63 | 64 | remDr$close() 65 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/tests/test-sliderinput.r: -------------------------------------------------------------------------------- 1 | context("controls") 2 | 3 | library(RSelenium) 4 | library(testthat) 5 | if(exists('rsel.opt', where = parent.env(environment()) , 6 | inherits = FALSE)){ 7 | # print(rsel.opt) 8 | remDr <- do.call(remoteDriver, rsel.opt) 9 | }else{ 10 | remDr <- remoteDriver() 11 | } 12 | remDr$open(silent = TRUE) 13 | on.exit(remDr$close()) 14 | sysDetails <- remDr$getStatus() 15 | remDr$setImplicitWaitTimeout(3000) 16 | browser <- remDr$sessionInfo$browserName 17 | appURL <- "http://127.0.0.1:6012" 18 | 19 | test_that("sliderInput label correct", { 20 | remDr$navigate(appURL) 21 | webElem <- remDr$findElement("css selector", "#ctrlSelect4") 22 | initState <- webElem$isElementSelected()[[1]] 23 | if(!initState){ 24 | # select the checkbox 25 | if(browser == "internet explorer"){ 26 | webElem$sendKeysToElement(list(key = "space")) 27 | }else{ 28 | webElem$clickElement() 29 | } 30 | } 31 | webElem <- remDr$findElement("css selector", 32 | "#reqcontrols label[for = 'range']") 33 | expect_output(webElem$getElementText()[[1]], 34 | "Select range of diamond prices:") 35 | } 36 | ) 37 | 38 | test_that("sliderInput selection invokes change", { 39 | # get the slider element using siblings 40 | webElem <- remDr$findElement("css selector", "#reqcontrols #range") 41 | appMin <- as.numeric(webElem$getElementAttribute("data-from")) 42 | appMax <- as.numeric(webElem$getElementAttribute("data-to")) 43 | appValue <- webElem$getElementAttribute("value") 44 | appValue <- as.numeric(unlist(strsplit(appValue[[1]], ";"))) 45 | appStep <- as.numeric(webElem$getElementAttribute("data-step")) 46 | appRound <- as.logical(webElem$getElementAttribute("data-round")) 47 | outElem <- remDr$findElement("css selector", "#dttable") 48 | initOutput <- outElem$getElementText()[[1]] 49 | 50 | # get the slider dimensions 51 | webElem <- remDr$findElement("css selector", 52 | "#reqcontrols input#range + .jslider") 53 | sliderDim <- webElem$getElementSize() 54 | 55 | newValues <- seq(from = appMin, to = appMax, by = appStep) 56 | newValues <- sort(sample(newValues, 2)) 57 | # use siblings to get the pointers 58 | cSelect <- "#reqcontrols input#range + .jslider .jslider-pointer" 59 | webElems <- remDr$findElements("css selector", cSelect) 60 | pxToMoveSldr <- trunc(sliderDim$width * 61 | (newValues - appValue)/(appMax - appMin)) 62 | 63 | # move first slider 64 | moveOrder <- 1:2 65 | if(newValues[1] > appValue[2]){moveOrder <- rev(moveOrder)} 66 | for(x in moveOrder){ 67 | remDr$mouseMoveToLocation(webElement = webElems[[x]]) 68 | remDr$buttondown() 69 | remDr$mouseMoveToLocation(x = as.integer(pxToMoveSldr[x]), y = -1L) 70 | remDr$buttonup() 71 | } 72 | #webElem <- remDr$findElement("css selector", "#reqcontrols #range") 73 | #appValue <- webElem$getElementAttribute("value") 74 | 75 | # Shiny.onInputChange("range", [2000, 10000]) 76 | # Shiny.shinyapp.sendInput({range: [6222, 9333]}) 77 | Sys.sleep(1) 78 | outElem <- remDr$findElement("css selector", "#dttable") 79 | changeOutput <- outElem$getElementText()[[1]] 80 | 81 | expect_false(initOutput == changeOutput) 82 | 83 | } 84 | ) 85 | -------------------------------------------------------------------------------- /inst/apps/shinytestapp/ui.R: -------------------------------------------------------------------------------- 1 | shinyUI( 2 | navbarPage( 3 | "Shiny Test App", 4 | tabPanel("Plots", sidebarLayout( 5 | 6 | # Sidebar with a slider input 7 | sidebarPanel( 8 | checkboxGroupInput("ctrlSelect", "Select controls required:", 9 | setNames(1:4, c("selectInput", 10 | "numericInput", 11 | "dateRangeInput", 12 | "sliderInput"))) 13 | , uiOutput("reqcontrols") 14 | , width = 3 15 | ) 16 | , mainPanel( 17 | uiOutput("reqplots") 18 | , width = 9 19 | ) 20 | ) 21 | ), 22 | tabPanel("About", 23 | "A simple shiny app to illustrate testing as part of the 24 | RSelenium package.") 25 | ) 26 | 27 | ) 28 | -------------------------------------------------------------------------------- /inst/sauceTests/Readme.txt: -------------------------------------------------------------------------------- 1 | Port of the python tests in the Selenium project currently at /selenium/py/test/selenium/webdriver/commmon . The html files utilised are currently located at /selenium/common/src/web also in the selenium project. A environment variable SEL_TEST_DIR should be set on a local system to refer to the base directory containing the html files. This should be a fully qualified path. 2 | -------------------------------------------------------------------------------- /inst/sauceTests/cleanBuild.R: -------------------------------------------------------------------------------- 1 | # quick script to get non passing ids 2 | require(RSelenium) 3 | require(selectr) 4 | remDr <- remoteDriver() 5 | remDr$open() 6 | remDr$navigate("https://saucelabs.com/u/rselenium0") 7 | slSource <- htmlParse(remDr$getPageSource()[[1]]) 8 | slIds <- vapply(querySelectorAll(slSource, "#jobGrid .slick-row .r0 input") 9 | , xmlGetAttr, character(1), name = "data-id") 10 | slBuild <- vapply(querySelectorAll(slSource, "#jobGrid .slick-row .r4") 11 | , xmlValue, character(1)) 12 | slPass <- vapply(querySelectorAll(slSource, "#jobGrid .slick-row .r5") 13 | , xmlValue, character(1)) 14 | 15 | removeIds <- slIds[slBuild == "132" & slPass != "Pass"] 16 | user <- "rselenium0" 17 | pass <- "49953c74-5c46-4ff9-b584-cf31a4c71809" 18 | 19 | for(x in removeIds){ 20 | ip <- paste0(user, ':', pass, "@saucelabs.com/rest/v1/", user, "/jobs/", x) 21 | qdata <- toJSON(list(build = 0)) 22 | res <- getURLContent(ip, customrequest = "PUT", 23 | httpheader = "Content-Type:text/json", 24 | postfields = qdata, isHTTP = FALSE) 25 | } 26 | remDr$close() 27 | -------------------------------------------------------------------------------- /inst/sauceTests/runtest.R: -------------------------------------------------------------------------------- 1 | require(testthat) 2 | user <- "rselenium0" 3 | pass <- "49953c74-5c46-4ff9-b584-cf31a4c71809" 4 | port <- 80 5 | selVersion <- "2.42.0" 6 | ip <- paste0(user, ':', pass, "@ondemand.saucelabs.com") 7 | testDir <- system.file("tests", package = "RSelenium") 8 | osBrowser <- list( 9 | "OS X 10.9" = list(list(browser = "safari", version = '7') 10 | , list(browser = "firefox", version = '28') 11 | , list(browser = "chrome", version = '34') 12 | ), 13 | "Windows 8" = list(list(browser = "chrome", version = '34') 14 | , list(browser = "firefox", version = '29') 15 | , list(browser = "internet explorer", version = '10') 16 | ), 17 | "Windows 7" = list(list(browser = "chrome", version = '34') 18 | , list(browser = "firefox", version = '29') 19 | , list(browser = "internet explorer", version = '10') 20 | ), 21 | "Linux" = list(list(browser = "chrome", version = '34') 22 | , list(browser = "firefox", version = '28') 23 | , list(browser = "opera", version = '12') 24 | ) 25 | ) 26 | 27 | out <- lapply(names(osBrowser), function(x){ 28 | platform <- x 29 | lapply(osBrowser[[x]], platform = platform, FUN = function(y, platform){ 30 | rdBrowser <- y$browser 31 | version <- y$version 32 | testsel <- test_env() 33 | testsel[['sauceTest']] <- TRUE 34 | testsel[['rsel.opt']] <- 35 | list(remoteServerAddr = ip, port = port, browserName = rdBrowser, 36 | version = version, platform = platform, 37 | extraCapabilities = list(username = user, 38 | accessKey = pass, 39 | "selenium-version" = selVersion) 40 | ) 41 | testRes <- test_dir(testDir, reporter = "Tap", filter = "api-example", 42 | env = testsel) 43 | list(testsel[['rsel.opt']]$id, testRes) 44 | }) 45 | }) 46 | 47 | lapply(out, function(x){ 48 | lapply(x, function(y){ 49 | testId <- y[[1]] 50 | testRes <- y[[2]] 51 | if(!any(testRes$failed)){ 52 | # test passed rsel.opt should contain the jobid 53 | pv <- packageVersion("RSelenium") 54 | 55 | ip <- paste0(user, ':', pass, "@saucelabs.com/rest/v1/", user, 56 | "/jobs/", testId) 57 | qdata <- toJSON( 58 | list(passed = TRUE, 59 | "custom-data" = list( 60 | release = do.call(paste, list(pv, collapse = ".")), 61 | testresult = testRes) 62 | ) 63 | ) 64 | res <- getURLContent(ip, customrequest = "PUT", 65 | httpheader = "Content-Type:text/json", 66 | postfields = qdata, isHTTP = FALSE) 67 | 68 | } 69 | }) 70 | }) 71 | 72 | -------------------------------------------------------------------------------- /inst/sauceTests/setup.r: -------------------------------------------------------------------------------- 1 | # setup some base functions etc that all tests use 2 | library(RSelenium) 3 | library(testthat) 4 | 5 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 6 | remDr <- do.call(remoteDriver, rsel.opt) 7 | }else{ 8 | remDr <- remoteDriver() 9 | } 10 | remDr$open(silent = TRUE) 11 | sysDetails <- remDr$getStatus() 12 | remDr$setImplicitWaitTimeout(3000) 13 | rdBrowser <- remDr$sessionInfo$browserName 14 | 15 | htmlSrc <- Sys.getenv("SEL_TEST_DIR") 16 | loadPage <- function(pgStr){ 17 | paste0("file://", file.path(htmlSrc, paste0(pgStr, ".html"))) 18 | } 19 | 20 | if(exists('sauceTest', where = parent.env(environment()) , inherits = FALSE)){ 21 | if(sauceTest){ 22 | # assume running /selenium/common/src/web$ python -m SimpleHTTPServer 3000 23 | # this will serve the files from the selenium project on port 3000 24 | # myname.local maps to 127.0.0.1 in hosts hopefully to allow windows to 25 | # work on sauceConnect 26 | if(rdBrowser %in% c("iPhone", "iPad", "safari")){ 27 | htmlSrc <- "localhost:3000" 28 | }else{ 29 | htmlSrc <- "myname.local:3000" 30 | } 31 | loadPage <- function(pgStr){ 32 | paste0("http://", file.path(htmlSrc, paste0(pgStr, ".html"))) 33 | } 34 | rsel.opt$id <<- remDr$sessionInfo$id 35 | } 36 | } 37 | 38 | 39 | -------------------------------------------------------------------------------- /inst/sauceTests/test-alerts.r: -------------------------------------------------------------------------------- 1 | context("alerts") 2 | # add build details for sauceLabs 3 | if(exists('rsel.opt', where = parent.env(environment()) , inherits = FALSE)){ 4 | pv <- packageVersion("RSelenium") 5 | slFlags <- 6 | list(name = "RSelenium-test-suite", 7 | build = sum(unlist(pv)*10^(3-seq_along(unlist(pv)))), 8 | tags = list("alerts"), 9 | "custom-data" = 10 | list(release = do.call(paste, list(pv, collapse = "."))) 11 | ) 12 | rsel.opt$extraCapabilities <- c(rsel.opt$extraCapabilities, slFlags) 13 | } 14 | 15 | source(file.path(find.package("RSelenium"), "tests", 'setup.r'), 16 | local = TRUE) 17 | on.exit(remDr$close()) 18 | 19 | #1 20 | test_that("testShouldBeAbleToOverrideTheWindowAlertMethod", { 21 | remDr$navigate(loadPage("alerts")) 22 | remDr$executeScript( 23 | "window.alert = function(msg) { 24 | document.getElementById('text').innerHTML = msg; }") 25 | remDr$findElement(using = "id", value="alert")$clickElement() 26 | expect_identical(remDr$findElement(using = "id", "text")$ 27 | getElementText()[[1]], "cheese") 28 | 29 | # if fail we probably need to click an alert 30 | if(!identical( 31 | remDr$findElement(using = "id", "text")$getElementText()[[1]], 32 | "cheese") 33 | ){ 34 | remDr$dismissAlert() 35 | } 36 | } 37 | ) 38 | 39 | #2 40 | test_that("testShouldAllowUsersToAcceptAnAlertManually", { 41 | remDr$dismissAlert() 42 | remDr$navigate(loadPage("alerts")) 43 | remDr$findElement(using = "id", value="alert")$clickElement() 44 | remDr$acceptAlert() 45 | # If we can perform any action, we're good to go 46 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 47 | 48 | } 49 | ) 50 | 51 | #3 52 | test_that("testShouldAllowUsersToAcceptAnAlertWithNoTextManually", { 53 | remDr$dismissAlert() 54 | remDr$navigate(loadPage("alerts")) 55 | remDr$findElement(using = "id", value="empty-alert")$clickElement() 56 | remDr$acceptAlert() 57 | # If we can perform any action, we're good to go 58 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 59 | 60 | } 61 | ) 62 | 63 | #4 64 | # test_that("testShouldGetTextOfAlertOpenedInSetTimeout", { 65 | # remDr$dismissAlert() 66 | # remDr$navigate(loadPage("alerts")) 67 | # remDr$findElement(using = "id", value="slow-alert")$clickElement() 68 | # # DO NOT WAIT OR SLEEP HERE 69 | # # This is a regression test for a bug where only the first switchTo 70 | # # call would throw, 71 | # # and only if it happens before the alert actually loads. 72 | # expect_identical("Slow", remDr$getAlertText()[[1]]) 73 | # remDr$acceptAlert() 74 | # 75 | # } 76 | # ) 77 | 78 | #5 79 | if(browser != "chrome"){ 80 | test_that("testShouldAllowUsersToDismissAnAlertManually", { 81 | remDr$dismissAlert() 82 | remDr$navigate(loadPage("alerts")) 83 | remDr$findElement(using = "id", value="alert")$clickElement() 84 | remDr$dismissAlert() 85 | # If we can perform any action, we're good to go 86 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 87 | 88 | } 89 | ) 90 | } 91 | #6 92 | test_that("testShouldAllowAUserToAcceptAPrompt", { 93 | remDr$dismissAlert() 94 | remDr$navigate(loadPage("alerts")) 95 | remDr$findElement(using = "id", value="prompt")$clickElement() 96 | remDr$acceptAlert() 97 | # If we can perform any action, we're good to go 98 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 99 | 100 | } 101 | ) 102 | 103 | #7 104 | test_that("testShouldAllowAUserToDismissAPrompt", { 105 | remDr$dismissAlert() 106 | remDr$navigate(loadPage("alerts")) 107 | remDr$findElement(using = "id", value="prompt")$clickElement() 108 | remDr$dismissAlert() 109 | # If we can perform any action, we're good to go 110 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 111 | 112 | } 113 | ) 114 | 115 | #8 116 | test_that("testShouldAllowAUserToSetTheValueOfAPrompt", { 117 | remDr$dismissAlert() 118 | remDr$navigate(loadPage("alerts")) 119 | remDr$findElement(using = "id", value="prompt")$clickElement() 120 | remDr$sendKeysToAlert("cheese") 121 | remDr$acceptAlert() 122 | Sys.sleep(0.5) 123 | promptText <- remDr$findElement(using = 'id', value = "text")$ 124 | getElementText()[[1]] 125 | expect_identical("cheese", promptText) 126 | } 127 | ) 128 | 129 | #9 130 | test_that("testSettingTheValueOfAnAlertThrows", { 131 | remDr$dismissAlert() 132 | remDr$navigate(loadPage("alerts")) 133 | remDr$findElement(using = "id", value="alert")$clickElement() 134 | remDr$sendKeysToAlert("cheese") 135 | # we expect an error here so status greater then 1 136 | expect_less_than(1, remDr$status) 137 | remDr$acceptAlert() 138 | } 139 | ) 140 | 141 | #10 142 | test_that("testAlertShouldNotAllowAdditionalCommandsIfDimissed", { 143 | remDr$dismissAlert() 144 | remDr$navigate(loadPage("alerts")) 145 | remDr$findElement(using = "id", value="alert")$clickElement() 146 | remDr$dismissAlert() 147 | Sys.sleep(1) 148 | # alertText <- remDr$getAlertText() 149 | remDr$getAlertText() 150 | # should fail and have status 27 151 | print(remDr$status) 152 | expect_equal(27, remDr$status) 153 | } 154 | ) 155 | 156 | #11 157 | test_that("testShouldAllowUsersToAcceptAnAlertInAFrame", { 158 | remDr$dismissAlert() 159 | remDr$navigate(loadPage("alerts")) 160 | remDr$switchToFrame("iframeWithAlert") 161 | remDr$findElement(using = "id", value= "alertInFrame")$clickElement() 162 | remDr$acceptAlert() 163 | # If we can perform any action, we're good to go 164 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 165 | } 166 | ) 167 | 168 | #12 169 | test_that("testShouldAllowUsersToAcceptAnAlertInANestedFrame", { 170 | remDr$dismissAlert() 171 | remDr$navigate(loadPage("alerts")) 172 | remDr$switchToFrame("iframeWithIframe") 173 | remDr$switchToFrame("iframeWithAlert") 174 | remDr$findElement(using = "id", value= "alertInFrame")$clickElement() 175 | remDr$acceptAlert() 176 | # If we can perform any action, we're good to go 177 | expect_identical("Testing Alerts", remDr$getTitle()[[1]]) 178 | 179 | } 180 | ) 181 | 182 | #13 183 | test_that("testPromptShouldUseDefaultValueIfNoKeysSent", { 184 | remDr$dismissAlert() 185 | remDr$navigate(loadPage("alerts")) 186 | remDr$findElement(using = "id", value = "prompt-with-default")$ 187 | clickElement() 188 | remDr$acceptAlert() 189 | promptText <- remDr$findElement(using = "id", value = "text")$ 190 | getElementText()[[1]] 191 | expect_identical("This is a default value", promptText) 192 | } 193 | ) 194 | 195 | #14 196 | test_that("testPromptShouldHaveNullValueIfDismissed", { 197 | remDr$dismissAlert() 198 | remDr$navigate(loadPage("alerts")) 199 | remDr$findElement(using = "id", value = "prompt-with-default")$ 200 | clickElement() 201 | remDr$dismissAlert() 202 | promptText <- remDr$findElement(using = "id", value = "text")$ 203 | getElementText()[[1]] 204 | expect_identical("null", promptText) 205 | 206 | } 207 | ) 208 | 209 | #15-16 210 | test_that("testHandlesTwoAlertsFromOneInteraction", { 211 | remDr$dismissAlert() 212 | remDr$navigate(loadPage("alerts")) 213 | remDr$findElement(using = "id", value = "double-prompt")$clickElement() 214 | remDr$sendKeysToAlert("brie") 215 | remDr$acceptAlert() 216 | remDr$sendKeysToAlert("cheddar") 217 | remDr$acceptAlert() 218 | promptText1 <- remDr$findElement(using = "id", value = "text1")$ 219 | getElementText()[[1]] 220 | promptText2 <- remDr$findElement(using = "id", value = "text2")$ 221 | getElementText()[[1]] 222 | expect_identical("brie", promptText1) 223 | expect_identical("cheddar", promptText2) 224 | } 225 | ) 226 | 227 | #17 228 | test_that("testShouldAllowTheUserToGetTheTextOfAnAlert", { 229 | remDr$dismissAlert() 230 | remDr$navigate(loadPage("alerts")) 231 | remDr$findElement(using = "id", value = "alert")$clickElement() 232 | Sys.sleep(1) 233 | # alertText <- remDr$getAlertText()[[1]] 234 | print(remDr$getAlertText()[[1]]) 235 | expect_identical("cheese", remDr$getAlertText()[[1]]) 236 | remDr$acceptAlert() 237 | } 238 | ) 239 | 240 | 241 | -------------------------------------------------------------------------------- /inst/sauceTests/test-api-example.r: -------------------------------------------------------------------------------- 1 | context("api-example") 2 | # add build details for sauceLabs 3 | if(exists('rsel.opt', where = parent.env(environment()) , 4 | inherits = FALSE)){ 5 | pv <- packageVersion("RSelenium") 6 | slFlags <- 7 | list(name = "RSelenium-test-suite", 8 | build = sum(unlist(pv)*10^(3-seq_along(unlist(pv)))), 9 | tags = list("api-example"), 10 | "custom-data" = list(release = 11 | do.call(paste, list(pv, collapse = "."))) 12 | ) 13 | rsel.opt$extraCapabilities <- c(rsel.opt$extraCapabilities, slFlags) 14 | } 15 | 16 | source(file.path(find.package("RSelenium"), "tests", 'setup.r'), 17 | local = TRUE) 18 | on.exit(remDr$close()) 19 | 20 | #1 21 | test_that("GetTitle", { 22 | remDr$navigate(loadPage("simpleTest")) 23 | title <- remDr$getTitle() 24 | expect_equal("Hello WebDriver", title[[1]]) 25 | } 26 | ) 27 | 28 | #2 29 | test_that("GetCurrentUrl", { 30 | remDr$navigate(loadPage("simpleTest")) 31 | url <- remDr$getCurrentUrl() 32 | expect_equal(loadPage("simpleTest"), url[[1]]) 33 | } 34 | ) 35 | 36 | #3 37 | test_that("FindElementsByXPath", { 38 | remDr$navigate(loadPage("simpleTest")) 39 | elem <- remDr$findElement(using = "xpath", "//h1") 40 | expect_equal("Heading", elem$getElementText()[[1]]) 41 | } 42 | ) 43 | 44 | #4 45 | test_that("FindElementByXpathThrowNoSuchElementException", { 46 | remDr$navigate(loadPage("simpleTest")) 47 | expect_error(remDr$findElement(using = "xpath", "//h4")) 48 | expect_equal(7, remDr$status) 49 | 50 | } 51 | ) 52 | 53 | #5-6 54 | test_that("FindElementsByXpath", { 55 | remDr$navigate(loadPage("nestedElements")) 56 | elems <- remDr$findElements(using = "xpath", "//option") 57 | expect_equal(48, length(elems)) 58 | expect_equal("One", elems[[1]]$getElementAttribute("value")[[1]]) 59 | } 60 | ) 61 | 62 | #7 63 | test_that("FindElementsByName", { 64 | remDr$navigate(loadPage("xhtmlTest")) 65 | elem <- remDr$findElement(using = "name", "windowOne") 66 | expect_equal("Open new window", elem$getElementText()[[1]]) 67 | } 68 | ) 69 | 70 | #8 71 | test_that("FindElementsByNameInElementContext", { 72 | remDr$navigate(loadPage("nestedElements")) 73 | elem <- remDr$findElement(using = "name", "form2") 74 | subElem <- elem$findChildElement(using = "name", "selectomatic") 75 | expect_equal("2", subElem$getElementAttribute("id")[[1]]) 76 | } 77 | ) 78 | 79 | #9 80 | test_that("FindElementsByLinkTextInElementContext", { 81 | remDr$navigate(loadPage("nestedElements")) 82 | elem <- remDr$findElement(using = "name", "div1") 83 | subElem <- elem$findChildElement(using = "link text", "hello world") 84 | expect_equal("link1", subElem$getElementAttribute("name")[[1]]) 85 | } 86 | ) 87 | 88 | #10 89 | test_that("FindElementByIdInElementContext", { 90 | remDr$navigate(loadPage("nestedElements")) 91 | elem <- remDr$findElement(using = "name", "form2") 92 | subElem <- elem$findChildElement(using = "id", "2") 93 | expect_equal("selectomatic", subElem$getElementAttribute("name")[[1]]) 94 | } 95 | ) 96 | 97 | #11 98 | test_that("FindElementByXpathInElementContext", { 99 | remDr$navigate(loadPage("nestedElements")) 100 | elem <- remDr$findElement(using = "name", "form2") 101 | subElem <- elem$findChildElement(using = "xpath", "select") 102 | expect_equal("2", subElem$getElementAttribute("id")[[1]]) 103 | } 104 | ) 105 | 106 | #12 107 | test_that("FindElementByXpathInElementContextNotFound", { 108 | remDr$navigate(loadPage("nestedElements")) 109 | elem <- remDr$findElement(using = "name", "form2") 110 | expect_error(elem$findChildElement(using = "xpath", "div")) 111 | expect_equal(7, elem$status) 112 | } 113 | ) 114 | 115 | #13 116 | test_that("ShouldBeAbleToEnterDataIntoFormFields", { 117 | remDr$navigate(loadPage("xhtmlTest")) 118 | elem <- 119 | remDr$findElement(using = "xpath", 120 | "//form[@name='someForm']/input[@id='username']") 121 | elem$clearElement() 122 | elem$sendKeysToElement(list("some text")) 123 | elem <- 124 | remDr$findElement(using = "xpath", 125 | "//form[@name='someForm']/input[@id='username']") 126 | expect_equal("some text", elem$getElementAttribute("value")[[1]]) 127 | } 128 | ) 129 | 130 | #14-15 131 | test_that("FindElementByTagName", { 132 | remDr$navigate(loadPage("simpleTest")) 133 | elems <- remDr$findElements(using = "tag name", "div") 134 | num_by_xpath <- length(remDr$findElements(using = "xpath", "//div")) 135 | expect_equal(num_by_xpath, length(elems)) 136 | elems <- remDr$findElements(using = "tag name", "iframe") 137 | expect_equal(0, length(elems)) 138 | } 139 | ) 140 | 141 | #16 142 | test_that("FindElementByTagNameWithinElement", { 143 | remDr$navigate(loadPage("simpleTest")) 144 | div <- remDr$findElement(using = "id", "multiline") 145 | elems <- div$findChildElements(using = "tag name", "p") 146 | expect_true(length(elems) == 1) 147 | } 148 | ) 149 | 150 | #17-18 151 | test_that("SwitchToWindow", { 152 | #if(rdBrowser == 'safari'){ 153 | # see https://code.google.com/p/selenium/issues/detail?id=3693 154 | return() 155 | #} 156 | title_1 <- "XHTML Test Page" 157 | title_2 <- "We Arrive Here" 158 | 159 | remDr$navigate(loadPage("xhtmlTest")) 160 | remDr$findElement(using = "link text", "Open new window")$clickElement() 161 | expect_equal(title_1, remDr$getTitle()[[1]]) 162 | Sys.sleep(5) 163 | remDr$switchToWindow("result") 164 | # wait.until(lambda dr: dr.switch_to_window("result") is None) 165 | expect_equal(title_2, remDr$getTitle()[[1]]) 166 | } 167 | ) 168 | 169 | #### 170 | test_that("SwitchFrameByName", { 171 | remDr$navigate(loadPage("frameset")) 172 | remDr$switchToFrame("third") 173 | checkbox <- remDr$findElement(using = "id", "checky") 174 | checkbox$clickElement() 175 | checkbox$submitElement() 176 | } 177 | ) 178 | 179 | #19-20 180 | test_that("IsEnabled", { 181 | remDr$navigate(loadPage("formPage")) 182 | elem <- remDr$findElement(using = "xpath", "//input[@id='working']") 183 | expect_true(elem$isElementEnabled()[[1]]) 184 | elem <- remDr$findElement(using = "xpath", "//input[@id='notWorking']") 185 | expect_false(elem$isElementEnabled()[[1]]) 186 | } 187 | ) 188 | 189 | #21-24 190 | test_that("IsSelectedAndToggle", { 191 | if(rdBrowser == 'chrome' && 192 | as.integer(sub("(.*?)\\..*", "\\1", remDr$sessionInfo$version)) < 16){ 193 | return("deselecting preselected values only works on chrome >= 16") 194 | } 195 | return() 196 | remDr$navigate(loadPage("formPage")) 197 | elem <- remDr$findElement(using = "id", "multi") 198 | option_elems <- elem$findChildElements(using = "xpath", "option") 199 | expect_true(option_elems[[1]]$isElementSelected()[[1]]) 200 | option_elems[[1]]$clickElement() 201 | expect_false(option_elems[[1]]$isElementSelected()[[1]]) 202 | option_elems[[1]]$clickElement() 203 | expect_true(option_elems[[1]]$isElementSelected()[[1]]) 204 | expect_true(option_elems[[3]]$isElementSelected()[[1]]) 205 | } 206 | ) 207 | 208 | #25-27 209 | test_that("Navigate", { 210 | # if(rdBrowser == 'safari'){ 211 | #return() 212 | # } 213 | 214 | remDr$navigate(loadPage("formPage")) 215 | remDr$findElement(using = "id", "imageButton")$submitElement() 216 | expect_equal("We Arrive Here", remDr$getTitle()[[1]]) 217 | remDr$goBack() 218 | expect_equal("We Leave From Here", remDr$getTitle()[[1]]) 219 | remDr$goForward() 220 | expect_equal("We Arrive Here", remDr$getTitle()[[1]]) 221 | } 222 | ) 223 | 224 | #28 225 | test_that("GetAttribute", { 226 | page <- "xhtmlTest" 227 | remDr$navigate(loadPage(page)) 228 | elem <- remDr$findElement(using = "id", "id1") 229 | attr <- elem$getElementAttribute("href")[[1]] 230 | expect_equal(paste0(loadPage(page), "#"), attr) 231 | } 232 | ) 233 | 234 | #29-33 235 | test_that("GetImplicitAttribute", { 236 | remDr$navigate(loadPage("nestedElements")) 237 | elems <- remDr$findElements(using = "xpath", "//option") 238 | expect_true(length(elems) >= 3) 239 | for(x in seq(4)){ 240 | expect_equal(x-1, as.integer(elems[[x]]$ 241 | getElementAttribute("index")[[1]])) 242 | } 243 | } 244 | ) 245 | 246 | #34 247 | test_that("ExecuteSimpleScript", { 248 | remDr$navigate(loadPage("xhtmlTest")) 249 | title <- remDr$executeScript("return document.title;")[[1]] 250 | expect_equal("XHTML Test Page", title) 251 | } 252 | ) 253 | 254 | #35 255 | test_that("ExecuteScriptAndReturnElement", { 256 | remDr$navigate(loadPage("xhtmlTest")) 257 | elem <- remDr$executeScript("return document.getElementById('id1');") 258 | expect_true("webElement" == class(elem[[1]])) 259 | } 260 | ) 261 | 262 | #36 263 | test_that("ExecuteScriptWithArgs", { 264 | remDr$navigate(loadPage("xhtmlTest")) 265 | jS <- "return arguments[0] == 'fish' ? 'fish' : 'not fish';" 266 | result <- remDr$executeScript(jS, list("fish")) 267 | expect_equal("fish", result[[1]]) 268 | } 269 | ) 270 | 271 | #37 272 | test_that("ExecuteScriptWithMultipleArgs", { 273 | remDr$navigate(loadPage("xhtmlTest")) 274 | result <- remDr$executeScript( 275 | "return arguments[0] + arguments[1]", list(1, 2)) 276 | expect_equal(3, result[[1]]) 277 | } 278 | ) 279 | 280 | #38 281 | test_that("ExecuteScriptWithElementArgs", { 282 | remDr$navigate(loadPage("javascriptPage")) 283 | button <- remDr$findElement(using = "id", "plainButton") 284 | jS <- "arguments[0]['flibble'] = arguments[0].getAttribute('id'); 285 | return arguments[0]['flibble'];" 286 | result <- remDr$executeScript(jS, list(button)) 287 | expect_equal("plainButton", result[[1]]) 288 | } 289 | ) 290 | 291 | #39 292 | test_that("FindElementsByPartialLinkText", { 293 | remDr$navigate(loadPage("xhtmlTest")) 294 | elem <- remDr$findElement(using = "partial link text", "new window") 295 | expect_equal("Open new window", elem$getElementText()[[1]]) 296 | } 297 | ) 298 | 299 | #40-41 300 | test_that("IsElementDisplayed", { 301 | remDr$navigate(loadPage("javascriptPage")) 302 | visible <- remDr$findElement(using = "id", "displayed")$ 303 | isElementDisplayed() 304 | not_visible <- remDr$findElement(using = "id", "hidden")$ 305 | isElementDisplayed() 306 | expect_true(visible[[1]], "Should be visible") 307 | expect_false(not_visible[[1]], "Should not be visible") 308 | } 309 | ) 310 | 311 | #42-43 312 | test_that("MoveWindowPosition", { 313 | if(rdBrowser == 'android' || rdBrowser == "safari"){ 314 | print("Not applicable") 315 | return() 316 | } 317 | return() 318 | remDr$navigate(loadPage("blank")) 319 | loc <- remDr$getWindowPosition() 320 | # note can't test 0,0 since some OS's dont allow that location 321 | # because of system toolbars 322 | new_x <- 50 323 | new_y <- 50 324 | if(loc[['x']] == new_x){ 325 | new_x <- new_x + 10 326 | } 327 | if(loc['y'] == new_y){ 328 | new_y <- new_y + 10 329 | } 330 | remDr$setWindowPosition(new_x, new_y) 331 | loc <- remDr$getWindowPosition() 332 | # change test to be within 10 pixels 333 | expect_less_than(abs(loc[['x']] - new_x), 10) 334 | expect_less_than(abs(loc[['y']] - new_y), 10) 335 | } 336 | ) 337 | 338 | #44-45 339 | test_that("ChangeWindowSize", { 340 | if(rdBrowser == 'android'){ 341 | print("Not applicable") 342 | return() 343 | } 344 | return() 345 | remDr$navigate(loadPage("blank")) 346 | size <- remDr$getWindowSize() 347 | newSize <- rep(600, 2) 348 | if( size[['width']] == 600){ 349 | newSize[1] <- 500 350 | } 351 | if( size[['height']] == 600){ 352 | newSize[2] <- 500 353 | } 354 | remDr$setWindowSize(newSize[1], newSize[2]) 355 | size <- remDr$getWindowSize() 356 | # change test to be within 10 pixels 357 | expect_less_than(abs(size[['width']] - newSize[1]), 10) 358 | expect_less_than(abs(size[['height']] - newSize[2]), 10) 359 | } 360 | ) 361 | -------------------------------------------------------------------------------- /man/RSelenium-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RSelenium.R 3 | \name{RSelenium-package} 4 | \alias{RSelenium-package} 5 | \alias{RSelenium} 6 | \title{An R client for Selenium Remote Webdriver} 7 | \description{ 8 | These are R bindings for the WebDriver API in Selenium 2. 9 | They use the JsonWireProtocol defined at 10 | https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol 11 | to communicate with a Selenium RemoteWebDriver Server. 12 | } 13 | \references{ 14 | http://seleniumhq.org/projects/webdriver/ 15 | } 16 | \author{ 17 | John Harrison 18 | } 19 | -------------------------------------------------------------------------------- /man/errorHandler-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/errorHandler.R 3 | \docType{class} 4 | \name{errorHandler-class} 5 | \alias{errorHandler-class} 6 | \alias{errorHandler} 7 | \title{CLASS errorHandler} 8 | \description{ 9 | class to handle errors 10 | } 11 | \details{ 12 | This class is an internal class used by remoteDriver and webElement. It 13 | describes how drivers may respond. With a wide range of browsers etc 14 | the response can be variable. 15 | } 16 | \section{Fields}{ 17 | 18 | \describe{ 19 | \item{\code{statusCodes}}{A list with status codes and their descriptions.} 20 | 21 | \item{\code{status}}{A status code summarizing the result of the command. A 22 | non-zero value indicates that the command failed. A value of one is 23 | not a failure but may indicate a problem.} 24 | 25 | \item{\code{statusclass}}{Class associated with the java library underlying 26 | the server. For Example: org.openqa.selenium.remote.Response} 27 | 28 | \item{\code{sessionid}}{An opaque handle used by the server to determine where 29 | to route session-specific commands. This ID should be included in 30 | all future session-commands in place of the :sessionId path segment 31 | variable.} 32 | 33 | \item{\code{hcode}}{A list} 34 | 35 | \item{\code{value}}{A list containing detailed information regarding possible 36 | errors: 37 | \describe{ 38 | \item{\code{message}:}{A descriptive message for the command 39 | failure.} 40 | \item{\code{screen}:}{string (Optional) If included, a 41 | screenshot of the current page as a base64 encoded string.} 42 | \item{\code{class}:}{string (Optional) If included, specifies 43 | the fully qualified class name for the exception that was thrown 44 | when the command failed.} 45 | \item{\code{stackTrace}:}{array (Optional) If included, 46 | specifies an array of JSON objects describing the stack trace 47 | for the exception that was thrown when the command failed. The 48 | zeroth element of the array represents the top of the stack.} 49 | }} 50 | 51 | \item{\code{responseheader}}{There are two levels of error handling specified 52 | by the wire protocol: invalid requests and failed commands. 53 | Invalid Requests will probably be indicted by a status of 1. 54 | 55 | All invalid requests should result in the server returning a 4xx HTTP 56 | response. The response Content-Type should be set to text/plain and 57 | the message body should be a descriptive error message. The 58 | categories of invalid requests are as follows: 59 | \describe{ 60 | \item{\code{Unknown Commands}:}{ 61 | If the server receives a command request whose path is not mapped 62 | to a resource in the REST service, it should respond with a 404 63 | Not Found message. 64 | } 65 | \item{\code{Unimplemented Commands}:}{ 66 | Every server implementing the WebDriver wire protocol must 67 | respond to every defined command. If an individual command has 68 | not been implemented on the server, the server should respond 69 | with a 501 Not Implemented error message. Note this is the only 70 | error in the Invalid Request category that does not return a 4xx 71 | status code. 72 | } 73 | \item{\code{Variable Resource Not Found}:}{ 74 | If a request path maps to a variable resource, but that resource 75 | does not exist, then the server should respond with a 404 Not 76 | Found. For example, if ID my-session is not a valid session ID 77 | on the server, and a command is sent to GET /session/my-session 78 | HTTP/1.1, then the server should gracefully return a 404. 79 | } 80 | \item{\code{Invalid Command Method}:}{ 81 | If a request path maps to a valid resource, but that resource 82 | does not respond to the request method, the server should 83 | respond with a 405 Method Not Allowed. The response must include 84 | an Allows header with a list of the allowed methods for the 85 | requested resource. 86 | } 87 | \item{\code{Missing Command Parameters}:}{ 88 | If a POST/PUT command maps to a resource that expects a set of 89 | JSON parameters, and the response body does not include one of 90 | those parameters, the server should respond with a 400 Bad 91 | Request. The response body should list the missing parameters. 92 | } 93 | }} 94 | 95 | \item{\code{debugheader}}{Not currently implemented} 96 | }} 97 | 98 | \section{Methods}{ 99 | 100 | \describe{ 101 | \item{\code{checkStatus(resContent)}}{An internal method to check the status returned by the server. If 102 | status indicates an error an appropriate error message is thrown.} 103 | 104 | \item{\code{errorDetails(type = "value")}}{Return error details. Type can one of c("value", "class", 105 | "status")} 106 | 107 | \item{\code{obscureUrlPassword(url)}}{Replaces the username and password of url with ****} 108 | 109 | \item{\code{queryRD(ipAddr, method = "GET", qdata = NULL)}}{A method to communicate with the remote server implementing the 110 | JSON wire protocol.} 111 | }} 112 | 113 | -------------------------------------------------------------------------------- /man/getChromeProfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/util.R 3 | \name{getChromeProfile} 4 | \alias{getChromeProfile} 5 | \title{Get Chrome profile.} 6 | \usage{ 7 | getChromeProfile(dataDir, profileDir) 8 | } 9 | \arguments{ 10 | \item{dataDir}{Specifies the user data directory, which is where the 11 | browser will look for all of its state.} 12 | 13 | \item{profileDir}{Selects directory of profile to associate with the 14 | first browser launched.} 15 | } 16 | \description{ 17 | \code{getChromeProfile} 18 | A utility function to get a Chrome profile. 19 | } 20 | \section{Detail}{ 21 | A chrome profile directory is passed as an extraCapability. 22 | The data dir has a number of default locations 23 | \describe{ 24 | \item{Windows XP}{ 25 | Google Chrome: C:/Documents and Settings/\%USERNAME\%/Local Settings/Application Data/Google/Chrome/User Data 26 | } 27 | \item{Windows 8 or 7 or Vista}{ 28 | Google Chrome: C:/Users/\%USERNAME\%/AppData/Local/Google/Chrome/User Data 29 | } 30 | \item{Mac OS X}{ 31 | Google Chrome: ~/Library/Application Support/Google/Chrome 32 | } 33 | \item{Linux}{ 34 | Google Chrome: ~/.config/google-chrome 35 | } 36 | } 37 | The profile directory is contained in the user directory and by default 38 | is named "Default" 39 | } 40 | 41 | \examples{ 42 | \dontrun{ 43 | # example from windows using a profile directory "Profile 1" 44 | cprof <- getChromeProfile( 45 | "C:\\\\Users\\\\john\\\\AppData\\\\Local\\\\Google\\\\Chrome\\\\User Data", 46 | "Profile 1" 47 | ) 48 | remDr <- remoteDriver(browserName = "chrome", extraCapabilities = cprof) 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /man/getFirefoxProfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/util.R 3 | \name{getFirefoxProfile} 4 | \alias{getFirefoxProfile} 5 | \title{Get Firefox profile.} 6 | \usage{ 7 | getFirefoxProfile(profDir, useBase = TRUE) 8 | } 9 | \arguments{ 10 | \item{profDir}{The directory in which the firefox profile resides} 11 | 12 | \item{useBase}{Logical indicating whether to attempt to use zip from 13 | utils package. Maybe easier for Windows users.} 14 | } 15 | \description{ 16 | \code{getFirefoxProfile} 17 | A utility function to get a firefox profile. 18 | } 19 | \section{Detail}{ 20 | A firefox profile directory is zipped and base64 21 | encoded. It can then be passed to the selenium server as a required 22 | capability with key firefox_profile 23 | } 24 | 25 | \examples{ 26 | \dontrun{ 27 | fprof <- getFirefoxProfile("~/.mozilla/firefox/9qlj1ofd.testprofile") 28 | remDr <- remoteDriver(extraCapabilities = fprof) 29 | remDr$open() 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /man/makeFirefoxProfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/util.R 3 | \name{makeFirefoxProfile} 4 | \alias{makeFirefoxProfile} 5 | \title{Make Firefox profile.} 6 | \usage{ 7 | makeFirefoxProfile(opts) 8 | } 9 | \arguments{ 10 | \item{opts}{option list of firefox} 11 | } 12 | \description{ 13 | \code{makeFirefoxProfile} 14 | A utility function to make a firefox profile. 15 | } 16 | \note{ 17 | Windows doesn't come with command-line zip capability. 18 | Installing rtools 19 | \url{https://CRAN.R-project.org/bin/windows/Rtools/index.html} is a 20 | straightforward way to gain this capability. 21 | } 22 | \section{Detail}{ 23 | A firefox profile directory is zipped and base64 24 | encoded. It can then be passed 25 | to the selenium server as a required capability with key 26 | firefox_profile 27 | } 28 | 29 | \examples{ 30 | \dontrun{ 31 | fprof <- makeFirefoxProfile(list(browser.download.dir = "D:/temp")) 32 | remDr <- remoteDriver(extraCapabilities = fprof) 33 | remDr$open() 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /man/rsDriver.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsDriver.R 3 | \name{rsDriver} 4 | \alias{rsDriver} 5 | \title{Start a selenium server and browser} 6 | \usage{ 7 | rsDriver( 8 | port = 4567L, 9 | browser = c("chrome", "firefox", "phantomjs", "internet explorer"), 10 | version = "latest", 11 | chromever = "latest", 12 | geckover = "latest", 13 | iedrver = NULL, 14 | phantomver = "2.1.1", 15 | verbose = TRUE, 16 | check = TRUE, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{port}{Port to run on} 22 | 23 | \item{browser}{Which browser to start} 24 | 25 | \item{version}{what version of Selenium Server to run. Default = "latest" 26 | which runs the most recent version. To see other version currently 27 | sourced run binman::list_versions("seleniumserver")} 28 | 29 | \item{chromever}{what version of Chrome driver to run. Default = "latest" 30 | which runs the most recent version. To see other version currently 31 | sourced run binman::list_versions("chromedriver"), A value of NULL 32 | excludes adding the chrome browser to Selenium Server.} 33 | 34 | \item{geckover}{what version of Gecko driver to run. Default = "latest" 35 | which runs the most recent version. To see other version currently 36 | sourced run binman::list_versions("geckodriver"), A value of NULL 37 | excludes adding the firefox browser to Selenium Server.} 38 | 39 | \item{iedrver}{what version of IEDriverServer to run. Default = "latest" 40 | which runs the most recent version. To see other version currently 41 | sourced run binman::list_versions("iedriverserver"), A value of NULL 42 | excludes adding the internet explorer browser to Selenium Server. 43 | NOTE this functionality is Windows OS only.} 44 | 45 | \item{phantomver}{what version of PhantomJS to run. Default = "2.1.1" 46 | which runs the most recent stable version. To see other version currently 47 | sourced run binman::list_versions("phantomjs"), A value of NULL 48 | excludes adding the PhantomJS headless browser to Selenium Server.} 49 | 50 | \item{verbose}{If TRUE, include status messages (if any)} 51 | 52 | \item{check}{If TRUE check the versions of selenium available and the 53 | versions of associated drivers (chromever, geckover, phantomver, 54 | iedrver). If new versions are available they will be downloaded.} 55 | 56 | \item{...}{Additional arguments to pass to \code{\link{remoteDriver}}} 57 | } 58 | \value{ 59 | A list containing a server and a client. The server is the object 60 | returned by \code{\link[wdman]{selenium}} and the client is an object of class 61 | \code{\link{remoteDriver}} 62 | } 63 | \description{ 64 | Start a selenium server and browser 65 | } 66 | \details{ 67 | This function is a wrapper around \code{\link[wdman]{selenium}}. 68 | It provides a "shim" for the current issue running firefox on 69 | Windows. For a more detailed set of functions for running binaries 70 | relating to the Selenium/webdriver project see the 71 | \code{\link[wdman]{wdman}} package. Both the client and server 72 | are closed using a registered finalizer. 73 | } 74 | \examples{ 75 | \dontrun{ 76 | # start a chrome browser 77 | rD <- rsDriver() 78 | remDr <- rD[["client"]] 79 | remDr$navigate("http://www.google.com/ncr") 80 | remDr$navigate("http://www.bbc.com") 81 | remDr$close() 82 | # stop the selenium server 83 | rD[["server"]]$stop() 84 | 85 | # if user forgets to stop server it will be garbage collected. 86 | rD <- rsDriver() 87 | rm(rD) 88 | gc(rD) 89 | } 90 | } 91 | -------------------------------------------------------------------------------- /man/selKeys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/selKeys-data.R 3 | \docType{data} 4 | \name{selKeys} 5 | \alias{selKeys} 6 | \title{Selenium key mappings} 7 | \format{ 8 | A named list. The names are the descriptions of the keys. The 9 | values are the "UTF-8" character representations. 10 | } 11 | \source{ 12 | https://www.selenium.dev/documentation/legacy/json_wire_protocol/#sessionsessionidelementidvalue 13 | } 14 | \usage{ 15 | selKeys 16 | } 17 | \description{ 18 | This data set contains a list of selenium key mappings. 19 | selKeys is used when a sendKeys variable is needed. 20 | sendKeys is defined as a list. 21 | If an entry is needed from selKeys it is denoted by key. 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /man/webElement-class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/webElement.R 3 | \docType{class} 4 | \name{webElement-class} 5 | \alias{webElement-class} 6 | \alias{webElement} 7 | \title{CLASS webElement} 8 | \description{ 9 | Selenium Webdriver represents all the HTML elements as WebElements. 10 | This class provides a mechanism to represent them as objects & 11 | perform various actions on the related elements. Typically, the 12 | findElement method in \code{\link{remoteDriver}} returns an object 13 | of class webElement. 14 | } 15 | \details{ 16 | webElement is a generator object. To define a new webElement class 17 | method `new` is called. When a webElement class is created an 18 | elementId should be given. Each webElement inherits from a 19 | remoteDriver. webElement is not usually called by the end-user. 20 | } 21 | \section{Fields}{ 22 | 23 | \describe{ 24 | \item{\code{elementId}}{Object of class \code{"character"}, giving a character 25 | representation of the element id.} 26 | }} 27 | 28 | \section{Methods}{ 29 | 30 | \describe{ 31 | \item{\code{clearElement()}}{Clear a TEXTAREA or text INPUT element's value.} 32 | 33 | \item{\code{clickElement()}}{Click the element.} 34 | 35 | \item{\code{compareElements(otherElem)}}{Test if the current webElement and an other web element refer to 36 | the same DOM element.} 37 | 38 | \item{\code{describeElement()}}{Describe the identified element.} 39 | 40 | \item{\code{findChildElement( 41 | using = c("xpath", "css selector", "id", "name", "tag name", "class name", "link text", 42 | "partial link text"), 43 | value 44 | )}}{Search for an element on the page, starting from the node defined 45 | by the parent webElement. The located element will be returned as 46 | an object of webElement class. 47 | The inputs are: 48 | \describe{ 49 | \item{\code{using}:}{Locator scheme to use to search the 50 | element, available schemes: {"class name", "css selector", 51 | "id", "name", "link text", "partial link text", 52 | "tag name", "xpath" }. Defaults to 'xpath'. Partial string 53 | matching is accepted.} 54 | \item{\code{value}:}{The search target. See examples.} 55 | }} 56 | 57 | \item{\code{findChildElements( 58 | using = c("xpath", "css selector", "id", "name", "tag name", "class name", "link text", 59 | "partial link text"), 60 | value 61 | )}}{Search for multiple elements on the page, starting from the node 62 | defined by the parent webElement. The located elements will be 63 | returned as an list of objects of class WebElement. 64 | The inputs are: 65 | \describe{ 66 | \item{\code{using}:}{Locator scheme to use to search the 67 | element, available schemes: {"class name", "css selector", 68 | "id", "name", "link text", "partial link text", 69 | "tag name", "xpath" }. Defaults to 'xpath'. 70 | Partial string matching is accepted.} 71 | \item{\code{value}:}{The search target. See examples.} 72 | }} 73 | 74 | \item{\code{getElementAttribute(attrName)}}{Get the value of an element's attribute. See examples.} 75 | 76 | \item{\code{getElementLocation()}}{Determine an element's location on the page. The point (0, 0) 77 | refers to the upper-left corner of the page.} 78 | 79 | \item{\code{getElementLocationInView()}}{Determine an element's location on the screen once it has been 80 | scrolled into view. 81 | Note: This is considered an internal command and should only be 82 | used to determine an element's location for correctly generating 83 | native events.} 84 | 85 | \item{\code{getElementSize()}}{Determine an element's size in pixels. The size will be returned 86 | with width and height properties.} 87 | 88 | \item{\code{getElementTagName()}}{Query for an element's tag name.} 89 | 90 | \item{\code{getElementText()}}{Get the innerText of the element.} 91 | 92 | \item{\code{getElementValueOfCssProperty(propName)}}{Query the value of an element's computed CSS property. The CSS 93 | property to query should be specified using the CSS property name, 94 | not the JavaScript property name (e.g. background-color instead of 95 | backgroundColor).} 96 | 97 | \item{\code{highlightElement(wait = 75/1000)}}{Utility function to highlight current Element. Wait denotes the 98 | time in seconds between style changes on element.} 99 | 100 | \item{\code{isElementDisplayed()}}{Determine if an element is currently displayed.} 101 | 102 | \item{\code{isElementEnabled()}}{Determine if an element is currently enabled. Obviously to enable 103 | an element just preform a click on it.} 104 | 105 | \item{\code{isElementSelected()}}{Determine if an OPTION element, or an INPUT element of type 106 | checkbox or radiobutton is currently selected.} 107 | 108 | \item{\code{selectTag()}}{Utility function to return options from a select DOM node. The 109 | option nodes are returned as webElements. The option text and the 110 | value of the option attribute 'value' and whether the option is 111 | selected are returned also. If this 112 | method is called on a webElement that is not a select DOM node an 113 | error will result.} 114 | 115 | \item{\code{sendKeysToElement(sendKeys)}}{Send a sequence of key strokes to an element. The key strokes are 116 | sent as a list. Plain text is enter as an unnamed element of the 117 | list. Keyboard entries are defined in `selKeys` and should be 118 | listed with name `key`. See the examples.} 119 | 120 | \item{\code{setElementAttribute(attributeName, value)}}{Utility function to set an elements attributes.} 121 | 122 | \item{\code{submitElement()}}{Submit a FORM element. The submit command may also be applied to 123 | any element that is a descendant of a FORM element.} 124 | }} 125 | 126 | -------------------------------------------------------------------------------- /tests/README.md: -------------------------------------------------------------------------------- 1 | # Testing `RSelenium` 2 | 3 | These tests are converted from the Python tests in the Selenium project. The tests use a set of HTML documents from [SeleniumHQ/selenium](https://github.com/SeleniumHQ/selenium/tree/trunk/common/src/web). 4 | 5 | First, we create a bridge network to link the Selenium server and the http server: 6 | 7 | ```sh 8 | docker network create rselenium 9 | ``` 10 | 11 | The tests assume these HTML documents are available and served locally. To serve the files, we use a Docker image [juyeongkim/test-server](https://hub.docker.com/r/juyeongkim/test-server/). This image runs the node application http-server exposing the `/web` directory (cloned HTML documents from [SeleniumHQ/selenium](https://github.com/SeleniumHQ/selenium/tree/trunk/common/src/web)) at port 8080. 12 | 13 | ```sh 14 | docker run -d --network rselenium --network-alias test-server -p 3000:8080 juyeongkim/test-server 15 | ``` 16 | 17 | Next, we run a Docker image containing the standalone Selenium server and a chrome browser: 18 | 19 | ```sh 20 | docker run -d --network rselenium --network-alias selenium -p 4444:4444 -v /dev/shm:/dev/shm selenium/standalone-chrome:2.53.1 21 | ``` 22 | 23 | or a debug version with VNC exposed on port 5901 of the host: 24 | 25 | ```sh 26 | docker run -d --network rselenium --network-alias selenium -p 5901:5900 -p 4444:4444 -v /dev/shm:/dev/shm selenium/standalone-chrome:2.53.1 27 | ``` 28 | 29 | The two Docker containers are linked, so the Selenium server will be able to access the http server on its port 8080 and referencing the http server as "test-server". 30 | 31 | ``` 32 | test-server:8080/*.html 33 | ``` 34 | 35 | Normally, on the test machine, docker containers are stopped and removed prior to testing: 36 | 37 | ```sh 38 | docker stop $(docker ps -q) 39 | docker rm $(docker ps -aq) 40 | ``` 41 | 42 | ## Environment variables 43 | 44 | For CRAN and GitHub Actions compatibility, two environmental variables are looked for: `NOT_CRAN`, `SELENIUM_BROWSER`, and `TEST_SERVER`. If the tests are being run locally with the above setup, you can set these environmental variables in `~/.Renviron` or set them in R: 45 | 46 | ```R 47 | Sys.setenv("NOT_CRAN" = "true") 48 | Sys.setenv("SELENIUM_BROWSER" = "firefox") 49 | Sys.setenv("TEST_SERVER" = "http://test-server:8080") 50 | ``` 51 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(RSelenium) 3 | 4 | if (Sys.getenv("NOT_CRAN") == "true") { 5 | test_check("RSelenium") 6 | } 7 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | initFun <- function(silent = TRUE, ...) { 2 | browserName <- Sys.getenv("SELENIUM_BROWSER", "chrome") 3 | remDr <- remoteDriver(browserName = browserName, ...) 4 | 5 | remDr$open(silent) 6 | # set page load timeout to 20 secs 7 | remDr$setTimeout(milliseconds = 20000) 8 | # wait 5 secs for elements to load 9 | remDr$setTimeout(type = "implicit", milliseconds = 5000) 10 | 11 | htmlSrc <- Sys.getenv("TEST_SERVER", "http://localhost:3000") 12 | loadPage <- function(pgStr) { 13 | paste0(file.path(htmlSrc, paste0(pgStr, ".html"))) 14 | } 15 | 16 | rdBrowser <- remDr$browserName 17 | 18 | list(remDr = remDr, rdBrowser = rdBrowser, loadPage = loadPage) 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat/test-alerts_tests.R: -------------------------------------------------------------------------------- 1 | context("alerts_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$closeall()) 7 | 8 | # 1 9 | test_that("testShouldBeAbleToOverrideTheWindowAlertMethod", { 10 | script <- "window.alert = function(msg) { 11 | document.getElementById('text').innerHTML = msg;}" 12 | remDr$navigate(loadPage("alerts")) 13 | remDr$executeScript(script) 14 | remDr$findElement("id", "alert")$ 15 | clickElement() 16 | appText <- remDr$findElement("id", "text")$ 17 | getElementText() 18 | expect_equal("cheese", appText[[1]]) 19 | }) 20 | 21 | test_that("testShouldAllowUsersToAcceptAnAlertManually", { 22 | remDr$navigate(loadPage("alerts")) 23 | remDr$findElement("id", "alert")$ 24 | clickElement() 25 | remDr$acceptAlert() 26 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 27 | }) 28 | 29 | test_that("testShouldAllowUsersToAcceptAnAlertWithNoTextManually", { 30 | remDr$navigate(loadPage("alerts")) 31 | remDr$findElement("id", "empty-alert")$ 32 | clickElement() 33 | remDr$acceptAlert() 34 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 35 | }) 36 | 37 | test_that("testShouldGetTextOfAlertOpenedInSetTimeout", { 38 | if (identical(rdBrowser, "chrome")) skip("Not chrome") 39 | 40 | remDr$navigate(loadPage("alerts")) 41 | remDr$findElement("id", "slow-alert")$ 42 | clickElement() 43 | alertTxt <- remDr$getAlertText()[[1]] 44 | expect_equal("Slow", alertTxt) 45 | remDr$acceptAlert() 46 | }) 47 | 48 | test_that("testShouldAllowUsersToDismissAnAlertManually", { 49 | remDr$navigate(loadPage("alerts")) 50 | remDr$findElement("id", "alert")$ 51 | clickElement() 52 | remDr$acceptAlert() 53 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 54 | }) 55 | 56 | test_that("testShouldAllowAUserToAcceptAPrompt", { 57 | remDr$navigate(loadPage("alerts")) 58 | remDr$findElement("id", "prompt")$ 59 | clickElement() 60 | remDr$acceptAlert() 61 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 62 | }) 63 | 64 | 65 | test_that("testShouldAllowAUserToDismissAPrompt", { 66 | remDr$navigate(loadPage("alerts")) 67 | remDr$findElement("id", "prompt")$ 68 | clickElement() 69 | remDr$dismissAlert() 70 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 71 | }) 72 | 73 | test_that("testShouldAllowAUserToSetTheValueOfAPrompt", { 74 | remDr$navigate(loadPage("alerts")) 75 | remDr$findElement("id", "prompt")$ 76 | clickElement() 77 | remDr$sendKeysToAlert(list("cheese")) 78 | remDr$acceptAlert() 79 | alertTxt <- remDr$findElement("id", "text")$ 80 | getElementText()[[1]] 81 | expect_equal("cheese", alertTxt) 82 | }) 83 | 84 | test_that("testSettingTheValueOfAnAlertThrows", { 85 | if (identical("chrome", rdBrowser)) skip("Not chrome") 86 | 87 | remDr$navigate(loadPage("alerts")) 88 | remDr$findElement("id", "alert")$ 89 | clickElement() 90 | expect_error(remDr$sendKeysToAlert(list("cheadder"))) 91 | remDr$dismissAlert() 92 | }) 93 | 94 | test_that("testAlertShouldNotAllowAdditionalCommandsIfDimissed", { 95 | remDr$navigate(loadPage("alerts")) 96 | remDr$findElement("id", "alert")$ 97 | clickElement() 98 | remDr$dismissAlert() 99 | expect_error(remDr$sendKeysToAlert()) 100 | }) 101 | 102 | test_that("testShouldAllowUsersToAcceptAnAlertInAFrame", { 103 | remDr$navigate(loadPage("alerts")) 104 | remDr$switchToFrame(remDr$findElement("name", "iframeWithAlert")) 105 | remDr$findElement("id", "alertInFrame")$ 106 | clickElement() 107 | remDr$acceptAlert() 108 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 109 | }) 110 | 111 | test_that("testShouldAllowUsersToAcceptAnAlertInANestedFrame", { 112 | remDr$navigate(loadPage("alerts")) 113 | remDr$switchToFrame(remDr$findElement("name", "iframeWithIframe")) 114 | remDr$switchToFrame(remDr$findElement("name", "iframeWithAlert")) 115 | remDr$findElement("id", "alertInFrame")$ 116 | clickElement() 117 | remDr$acceptAlert() 118 | expect_equal("Testing Alerts", remDr$getTitle()[[1]]) 119 | }) 120 | 121 | test_that("testPromptShouldUseDefaultValueIfNoKeysSent", { 122 | remDr$navigate(loadPage("alerts")) 123 | remDr$findElement("id", "prompt-with-default")$ 124 | clickElement() 125 | remDr$acceptAlert() 126 | alertTxt <- remDr$findElement("id", "text")$ 127 | getElementText()[[1]] 128 | expect_equal("This is a default value", alertTxt) 129 | }) 130 | 131 | test_that("testPromptShouldHaveNullValueIfDismissed", { 132 | remDr$navigate(loadPage("alerts")) 133 | remDr$findElement("id", "prompt-with-default")$ 134 | clickElement() 135 | remDr$dismissAlert() 136 | alertTxt <- remDr$findElement("id", "text")$ 137 | getElementText()[[1]] 138 | expect_equal("null", alertTxt) 139 | }) 140 | 141 | test_that("testHandlesTwoAlertsFromOneInteraction", { 142 | remDr$navigate(loadPage("alerts")) 143 | remDr$findElement("id", "double-prompt")$ 144 | clickElement() 145 | remDr$sendKeysToAlert(list("brie")) 146 | remDr$acceptAlert() 147 | remDr$sendKeysToAlert(list("cheddar")) 148 | remDr$acceptAlert() 149 | alertTxt1 <- remDr$findElement("id", "text1")$ 150 | getElementText()[[1]] 151 | alertTxt2 <- remDr$findElement("id", "text2")$ 152 | getElementText()[[1]] 153 | expect_equal("brie", alertTxt1) 154 | expect_equal("cheddar", alertTxt2) 155 | }) 156 | 157 | test_that("testShouldHandleAlertOnPageLoad", { 158 | remDr$navigate(loadPage("alerts")) 159 | remDr$findElement("id", "open-page-with-onload-alert")$ 160 | clickElement() 161 | alertTxt <- remDr$getAlertText()[[1]] 162 | remDr$acceptAlert() 163 | expect_equal("onload", alertTxt) 164 | }) 165 | 166 | test_that("testShouldAllowTheUserToGetTheTextOfAnAlert", { 167 | remDr$navigate(loadPage("alerts")) 168 | remDr$findElement("id", "alert")$ 169 | clickElement() 170 | alertTxt <- remDr$getAlertText()[[1]] 171 | remDr$acceptAlert() 172 | expect_equal("cheese", alertTxt) 173 | }) 174 | 175 | test_that("testUnexpectedAlertPresentExceptionContainsAlertText", { 176 | remDr$navigate(loadPage("alerts")) 177 | remDr$findElement("id", "alert")$ 178 | clickElement() 179 | expect_error(remDr$navigate(loadPage("simpleTest"))) 180 | expect_equal(remDr$status, 26L) 181 | tryCatch( 182 | { 183 | remDr$acceptAlert() 184 | }, 185 | error = function(e) {} 186 | ) 187 | }) 188 | -------------------------------------------------------------------------------- /tests/testthat/test-api_example_tests.R: -------------------------------------------------------------------------------- 1 | context("api_example_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$close()) 7 | 8 | # 1 9 | test_that("GetTitle", { 10 | remDr$navigate(loadPage("simpleTest")) 11 | title <- remDr$getTitle() 12 | expect_equal("Hello WebDriver", title[[1]]) 13 | }) 14 | 15 | # 2 16 | test_that("GetCurrentUrl", { 17 | remDr$navigate(loadPage("simpleTest")) 18 | getCurrentUrl <- remDr$getCurrentUrl() 19 | expect_equal(loadPage("simpleTest"), getCurrentUrl[[1]]) 20 | }) 21 | 22 | # 3 23 | test_that("FindElementsByXPath", { 24 | remDr$navigate(loadPage("simpleTest")) 25 | findElementText <- remDr$findElement(using = "xpath", "//h1")$ 26 | getElementText() 27 | 28 | expect_equal("Heading", findElementText[[1]]) 29 | }) 30 | 31 | # 4-5 32 | test_that("FindElementByXpathThrowNoSuchElementException", { 33 | expect_error({ 34 | remDr$navigate(loadPage("simpleTest")) 35 | findElementText <- remDr$findElement(using = "xpath", "//h4")$ 36 | getElementText() 37 | }) 38 | expect_equal(7, remDr$status) 39 | }) 40 | 41 | # 6-7 42 | test_that("FindElementsByXpath", { 43 | remDr$navigate(loadPage("nestedElements")) 44 | elems <- remDr$findElements(using = "xpath", "//option") 45 | expect_equal(48, length(elems)) 46 | expect_equal("One", elems[[1]]$getElementAttribute("value")[[1]]) 47 | }) 48 | 49 | # 8 50 | test_that("FindElementsByName", { 51 | remDr$navigate(loadPage("xhtmlTest")) 52 | elem <- remDr$findElement(using = "name", "windowOne") 53 | expect_equal("Open new window", elem$getElementText()[[1]]) 54 | }) 55 | 56 | # 9 57 | test_that("FindElementsByNameInElementContext", { 58 | remDr$navigate(loadPage("nestedElements")) 59 | elem <- remDr$findElement(using = "name", "form2") 60 | childElem <- elem$findChildElement(using = "name", "selectomatic") 61 | expect_equal("2", childElem$getElementAttribute("id")[[1]]) 62 | }) 63 | 64 | # 10 65 | test_that("FindElementsByLinkTextInElementContext", { 66 | remDr$navigate(loadPage("nestedElements")) 67 | elem <- remDr$findElement(using = "name", "div1") 68 | childElem <- elem$findChildElement(using = "link text", "hello world") 69 | expect_equal("link1", childElem$getElementAttribute("name")[[1]]) 70 | }) 71 | 72 | # 11 73 | test_that("FindElementByIdInElementContext", { 74 | remDr$navigate(loadPage("nestedElements")) 75 | elem <- remDr$findElement(using = "name", "form2") 76 | childElem <- elem$findChildElement(using = "id", "2") 77 | expect_equal("selectomatic", childElem$getElementAttribute("name")[[1]]) 78 | }) 79 | 80 | # 12 81 | test_that("FindElementByXpathInElementContext", { 82 | remDr$navigate(loadPage("nestedElements")) 83 | elem <- remDr$findElement(using = "name", "form2") 84 | childElem <- elem$findChildElement(using = "xpath", "select") 85 | expect_equal("2", childElem$getElementAttribute("id")[[1]]) 86 | }) 87 | 88 | # 13-14 89 | test_that("FindElementByXpathInElementContextNotFound", { 90 | expect_error({ 91 | remDr$navigate(loadPage("nestedElements")) 92 | elem <- remDr$findElement(using = "name", "form2") 93 | childElem <- elem$findChildElement(using = "xpath", "div") 94 | }) 95 | expect_equal(7, elem$status) 96 | }) 97 | 98 | # 15 99 | test_that("ShouldBeAbleToEnterDataIntoFormFields", { 100 | remDr$navigate(loadPage("xhtmlTest")) 101 | elem <- 102 | remDr$findElement( 103 | using = "xpath", 104 | "//form[@name='someForm']/input[@id='username']" 105 | ) 106 | elem$clearElement() 107 | elem$sendKeysToElement(list("some text")) 108 | elem <- 109 | remDr$findElement( 110 | using = "xpath", 111 | "//form[@name='someForm']/input[@id='username']" 112 | ) 113 | expect_equal("some text", elem$getElementAttribute("value")[[1]]) 114 | }) 115 | 116 | # 16-17 117 | test_that("FindElementByTagName", { 118 | remDr$navigate(loadPage("simpleTest")) 119 | elems <- remDr$findElements(using = "tag name", "div") 120 | num_by_xpath <- length(remDr$findElements(using = "xpath", "//div")) 121 | expect_equal(num_by_xpath, length(elems)) 122 | elems <- remDr$findElements(using = "tag name", "iframe") 123 | expect_equal(0, length(elems)) 124 | }) 125 | 126 | # 18 127 | test_that("FindElementByTagNameWithinElement", { 128 | remDr$navigate(loadPage("simpleTest")) 129 | elems <- remDr$findElement(using = "id", "multiline")$ 130 | findChildElements(using = "tag name", "p") 131 | expect_true(length(elems) == 1) 132 | }) 133 | 134 | # 19-21 135 | test_that("SwitchToWindow", { 136 | # if(rdBrowser == 'safari'){ 137 | # see https://code.google.com/p/selenium/issues/detail?id=3693 138 | # return() 139 | # } 140 | title_1 <- "XHTML Test Page" 141 | title_2 <- "We Arrive Here" 142 | 143 | remDr$navigate(loadPage("xhtmlTest")) 144 | elem <- remDr$findElement(using = "link text", "Open new window") 145 | elem$clickElement() 146 | expect_equal(title_1, remDr$getTitle()[[1]]) 147 | remDr$switchToWindow("result") 148 | # wait.until(lambda dr: dr.switch_to_window("result") is None) 149 | expect_equal(title_2, remDr$getTitle()[[1]]) 150 | # close window and switch back to first one 151 | windows <- unlist(remDr$getWindowHandles()) 152 | currentWindow <- remDr$getCurrentWindowHandle()[[1]] 153 | remDr$closeWindow() 154 | remDr$switchToWindow(windows[!windows %in% currentWindow]) 155 | expect_equal(title_1, remDr$getTitle()[[1]]) 156 | }) 157 | 158 | #### 159 | test_that("SwitchFrameByName", { 160 | remDr$navigate(loadPage("frameset")) 161 | remDr$switchToFrame("third") 162 | remDr$findElement(using = "id", "checky")$clickElement() 163 | }) 164 | 165 | # 22-23 166 | test_that("IsEnabled", { 167 | remDr$navigate(loadPage("formPage")) 168 | elem <- remDr$findElement(using = "xpath", "//input[@id='working']") 169 | expect_true(elem$isElementEnabled()[[1]]) 170 | elem <- remDr$findElement(using = "xpath", "//input[@id='notWorking']") 171 | expect_false(elem$isElementEnabled()[[1]]) 172 | }) 173 | 174 | # 24-27 175 | test_that("IsSelectedAndToggle", { 176 | if (rdBrowser == "chrome" && 177 | package_version(remDr$sessionInfo$version)$major < 16) { 178 | return("deselecting preselected values only works on chrome >= 16") 179 | } 180 | remDr$navigate(loadPage("formPage")) 181 | elem <- remDr$findElement(using = "id", "multi") 182 | option_elems <- elem$findChildElements(using = "xpath", "option") 183 | expect_true(option_elems[[1]]$isElementSelected()[[1]]) 184 | option_elems[[1]]$clickElement() 185 | expect_false(option_elems[[1]]$isElementSelected()[[1]]) 186 | option_elems[[1]]$clickElement() 187 | expect_true(option_elems[[1]]$isElementSelected()[[1]]) 188 | expect_true(option_elems[[3]]$isElementSelected()[[1]]) 189 | }) 190 | 191 | # 28-30 192 | test_that("Navigate", { 193 | remDr$navigate(loadPage("formPage")) 194 | remDr$findElement(using = "id", "imageButton")$clickElement() 195 | expect_equal("We Arrive Here", remDr$getTitle()[[1]]) 196 | remDr$goBack() 197 | expect_equal("We Leave From Here", remDr$getTitle()[[1]]) 198 | remDr$goForward() 199 | expect_equal("We Arrive Here", remDr$getTitle()[[1]]) 200 | }) 201 | 202 | # 31 203 | test_that("GetAttribute", { 204 | remDr$navigate(loadPage("xhtmlTest")) 205 | attr <- remDr$findElement(using = "id", "id1")$ 206 | getElementAttribute("href") 207 | expect_equal(paste0(loadPage("xhtmlTest"), "#"), attr[[1]]) 208 | }) 209 | 210 | # 32-36 211 | test_that("GetImplicitAttribute", { 212 | remDr$navigate(loadPage("nestedElements")) 213 | elems <- remDr$findElements(using = "xpath", "//option") 214 | expect_true(length(elems) >= 3) 215 | for (x in seq(4)) { 216 | expect_equal(x - 1, as.integer(elems[[x]]$ 217 | getElementAttribute("index")[[1]])) 218 | } 219 | }) 220 | 221 | # 37 222 | test_that("ExecuteSimpleScript", { 223 | remDr$navigate(loadPage("xhtmlTest")) 224 | title <- remDr$executeScript("return document.title;") 225 | expect_equal("XHTML Test Page", title[[1]]) 226 | }) 227 | 228 | # 38 229 | test_that("ExecuteScriptAndReturnElement", { 230 | remDr$navigate(loadPage("xhtmlTest")) 231 | elem <- remDr$executeScript("return document.getElementById('id1');") 232 | expect_true(inherits(elem[[1]], "webElement")) 233 | }) 234 | 235 | # 39 236 | test_that("ExecuteScriptWithArgs", { 237 | remDr$navigate(loadPage("xhtmlTest")) 238 | jS <- "return arguments[0] == 'fish' ? 'fish' : 'not fish';" 239 | result <- remDr$executeScript(jS, list("fish")) 240 | expect_equal("fish", result[[1]]) 241 | }) 242 | 243 | # 40 244 | test_that("ExecuteScriptWithMultipleArgs", { 245 | remDr$navigate(loadPage("xhtmlTest")) 246 | result <- remDr$executeScript( 247 | "return arguments[0] + arguments[1]", 248 | list(1, 2) 249 | ) 250 | expect_equal(3, result[[1]]) 251 | }) 252 | 253 | # 41 254 | test_that("ExecuteScriptWithElementArgs", { 255 | remDr$navigate(loadPage("javascriptPage")) 256 | button <- remDr$findElement(using = "id", "plainButton") 257 | appScript <- "arguments[0]['flibble'] = arguments[0].getAttribute('id'); 258 | return arguments[0]['flibble'];" 259 | result <- remDr$executeScript(appScript, list(button)) 260 | expect_equal("plainButton", result[[1]]) 261 | }) 262 | 263 | # 42 264 | test_that("FindElementsByPartialLinkText", { 265 | remDr$navigate(loadPage("xhtmlTest")) 266 | elem <- remDr$findElement(using = "partial link text", "new window") 267 | expect_equal("Open new window", elem$getElementText()[[1]]) 268 | }) 269 | 270 | # 43-44 271 | test_that("IsElementDisplayed", { 272 | remDr$navigate(loadPage("javascriptPage")) 273 | visible <- remDr$findElement(using = "id", "displayed")$ 274 | isElementDisplayed() 275 | not_visible <- remDr$findElement(using = "id", "hidden")$ 276 | isElementDisplayed() 277 | expect_true(visible[[1]]) 278 | expect_false(not_visible[[1]]) 279 | }) 280 | 281 | # 45-46 282 | test_that("MoveWindowPosition", { 283 | if (rdBrowser == "android" || rdBrowser == "safari") { 284 | print("Not applicable") 285 | return() 286 | } 287 | remDr$navigate(loadPage("blank")) 288 | loc <- remDr$getWindowPosition() 289 | # note can't test 0,0 since some OS's dont allow that location 290 | # because of system toolbars 291 | new_x <- 50 292 | new_y <- 50 293 | if (loc[["x"]] == new_x) { 294 | new_x <- new_x + 10 295 | } 296 | if (loc["y"] == new_y) { 297 | new_y <- new_y + 10 298 | } 299 | remDr$setWindowPosition(new_x, new_y) 300 | loc <- remDr$getWindowPosition() 301 | expect_lt(abs(loc[["x"]] - new_x), 10) 302 | expect_lt(abs(loc[["y"]] - new_y), 10) 303 | }) 304 | 305 | # 47-48 306 | test_that("ChangeWindowSize", { 307 | if (rdBrowser == "android") { 308 | print("Not applicable") 309 | return() 310 | } 311 | remDr$navigate(loadPage("blank")) 312 | size <- remDr$getWindowSize() 313 | newSize <- rep(600, 2) 314 | if (size[["width"]] == 600) { 315 | newSize[1] <- 500 316 | } 317 | if (size[["height"]] == 600) { 318 | newSize[2] <- 500 319 | } 320 | remDr$setWindowSize(newSize[1], newSize[2]) 321 | size <- remDr$getWindowSize() 322 | # change test to be within 10 pixels 323 | expect_lt(abs(size[["width"]] - newSize[1]), 10) 324 | expect_lt(abs(size[["height"]] - newSize[2]), 10) 325 | }) 326 | 327 | # On headless docker container the below doesnt make sense 328 | # test_that("testShouldMaximizeTheWindow", { 329 | # size <- remDr$navigate(loadPage("blank")) %>% 330 | # setWindowSize(200,200) %>% 331 | # getWindowSize 332 | # new_size <- remDr %>% maximizeWindow %>% 333 | # getWindowSize 334 | # expect_gt(new_size[['width']], size[['width']]) 335 | # expect_gt(new_size[['height']], size[['height']]) 336 | # } 337 | # ) 338 | -------------------------------------------------------------------------------- /tests/testthat/test-cookie_tests.R: -------------------------------------------------------------------------------- 1 | context("cookie_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$close()) 7 | 8 | 9 | test_that("testAddCookie", { 10 | remDr$navigate(loadPage("simpleTest")) 11 | remDr$executeScript("return document.cookie;") 12 | remDr$addCookie( 13 | name = "foo", 14 | value = "bar" 15 | ) 16 | cookie_returned <- remDr$executeScript("return document.cookie;") 17 | expect_true(grepl("foo=bar", cookie_returned[[1]])) 18 | remDr$deleteAllCookies() 19 | }) 20 | 21 | test_that("testAddingACookieThatExpiredInThePast", { 22 | remDr$navigate(loadPage("simpleTest")) 23 | remDr$addCookie( 24 | name = "foo", 25 | value = "bar", 26 | expiry = as.integer(Sys.time() - 100) 27 | ) 28 | cookies <- remDr$getAllCookies() 29 | expect_equal(length(cookies), 0L) 30 | remDr$deleteAllCookies() 31 | }) 32 | 33 | test_that("testDeleteAllCookie", { 34 | remDr$navigate(loadPage("simpleTest")) 35 | remDr$addCookie( 36 | name = "foo", 37 | value = "bar" 38 | ) 39 | remDr$deleteAllCookies() 40 | expect_equal(0L, length(remDr$getAllCookies())) 41 | remDr$deleteAllCookies() 42 | }) 43 | 44 | test_that("testDeleteCookie", { 45 | remDr$navigate(loadPage("simpleTest")) 46 | remDr$addCookie( 47 | name = "foo", 48 | value = "bar" 49 | ) 50 | remDr$deleteCookieNamed(name = "foo") 51 | expect_equal(0L, length(remDr$getAllCookies())) 52 | remDr$deleteAllCookies() 53 | }) 54 | 55 | test_that("testShouldGetCookieByName", { 56 | key <- sprintf("key_%d", as.integer(runif(1) * 10000000)) 57 | remDr$navigate(loadPage("simpleTest")) 58 | remDr$executeScript("document.cookie = arguments[0] + '=set';", list(key)) 59 | cookie <- remDr$getAllCookies() 60 | expect_equal( 61 | cookie[vapply(cookie, "[[", character(1), "name") == key][[1]][["value"]], 62 | "set" 63 | ) 64 | remDr$deleteAllCookies() 65 | }) 66 | 67 | test_that("testGetAllCookies", { 68 | key1 <- sprintf("key_%d", as.integer(runif(1) * 10000000)) 69 | key2 <- sprintf("key_%d", as.integer(runif(1) * 10000000)) 70 | remDr$navigate(loadPage("simpleTest")) 71 | cookies <- remDr$getAllCookies() 72 | count <- length(cookies) 73 | remDr$addCookie(name = key1, value = "value") 74 | remDr$addCookie(name = key2, value = "value") 75 | cookies <- remDr$getAllCookies() 76 | expect_equal(count + 2, length(cookies)) 77 | remDr$deleteAllCookies() 78 | }) 79 | 80 | test_that("testShouldNotDeleteCookiesWithASimilarName", { 81 | cookieOneName <- "fish" 82 | remDr$navigate(loadPage("simpleTest")) 83 | remDr$addCookie(name = cookieOneName, value = "cod") 84 | remDr$addCookie(name = paste0(cookieOneName, "x"), value = "earth") 85 | remDr$deleteCookieNamed(cookieOneName) 86 | cookies <- remDr$getAllCookies() 87 | expect_false(identical(cookies[[1]][["name"]], cookieOneName)) 88 | expect_equal(cookies[[1]][["name"]], paste0(cookieOneName, "x")) 89 | remDr$deleteAllCookies() 90 | }) 91 | -------------------------------------------------------------------------------- /tests/testthat/test-errorHandler.R: -------------------------------------------------------------------------------- 1 | context("test-errorHandler") 2 | 3 | test_that("canGetHttrError", { 4 | # hopefully no sel server running on 9999L 5 | dumRD <- remoteDriver(port = 9999L) 6 | expect_error( 7 | dumRD$open(silent = TRUE), 8 | "Undefined error in httr call. httr output: Failed to connect to localhost port 9999: Connection refused" 9 | ) 10 | }) 11 | 12 | test_that("canCheckErrorDetails", { 13 | # hopefully no sel server running on 9999L 14 | dumRD <- remoteDriver(port = 9999L) 15 | expect_identical(dumRD$errorDetails(), list()) 16 | expect_identical(dumRD$errorDetails("class"), NA_character_) 17 | expect_identical(dumRD$errorDetails("status"), 0L) 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-executing_javascript_tests.R: -------------------------------------------------------------------------------- 1 | context("executing_javascript_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$close()) 7 | 8 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndReturnAString", { 9 | skip_on_cran() 10 | remDr$navigate(loadPage("xhtmlTest")) 11 | result <- remDr$executeScript("return document.title") 12 | expect_true(inherits(result[[1]], "character")) 13 | expect_equal("XHTML Test Page", result[[1]]) 14 | }) 15 | 16 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndReturnAnInteger", { 17 | skip_on_cran() 18 | remDr$navigate(loadPage("nestedElements")) 19 | result <- remDr$ 20 | executeScript("return document.getElementsByName('checky').length") 21 | expect_true(inherits(result[[1]], "integer")) 22 | expect_gt(result[[1]], 1L) 23 | }) 24 | 25 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndReturnAWebElement", { 26 | skip_on_cran() 27 | remDr$navigate(loadPage("xhtmlTest")) 28 | result <- remDr$executeScript("return document.getElementById('id1')") 29 | expect_true(inherits(result[[1]], "webElement")) 30 | expect_equal(result[[1]]$getElementTagName()[[1]], "a") 31 | }) 32 | 33 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndReturnABoolean", { 34 | skip_on_cran() 35 | remDr$navigate(loadPage("xhtmlTest")) 36 | result <- remDr$executeScript("return true") 37 | expect_true(inherits(result[[1]], "logical")) 38 | expect_true(result[[1]]) 39 | }) 40 | 41 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndAStringsArray", { 42 | skip_on_cran() 43 | remDr$navigate(loadPage("javascriptPage")) 44 | result <- remDr$executeScript("return ['zero', 'one', 'two']") 45 | expectedResult <- list("zero", "one", "two") 46 | expect_identical(result, expectedResult) 47 | }) 48 | 49 | test_that("testShouldBeAbleToExecuteSimpleJavascriptAndReturnAnArray", { 50 | skip_on_cran() 51 | remDr$navigate(loadPage("javascriptPage")) 52 | result <- remDr$executeScript("return ['zero', [true, false]]") 53 | expectedResult <- list("zero", list(TRUE, FALSE)) 54 | expect_identical(result, expectedResult) 55 | }) 56 | 57 | test_that("testPassingAndReturningAnIntShouldReturnAWholeNumber", { 58 | skip_on_cran() 59 | expectedResult <- 1 60 | remDr$navigate(loadPage("javascriptPage")) 61 | result <- remDr$executeScript( 62 | "return arguments[0]", 63 | list(expectedResult) 64 | ) 65 | expect_true(inherits(result[[1]], "integer")) 66 | expect_equal(result[[1]], expectedResult) 67 | }) 68 | 69 | test_that("testPassingAndReturningADoubleShouldReturnADecimal", { 70 | skip_on_cran() 71 | expectedResult <- 1.2 72 | remDr$navigate(loadPage("javascriptPage")) 73 | result <- remDr$executeScript( 74 | "return arguments[0]", 75 | list(expectedResult) 76 | ) 77 | expect_true(inherits(result[[1]], "numeric")) 78 | expect_identical(result[[1]], expectedResult) 79 | }) 80 | 81 | test_that("testShouldThrowAnExceptionWhenTheJavascriptIsBad", { 82 | skip_on_cran() 83 | remDr$navigate(loadPage("xhtmlTest")) 84 | expect_error( 85 | remDr$executeScript("return squiggle()", retry = FALSE) 86 | ) 87 | }) 88 | 89 | test_that("testShouldBeAbleToCallFunctionsDefinedOnThePage", { 90 | skip_on_cran() 91 | remDr$navigate(loadPage("javascriptPage")) 92 | remDr$executeScript("displayMessage('I like cheese')") 93 | text <- remDr$findElement("id", "result")$ 94 | getElementText()[[1]] 95 | expect_identical(text, "I like cheese") 96 | }) 97 | 98 | test_that("testShouldBeAbleToPassAStringAnAsArgument", { 99 | skip_on_cran() 100 | remDr$navigate(loadPage("javascriptPage")) 101 | value <- remDr$executeScript( 102 | "return arguments[0] == 'fish' ? 'fish' : 'not fish'", 103 | list("fish") 104 | ) 105 | expect_identical(value[[1]], "fish") 106 | }) 107 | 108 | test_that("testShouldBeAbleToPassABooleanAnAsArgument", { 109 | skip_on_cran() 110 | remDr$navigate(loadPage("javascriptPage")) 111 | value <- remDr$executeScript( 112 | "return arguments[0] == true", 113 | list(TRUE) 114 | ) 115 | expect_true(value[[1]]) 116 | }) 117 | 118 | test_that("testShouldBeAbleToPassANumberAnAsArgument", { 119 | skip_on_cran() 120 | remDr$navigate(loadPage("javascriptPage")) 121 | value <- remDr$executeScript( 122 | "return arguments[0] == 1 ? true : false", 123 | list(1L) 124 | ) 125 | expect_true(value[[1]]) 126 | }) 127 | 128 | test_that("testShouldBeAbleToPassAWebElementAsArgument", { 129 | skip_on_cran() 130 | jS <- "arguments[0]['flibble'] = arguments[0].getAttribute('id'); 131 | return arguments[0]['flibble']" 132 | remDr$navigate(loadPage("javascriptPage")) 133 | value <- remDr$executeScript( 134 | jS, 135 | list(remDr$findElement("id", "plainButton")) 136 | ) 137 | expect_identical(value[[1]], "plainButton") 138 | }) 139 | 140 | test_that("testShouldBeAbleToPassAnArrayAsArgument", { 141 | skip_on_cran() 142 | array <- list("zerohero", 1, TRUE, 3.14159) 143 | remDr$navigate(loadPage("javascriptPage")) 144 | value <- remDr$executeScript( 145 | "return arguments[0].length", 146 | list(array) 147 | ) 148 | expect_equal(value[[1]], length(array)) 149 | }) 150 | 151 | test_that("testShouldBeAbleToPassInMoreThanOneArgument", { 152 | skip_on_cran() 153 | remDr$navigate(loadPage("javascriptPage")) 154 | value <- remDr$executeScript( 155 | "return arguments[0] + arguments[1]", 156 | list("one", "two") 157 | ) 158 | expect_identical(value[[1]], "onetwo") 159 | }) 160 | 161 | test_that("testJavascriptStringHandlingShouldWorkAsExpected", { 162 | skip_on_cran() 163 | remDr$navigate(loadPage("javascriptPage")) 164 | value <- remDr$executeScript("return ''") 165 | expect_identical(value[[1]], "") 166 | value <- remDr$executeScript("return ' '") 167 | expect_identical(value[[1]], " ") 168 | }) 169 | 170 | test_that("testShouldBeAbleToCreateAPersistentValue", { 171 | skip_on_cran() 172 | remDr$navigate(loadPage("formPage")) 173 | remDr$executeScript("document.alerts = []") 174 | remDr$executeScript("document.alerts.push('hello world')") 175 | text <- remDr$executeScript("return document.alerts.shift()") 176 | expect_identical(text[[1]], "hello world") 177 | }) 178 | 179 | test_that("testCanPassANone", { 180 | skip_on_cran() 181 | remDr$navigate(loadPage("simpleTest")) 182 | res <- remDr$executeScript("return arguments[0] === null", list(NA)) 183 | expect_true(res[[1]]) 184 | }) 185 | 186 | test_that("testShouldBeAbleToReturnNestedWebElements", { 187 | skip_on_cran() 188 | remDr$navigate(loadPage("xhtmlTest")) 189 | result <- 190 | remDr$executeScript("var1 = document.getElementById('id1'); 191 | return [var1, [var1, [var1, var1]]]") 192 | expect_true(inherits(result[[1]], "webElement")) 193 | expect_true(inherits(result[[2]][[1]], "webElement")) 194 | expect_true(inherits(result[[2]][[2]][[1]], "webElement")) 195 | expect_true(inherits(result[[2]][[2]][[2]], "webElement")) 196 | expect_equal(result[[1]]$getElementTagName()[[1]], "a") 197 | }) 198 | -------------------------------------------------------------------------------- /tests/testthat/test-misc_remoteDriver_methods_tests.R: -------------------------------------------------------------------------------- 1 | context("misc_remoteDriver_methods_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$closeall()) 7 | 8 | test_that("canShowRemoteDriver", { 9 | expect_identical(remDr$show()$browserName, rdBrowser) 10 | }) 11 | 12 | test_that("canShowErrorClass", { 13 | status <- remDr$showErrorClass()$status 14 | expect_equal(status, 0L) 15 | }) 16 | 17 | test_that("canGetSessions", { 18 | sessions <- remDr$getSessions() 19 | expect_equal(length(sessions), 1L) 20 | expect_identical(sessions[[1]][["id"]], remDr$sessionid) 21 | }) 22 | 23 | test_that("canGetStatus", { 24 | status <- remDr$getStatus() 25 | expect_identical(names(status), c("build", "os", "java")) 26 | }) 27 | 28 | test_that("canSetAsyncScriptTimeout", { 29 | expect_silent(remDr$setAsyncScriptTimeout()) 30 | }) 31 | 32 | test_that("canSetImplicitWaitTimeout", { 33 | expect_silent(remDr$setImplicitWaitTimeout()) 34 | }) 35 | 36 | test_that("canGetLogTypes", { 37 | expect_gt(length(remDr$getLogTypes()), 0L) 38 | }) 39 | 40 | test_that("canGetLog", { 41 | logs <- remDr$getLogTypes()[[1]] 42 | expect_true(inherits(remDr$log(logs[1]), "list")) 43 | }) 44 | 45 | test_that("canGetPageSource", { 46 | remDr$navigate(loadPage("simpleTest")) 47 | source <- remDr$getPageSource() 48 | expect_true(grepl("html", source[[1]])) 49 | }) 50 | 51 | test_that("canSetExtraCaps", { 52 | prefs <- list("profile.managed_default_content_settings.images" = 2L) 53 | cprof <- list(chromeOptions = list(prefs = prefs)) 54 | expect_output( 55 | init2 <- initFun(silent = FALSE, extraCapabilities = cprof) 56 | ) 57 | on.exit(init2$remDr$close()) 58 | expect_identical(init2$remDr$extraCapabilities, cprof) 59 | }) 60 | -------------------------------------------------------------------------------- /tests/testthat/test-misc_webElement_methods_tests.R: -------------------------------------------------------------------------------- 1 | context("misc_webElement_methods_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$closeall()) 7 | 8 | test_that("canSetElementAttribute", { 9 | remDr$navigate(loadPage("nestedElements")) 10 | elem <- remDr$findElement("id", "test_id") 11 | elem$setElementAttribute("name", "jimmy") 12 | expect_identical(elem$getElementAttribute("name")[[1]], "jimmy") 13 | }) 14 | 15 | test_that("canHighlightElement", { 16 | remDr$navigate(loadPage("nestedElements")) 17 | elem <- remDr$findElement("id", "test_id") 18 | expect_silent(elem$highlightElement()) 19 | }) 20 | 21 | test_that("canSelectTagOptions", { 22 | remDr$navigate(loadPage("nestedElements")) 23 | elem <- remDr$findElement("id", "1") 24 | expect_identical(elem$getElementTagName()[[1]], "select") 25 | options <- elem$selectTag() 26 | expect_identical(options[["value"]], NULL) 27 | expect_identical(options[["selected"]], c(TRUE, FALSE, FALSE, FALSE)) 28 | exT <- c("One", "Two", "Four", "Still learning how to count, apparently") 29 | expect_identical(options[["text"]], exT) 30 | }) 31 | 32 | test_that("errorWhenSelectTagNonSelectElement", { 33 | remDr$navigate(loadPage("nestedElements")) 34 | elem <- remDr$findElement("id", "test_id") 35 | expect_error(elem$selectTag()) 36 | }) 37 | 38 | test_that("canPrintWebElement", { 39 | remDr$navigate(loadPage("nestedElements")) 40 | elem <- remDr$findElement("id", "test_id") 41 | expect_output(print(elem), "webElement fields") 42 | }) 43 | -------------------------------------------------------------------------------- /tests/testthat/test-page_loading_tests.R: -------------------------------------------------------------------------------- 1 | context("page_loading_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$close()) 7 | 8 | test_that("testShouldWaitForDocumentToBeLoaded", { 9 | remDr$navigate(loadPage("simpleTest")) 10 | result <- remDr$getTitle() 11 | expect_identical(result[[1]], "Hello WebDriver") 12 | }) 13 | 14 | test_that("testShouldBeAbleToGetAFragmentOnTheCurrentPage", { 15 | remDr$navigate(loadPage("xhtmlTest")) 16 | result <- remDr$getCurrentUrl() 17 | remDr$navigate(paste0(result[[1]], "#text")) 18 | wElem <- remDr$findElement("id", "id1") 19 | expect_true(inherits(wElem, "webElement")) 20 | }) 21 | 22 | test_that("testShouldReturnWhenGettingAUrlThatDoesNotResolve", { 23 | expect_silent( 24 | result <- remDr$navigate("http://www.thisurldoesnotexist.comx/") 25 | ) 26 | }) 27 | 28 | test_that("testShouldReturnWhenGettingAUrlThatDoesNotConnect", { 29 | expect_silent( 30 | result <- remDr$navigate("http://localhost:3001") 31 | ) 32 | }) 33 | 34 | test_that("testShouldBeAbleToNavigateBackInTheBrowserHistory", { 35 | remDr$navigate(loadPage("formPage")) 36 | remDr$findElement("id", "imageButton")$clickElement() 37 | result <- remDr$getTitle() 38 | expect_identical(result[[1]], "We Arrive Here") 39 | remDr$goBack() 40 | resBack <- remDr$getTitle() 41 | expect_identical(resBack[[1]], "We Leave From Here") 42 | }) 43 | 44 | test_that("testShouldBeAbleToNavigateBackInPresenceOfIframes", { 45 | remDr$navigate(loadPage("xhtmlTest")) 46 | remDr$findElement("name", "sameWindow")$clickElement() 47 | expect_identical(remDr$getTitle()[[1]], "This page has iframes") 48 | remDr$goBack() 49 | result <- remDr$getTitle() 50 | expect_identical(result[[1]], "XHTML Test Page") 51 | }) 52 | 53 | test_that("testShouldBeAbleToNavigateForwardsInTheBrowserHistory", { 54 | remDr$navigate(loadPage("formPage")) 55 | remDr$findElement("id", "imageButton")$clickElement() 56 | expect_identical(remDr$getTitle()[[1]], "We Arrive Here") 57 | remDr$goBack() 58 | expect_identical(remDr$getTitle()[[1]], "We Leave From Here") 59 | remDr$goForward() 60 | expect_identical(remDr$getTitle()[[1]], "We Arrive Here") 61 | }) 62 | 63 | test_that("testShouldNotHangifOpenCallIsNeverFollowedByCloseCall", { 64 | result <- remDr$navigate(loadPage("document_write_in_onload")) 65 | result <- remDr$findElement("xpath", "//body") 66 | expect_true(inherits(result, "webElement")) 67 | }) 68 | 69 | test_that("testShouldBeAbleToRefreshAPage", { 70 | remDr$navigate(loadPage("xhtmlTest")) 71 | remDr$refresh() 72 | result <- remDr$getTitle() 73 | expect_identical(result[[1]], "XHTML Test Page") 74 | }) 75 | -------------------------------------------------------------------------------- /tests/testthat/test-takes_screenshots_tests.R: -------------------------------------------------------------------------------- 1 | context("takes_screenshots_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | on.exit(remDr$close()) 7 | 8 | test_that("testShouldWriteScreenshotToFile", { 9 | tmpF <- tempfile() 10 | result <- remDr$navigate(loadPage("simpleTest")) 11 | remDr$screenshot(file = tmpF) 12 | expect_true(file.exists(tmpF)) 13 | }) 14 | 15 | test_that("test_get_screenshot_as_png", { 16 | if (!.Platform$OS.type == "unix") { 17 | skip("unix file command used to determine file type") 18 | } 19 | tmpF <- tempfile() 20 | result <- remDr$navigate(loadPage("simpleTest")) 21 | remDr$screenshot(file = tmpF) 22 | fileInfo <- system(paste("file --mime-type", tmpF), intern = TRUE) 23 | expect_true(grepl("image/png", fileInfo)) 24 | }) 25 | -------------------------------------------------------------------------------- /tests/testthat/test-util_function_tests.R: -------------------------------------------------------------------------------- 1 | context("util_function_tests") 2 | init <- initFun() 3 | remDr <- init$remDr 4 | rdBrowser <- init$rdBrowser 5 | loadPage <- init$loadPage 6 | selFILE <- "" 7 | on.exit(remDr$close()) 8 | 9 | # test_that("canDownloadSeleniumServer", { 10 | # with_mock( 11 | # `utils::download.file` = function(url, destfile, ...){ 12 | # tempFile <- file.path(tempdir(),"selenium-server-standalone.jar") 13 | # write("", file = tempFile) 14 | # list(sURL = url, sFile = destfile, tFile = tempFile) 15 | # }, 16 | # { 17 | # expect_warning(out <- checkForServer(update = TRUE)) 18 | # selFILE <<- out$tFile 19 | # expect_true(grepl("selenium-server-standalone", out$sFile)) 20 | # } 21 | # ) 22 | # } 23 | # ) 24 | 25 | # test_that("canStartSeleniumServer", { 26 | # if(.Platform$OS.type != "unix") return() 27 | # if(Sys.info()[["sysname"]] != "Linux") return() 28 | # with_mock( 29 | # `base::system2` = function(command, args, ...){ 30 | # if(grepl("java", command)){ 31 | # return(0L) 32 | # } 33 | # }, 34 | # `base::system` = function(command, ...){ 35 | # if(grepl('ps -Ao"%p"', command)){ 36 | # return(100L) 37 | # } 38 | # if(grepl('ps -Ao"%a"', command)){ 39 | # return(selFILE) 40 | # } 41 | # }, 42 | # `tools::pskill` = function(pid, ...){ 43 | # return(pid) 44 | # } 45 | # , { 46 | # expect_warning(out <- startServer(dir = dirname(selFILE))) 47 | # expect_identical(out$getPID(), 100L) 48 | # expect_identical(out$stop(), 100L) 49 | # } 50 | # ) 51 | # } 52 | # ) 53 | 54 | test_that("canGetFirefoxProfile", { 55 | if (Sys.info()[["sysname"]] != "Linux") { 56 | return() 57 | } 58 | out <- getFirefoxProfile(tempdir(), useBase = TRUE) 59 | expect_identical(names(out), "firefox_profile") 60 | }) 61 | 62 | test_that("canGetChromeProfile", { 63 | cprof <- getChromeProfile("a", "b") 64 | expect_equal(length(cprof[["chromeOptions"]][["args"]]), 2L) 65 | expect_identical( 66 | cprof[["chromeOptions"]][["args"]][[1]], 67 | "--user-data-dir=a" 68 | ) 69 | expect_identical( 70 | cprof[["chromeOptions"]][["args"]][[2]], 71 | "--profile-directory=b" 72 | ) 73 | }) 74 | 75 | # test_that("canStartPhantom", { 76 | # if(Sys.info()[["sysname"]] != "Linux") return() 77 | # with_mock( 78 | # `base::system2` = function(command, args, ...){ 79 | # if(grepl("myphantompath", command)){ 80 | # return(0L) 81 | # } 82 | # }, 83 | # `base::system` = function(command, ...){ 84 | # if(grepl('ps -Ao"%p"', command)){ 85 | # return(100L) 86 | # } 87 | # if(grepl('ps -Ao"%a"', command)){ 88 | # return("phantomjs") 89 | # } 90 | # }, 91 | # `tools::pskill` = function(pid, ...){ 92 | # return(pid) 93 | # }, 94 | # { 95 | # out <- phantom("myphantompath") 96 | # expect_identical(out$getPID(), 100L) 97 | # expect_identical(out$stop(), 100L) 98 | # } 99 | # 100 | # ) 101 | # }) 102 | 103 | test_that("canMakeFirefoxProfile", { 104 | if (Sys.info()[["sysname"]] != "Linux") { 105 | return() 106 | } 107 | fprof <- makeFirefoxProfile(list(browser.download.dir = "D:/temp")) 108 | expect_identical(names(fprof), "firefox_profile") 109 | }) 110 | -------------------------------------------------------------------------------- /vignettes/internetexplorer.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Internet Explorer" 3 | author: "Sebastian Wolf" 4 | output: 5 | html_vignette: 6 | toc: yes 7 | vignette: > 8 | %\VignetteIndexEntry{Internet Explorer} 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteEncoding{UTF-8} 11 | --- 12 | 13 | **NOTE: Internet Explorer 11 has retired as of June 15, 2022.** 14 | 15 | ## Introduction 16 | 17 | This tutorial shall show you creating a setup that allows you to test web apps using Selenium Server + a connection to Microsoft Internet Explorer. It contains the most important tricks in Microsoft Windows you'll need to perform. Additionally some extra information is given on how to change default methods like clicking to run stable in Internet Explorer. 18 | 19 | 20 | ## Windows Registry setup 21 | 22 | ### Admin rights 23 | 24 | You will need administrator rights to perform all steps in this chapter 25 | 26 | ### Edit Registry Main 27 | 28 | To allow the Internet Explorer Selenium connection there are certain settings in the Windows Registry that need to be changed. 29 | 30 | Open registry by `regedit` command on Windows 31 | 32 | Create the Key: 33 | 34 | ``` 35 | HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BFCACHE 36 | ``` 37 | 38 | Please note that the `FEATURE_BFCACHE` subkey may or may not be present, and should be created if it is not present. 39 | 40 | **Important**: Inside this key, create a `DWORD` value named `iexplore.exe` with the value of `0`. 41 | 42 | ### Edit Registry User 43 | 44 | Create the Key: 45 | 46 | ``` 47 | HKEY_LOCAL_MACHINE \SOFTW ARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BFCACHE 48 | ``` 49 | 50 | Please note that the `FEATURE_BFCACHE` subkey may or may not be present, and should be created if it is not present. 51 | 52 | **Important**: Inside this key, create a `DWORD` value named `iexplore.exe` with the value of `0`. 53 | 54 | ### Allow Window Navigation 55 | 56 | Go to: 57 | 58 | ``` 59 | HKEY_CURRENT_USER \Software 60 | \Microsoft \Internet Explorer \Main 61 | ``` 62 | 63 | Inside this key (Main) , create a `DWORD` value named `TabProcGrowth` with the value of `0`. 64 | 65 | 66 | ## Selenium Server 67 | 68 | To use Internet Explorer there is sadly just one way to use a Selenium Server which is running it via the Java Binary as explained in the **Basics** vignette of this package. 69 | 70 | 71 | ## Selenium Driver 72 | 73 | For Internet Explorer please download the 32-bit version of the SeleniumDriver. The 64 bit version still has trouble inserting text and can make your user interface testing really slow. 74 | 75 | Please have the `IEDriverServer.exe` in your PATH variable. You can simply do this by using 76 | 77 | ```R 78 | ie_driver_folder <- "C:\\Selenium" 79 | Sys.setenv(PATH = paste(ie_driver_folder, Sys.getenv("PATH"), sep = ";")) 80 | ``` 81 | 82 | if you copied the "IEDriverServer.exe" to `C:\Selenium` 83 | 84 | 85 | ## Initialization for a Selenium Driver object 86 | 87 | ### Set extra capabilities 88 | 89 | For initialization of a Selenium Driver object in with Internet Explorer there are certain extra settings to be made. The first one are the extraCapabilities. Not all of these are needed, but those 90 | 91 | - `ie.forceCreateProcessApi=FALSE` and `InternetExplorerDriver.INTRODUCE_FLAKINESS_BY_IGNORING_SECURITY_DOMAIN=TRUE` are needed to basically access the Internet Explorer from Selenium. 92 | - `InternetExplorerDriver.IGNORE_ZOOM_SETTING=TRUE` will allow you to start Internet Explorer Selenium Driver Sessions even if you did not set the zoom to "100%" before starting your session. 93 | - `requireWindowFocus=TRUE` allows more native browser interactions. 94 | - `enablePersistentHover=FALSE` allows you to hover and focus elements. 95 | 96 | So please define a list like that: 97 | 98 | ```R 99 | extraCapabilities <- list( 100 | ie.forceCreateProcessApi = FALSE, 101 | InternetExplorerDriver.INTRODUCE_FLAKINESS_BY_IGNORING_SECURITY_DOMAIN = TRUE, 102 | InternetExplorerDriver.IGNORE_ZOOM_SETTING = TRUE, 103 | requireWindowFocus = TRUE, 104 | enablePersistentHover = FALSE 105 | ) 106 | ``` 107 | 108 | ### Start the driver 109 | 110 | To navigate to your first page you can now start the remoteDriver. Please note that Internet Explorer will now open and connect to the local Selenium Server. You need to have the following: 111 | 112 | ```R 113 | remDr <- remoteDriver( 114 | browserName = "internet explorer", 115 | extraCapabilities = extraCapabilities 116 | ) 117 | remDr$open() 118 | remDr$setImplicitWaitTimeout(as.numeric(10000)) 119 | 120 | url <- "https://docs.ropensci.org/RSelenium" 121 | remDr$navigate(url) 122 | ``` 123 | 124 | We use a global definition of the `remDr` element as there exists no possibility to create two parallel sessions using Internet Explorer. Additionally it is necessary to set a really long implicit wait timeout due to basic troubles Internet Explorer might have running multiple tests in a row. 125 | 126 | ### Initialization for more reproducible tests 127 | 128 | For reproducibility reasons we noticed that in Internet Explorer you either want to always maximize the screen or set it to a fixed size. Additionally always move the Window to the top left corner of your screen. This is mainly important for checking images that you want to compare against other images created by your web app. 129 | 130 | ```R 131 | remDr$navigate(url) 132 | remDr$maxWindowSize() 133 | remDr$setWindowSize(1936, 1056) 134 | remDr$setWindowPosition(0, 0) 135 | ``` 136 | 137 | ### Additional functionalities for testing shiny 138 | 139 | Shiny may sometimes run inside `iframes`. In Internet Explorer it might be hard to get into those. Therefore in testing shiny using Internet Explorer we recommend adding a boolean variable called `in_shiny` to your sessionInfo. 140 | 141 | ```R 142 | remDr$sessionInfo$in_shiny <- FALSE 143 | ``` 144 | 145 | This variable can be used to check if you are running inside the shiny app already or not. You do not want do go into an iframe inside the shiny app, if you are already inside the shiny app. 146 | 147 | So after starting a Selenium Session maybe do the following: 148 | 149 | Navigate to the mainframe 150 | 151 | ```R 152 | remDr$sessionInfo$in_shiny <- FALSE 153 | object$switchToFrame(NULL) 154 | object$setImplicitWaitTimeout(1000) 155 | ``` 156 | 157 | Navigate into the first iframe if an iframe is there. 158 | 159 | ```R 160 | iframe_found <- TRUE 161 | 162 | if (length(remDr$findElements("tag", "iframe")) == 0 || remDr$sessionInfo$in_shiny) { 163 | iframe_found <- FALSE 164 | remDr$sessionInfo$in_shiny <- TRUE 165 | } else { 166 | remDr$sessionInfo$in_shiny <- TRUE 167 | remDr$switchToFrame(remDr$findElements("tag", "iframe")[[1]]) 168 | } 169 | ``` 170 | 171 | 172 | ## Interacting with the page 173 | 174 | ### Clicking 175 | 176 | As simple as it might seem, during a lot of test runs using Internet Explorer for Web testing with Selenium, we found that clicking might have some hurdles. Instead of using the basic `click` functionality of Selenium we recommend either 177 | 178 | 1. Move the mouse to the element and click 179 | 180 | ```R 181 | web_element <- remDr$findElements("tag", "a")[[1]] 182 | remDr$mouseMoveToLocation( 183 | x = round(web_element$getElementSize()$width / 3), 184 | y = round(web_element_selector$getElementSize()$height / 3), 185 | webElement = web_element 186 | ) 187 | web_element$clickElement() 188 | ``` 189 | 190 | 2. Click by using javascript 191 | 192 | ```R 193 | remDr$executeScript("arguments[0].click();", list(web_element)) 194 | ``` 195 | 196 | ### Entering Text in a input text field 197 | 198 | For entering a text into a Text box in Internet Explorer we highly recommend to first set the value of the text box. Afterwards clean it and then send the character string to the textbox to type it in. 199 | 200 | ```R 201 | web_element <- remDr$findElements("css selector", "input[type='text']")[[1]] 202 | text_to_type = "My input text" 203 | remDr$executeScript( 204 | paste0("arguments[0].setAttribute('value','", text_to_type, "');"), 205 | list(web_element) 206 | ) 207 | 208 | web_element$clearElement() 209 | web_element$sendKeysToElement(list(text_to_type)) 210 | ``` 211 | 212 | ### Checking a checkbox 213 | 214 | It may seem simple, but it is one of the hardest parts using Selenium to check a checkbox. In Internet Explorer there is just one way to make it save and always happen. 215 | 216 | **Important** You are never allowed to not have the cursor on the screen where Internet Explorer is running. You need to have the Internet Explorer Window focused. 217 | 218 | Please always get the checkboxed focus by executing Javascript code using Selenium and afterwards click just the `input` element of this checkbox. 219 | 220 | ```R 221 | checkboxes <- remDr$findElements("class name", "checkbox") 222 | remDr$executeScript( 223 | "arguments[0].focus();", 224 | list(checkboxes[[1]]$findChildElements("tag", "input")[[1]]) 225 | ) 226 | checkboxes[[1]]$findChildElements("tag", "input")[[1]]$clickElement() 227 | ``` 228 | --------------------------------------------------------------------------------