1#! /usr/bin/env Rscript 2 3## To get the async package: 4## source("https://install-github.me/r-lib/async") 5 6setup_app <- function() { 7 theme <- list("url" = list(color = "blue")) 8 app <- cli::start_app(theme = theme, output = "stdout") 9} 10 11load_packages <- function() { 12 tryCatch({ 13 library(cli) 14 library(async) 15 library(docopt) }, 16 error = function(e) { 17 cli_alert_danger("The {.pkg async} and {.pkg docopt} packages are needed!") 18 q(save = "no", status = 1) 19 }) 20} 21 22up <- function(urls, timeout = 5) { 23 load_packages() 24 setup_app() 25 chk_url <- async(function(url, ...) { 26 http_head(url, ...)$ 27 then(function(res) { 28 if (res$status_code < 300) { 29 cli_alert_success("{.url {url}} ({res$times[['total']]}s)") 30 } else { 31 cli_alert_danger("{.url {url}} (HTTP {res$status_code})") 32 } 33 })$ 34 catch(error = function(err) { 35 e <- if (grepl("timed out", err$message)) "timed out" else "error" 36 cli_alert_danger("{.url {url}} ({e})") 37 }) 38 }) 39 40 invisible(synchronise( 41 async_map(urls, chk_url, options = list(timeout = timeout)) 42 )) 43} 44 45parse_arguments <- function() { 46 47 "Usage: 48 up.R [-t timeout] [URLS ...] 49 up.R -h | --help 50 51Options: 52 -t timeout Timeout for giving up on a site, in seconds [default: 5]. 53 -h --help Print this help message 54 55Check if web sites are up. 56" -> doc 57 58 docopt(doc) 59} 60 61if (is.null(sys.calls())) { 62 load_packages() 63 opts <- parse_arguments() 64 up(opts$URLS, timeout = as.numeric(opts$t)) 65} 66