From 2ccd4da8cccc9898d2857dc5ac5af350d3bfd0ab Mon Sep 17 00:00:00 2001 From: Bob Rudis Date: Tue, 21 Feb 2017 11:07:43 -0500 Subject: [PATCH] better info in README; tweaks to image renderers; splash_local default parameter to many render functions --- R/docker.r | 53 ------------------ R/render-har.r | 2 +- R/render-html.r | 2 +- R/render-jpg.r | 6 ++- R/render-json.r | 2 +- R/render-png.r | 20 ++++--- R/render_file.R | 2 +- R/splashr.r | 10 ++-- README.Rmd | 53 +++++++++--------- README.md | 138 ++++++++++++++++++++++------------------------- img/cap.jpg | Bin 126298 -> 42444 bytes img/cap.png | Bin 447385 -> 335346 bytes man/install_splash.Rd | 16 +----- man/render_file.Rd | 4 +- man/render_har.Rd | 9 ++-- man/render_html.Rd | 4 +- man/render_jpeg.Rd | 4 +- man/render_json.Rd | 4 +- man/render_png.Rd | 14 ++--- man/splash_active.Rd | 2 +- man/splash_debug.Rd | 2 +- man/splash_history.Rd | 2 +- man/splash_perf_stats.Rd | 2 +- man/splash_version.Rd | 2 +- man/start_splash.Rd | 22 +------- man/stop_splash.Rd | 20 +------ 26 files changed, 143 insertions(+), 252 deletions(-) delete mode 100644 R/docker.r diff --git a/R/docker.r b/R/docker.r deleted file mode 100644 index 406539a..0000000 --- a/R/docker.r +++ /dev/null @@ -1,53 +0,0 @@ -#' Retrieve the Docker image for Splash -#' -#' @md -#' @param host Docker host; defauolts to `localhost` -#' @return `harbor` `host` object -#' @export -#' @examples \dontrun{ -#' install_splash() -#' splash_container <- start_splash() -#' stop_splash(splash_container) -#' } -install_splash <- function(host = harbor::localhost) { - harbor::docker_pull(host, "scrapinghub/splash") -} - -#' Start a Splash server Docker container -#' -#' @param host Docker host; defauolts to `localhost` -#' @note you need Docker running on your system and have pulled the container with -#' [install_spash] for this to work. You should save the resultant `host` -#' object for use in [stop_splash]. -#' @return `harbor` `container` object -#' @export -#' @examples \dontrun{ -#' install_splash() -#' splash_container <- start_splash() -#' stop_splash(splash_container) -#' } -start_splash <- function(host = harbor::localhost) { - harbor::docker_run(host, - image = "scrapinghub/splash", - detach = TRUE, - docker_opts = c("-p", "5023:5023", - "-p", "8050:8050", - "-p", "8051:8051")) -} - -#' Stop a running a Splash server Docker container -#' -#' @param splash_container saved Splash container id from [start_splash] -#' @param splash_container Docker `container` object created by [start_splash] -#' @note you need Docker running on your system and have pulled the container with -#' [install_spash] and started the Splash container with [start_splash] for this -#' to work. You will need the `container` object from [start_splash] for this to work. -#' @export -#' @examples \dontrun{ -#' install_splash() -#' splash_container <- start_splash() -#' stop_splash(splash_container) -#' } -stop_splash <- function(splash_container) { - harbor::container_rm(splash_container, force=TRUE) -} diff --git a/R/render-har.r b/R/render-har.r index a042087..a40644e 100644 --- a/R/render-har.r +++ b/R/render-har.r @@ -9,7 +9,7 @@ #' @return a [HARtools::har] object #' @references [Splash docs](http://splash.readthedocs.io/en/stable/index.html) #' @export -render_har <- function(splash_obj, url, base_url, response_body=FALSE, timeout=30, resource_timeout, wait=0, +render_har <- function(splash_obj = splash_local, url, base_url, response_body=FALSE, timeout=30, resource_timeout, wait=0, proxy, js, js_src, filters, allowed_domains, allowed_content_types, forbidden_content_types, viewport="1024x768", images, headers, body, http_method, save_args, load_args) { diff --git a/R/render-html.r b/R/render-html.r index 4895eb6..ea33a69 100644 --- a/R/render-html.r +++ b/R/render-html.r @@ -30,7 +30,7 @@ #' character vector. #' @references [Splash docs](http://splash.readthedocs.io/en/stable/index.html) #' @export -render_html <- function(splash_obj, url, base_url, timeout=30, resource_timeout, wait=0, +render_html <- function(splash_obj = splash_local, url, base_url, timeout=30, resource_timeout, wait=0, proxy, js, js_src, filters, allowed_domains, allowed_content_types, forbidden_content_types, viewport="1024x768", images, headers, body, http_method, save_args, load_args, raw_html=FALSE) { diff --git a/R/render-jpg.r b/R/render-jpg.r index 3ad53d2..3ac2c4f 100644 --- a/R/render-jpg.r +++ b/R/render-jpg.r @@ -8,13 +8,15 @@ #' @references [Splash docs](http://splash.readthedocs.io/en/stable/index.html) #' @export render_jpeg <- render_jpg <- function( - splash_obj, url, base_url=NULL, quality=75, width=1024, height=768, + splash_obj = splash_local, url, base_url=NULL, quality=75, width=1024, height=768, timeout=30, resource_timeout, wait=0, render_all=FALSE, proxy, js, js_src, filters, allowed_domains, allowed_content_types, forbidden_content_types, viewport="1024x768", images, headers, body, http_method, save_args, load_args) { - params <- list(url=url, timeout=timeout, wait=wait, viewport=viewport, + params <- list(url=url, timeout=timeout, + wait=if (render_all & wait == 0) 0.5 else wait, + viewport=viewport, quality=quality, width=width, height=height, render_all=as.numeric(render_all)) if (!missing(base_url)) params$base_url <- base_url diff --git a/R/render-json.r b/R/render-json.r index 17bfee0..e40429d 100644 --- a/R/render-json.r +++ b/R/render-json.r @@ -27,7 +27,7 @@ #' overwhelmed with data. Use [str] to inspect various portions of the result. #' @references [Splash docs](http://splash.readthedocs.io/en/stable/index.html) #' @export -render_json <- function(splash_obj, url, base_url=NULL, quality=75, width=1024, height=768, +render_json <- function(splash_obj = splash_local, url, base_url=NULL, quality=75, width=1024, height=768, timeout=30, resource_timeout, wait=0, render_all=FALSE, proxy, js, js_src, filters, allowed_domains, allowed_content_types, forbidden_content_types, viewport="1024x768", images, headers, body, diff --git a/R/render-png.r b/R/render-png.r index 2cdb3b3..f716bc7 100644 --- a/R/render-png.r +++ b/R/render-png.r @@ -7,14 +7,17 @@ #' @references [Splash docs](http://splash.readthedocs.io/en/stable/index.html) #' @inheritParams render_html #' @export -render_png <- function(splash_obj, url, base_url, width=1024, height=768, render_all=TRUE, - timeout=30, resource_timeout, wait=0, - proxy, js, js_src, filters, allowed_domains, allowed_content_types, - forbidden_content_types, viewport="1024x768", images, headers, body, - http_method, save_args, load_args) { +render_png <- function( + splash_obj = splash_local, url, base_url=NULL, quality=75, width=1024, height=768, + timeout=30, resource_timeout, wait=0, render_all=FALSE, + proxy, js, js_src, filters, allowed_domains, allowed_content_types, + forbidden_content_types, viewport="1024x768", images, headers, body, + http_method, save_args, load_args) { - params <- list(url=url, timeout=timeout, wait=wait, viewport=viewport, - width=width, height=height, render_all=as.numeric(render_all)) + params <- list(url=url, timeout=timeout, + wait=if (render_all & wait == 0) 0.5 else wait, + viewport=viewport, + quality=quality, width=width, height=height, render_all=as.numeric(render_all)) if (!missing(base_url)) params$base_url <- base_url if (!missing(resource_timeout)) params$resource_timeout <- resource_timeout @@ -38,4 +41,5 @@ render_png <- function(splash_obj, url, base_url, width=1024, height=768, render magick::image_read(httr::content(res, as="raw")) -} \ No newline at end of file +} + diff --git a/R/render_file.R b/R/render_file.R index b1f7cde..28d7e6e 100644 --- a/R/render_file.R +++ b/R/render_file.R @@ -13,7 +13,7 @@ #' @param ... other params to [render_html]() or [render_png]() #' @return An XML document or `magick` object #' @export -render_file <- function(splash_obj, file_path, output=c("html", "png"), wait=0, viewport="1024x768", ...) { +render_file <- function(splash_obj = slpash_local, file_path, output=c("html", "png"), wait=0, viewport="1024x768", ...) { output <- match.arg(output, c("html", "png")) diff --git a/R/splashr.r b/R/splashr.r index 082e191..69135a6 100644 --- a/R/splashr.r +++ b/R/splashr.r @@ -21,7 +21,7 @@ s_GET <- purrr::safely(GET) #' @param splash_obj A splash connection object #' @return `TRUE` if Slash server is running, otherwise `FALSE` #' @export -splash_active <- function(splash_obj) { +splash_active <- function(splash_obj = splash_local) { res <- s_GET(splash_url(splash_obj), path="_ping") @@ -46,7 +46,7 @@ splash_active <- function(splash_obj) { #' #' @param splash_obj A splash connection object #' @export -splash_version <- function(splash_obj) { +splash_version <- function(splash_obj = splash_local) { execute_lua(splash_obj, ' function main(splash) return splash:get_version() @@ -59,7 +59,7 @@ end #' #' @param splash_obj A splash connection object #' @export -splash_history <- function(splash_obj) { +splash_history <- function(splash_obj = splash_local) { execute_lua(splash_obj, ' function main(splash) return splash:history() @@ -73,7 +73,7 @@ end #' #' @param splash_obj A splash connection object #' @export -splash_perf_stats <- function(splash_obj) { +splash_perf_stats <- function(splash_obj = splash_local) { execute_lua(splash_obj, ' function main(splash) return splash:get_perf_stats() @@ -86,7 +86,7 @@ end #' #' @param splash_obj A splash connection object #' @export -splash_debug <- function(splash_obj) { +splash_debug <- function(splash_obj = splash_local) { httr::GET(splash_url(splash_obj), path="_debug") %>% httr::stop_for_status() %>% diff --git a/README.Rmd b/README.Rmd index 6bf7f24..8ca5a01 100644 --- a/README.Rmd +++ b/README.Rmd @@ -15,7 +15,14 @@ You can also get it running with two commands: sudo docker pull hrbrmstr/splashttpd sudo docker run -p 5023:5023 -p 8050:8050 -p 8051:8051 hrbrmstr/splashttpd -(Do whatever you Windows ppl do with Docker on your systems to make ^^ work.) +Do whatever you Windows ppl do with Docker on your systems to make ^^ work. + +Folks super-new to Docker on Unix-ish platforms should [make sure to do](https://github.com/hrbrmstr/splashr/issues/3#issuecomment-280686494): + + sudo groupadd docker + sudo usermod -aG docker $USER + +(`$USER` is your username and shld be defined for you in the environment) If using the [`harbor`](https://github.com/wch/harbor) package you can use the convience wrappers in this pacakge: @@ -26,7 +33,7 @@ and then run: stop_splash(splash_container) -when done. All of that happens on your localhost so use `localhost` as the Splash server parameter. +when done. All of that happens on your localhost and you will not need to specify `splash_obj` to many of the `splashr` functions if you're running Splash in this default configuration as long as you use named parameters. You can also use the pre-defined `splash_local` object if you want to use positional parameters. You can run Selenium in Docker, so this is not unique to Splash. But, a Docker context makes it so that you don't have to run or maintain icky Python stuff directly on your system. Leave it in the abandoned warehouse district where it belongs. @@ -111,6 +118,8 @@ options(width=120) ### Usage +NOTE: ALL of these examples assume Splash is running in the default configuraiton on `localhost` (i.e. started with `start_splash()` or the docker example commands) unless otherwise noted. + ```{r message=FALSE, warning=FALSE, error=FALSE} library(splashr) library(magick) @@ -124,27 +133,23 @@ library(tidyverse) # current verison packageVersion("splashr") -splash("splash", 8050L) %>% - splash_active() +splash_active() -splash("splash", 8050L) %>% - splash_debug() +splash_debug() ``` Notice the difference between a rendered HTML scrape and a non-rendered one: ```{r} -splash("splash", 8050L) %>% - render_html("http://marvel.com/universe/Captain_America_(Steve_Rogers)") +render_html(url = "http://marvel.com/universe/Captain_America_(Steve_Rogers)") -read_html("http://marvel.com/universe/Captain_America_(Steve_Rogers)") +xml2::read_html("http://marvel.com/universe/Captain_America_(Steve_Rogers)") ``` You can also profile pages: ```{r} -splash("splash", 8050L) %>% - render_har("http://www.poynter.org/") -> har +render_har(url = "http://www.poynter.org/") -> har print(har) ``` @@ -154,26 +159,22 @@ You can use [`HARtools::HARviewer`](https://github.com/johndharrison/HARtools/bl Full web page snapshots are easy-peasy too: ```{r eval=FALSE} -splash("splash", 8050L) %>% - render_png("http://marvel.com/universe/Captain_America_(Steve_Rogers)") +render_png(url = "http://www.marveldirectory.com/individuals/c/captainamerica.htm") ``` ```{r eval=TRUE, include=FALSE} -splash("splash", 8050L) %>% - render_png("http://marvel.com/universe/Captain_America_(Steve_Rogers)") %>% +render_png(url = "http://www.marveldirectory.com/individuals/c/captainamerica.htm") %>% image_write("img/cap.png") ``` ![](img/cap.png) ```{r eval=FALSE} -splash("splash", 8050L) %>% - render_jpeg("http://marvel.com/universe/Captain_America_(Steve_Rogers)") +render_jpeg(url = "http://static2.comicvine.com/uploads/scale_small/3/31666/5052983-capasr2016001-eptingvar-18bdb.jpg") ``` ```{r eval=TRUE, include=FALSE} -splash("splash", 8050L) %>% - render_jpeg("http://marvel.com/universe/Captain_America_(Steve_Rogers)") %>% +render_jpeg(url = "http://static2.comicvine.com/uploads/scale_small/3/31666/5052983-capasr2016001-eptingvar-18bdb.jpg") %>% image_write("img/cap.jpg") ``` @@ -191,7 +192,7 @@ function main(splash) end ' -res <- splash("localhost") %>% execute_lua(lua_ex) +splash_local %>% execute_lua(lua_ex) -> res rawToChar(res) %>% jsonlite::fromJSON() @@ -200,10 +201,10 @@ rawToChar(res) %>% ### Rendering Widgets ```{r eval=FALSE} -splash_vm <- start_splash(add_tempdir=TRUE) +splash_vm <- start_splash(add_tempdir = TRUE) ``` -```{r} +```{r eval=FALSE} DiagrammeR(" graph LR A-->B @@ -216,13 +217,7 @@ DiagrammeR(" ") %>% saveWidget("/tmp/diag.html") -splash("localhost") %>% - render_file("/tmp/diag.html", output="html") -``` - -```{r eval=FALSE} -splash("localhost") %>% - render_file("/tmp/diag.html", output="png", wait=2) +render_file(url = "/tmp/diag.html", output="html") ``` ![](img/diag.png) diff --git a/README.md b/README.md index e7467d7..11139dd 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,14 @@ You can also get it running with two commands: sudo docker pull hrbrmstr/splashttpd sudo docker run -p 5023:5023 -p 8050:8050 -p 8051:8051 hrbrmstr/splashttpd -(Do whatever you Windows ppl do with Docker on your systems to make ^^ work.) +Do whatever you Windows ppl do with Docker on your systems to make ^^ work. + +Folks super-new to Docker on Unix-ish platforms should [make sure to do](https://github.com/hrbrmstr/splashr/issues/3#issuecomment-280686494): + + sudo groupadd docker + sudo usermod -aG docker $USER + +(`$USER` is your username and shld be defined for you in the environment) If using the [`harbor`](https://github.com/wch/harbor) package you can use the convience wrappers in this pacakge: @@ -23,7 +30,7 @@ and then run: stop_splash(splash_container) -when done. All of that happens on your localhost so use `localhost` as the Splash server parameter. +when done. All of that happens on your localhost and you will not need to specify `splash_obj` to many of the `splashr` functions if you're running Splash in this default configuration as long as you use named parameters. You can also use the pre-defined `splash_local` object if you want to use positional parameters. You can run Selenium in Docker, so this is not unique to Splash. But, a Docker context makes it so that you don't have to run or maintain icky Python stuff directly on your system. Leave it in the abandoned warehouse district where it belongs. @@ -31,7 +38,7 @@ All you need for this package to work is a running Splash instance. You provide ### About Splash -> 'Splash' is a javascript rendering service. It’s a lightweight web browser with an 'HTTP' API, implemented in Python using 'Twisted'and 'QT' [and provides some of the core functionality of the 'RSelenium' or 'seleniumPipes' R packages but with a Java-free footprint]. The (twisted) 'QT' reactor is used to make the sever fully asynchronous allowing to take advantage of 'webkit' concurrency via QT main loop. Some of Splash features include the ability to process multiple webpages in parallel; retrieving HTML results and/or take screenshots; disabling images or use Adblock Plus rules to make rendering faster; executing custom JavaScript in page context; getting detailed rendering info in HAR format. +> 'Splash' is a javascript rendering service. It’s a lightweight web browser with an 'HTTP' API, implemented in Python using 'Twisted'and 'QT' \[and provides some of the core functionality of the 'RSelenium' or 'seleniumPipes' R packages but with a Java-free footprint\]. The (twisted) 'QT' reactor is used to make the sever fully asynchronous allowing to take advantage of 'webkit' concurrency via QT main loop. Some of Splash features include the ability to process multiple webpages in parallel; retrieving HTML results and/or take screenshots; disabling images or use Adblock Plus rules to make rendering faster; executing custom JavaScript in page context; getting detailed rendering info in HAR format. The following functions are implemented: @@ -48,40 +55,40 @@ The following functions are implemented: Mini-DSL (domain-specific language). These can be used to create a "script" without actually scripting in Lua. They are a less-powerful/configurable set of calls than what you can make with a full Lua function but the idea is to have it take care of very common but simple use-cases, like waiting a period of time before capturing a HAR/HTML/PNG image of a site: -- `splash_plugins`: Enable or disable browser plugins (e.g. Flash). -- `splash_images`: Enable/disable images -- `splash_response_body`: Enable or disable response content tracking. -- `splash_go`: Go to an URL. -- `splash_wait`: Wait for a period time -- `splash_har`: Return information about Splash interaction with a website in HAR format. -- `splash_html`: Return a HTML snapshot of a current page. -- `splash_png`: Return a screenshot of a current page in PNG format. -- `splash_user_agent: Overwrite the User-Agent header for all further requests. NOTE: There are many "helper" user agent strings to go with `splash_user_agent`. Look for objects in `splashr` starting with `ua_`. +- `splash_plugins`: Enable or disable browser plugins (e.g. Flash). +- `splash_images`: Enable/disable images +- `splash_response_body`: Enable or disable response content tracking. +- `splash_go`: Go to an URL. +- `splash_wait`: Wait for a period time +- `splash_har`: Return information about Splash interaction with a website in HAR format. +- `splash_html`: Return a HTML snapshot of a current page. +- `splash_png`: Return a screenshot of a current page in PNG format. +- `splash_user_agent: Overwrite the User-Agent header for all further requests. NOTE: There are many "helper" user agent strings to go with`splash\_user\_agent`. Look for objects in`splashr`starting with`ua\_\`. `httr` helpers. These help turn various bits of `splashr` objects into `httr`-ish things: -- `as_req`: Turn a HAR response entry into a working `httr` function you can use to make a request with -- `as_request`: Turn a HAR response entry into an `httr` `response`-like object (i.e. you can use `httr::content()` on it) +- `as_req`: Turn a HAR response entry into a working `httr` function you can use to make a request with +- `as_request`: Turn a HAR response entry into an `httr` `response`-like object (i.e. you can use `httr::content()` on it) Helpers: -- `get_body_size`: Retrieve size of content | body | headers -- `get_content_sie`: Retrieve size of content | body | headers -- `get_content_type` Retrieve or test content type of a HAR request object -- `get_headers_size` Retrieve size of content | body | headers -- `is_binary`: Retrieve or test content type of a HAR request object -- `is_content_type`: Retrieve or test content type of a HAR request object -- `is_css`: Retrieve or test content type of a HAR request object -- `is_gif`: Retrieve or test content type of a HAR request object -- `is_html`: Retrieve or test content type of a HAR request object -- `is_javascript`: Retrieve or test content type of a HAR request object -- `is_jpeg`: Retrieve or test content type of a HAR request object -- `is_json`: Retrieve or test content type of a HAR request object -- `is_plain`: Retrieve or test content type of a HAR request object -- `is_png`: Retrieve or test content type of a HAR request object -- `is_svg`: Retrieve or test content type of a HAR request object +- `get_body_size`: Retrieve size of content | body | headers +- `get_content_sie`: Retrieve size of content | body | headers +- `get_content_type` Retrieve or test content type of a HAR request object +- `get_headers_size` Retrieve size of content | body | headers +- `is_binary`: Retrieve or test content type of a HAR request object +- `is_content_type`: Retrieve or test content type of a HAR request object +- `is_css`: Retrieve or test content type of a HAR request object +- `is_gif`: Retrieve or test content type of a HAR request object +- `is_html`: Retrieve or test content type of a HAR request object +- `is_javascript`: Retrieve or test content type of a HAR request object +- `is_jpeg`: Retrieve or test content type of a HAR request object +- `is_json`: Retrieve or test content type of a HAR request object +- `is_plain`: Retrieve or test content type of a HAR request object +- `is_png`: Retrieve or test content type of a HAR request object +- `is_svg`: Retrieve or test content type of a HAR request object - `is_xhr`: Retrieve or test content type of a HAR request object -- `is_xml`: Retrieve or test content type of a HAR request object +- `is_xml`: Retrieve or test content type of a HAR request object Some functions from `HARtools` are imported/exported and `%>%` is imported/exported. @@ -108,6 +115,8 @@ options(width=120) ### Usage +NOTE: ALL of these examples assume Splash is running in the default configuraiton on `localhost` (i.e. started with `start_splash()` or the docker example commands) unless otherwise noted. + ``` r library(splashr) library(magick) @@ -125,46 +134,43 @@ packageVersion("splashr") ## [1] '0.3.0' ``` r -splash("splash", 8050L) %>% - splash_active() +splash_active() ``` ## [1] TRUE ``` r -splash("splash", 8050L) %>% - splash_debug() +splash_debug() ``` ## List of 7 ## $ active : list() ## $ argcache: int 0 - ## $ fds : int 17 + ## $ fds : int 21 ## $ leaks :List of 4 ## ..$ Deferred : int 50 ## ..$ LuaRuntime: int 1 ## ..$ QTimer : int 1 ## ..$ Request : int 1 - ## $ maxrss : int 491092 + ## $ maxrss : int 202020 ## $ qsize : int 0 - ## $ url : chr "http://splash:8050" + ## $ url : chr "http://localhost:8050" ## - attr(*, "class")= chr [1:2] "splash_debug" "list" ## NULL Notice the difference between a rendered HTML scrape and a non-rendered one: ``` r -splash("splash", 8050L) %>% - render_html("http://marvel.com/universe/Captain_America_(Steve_Rogers)") +render_html(url = "http://marvel.com/universe/Captain_America_(Steve_Rogers)") ``` ## {xml_document} ## - ## [1] \n