Mercurial > repos > prog > lcmsmatching
diff UrlRequestScheduler.R @ 6:f86fec07f392 draft default tip
planemo upload commit c397cd8a93953798d733fd62653f7098caac30ce
author | prog |
---|---|
date | Fri, 22 Feb 2019 16:04:22 -0500 |
parents | fb9c0409d85c |
children |
line wrap: on
line diff
--- a/UrlRequestScheduler.R Wed Apr 19 10:00:05 2017 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,126 +0,0 @@ -if ( ! exists('UrlRequestScheduler')) { # Do not load again if already loaded - - ############# - # CONSTANTS # - ############# - - RLIB.GET <- 'GET' - RLIB.POST <- 'POST' - - ##################### - # CLASS DECLARATION # - ##################### - - UrlRequestScheduler <- setRefClass("UrlRequestScheduler", fields = list(.n = "numeric", .t = "numeric", .time.of.last.request = "ANY", .useragent = "character", .ssl.verifypeer = "logical", .nb.max.tries = "integer", .verbose = "integer")) - - # n: number of connections - # t: time (in seconds) - - # The scheduler restrict the number of connections at n per t seconds. - - ############### - # CONSTRUCTOR # - ############### - - UrlRequestScheduler$methods( initialize = function(n = 1, t = 1, useragent = NA_character_, ssl.verifypeer = TRUE, ...) { - .n <<- n - .t <<- t - .time.of.last.request <<- -1 - .useragent <<- useragent - .nb.max.tries <<- 10L - .ssl.verifypeer <<- ssl.verifypeer - .verbose <<- 0L - callSuper(...) # calls super-class initializer with remaining parameters - }) - - ################## - # SET USER AGENT # - ################## - - UrlRequestScheduler$methods( setUserAgent = function(useragent) { - .useragent <<- useragent - }) - - ############### - # SET VERBOSE # - ############### - - UrlRequestScheduler$methods( setVerbose = function(verbose) { - .verbose <<- verbose - }) - - ################## - # WAIT AS NEEDED # - ################## - - # Wait the specified between two requests. - UrlRequestScheduler$methods( .wait.as.needed = function() { - - # Compute minimum waiting time between two URL requests - waiting_time <- .self$.t / .self$.n - - # Wait, if needed, before previous URL request and this new URL request. - if (.self$.time.of.last.request > 0) { - spent_time <- Sys.time() - .self$.time.of.last.request - if (spent_time < waiting_time) - Sys.sleep(waiting_time - spent_time) - } - - # Store current time - .time.of.last.request <<- Sys.time() - }) - - #################### - # GET CURL OPTIONS # - #################### - - UrlRequestScheduler$methods( .get_curl_opts = function(url) { - opts <- curlOptions(useragent = .self$.useragent, timeout.ms = 60000, verbose = FALSE) - return(opts) - }) - - ########### - # GET URL # - ########### - - UrlRequestScheduler$methods( .doGetUrl = function(url, params = NULL, method = RLIB.GET) { - - content <- NA_character_ - - # Use form to send URL request - if ( ! is.null(params) && ! is.na(params)) - switch(method, - GET = { content <- getForm(url, .opts = .self$.get_curl_opts(), .params = params) }, - POST = { content <- postForm(url, .opts = .self$.get_curl_opts(), .params = params) }, - stop(paste('Unknown method "', method, '".')) - ) - - # Get URL normally - else - content <- getURL(url, .opts = .self$.get_curl_opts(), ssl.verifypeer = .self$.ssl.verifypeer) - - return(content) - }) - - UrlRequestScheduler$methods( getUrl = function(url, params = NULL, method = RLIB.GET) { - - # Load library here and not inside .doGetUrl() since it is called from inside a try/catch clause, hence if library is missing the error will be ignored. - library(bitops) - library(RCurl) - - content <- NA_character_ - - # Wait required time between two requests - .self$.wait.as.needed() - - # Run query - for (i in seq(.self$.nb.max.tries)) { - tryCatch({ content <- .self$.doGetUrl(url, params = params, method = method) }, - error = function(e) { if (.self$.verbose > 0) print("Retry connection to server...") } ) - if ( ! is.na(content)) - break - } - - return(content) - }) -}