Skip to content

Commit

Permalink
Centralizing download and implementing cache
Browse files Browse the repository at this point in the history
Issue #54
  • Loading branch information
wilsonfreitas committed May 13, 2022
1 parent 016f649 commit 6d3d453
Show file tree
Hide file tree
Showing 10 changed files with 92 additions and 31 deletions.
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,8 @@ Imports:
utils,
stats,
methods,
purrr
purrr,
digest
RoxygenNote: 7.1.2
Suggests:
testthat (>= 3.0.0),
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ export(rbcb_dataset)
export(rbcb_get)
export(rbcb_search)
export(sgs)
importFrom(digest,digest)
importFrom(httr,GET)
importFrom(httr,POST)
importFrom(httr,add_headers)
Expand Down
46 changes: 45 additions & 1 deletion R/http_util.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,4 +38,48 @@ http_gettext <- function(res, encoding = "UTF-8", as = "raw") {
} else {
x
}
}
}

http_download <- function(method = c("get", "post"), ...) {
method <- match.arg(method)
cache <- getOption("rbcb_cache", default = TRUE)
params <- list(...)
code <- digest(params)
dest <- file.path(tempdir(), code)

if (cache && file.exists(dest)) {
message("Skipping download - using cached version")
return(dest)
}

res <- if (method == "get") {
http_getter(...)
} else {
http_poster(...)
}

bin <- content(res, as = "raw")
writeBin(bin, dest)

dest
}

#' rbcb options
#'
#' Options used in rbcb inside some of its functions.
#'
#' * `rbcb_cache`: all downloaded data is stored in temporary directories,
#' if `rbcb_cache` is FALSE downloaded data overwrites files if it already
#' exists. Otherwise, download is not executed and the existing file is
#' returned. Defaults to TRUE.
#' * `rbcb_verbose`: if TRUE verbose messages are displayed when http requests
#' are executed with httr. Defaults to FALSE.
#'
#' @name rbcb-options
#'
#' @examples
#' \dontrun{
#' options(rbcb_cache = FALSE)
#' options(rbcb_verbose = TRUE)
#' }
NULL
1 change: 1 addition & 0 deletions R/rbcb-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,5 +19,6 @@
#' @importFrom methods is
#' @importFrom tibble tibble as_tibble
#' @importFrom purrr map map_dfr
#' @importFrom digest digest
#'
NULL
19 changes: 2 additions & 17 deletions R/rbcb_get_currencies.R
Original file line number Diff line number Diff line change
Expand Up @@ -160,11 +160,7 @@ get_all_currencies <- function(date) {
ChkMoeda = 1
)
res <- http_poster(url, body = body, encode = "form")
if (res$status_code != 200) {
stop("BCB API Request error")
}
x <- content(res, as = "text")
# x <- http_gettext(res)
x <- http_gettext(res)
m <- regexec("gerarCSVTodasAsMoedas&amp;id=(\\d+)", x)
if (length(m[[1]]) == 1 && m[[1]] == -1) {
stop("BCB API Request error")
Expand All @@ -173,10 +169,6 @@ get_all_currencies <- function(date) {
url2 <- "https://ptax.bcb.gov.br/ptax_internet/consultaBoletim.do?method=gerarCSVTodasAsMoedas&id=%s"
url2 <- sprintf(url2, id)
res <- http_getter(url2)
if (res$status_code != 200) {
stop("BCB API Request error")
}
# x <- content(res, as = "text", encoding = "UTF-8")
x <- http_gettext(res)
df <- read.table(text = x, sep = ";", header = FALSE, colClasses = "character")
names(df) <- c("date", "code", "type", "symbol", "bid", "ask", "bid.USD", "ask.USD")
Expand Down Expand Up @@ -241,15 +233,8 @@ get_currency <- function(symbol, start_date, end_date, as = c("tibble", "xts", "
id <- get_currency_id(symbol)
url <- currency_url(id, start_date, end_date)
res <- http_getter(url)
if (res$status_code != 200) {
stop("BCB API Request error, status code = ", res$status_code)
}
if (grepl("text/html", headers(res)[["content-type"]])) {
# x <- content(res, as = 'text')
x <- http_gettext(res)
x <- read_html(x)
x <- xml_find_first(x, "//div[@class='msgErro']")
stop("BCB API returned error: ", xml_text(x))
stop("BCB API returned error")
}
csv_ <- http_gettext(res)

Expand Down
5 changes: 2 additions & 3 deletions R/rbcb_get_market_expectations.R
Original file line number Diff line number Diff line change
Expand Up @@ -710,9 +710,8 @@ get_market_expectations <- function(type = c(
indic, start_date, end_date, ...
)

res <- http_getter(url)
text_ <- http_gettext(res, as = "text")
data_ <- fromJSON(text_)
f <- http_download("get", url)
data_ <- fromJSON(f)

if (!is.null(data_$value) && length(data_$value) == 0) {
return(tibble())
Expand Down
4 changes: 2 additions & 2 deletions R/rbcb_olinda_get_currencies.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,8 @@ olinda_usd_url <- function(start_date, end_date) {
#' @export
olinda_list_currencies <- function() {
url <- "https://olinda.bcb.gov.br/olinda/servico/PTAX/versao/v1/odata/Moedas"
res <- GET(url)
data <- fromJSON(content(res, as = "text"))
f <- http_download("get", url)
data <- fromJSON(f)
df <- data$value
names(df) <- c("symbol", "name", "currency_type")
df
Expand Down
13 changes: 6 additions & 7 deletions R/sgs.R
Original file line number Diff line number Diff line change
Expand Up @@ -43,13 +43,13 @@ sgs_info <- function(x) {
url <- "https://www3.bcb.gov.br/sgspub/consultarvalores/consultarValoresSeries.do?method=consultarGraficoPorId"
url <- modify_url(url, query = list(hdOidSeriesSelecionadas = x$code))

res <- http_getter(url)
f <- http_download("get", url)

sgs_parse_info(x, http_gettext(res, encoding = "latin1", as = "text"))
sgs_parse_info(x, f)
}

sgs_parse_info <- function(x, txt) {
doc <- read_html(txt)
sgs_parse_info <- function(x, f) {
doc <- read_html(f, encoding = "latin1")

info <- xml_find_first(doc, '//tr[@class="fundoPadraoAClaro3"]')
if (length(info) == 0) {
Expand Down Expand Up @@ -137,9 +137,8 @@ print.sgs <- function(x, ...) {
rbcb_get.sgs <- function(x, from = NULL, to = NULL, last = 0, ...) {
map_dfr(x, function(ser) {
url <- sgs_url(ser, from, to, last)
res <- http_getter(url)
json <- http_gettext(res, as = "text")
sgs_create_series(ser, json)
f <- http_download("get", url)
sgs_create_series(ser, f)
})
}

Expand Down
22 changes: 22 additions & 0 deletions man/rbcb-options.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 9 additions & 0 deletions tests/testthat/test-http.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
test_that("it should test http download", {
url <- "https://olinda.bcb.gov.br/olinda/servico/PTAX/versao/v1/odata/Moedas"
f <- http_download("get", url)
expect_message(http_download("get", url))
expect_true(file.exists(f))
options(rbcb_cache = FALSE)
expect_silent(http_download("get", url))
options(rbcb_cache = TRUE)
})

0 comments on commit 6d3d453

Please sign in to comment.