From 7c1e8b7e2f0747613b5807beba628a38cec37c10 Mon Sep 17 00:00:00 2001 From: bubux Date: Tue, 24 Sep 2024 19:32:12 +0200 Subject: [PATCH] introduce overwrite_url param --- R/gen_api.R | 34 ++++++++++++++++++++++++++++------ R/gen_table.R | 22 ++++++++++++++++++---- 2 files changed, 46 insertions(+), 10 deletions(-) diff --git a/R/gen_api.R b/R/gen_api.R index 8d5520e..e79791b 100644 --- a/R/gen_api.R +++ b/R/gen_api.R @@ -3,6 +3,8 @@ #' @description Low-level function to interact with the GENESIS API #' #' @param endpoint Character string. The endpoint of the API that is to be queried. +#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: GENESIS), else there will be errors. Hence, use with caution. +#' @param ... Further parameters passed on to the final API call. #' #' @importFrom httr2 `%>%` #' @@ -14,9 +16,14 @@ #' httr2::resp_body_json() #' } #' -gen_genesis_api <- function(endpoint, ...) { +gen_genesis_api <- function(endpoint, + overwrite_url, + ...) { + + url <- ifelse(is.null(overwrite_url), + "https://www-genesis.destatis.de/genesisWS/rest/2020", + overwrite_url) - url <- "https://www-genesis.destatis.de/genesisWS/rest/2020" user_agent <- "https://github.com/CorrelAid/restatis" body_parameters <- list(...) @@ -51,6 +58,8 @@ gen_genesis_api <- function(endpoint, ...) { #' @description Low-level function to interact with the regionalstatistik.de API #' #' @param endpoint Character string. The endpoint of the API that is to be queried. +#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: www.regionalstatistik.de), else there will be errors. Hence, use with caution. +#' @param ... Further parameters passed on to the final API call. #' #' @importFrom httr2 `%>%` #' @@ -62,9 +71,15 @@ gen_genesis_api <- function(endpoint, ...) { #' httr2::resp_body_json() #' } #' -gen_regio_api <- function(endpoint, ...) { +gen_regio_api <- function(endpoint, + overwrite_url, + ...) { + + url <- ifelse(is.null(overwrite), + "https://www.regionalstatistik.de/genesisws/rest/2020/", + overwrite_url) - httr2::request("https://www.regionalstatistik.de/genesisws/rest/2020/") %>% + httr2::request(url) %>% httr2::req_user_agent("https://github.com/CorrelAid/restatis") %>% httr2::req_url_path_append(endpoint) %>% httr2::req_url_query(!!!gen_auth_get(database = "regio"), ...) %>% @@ -80,6 +95,8 @@ gen_regio_api <- function(endpoint, ...) { #' @description Low-level function to interact with the Zensus 2022 database #' #' @param endpoint Character string. The endpoint of the API that is to be queried. +#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: Zensus 2022), else there will be errors. Hence, use with caution. +#' @param ... Further parameters passed on to the final API call. #' #' @importFrom httr2 `%>%` #' @@ -91,9 +108,14 @@ gen_regio_api <- function(endpoint, ...) { #' httr2::resp_body_json() #' } #' -gen_zensus_api <- function(endpoint, ...) { +gen_zensus_api <- function(endpoint, + overwrite_url, + ...) { + + url <- ifelse(is.null(overwrite_url), + "https://ergebnisse.zensus2022.de/api/rest/2020", + overwrite_url) - url <- "https://ergebnisse.zensus2022.de/api/rest/2020" user_agent <- "https://github.com/CorrelAid/restatis" body_parameters <- list(...) diff --git a/R/gen_table.R b/R/gen_table.R index d3b6ead..67a14ef 100644 --- a/R/gen_table.R +++ b/R/gen_table.R @@ -50,7 +50,9 @@ #' } #' gen_table <- function(name, ...) { + gen_table_(name, ...) + } #------------------------------------------------------------------------------- @@ -73,7 +75,8 @@ gen_table_ <- function(name, stand = NULL, language = Sys.getenv("GENESIS_LANG"), job = FALSE, - all_character = TRUE) { + all_character = TRUE, + overwrite_url = NULL) { #----------------------------------------------------------------------------- # Parameter processing @@ -85,6 +88,14 @@ gen_table_ <- function(name, } + if (!is.null(overwrite_url) & + (!is.character(overwrite_url) | length(overwrite_url) != 1)) { + + stop("The parameter 'overwrite_url' has to be of type 'character' and of length 1.", + call. = FALSE) + + } + database <- match.arg(database) area <- match.arg(area) @@ -130,7 +141,8 @@ gen_table_ <- function(name, stand = stand, language = language, format = "ffcsv", - job = FALSE) + job = FALSE, + overwrite_url = overwrite_url) #----------------------------------------------------------------------------- @@ -154,7 +166,8 @@ gen_table_ <- function(name, stand = stand, language = language, format = "ffcsv", - job = job) + job = job, + overwrite_url = overwrite_url) #----------------------------------------------------------------------------- @@ -178,7 +191,8 @@ gen_table_ <- function(name, stand = stand, language = language, format = "ffcsv", - job = job) + job = job, + overwrite_url = overwrite_url) #-----------------------------------------------------------------------------