diff --git a/R/gen_api.R b/R/gen_api.R index 71f0f7a..3e45b18 100644 --- a/R/gen_api.R +++ b/R/gen_api.R @@ -1,8 +1,9 @@ -#' gen_genesis_api +#' gen_api #' -#' @description Low-level function to interact with the GENESIS API +#' @description Low-level function to interact with the one of the APIs #' #' @param endpoint Character string. The endpoint of the API that is to be queried. +#' @param database The database the query should be sent to. #' @param ... Further parameters passed on to the final API call. #' #' @importFrom httr2 `%>%` @@ -11,122 +12,78 @@ #' #' @examples #' \dontrun{ -#' gen_genesis_api("helloworld/logincheck") %>% +#' gen_api(endpoint = "helloworld/logincheck", database = "genesis") %>% #' httr2::resp_body_json() #' } #' -gen_genesis_api <- function(endpoint, - ...) { +gen_api <- function(endpoint, + database, + ...) { - url <- Sys.getenv("RESTATIS_GENESIS_URL") + #----------------------------------------------------------------------------- - user_agent <- "https://github.com/CorrelAid/restatis" + # Define URLs - body_parameters <- list(...) + if (database == "genesis") { - if (length(body_parameters) > 0) { + url <- Sys.getenv("RESTATIS_GENESIS_URL") - req <- httr2::request(url) %>% - httr2::req_body_form(!!!body_parameters) + } else if (database == "zensus") { - } else { + url <- Sys.getenv("RESTATIS_ZENSUS_URL") - req <- httr2::request(url) %>% - httr2::req_body_form(!!!list("foo" = "bar")) + } else if (database == "regio") { - } + url <- Sys.getenv("RESTATIS_REGIO_URL") - req %>% - httr2::req_user_agent(user_agent) %>% - httr2::req_url_path_append(endpoint) %>% - httr2::req_headers("Content-Type" = "application/x-www-form-urlencoded", - "username" = gen_auth_get(database = "genesis")$username, - "password" = gen_auth_get(database = "genesis")$password) %>% - httr2::req_retry(max_tries = 3) %>% - httr2::req_perform() + } -} + user_agent <- "https://github.com/CorrelAid/restatis" -#------------------------------------------------------------------------------- + #----------------------------------------------------------------------------- -#' gen_regio_api -#' -#' @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 ... Further parameters passed on to the final API call. -#' -#' @importFrom httr2 `%>%` -#' -#' @noRd -#' -#' @examples -#' \dontrun{ -#' gen_regio_api("helloworld/logincheck") %>% -#' httr2::resp_body_json() -#' } -#' -gen_regio_api <- function(endpoint, - ...) { + # First try to request with POST + # If POST errors, try GET - url <- Sys.getenv("RESTATIS_REGIO_URL") + tryCatch( - 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"), ...) %>% - httr2::req_retry(max_tries = 3) %>% - httr2::req_perform() + error = function(cnd) { -} + 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 = database), ...) %>% + httr2::req_retry(max_tries = 3) %>% + httr2::req_perform() -#------------------------------------------------------------------------------- + }, { -#' gen_zensus_api -#' -#' @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 ... Further parameters passed on to the final API call. -#' -#' @importFrom httr2 `%>%` -#' -#' @noRd -#' -#' @examples -#' \dontrun{ -#' gen_zensus_api("helloworld/logincheck") %>% -#' httr2::resp_body_json() -#' } -#' -gen_zensus_api <- function(endpoint, - ...) { + body_parameters <- list(...) - url <- Sys.getenv("RESTATIS_ZENSUS_URL") + if (length(body_parameters) > 0) { - user_agent <- "https://github.com/CorrelAid/restatis" + req <- httr2::request(url) %>% + httr2::req_body_form(!!!body_parameters) - body_parameters <- list(...) + } else { - if (length(body_parameters) > 0) { + req <- httr2::request(url) %>% + httr2::req_body_form(!!!list("foo" = "bar")) - req <- httr2::request(url) %>% - httr2::req_body_form(!!!body_parameters) + } - } else { + req %>% + httr2::req_user_agent(user_agent) %>% + httr2::req_url_path_append(endpoint) %>% + httr2::req_headers("Content-Type" = "application/x-www-form-urlencoded", + "username" = gen_auth_get(database = database)$username, + "password" = gen_auth_get(database = database)$password) %>% + httr2::req_retry(max_tries = 3) %>% + httr2::req_perform() - req <- httr2::request(url) %>% - httr2::req_body_form(!!!list("foo" = "bar")) + }) - } + #----------------------------------------------------------------------------- - req %>% - httr2::req_user_agent(user_agent) %>% - httr2::req_url_path_append(endpoint) %>% - httr2::req_headers("Content-Type" = "application/x-www-form-urlencoded", - "username" = gen_auth_get(database = "zensus")$username, - "password" = gen_auth_get(database = "zensus")$password) %>% - httr2::req_retry(max_tries = 3) %>% - httr2::req_perform() } diff --git a/R/gen_catalogue.R b/R/gen_catalogue.R index 755f912..606cec1 100644 --- a/R/gen_catalogue.R +++ b/R/gen_catalogue.R @@ -39,15 +39,16 @@ gen_catalogue <- function(code = NULL, caller <- as.character(match.call()[1]) - gen_fun <- test_database_function(database, - error.input = error.ignore, - text = verbose) + # database_vector will hold a vector of the specified databases to query + database_vector <- test_database_function(database, + error.input = error.ignore, + text = verbose) check_function_input(code = code, category = category, detailed = detailed, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, sortcriterion = sortcriterion, caller = caller, verbose = verbose) @@ -61,11 +62,11 @@ gen_catalogue <- function(code = NULL, #----------------------------------------------------------------------------- # Processing # - res <- lapply(gen_fun, function(db){ + res <- lapply(database_vector, function(db){ if (isTRUE(verbose)) { - info <- paste("Started the processing of", rev_database_function(db), "database.") + info <- paste("Started the processing of", db, "database.") message(info) @@ -73,20 +74,20 @@ gen_catalogue <- function(code = NULL, #--------------------------------------------------------------------------- - if ("cubes" %in% category && db == "gen_zensus_api") { + if ("cubes" %in% category && db == "zensus") { list_of_cubes <- "There are generally no 'cubes' objects available for the 'zensus' database." - } else if ("cubes" %in% category && (db == "gen_genesis_api" | db == "gen_regio_api")) { + } else if ("cubes" %in% category && (db == "genesis" | db == "regio")) { - results_raw <- do.call(db, - list(endpoint = "catalogue/cubes", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - sortcriterion = sortcriterion, - area = area, - ...)) + results_raw <- gen_api(endpoint = "catalogue/cubes", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + sortcriterion = sortcriterion, + area = area, + ...) results_json <- test_if_json(results_raw) @@ -132,14 +133,13 @@ gen_catalogue <- function(code = NULL, if ("statistics" %in% category) { - par_list <- list(endpoint = "catalogue/statistics", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - sortcriterion = sortcriterion, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "catalogue/statistics", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + sortcriterion = sortcriterion, + ...) results_json <- test_if_json(results_raw) @@ -182,15 +182,14 @@ gen_catalogue <- function(code = NULL, if ("tables" %in% category) { - par_list <- list(endpoint = "catalogue/tables", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - area = area, - sortcriterion = sortcriterion, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "catalogue/tables", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + area = area, + sortcriterion = sortcriterion, + ...) results_json <- test_if_json(results_raw) @@ -243,7 +242,7 @@ gen_catalogue <- function(code = NULL, #--------------------------------------------------------------------------- } else if ("cubes" %in% category) { - if (length(list_of_cubes) == 1 && db == "gen_zensus_api"){ + if (length(list_of_cubes) == 1 && db == "zensus"){ list_resp <- list_of_cubes @@ -289,12 +288,12 @@ gen_catalogue <- function(code = NULL, #--------------------------------------------------------------------------- attr(list_resp, "Code") <- code - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Category") <- category - if (length(category) == 1 && "cubes" %in% category && db == "gen_zensus_api"){ + if (length(category) == 1 && "cubes" %in% category && db == "zensus"){ - attr(list_resp, "Info") <- "NO API call done" + attr(list_resp, "Info") <- "No API call has been executed." } else { diff --git a/R/gen_cube.R b/R/gen_cube.R index e90ee5f..50b1b7a 100644 --- a/R/gen_cube.R +++ b/R/gen_cube.R @@ -95,62 +95,28 @@ gen_cube_ <- function(name, #----------------------------------------------------------------------------- - if (database == "genesis") { - - cube_raw <- gen_genesis_api("data/cubefile", - name = name, - area = area, - values = values, - metadata = metadata, - additionals = additionals, - startyear = startyear, - endyear = endyear, - timeslices = timeslices, - contents = contents, - regionalvariable = regionalvariable, - regionalkey = regionalkey, - classifyingvariable1 = classifyingvariable1, - classifyingkey1 = classifyingkey1, - classifyingvariable2 = classifyingvariable2, - classifyingkey2 = classifyingkey2, - classifyingvariable3 = classifyingvariable3, - classifyingkey3 = classifyingkey3, - stand = stand, - language = language, - job = FALSE) - - #----------------------------------------------------------------------------- - - } else if (database == "regio") { - - cube_raw <- gen_regio_api("data/cubefile", - name = name, - area = area, - values = values, - metadata = metadata, - additionals = additionals, - startyear = startyear, - endyear = endyear, - timeslices = timeslices, - contents = contents, - regionalvariable = regionalvariable, - regionalkey = regionalkey, - classifyingvariable1 = classifyingvariable1, - classifyingkey1 = classifyingkey1, - classifyingvariable2 = classifyingvariable2, - classifyingkey2 = classifyingkey2, - classifyingvariable3 = classifyingvariable3, - classifyingkey3 = classifyingkey3, - stand = stand, - language = language, - job = FALSE) - - } else { - - stop("Wrong specification of parameter 'database' (must only be 'regio' or 'genesis').", - call. = FALSE) - - } + cube_raw <- gen_api(endpoint = "data/cubefile", + database = database, + name = name, + area = area, + values = values, + metadata = metadata, + additionals = additionals, + startyear = startyear, + endyear = endyear, + timeslices = timeslices, + contents = contents, + regionalvariable = regionalvariable, + regionalkey = regionalkey, + classifyingvariable1 = classifyingvariable1, + classifyingkey1 = classifyingkey1, + classifyingvariable2 = classifyingvariable2, + classifyingkey2 = classifyingkey2, + classifyingvariable3 = classifyingvariable3, + classifyingkey3 = classifyingkey3, + stand = stand, + language = language, + job = FALSE) #------------------------------------------------------------------------------- diff --git a/R/gen_find.R b/R/gen_find.R index d9bc28d..1d3bb84 100644 --- a/R/gen_find.R +++ b/R/gen_find.R @@ -9,6 +9,7 @@ #' @param category Character string. Specify specific GENESIS/regionalstatistik.de object types ('tables', 'statistics' and 'cubes') and specific Zensus 2022 object types ('tables' and 'statistics'). All types that are specific for one database can be used together. Default option is to use all types that are possible for the specific database. #' @param detailed Boolean. Indicator if the function should return the detailed output of the iteration including all object-related information or only a shortened output including only code and object title. Default option is 'FALSE'. #' @param ordering A logical. Indicator if the function should return the output of the iteration ordered first based on the fact if the searched term is appearing in the title of the object and secondly on an estimator of the number of variables in this object. Default option is 'TRUE'. +#' @param pagelength Integer. Maximum length of results (e.g., number of tables). Defaults to 500. #' @param error.ignore Boolean. Indicator if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'TRUE'. #' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings. #' @param ... Additional parameters for the API call. These parameters are only affecting the call itself, no further processing. For more details see `vignette("additional_parameter")`. @@ -36,6 +37,7 @@ gen_find <- function(term = NULL, category = c("all", "tables", "statistics", "variables", "cubes"), detailed = FALSE, ordering = TRUE, + pagelength = 500, error.ignore = TRUE, verbose = TRUE, ...) { @@ -50,6 +52,7 @@ gen_find <- function(term = NULL, category = category, detailed = detailed, ordering = ordering, + pagelength = pagelength, error.ignore = error.ignore, database = gen_fun, caller = caller, diff --git a/R/gen_jobs.R b/R/gen_jobs.R index cd50195..89153c7 100644 --- a/R/gen_jobs.R +++ b/R/gen_jobs.R @@ -49,24 +49,9 @@ gen_list_jobs <- function(database = c("genesis", "regio"), #----------------------------------------------------------------------------- - if (gen_fun == "gen_genesis_api"){ - - par_list <- list(endpoint = "catalogue/jobs", - sortcriterion = sortcriterion, - ...) - - } else if (gen_fun == "gen_regio_api") { - - par_list <- list(endpoint = "catalogue/jobs", - sortcriterion = sortcriterion, - ...) - - } else { - - stop("Misspecification of the parameter 'database': Only 'genesis' and 'regio' allowed.", - call. = FALSE) - - } + par_list <- list(endpoint = "catalogue/jobs", + sortcriterion = sortcriterion, + ...) results_raw <- do.call(gen_fun, par_list) @@ -167,34 +152,15 @@ gen_download_job <- function(name, #----------------------------------------------------------------------------- - if (database == "genesis") { - - response <- gen_genesis_api("data/resultfile", - name = name, - area = area, - compress = compress, - format = "ffcsv", - language = language) + response <- gen_api(endpoint = "data/resultfile", + database = database, + name = name, + area = area, + compress = compress, + format = "ffcsv", + language = language) - response_type <- resp_check_data(response) - - } else if (database == "regio"){ - - response <- gen_regio_api("data/resultfile", - name = name, - area = area, - compress = compress, - format = "ffcsv", - language = language) - - response_type <- resp_check_data(response) - - } else { - - stop("Misspecification of parameter 'database': Can only be 'genesis' or 'regio'.", - call. = FALSE) - - } + response_type <- resp_check_data(response) #----------------------------------------------------------------------------- diff --git a/R/gen_table.R b/R/gen_table.R index 882bc53..7d923c8 100644 --- a/R/gen_table.R +++ b/R/gen_table.R @@ -112,84 +112,26 @@ gen_table_ <- function(name, #----------------------------------------------------------------------------- # Data download - if (database == "zensus"){ - - response <- gen_zensus_api("data/tablefile", - name = name, - area = area, - compress = compress, - transpose = transpose, - startyear = startyear, - endyear = endyear, - regionalvariable = regionalvariable, - regionalkey = regionalkey, - classifyingvariable1 = classifyingvariable1, - classifyingkey1 = classifyingkey1, - classifyingvariable2 = classifyingvariable2, - classifyingkey2 = classifyingkey2, - classifyingvariable3 = classifyingvariable3, - classifyingkey3 = classifyingkey3, - stand = stand, - language = language, - format = "ffcsv", - job = FALSE) - - #----------------------------------------------------------------------------- - - } else if (database == "genesis"){ - - response <- gen_genesis_api("data/tablefile", - name = name, - area = area, - compress = compress, - transpose = transpose, - startyear = startyear, - endyear = endyear, - regionalvariable = regionalvariable, - regionalkey = regionalkey, - classifyingvariable1 = classifyingvariable1, - classifyingkey1 = classifyingkey1, - classifyingvariable2 = classifyingvariable2, - classifyingkey2 = classifyingkey2, - classifyingvariable3 = classifyingvariable3, - classifyingkey3 = classifyingkey3, - stand = stand, - language = language, - format = "ffcsv", - job = job) - - #----------------------------------------------------------------------------- - - } else if (database == "regio") { - - response <- gen_regio_api("data/tablefile", - name = name, - area = area, - compress = compress, - transpose = transpose, - startyear = startyear, - endyear = endyear, - regionalvariable = regionalvariable, - regionalkey = regionalkey, - classifyingvariable1 = classifyingvariable1, - classifyingkey1 = classifyingkey1, - classifyingvariable2 = classifyingvariable2, - classifyingkey2 = classifyingkey2, - classifyingvariable3 = classifyingvariable3, - classifyingkey3 = classifyingkey3, - stand = stand, - language = language, - format = "ffcsv", - job = job) - - #----------------------------------------------------------------------------- - - } else { - - stop("Parameter 'database' has to be 'zensus', 'regio' or 'genesis'.", - call. = FALSE) - - } + response <- gen_api(endpoint = "data/tablefile", + database = database, + name = name, + area = area, + compress = compress, + transpose = transpose, + startyear = startyear, + endyear = endyear, + regionalvariable = regionalvariable, + regionalkey = regionalkey, + classifyingvariable1 = classifyingvariable1, + classifyingkey1 = classifyingkey1, + classifyingvariable2 = classifyingvariable2, + classifyingkey2 = classifyingkey2, + classifyingvariable3 = classifyingvariable3, + classifyingkey3 = classifyingkey3, + stand = stand, + language = language, + format = "ffcsv", + job = FALSE) #----------------------------------------------------------------------------- # Data processing diff --git a/R/gen_var2-val2.R b/R/gen_var2-val2.R index 20af9af..7452e6a 100644 --- a/R/gen_var2-val2.R +++ b/R/gen_var2-val2.R @@ -7,6 +7,7 @@ #' @param area Character string. Indicator from which area of the database the results are called. In general, 'all' is the appropriate solution. Default option is 'all'. Not used for 'statistics'. #' @param detailed Boolean. Indicator if the function should return the detailed output of the iteration including all object-related information or only a shortened output including only code and object title. Default option is 'FALSE'. #' @param sortcriterion Character string. Indicator if the output should be sorted by 'code' or 'content'. This is a parameter of the API call itself. The default is 'code'. +#' @param pagelength Integer. Maximum length of results (e.g., number of tables). Defaults to 500. #' @param error.ignore Boolean. Indicator if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'FALSE'. #' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings. #' @param ... Additional parameters for the API call. These parameters are only affecting the call itself, no further processing. For more details see `vignette("additional_parameter")`. @@ -26,6 +27,7 @@ gen_var2stat <- function(code = NULL, area = c("all", "public", "user"), detailed = FALSE, sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = FALSE, verbose = TRUE, ...) { @@ -149,6 +151,7 @@ gen_var2stat <- function(code = NULL, #' @param database Character string. Indicator if the GENESIS ('genesis'), Zensus 2022 ('zensus') or regionalstatistik.de ('regio') database is called. Default option is 'all'. #' @param area Character string. Indicator from which area of the database the results are called. In general, 'all' is the appropriate solution. Default option is 'all'. Not used for 'statistics'. #' @param sortcriterion Character string. Indicator if the output should be sorted by 'code' or 'content'. This is a parameter of the API call itself. The default is 'code'. +#' @param pagelength Integer. Maximum length of results (e.g., number of tables). Defaults to 500. #' @param error.ignore Boolean. Indicator for values if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'TRUE', this prevents the function to stop even if a variable has no further explanation (often the case for numerical variables). #' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings. #' @param ... Additional parameters for the API call. These parameters are only affecting the call itself, no further processing. For more details see `vignette("additional_parameter")`. @@ -166,6 +169,7 @@ gen_val2var <- function(code = NULL, database = c("all", "genesis", "zensus", "regio"), area = c("all", "public", "user"), sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = TRUE, verbose = TRUE, ...) { @@ -284,6 +288,7 @@ gen_val2var <- function(code = NULL, #' @param area Character string. Indicator from which area of the database the results are called. In general, 'all' is the appropriate solution. Default option is 'all'. Not used for 'statistics'. #' @param detailed Boolean. Indicator if the function should return the detailed output of the iteration including all object-related information or only a shortened output including only code and object title. Default option is 'FALSE'. #' @param sortcriterion Character string. Indicator if the output should be sorted by 'code' or 'content'. This is a parameter of the API call itself. The default is 'code'. +#' @param pagelength Integer. Maximum length of results (e.g., number of tables). Defaults to 500. #' @param error.ignore.var Boolean. Indicator for variables if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'FALSE'. #' @param error.ignore.val Boolean. Indicator for values if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'TRUE', this prevents the function to stop even if a variable has no further explanation (often the case for numerical variables). #' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings. @@ -304,6 +309,7 @@ gen_val2var2stat <- function(code = NULL, area = c("all", "public", "user"), detailed = FALSE, sortcriterion = c("code", "content"), + pagelength = 500, error.ignore.var = FALSE, error.ignore.val = TRUE, verbose = TRUE, @@ -394,6 +400,7 @@ gen_val2var2stat <- function(code = NULL, #' @param database Character string. Indicator if the GENESIS ('genesis'), Zensus 2022 ('zensus') or regionalstatistik.de ('regio') database is called. Default option is 'all'. #' @param area Character string. Indicator from which area of the database the results are called. In general, 'all' is the appropriate solution. Default option is 'all'. Not used for 'statistics'. #' @param sortcriterion Character string. Indicator if the output should be sorted by 'code' or 'content'. This is a parameter of the API call itself. The default is 'code'. +#' @param pagelength Integer. Maximum length of results (e.g., number of tables). Defaults to 500. #' @param error.ignore Boolean. Indicator if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'FALSE'. #' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings. #' @param ... Additional parameters for the API call. These parameters are only affecting the call itself, no further processing. For more details see `vignette("additional_parameter")`. @@ -411,6 +418,7 @@ gen_search_vars <- function(code = NULL, database = c("all", "genesis", "zensus", "regio"), area = c("all", "public", "user"), sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = FALSE, verbose = TRUE, ...) { diff --git a/R/utils_dataprocessing.R b/R/utils_dataprocessing.R index 76940ad..20b065b 100644 --- a/R/utils_dataprocessing.R +++ b/R/utils_dataprocessing.R @@ -289,6 +289,7 @@ check_function_input <- function(code = NULL, similarity = NULL, error.ignore = NULL, ordering = NULL, + pagelength = NULL, database = NULL, area = NULL, caller = NULL, @@ -316,6 +317,16 @@ check_function_input <- function(code = NULL, } + #------------------------------------------------------------------------------- + # Pagelength + + if (!is.null(pagelength) && (!(pagelength %in% c(1:25000)) || length(pagelength) != 1)) { + + stop("Parameter 'pagelength' must have a value between 1 and 25,000 and a length of 1.", + call. = FALSE) + + } + #----------------------------------------------------------------------------- # Code & Term ---- @@ -1098,7 +1109,7 @@ titel_search <- function(x, term, text) { #' test_database_function <- function(input, error.input, text){ - #------------------------------------------------------------------------- + #----------------------------------------------------------------------------- if (!is.logical(text) || length(text) != 1) { @@ -1107,6 +1118,8 @@ test_database_function <- function(input, error.input, text){ } + #----------------------------------------------------------------------------- + if (!is.logical(error.input) || length(error.input) != 1) { stop("Parameter 'error.ignore' has to be of type 'logical' and of length 1.", @@ -1129,31 +1142,35 @@ test_database_function <- function(input, error.input, text){ if ("genesis" %in% input) { - res <- c(res, "genesis" = "gen_genesis_api") + res <- c(res, "genesis") } if ("zensus" %in% input) { - res <- c(res, "zensus" = "gen_zensus_api") + res <- c(res, "zensus") } if ("regio" %in% input) { - res <- c(res, "regio" = "gen_regio_api") + res <- c(res, "regio") } + #----------------------------------------------------------------------------- + if ("all" %in% input) { if (isTRUE(text)) { - message("All databases accessible to you are selected. Additional databases specified in the 'database'-parameter are ignored.") + message("All databases accessible to you are selected. Additional databases specified in the 'database' parameter are ignored.") } - res <- c("genesis" = "gen_genesis_api", "zensus" = "gen_zensus_api", "regio" = "gen_regio_api") + res <- c("genesis", + "zensus", + "regio") } else if (length(res) != length(input)) { @@ -1176,13 +1193,13 @@ test_database_function <- function(input, error.input, text){ #----------------------------------------------------------------------------- - check <- sapply(res, function(y) { + # Check if credentials are available for the selected databases - nam <- rev_database_function(y) + check <- sapply(res, function(y) { result <- tryCatch({ - user <- gen_auth_get(nam)$username + user <- gen_auth_get(y)$username }, error = function(e) { @@ -1239,7 +1256,7 @@ test_database_function <- function(input, error.input, text){ if (identical(res, c())) { - stop("You have to correctly specifiy a 'database' parameter. Please refer to the documentation for further information.", + stop("You have to correctly specify a 'database' parameter. Please refer to the documentation for further information.", call. = FALSE) } else { @@ -1250,21 +1267,6 @@ test_database_function <- function(input, error.input, text){ } -#------------------------------------------------------------------------------- -#' rev_database_function -#' -#' @param input Input to test for database name -#' -rev_database_function <- function(input){ - - input[which(input == "gen_genesis_api")] <- "genesis" - input[which(input == "gen_zensus_api")] <- "zensus" - input[which(input == "gen_regio_api")] <- "regio" - - return(input) - -} - #------------------------------------------------------------------------------- #' check_results #' diff --git a/R/utils_httr2.R b/R/utils_httr2.R index 96ef57d..1869753 100644 --- a/R/utils_httr2.R +++ b/R/utils_httr2.R @@ -438,9 +438,8 @@ logincheck_http_error <- function(database, #--------------------------------------------------------------------------- - if (database == "genesis") response <- gen_genesis_api("helloworld/logincheck") - if (database == "zensus") response <- gen_zensus_api("helloworld/logincheck") - if (database == "regio") response <- gen_regio_api("helloworld/logincheck") + response <- gen_api(endpoint = "helloworld/logincheck", + database = database) logincheck_stop_or_warn(response = response, error = TRUE, @@ -453,9 +452,9 @@ logincheck_http_error <- function(database, databases <- list("genesis", "zensus", "regio") - response_list <- list(response_genesis = gen_genesis_api("helloworld/logincheck"), - response_zensus = gen_zensus_api("helloworld/logincheck"), - response_regio = gen_regio_api("helloworld/logincheck")) + response_list <- list(response_genesis = gen_api(endpoint = "helloworld/logincheck", database = "genesis"), + response_zensus = gen_api(endpoint = "helloworld/logincheck", database = "zensus"), + response_regio = gen_api(endpoint = "helloworld/logincheck", database = "regio")) purrr::walk2(.x = response_list, .y = databases, @@ -479,7 +478,7 @@ logincheck_http_error <- function(database, if ("genesis" %in% database) { - logincheck_stop_or_warn(response = gen_genesis_api("helloworld/logincheck"), + logincheck_stop_or_warn(response = gen_api(endpoint = "helloworld/logincheck", database = "genesis"), error = FALSE, verbose = verbose, database = "genesis") @@ -490,7 +489,7 @@ logincheck_http_error <- function(database, if ("zensus" %in% database) { - logincheck_stop_or_warn(response = gen_zensus_api("helloworld/logincheck"), + logincheck_stop_or_warn(response = gen_api(endpoint = "helloworld/logincheck", database = "zensus"), error = FALSE, verbose = verbose, database = "zensus") @@ -501,7 +500,7 @@ logincheck_http_error <- function(database, if ("regio" %in% database) { - logincheck_stop_or_warn(response = gen_regio_api("helloworld/logincheck"), + logincheck_stop_or_warn(response = gen_api(endpoint = "helloworld/logincheck", database = "regio"), error = FALSE, verbose = verbose, database = "regio") diff --git a/R/zzz.R b/R/zzz.R index d9e19a1..e49dbd7 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,9 +1,7 @@ .onLoad <- function(libname, pkgname) { # Set the functions whose results are to be cached - gen_genesis_api <<- memoise::memoise(gen_genesis_api) - gen_zensus_api <<- memoise::memoise(gen_zensus_api) - gen_regio_api <<- memoise::memoise(gen_regio_api) + gen_api <<- memoise::memoise(gen_api) # Set the default language of the package if (!nzchar(Sys.getenv("RESTATIS_LANG"))) Sys.setenv(RESTATIS_LANG = "en")