From a9cde250f28e47f4c7ba97fb7749e784e8a4bc5b Mon Sep 17 00:00:00 2001 From: buhly Date: Sun, 15 Dec 2024 20:06:46 +0100 Subject: [PATCH] rework the consequences of abstracting gen_api --- R/gen_find.R | 47 ++++---- R/gen_metadata.R | 201 ++++++++++++++++++++--------------- R/gen_modified_data.R | 97 +++++++++-------- R/gen_var2-val2.R | 131 ++++++++++++++--------- R/utils_dataprocessing.R | 22 ++-- man/check_function_input.Rd | 1 + man/gen_find.Rd | 3 + man/gen_search_vars.Rd | 3 + man/gen_val2var.Rd | 3 + man/gen_val2var2stat.Rd | 3 + man/gen_var2stat.Rd | 3 + man/rev_database_function.Rd | 14 --- 12 files changed, 292 insertions(+), 236 deletions(-) delete mode 100644 man/rev_database_function.Rd diff --git a/R/gen_find.R b/R/gen_find.R index 1d3bb84..951e72c 100644 --- a/R/gen_find.R +++ b/R/gen_find.R @@ -44,7 +44,8 @@ gen_find <- function(term = NULL, caller <- as.character(match.call()[1]) - gen_fun <- test_database_function(database, + # database_vector will hold a vector of the specified databases to query + database_vector <- test_database_function(database, error.input = error.ignore, text = verbose) @@ -54,7 +55,7 @@ gen_find <- function(term = NULL, ordering = ordering, pagelength = pagelength, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) @@ -62,11 +63,11 @@ gen_find <- function(term = NULL, #----------------------------------------------------------------------------- - res <- lapply(gen_fun, function(db){ + res <- lapply(database_vector, function(db){ if (verbose) { - info <- paste("Started the processing of", rev_database_function(db), "database.") + info <- paste("Started the processing of", db, "database.") message(info) @@ -74,20 +75,19 @@ gen_find <- function(term = NULL, #--------------------------------------------------------------------------- - if (db == "gen_zensus_api" && category == "cubes") { + if (db == "zensus" && category == "cubes") { empty_object <- "FAIL" } else { - par_list <- list(endpoint = "find/find", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - term = term, - category = category, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "find/find", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + term = term, + category = category, + ...) results_json <- test_if_json(results_raw) @@ -104,19 +104,19 @@ gen_find <- function(term = NULL, list_resp <- list("Output" = "No object found for your request.") attr(list_resp, "Term") <- results_json$Parameter$term - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Language") <- results_json$Parameter$language attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength attr(list_resp, "Copyright") <- results_json$Copyright return(list_resp) - } else if (empty_object == "FAIL" & db == "gen_zensus_api" ){ + } else if (empty_object == "FAIL" & db == "zensus" ){ list_resp <- list("Output" = "There are generally no 'cubes' objects available for the 'zensus' database.") attr(list_resp, "Term") <- term - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Category") <- category return(list_resp) @@ -126,7 +126,7 @@ gen_find <- function(term = NULL, list_resp <- list("Output" = results_json$Status$Content) attr(list_resp, "Term") <- results_json$Parameter$term - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Language") <- results_json$Parameter$language attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength attr(list_resp, "Copyright") <- results_json$Copyright @@ -431,9 +431,9 @@ gen_find <- function(term = NULL, } else { df_variables <- find_token(results_json$Variables, - error.input = error.ignore, - text = verbose, - sub_category = "Variables") + error.input = error.ignore, + text = verbose, + sub_category = "Variables") } @@ -443,7 +443,7 @@ gen_find <- function(term = NULL, if("cubes" %in% category) { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + if (db == "genesis" | db == "regio") { if(!is.null(results_json$Cubes)) { @@ -546,7 +546,7 @@ gen_find <- function(term = NULL, } - } else if (db == "gen_zensus_api") { + } else if (db == "zensus") { df_cubes <- "There are generally no 'cubes' objects available for the 'zensus' database." @@ -563,7 +563,7 @@ gen_find <- function(term = NULL, if("cubes" %in% category) {list_resp$Cubes <- tibble::as_tibble(df_cubes) } attr(list_resp, "Term") <- results_json$Parameter$term - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Language") <- results_json$Parameter$language attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength attr(list_resp, "Copyright") <- results_json$Copyright @@ -571,6 +571,7 @@ gen_find <- function(term = NULL, return(list_resp) } + }) res <- check_results(res) diff --git a/R/gen_metadata.R b/R/gen_metadata.R index 6496fdf..45125e2 100644 --- a/R/gen_metadata.R +++ b/R/gen_metadata.R @@ -29,13 +29,14 @@ gen_metadata_statistic <- 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, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose, raw = raw) @@ -46,29 +47,36 @@ gen_metadata_statistic <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "metadata/statistic", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - ...) + if (db == "genesis" | db == "regio") { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + results_raw <- gen_api(endpoint = "metadata/statistic", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) - par_list <- append(par_list, list(area = area)) + } else { - } + results_raw <- gen_api(endpoint = "metadata/statistic", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + ...) - results_raw <- do.call(db, par_list) + } results_json <- test_if_json(results_raw) @@ -105,7 +113,7 @@ gen_metadata_statistic <- function(code = NULL, } attr(df_stats, "Code") <- results_json$Parameter$name - attr(df_stats, "Database") <- rev_database_function(db) + attr(df_stats, "Database") <- db attr(df_stats, "Method") <- results_json$Ident$Method attr(df_stats, "Updated") <- results_json$Object$Updated attr(df_stats, "Language") <- results_json$Parameter$language @@ -154,13 +162,14 @@ gen_metadata_variable <- 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, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose, raw = raw) @@ -171,29 +180,36 @@ gen_metadata_variable <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "metadata/variable", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - ...) + if (db == "genesis" | db == "regio") { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + results_raw <- gen_api(endpoint = "metadata/variable", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) - par_list <- append(par_list, list(area = area)) + } else { - } + results_raw <- gen_api(endpoint = "metadata/variable", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + ...) - results_raw <- do.call(db, par_list) + } results_json <- test_if_json(results_raw) @@ -236,7 +252,7 @@ gen_metadata_variable <- function(code = NULL, } attr(list_resp, "Code") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Method") <- results_json$Ident$Method attr(list_resp, "Updated") <- results_json$Object$Updated attr(list_resp, "Language") <- results_json$Parameter$language @@ -287,13 +303,14 @@ gen_metadata_value <- 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, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose, raw = raw) @@ -304,30 +321,37 @@ gen_metadata_value <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "metadata/value", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - ...) + if (db == "genesis" | db == "regio") { + + results_raw <- gen_api(endpoint = "metadata/value", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) - if (db == "gen_genesis_api" | db == "gen_regio_api") { + } else { - par_list <- append(par_list, list(area = area)) + results_raw <- gen_api(endpoint = "metadata/value", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + ...) } - results_raw <- do.call(db, par_list) - results_json <- test_if_json(results_raw) empty_object <- test_if_error(results_json, para = error.ignore, verbose = verbose) @@ -366,7 +390,7 @@ gen_metadata_value <- function(code = NULL, } attr(list_resp, "Code") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Method") <- results_json$Ident$Method attr(list_resp, "Updated") <- results_json$Object$Updated attr(list_resp, "Language") <- results_json$Parameter$language @@ -417,13 +441,14 @@ gen_metadata_table <- 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, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose, raw = raw) @@ -434,24 +459,23 @@ gen_metadata_table <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "metadata/table", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - area = area, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "metadata/table", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) results_json <- test_if_json(results_raw) @@ -568,7 +592,7 @@ gen_metadata_table <- function(code = NULL, } attr(list_resp, "Code") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Method") <- results_json$Ident$Method attr(list_resp, "Updated") <- results_json$Object$Updated attr(list_resp, "Language") <- results_json$Parameter$language @@ -620,13 +644,14 @@ gen_metadata_cube <- 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, error.ignore = error.ignore, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose, raw = raw) @@ -637,24 +662,23 @@ gen_metadata_cube <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "metadata/cube", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - area = area, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "metadata/cube", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) results_json <- test_if_json(results_raw) @@ -745,7 +769,7 @@ gen_metadata_cube <- function(code = NULL, } attr(list_resp, "Code") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Method") <- results_json$Ident$Method attr(list_resp, "Updated") <- results_json$Object$Updated attr(list_resp, "Language") <- results_json$Parameter$language @@ -798,25 +822,26 @@ gen_metadata <- 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, error.ignore = error.ignore, category = category, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) #----------------------------------------------------------------------------- - res <- lapply(gen_fun, function(odb){ + res <- lapply(database_vector, function(odb){ if (category == "cube") { gen_metadata_cube(code = code, - database = rev_database_function(odb), + database = odb, error.ignore = error.ignore, verbose = verbose, raw = raw, @@ -825,7 +850,7 @@ gen_metadata <- function(code = NULL, } else if (category == "value") { gen_metadata_value(code = code, - database = rev_database_function(odb), + database = odb, area = area, error.ignore = error.ignore, verbose = verbose, @@ -835,7 +860,7 @@ gen_metadata <- function(code = NULL, } else if (category == "variable") { gen_metadata_variable(code = code, - database = rev_database_function(odb), + database = odb, area = area, error.ignore = error.ignore, verbose = verbose, @@ -845,7 +870,7 @@ gen_metadata <- function(code = NULL, } else if (category == "table") { gen_metadata_table(code = code, - database = rev_database_function(odb), + database = odb, area = area, error.ignore = error.ignore, verbose = verbose, @@ -855,7 +880,7 @@ gen_metadata <- function(code = NULL, } else if (category == "statistic") { gen_metadata_statistic(code = code, - database = rev_database_function(odb), + database = odb, area = area, error.ignore = error.ignore, verbose = verbose, diff --git a/R/gen_modified_data.R b/R/gen_modified_data.R index 7aa6dd2..da66652 100644 --- a/R/gen_modified_data.R +++ b/R/gen_modified_data.R @@ -32,40 +32,47 @@ gen_modified_data <- function(code = "", verbose = TRUE, ...) { - gen_fun <- test_database_function(database, - error.input = TRUE, - text = verbose) + # database_vector will hold a vector of the specified databases to query + database_vector <- test_database_function(database, + error.input = TRUE, + text = verbose) type <- match.arg(type) date <- check_function_input(code = code, type = type, date = date, - database = gen_fun, + database = database_vector, verbose = verbose) #----------------------------------------------------------------------------- if (date == "now") { + date <- format(Sys.Date(), format = "%d.%m.%Y") + } else if (date == "week_before") { + date <- format(Sys.Date() - 7, format = "%d.%m.%Y") + } else if (date == "month_before") { + date <- format(Sys.Date() - as.difftime(4, units = "weeks"), - format = "%d.%m.%Y" - ) + format = "%d.%m.%Y") + } else if (date == "year_before") { + date <- format(as.difftime(52, units = "weeks"), format = "%d.%m.%Y") } #----------------------------------------------------------------------------- # 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) @@ -75,15 +82,14 @@ gen_modified_data <- function(code = "", if (type == "tables") { - par_list <- list(endpoint = "catalogue/modifieddata", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - type = "Neue Tabellen", - date = date, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "catalogue/modifieddata", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + type = "Neue Tabellen", + date = date, + ...) results_json <- test_if_json(results_raw) @@ -95,15 +101,14 @@ gen_modified_data <- function(code = "", if (type == "statistics") { - par_list <- list(endpoint = "catalogue/modifieddata", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - type = "Neue Statistiken", - date = date, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "catalogue/modifieddata", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + type = "Neue Statistiken", + date = date, + ...) results_json <- test_if_json(results_raw) @@ -116,20 +121,19 @@ gen_modified_data <- function(code = "", if (type == "statisticsUpdates") { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + if (db == "genesis" | db == "regio") { - par_list <- list(endpoint = "catalogue/modifieddata", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - type = "Aktualisierte Statistiken", - date = date, - ...) + results_raw <- gen_api(endpoint = "catalogue/modifieddata", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + type = "Aktualisierte Statistiken", + date = date, + ...) } - results_raw <- do.call(db, par_list) - results_json <- test_if_json(results_raw) test_if_error_light(results_json) @@ -140,15 +144,14 @@ gen_modified_data <- function(code = "", if (type == "all") { - par_list <- list(endpoint = "catalogue/modifieddata", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - selection = code, - type = "all", - date = date, - ...) - - results_raw <- do.call(db, par_list) + results_raw <- gen_api(endpoint = "catalogue/modifieddata", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + selection = code, + type = "all", + date = date, + ...) results_json <- test_if_json(results_raw) @@ -160,7 +163,7 @@ gen_modified_data <- function(code = "", if (isTRUE(verbose)) { - message(paste0("No modified objects found for your code and date in ", rev_database_function(db))) + message(paste0("No modified objects found for your code and date in ", db)) } @@ -184,7 +187,7 @@ gen_modified_data <- function(code = "", list_resp <- list("Modified" = table) attr(list_resp, "Code") <- results_json$Parameter$selection - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Type") <- results_json$Parameter$type attr(list_resp, "Date") <- results_json$Parameter$date attr(list_resp, "Language") <- results_json$Parameter$language diff --git a/R/gen_var2-val2.R b/R/gen_var2-val2.R index 7452e6a..b8af8a3 100644 --- a/R/gen_var2-val2.R +++ b/R/gen_var2-val2.R @@ -34,15 +34,16 @@ gen_var2stat <- 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, detailed = detailed, error.ignore = error.ignore, sortcriterion = sortcriterion, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) @@ -55,11 +56,11 @@ gen_var2stat <- 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) @@ -67,19 +68,26 @@ gen_var2stat <- function(code = NULL, #--------------------------------------------------------------------------- - par_list <- list(endpoint = "catalogue/variables2statistic", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - ...) + if (db == "genesis" | db == "regio") { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + results_raw <- gen_api(endpoint = "catalogue/variables2statistic", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) - par_list <- append(par_list, list(area = area)) + } else { - } + results_raw <- gen_api(endpoint = "catalogue/variables2statistic", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + ...) - results_raw <- do.call(db, par_list) + } results_json <- test_if_json(results_raw) @@ -124,7 +132,7 @@ gen_var2stat <- function(code = NULL, list_resp <- list("Variables" = list_of_variables) attr(list_resp, "Code") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Language") <- results_json$Parameter$language attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength attr(list_resp, "Copyright") <- results_json$Copyright @@ -176,14 +184,15 @@ gen_val2var <- 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, error.ignore = error.ignore, sortcriterion = sortcriterion, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) @@ -197,29 +206,36 @@ gen_val2var <- function(code = NULL, #----------------------------------------------------------------------------- - 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) } - par_list <- list(endpoint = "catalogue/values2variable", - username = gen_auth_get(database = rev_database_function(db))$username, - password = gen_auth_get(database = rev_database_function(db))$password, - name = code, - ...) + if (db == "genesis" | db == "regio") { - if (db == "gen_genesis_api" | db == "gen_regio_api") { + results_raw <- gen_api(endpoint = "catalogue/values2variable", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + area = area, + ...) - par_list <- append(par_list, list(area = area)) + } else { - } + results_raw <- gen_api(endpoint = "catalogue/values2variable", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + ...) - results_raw <- do.call(db, par_list) + } results_json <- test_if_json(results_raw) @@ -258,7 +274,7 @@ gen_val2var <- function(code = NULL, list_resp <- list("Values" = list_of_variables) attr(list_resp, "Name") <- results_json$Parameter$name - attr(list_resp, "Database") <- rev_database_function(db) + attr(list_resp, "Database") <- db attr(list_resp, "Language") <- results_json$Parameter$language attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength attr(list_resp, "Copyright") <- results_json$Copyright @@ -317,14 +333,15 @@ gen_val2var2stat <- function(code = NULL, caller <- as.character(match.call()[1]) - gen_fun <- test_database_function(database, - error.input = error.ignore.var, - 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, error.ignore = error.ignore.var, sortcriterion = sortcriterion, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) @@ -425,14 +442,15 @@ gen_search_vars <- 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, error.ignore = error.ignore, sortcriterion = sortcriterion, - database = gen_fun, + database = database_vector, caller = caller, verbose = verbose) @@ -444,11 +462,11 @@ gen_search_vars <- function(code = NULL, #----------------------------------------------------------------------------- - 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) @@ -456,22 +474,29 @@ gen_search_vars <- function(code = NULL, #--------------------------------------------------------------------------- - par_list <- list(endpoint = "catalogue/variables", - 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, - ...) + if (db == "genesis" | db == "regio") { + + results_raw <- gen_api(endpoint = "catalogue/variables", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + name = code, + sortcriterion = sortcriterion, + area = area, + ...) - if (db == "gen_genesis_api" | db == "gen_regio_api") { + } else { - par_list <- append(par_list, list(area = area)) + results_raw <- gen_api(endpoint = "catalogue/variables", + database = db, + username = gen_auth_get(database = db)$username, + password = gen_auth_get(database = db)$password, + sortcriterion = sortcriterion, + name = code, + ...) } - results_raw <- do.call(db, par_list) - results_json <- test_if_json(results_raw) empty_object <- test_if_error(results_json, para = error.ignore) diff --git a/R/utils_dataprocessing.R b/R/utils_dataprocessing.R index 20b065b..2a3146a 100644 --- a/R/utils_dataprocessing.R +++ b/R/utils_dataprocessing.R @@ -469,7 +469,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - if("gen_zensus_api" %in% database){ + if("zensus" %in% database){ #----------------------------------------------------------------------- @@ -520,7 +520,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------------- - if("gen_genesis_api" %in% database){ + if("genesis" %in% database){ if (!all(category %in% c("tables", "cubes", "statistics"))) { @@ -540,7 +540,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - if("gen_zensus_api" %in% database){ + if("zensus" %in% database){ #----------------------------------------------------------------------- @@ -600,7 +600,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - if("gen_genesis_api" %in% database){ + if("genesis" %in% database){ if (!all(category %in% c("tables", "cubes", "variables"))) { @@ -623,7 +623,7 @@ check_function_input <- function(code = NULL, #--------------------------------------------------------------------- - if("gen_genesis_api" %in% database){ + if("genesis" %in% database){ stop("Available categories for parameter 'category' for 'genesis' database are 'all', 'tables', 'statistics', 'variables', and 'cubes'.", call. = FALSE) @@ -632,7 +632,7 @@ check_function_input <- function(code = NULL, #--------------------------------------------------------------------- - if("gen_zensus_api" %in% database){ + if("zensus" %in% database){ stop("Available categories for parameter 'category' for 'zensus' database are 'all', 'tables', 'statistics', and 'variables'.", call. = FALSE) @@ -649,7 +649,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - if("gen_zensus_api" %in% database){ + if("zensus" %in% database){ #----------------------------------------------------------------------- @@ -691,7 +691,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - if("gen_genesis_api" %in% database){ + if("genesis" %in% database){ #----------------------------------------------------------------------- @@ -706,7 +706,7 @@ check_function_input <- function(code = NULL, #------------------------------------------------------------------------- - else if("gen_zensus_api" %in% database) { + else if("zensus" %in% database) { if (!all(category %in% c("statistic", "table", "variable", "value"))) { @@ -751,7 +751,7 @@ check_function_input <- function(code = NULL, #--------------------------------------------------------------------------- - if ("gen_genesis_api" %in% database){ + if ("genesis" %in% database){ #------------------------------------------------------------------------- @@ -766,7 +766,7 @@ check_function_input <- function(code = NULL, #--------------------------------------------------------------------------- - if ("gen_zensus_api" %in% database){ + if ("zensus" %in% database){ if (!all(type %in% c("all", "tables", "statistics"))) { diff --git a/man/check_function_input.Rd b/man/check_function_input.Rd index 02cbae6..f2787f8 100644 --- a/man/check_function_input.Rd +++ b/man/check_function_input.Rd @@ -15,6 +15,7 @@ check_function_input( similarity = NULL, error.ignore = NULL, ordering = NULL, + pagelength = NULL, database = NULL, area = NULL, caller = NULL, diff --git a/man/gen_find.Rd b/man/gen_find.Rd index 0b8e00c..765f82c 100644 --- a/man/gen_find.Rd +++ b/man/gen_find.Rd @@ -10,6 +10,7 @@ gen_find( category = c("all", "tables", "statistics", "variables", "cubes"), detailed = FALSE, ordering = TRUE, + pagelength = 500, error.ignore = TRUE, verbose = TRUE, ... @@ -26,6 +27,8 @@ gen_find( \item{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'.} +\item{pagelength}{Integer. Maximum length of results (e.g., number of tables). Defaults to 500.} + \item{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'.} \item{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.} diff --git a/man/gen_search_vars.Rd b/man/gen_search_vars.Rd index c6c1917..8397e7e 100644 --- a/man/gen_search_vars.Rd +++ b/man/gen_search_vars.Rd @@ -9,6 +9,7 @@ gen_search_vars( database = c("all", "genesis", "zensus", "regio"), area = c("all", "public", "user"), sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = FALSE, verbose = TRUE, ... @@ -23,6 +24,8 @@ gen_search_vars( \item{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'.} +\item{pagelength}{Integer. Maximum length of results (e.g., number of tables). Defaults to 500.} + \item{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'.} \item{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.} diff --git a/man/gen_val2var.Rd b/man/gen_val2var.Rd index 40df213..dd9291b 100644 --- a/man/gen_val2var.Rd +++ b/man/gen_val2var.Rd @@ -9,6 +9,7 @@ gen_val2var( database = c("all", "genesis", "zensus", "regio"), area = c("all", "public", "user"), sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = TRUE, verbose = TRUE, ... @@ -23,6 +24,8 @@ gen_val2var( \item{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'.} +\item{pagelength}{Integer. Maximum length of results (e.g., number of tables). Defaults to 500.} + \item{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).} \item{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.} diff --git a/man/gen_val2var2stat.Rd b/man/gen_val2var2stat.Rd index 31b1825..91395fb 100644 --- a/man/gen_val2var2stat.Rd +++ b/man/gen_val2var2stat.Rd @@ -10,6 +10,7 @@ gen_val2var2stat( area = c("all", "public", "user"), detailed = FALSE, sortcriterion = c("code", "content"), + pagelength = 500, error.ignore.var = FALSE, error.ignore.val = TRUE, verbose = TRUE, @@ -27,6 +28,8 @@ gen_val2var2stat( \item{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'.} +\item{pagelength}{Integer. Maximum length of results (e.g., number of tables). Defaults to 500.} + \item{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'.} \item{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).} diff --git a/man/gen_var2stat.Rd b/man/gen_var2stat.Rd index 606dba9..bd00dd9 100644 --- a/man/gen_var2stat.Rd +++ b/man/gen_var2stat.Rd @@ -10,6 +10,7 @@ gen_var2stat( area = c("all", "public", "user"), detailed = FALSE, sortcriterion = c("code", "content"), + pagelength = 500, error.ignore = FALSE, verbose = TRUE, ... @@ -26,6 +27,8 @@ gen_var2stat( \item{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'.} +\item{pagelength}{Integer. Maximum length of results (e.g., number of tables). Defaults to 500.} + \item{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'.} \item{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.} diff --git a/man/rev_database_function.Rd b/man/rev_database_function.Rd deleted file mode 100644 index 4ed4acd..0000000 --- a/man/rev_database_function.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils_dataprocessing.R -\name{rev_database_function} -\alias{rev_database_function} -\title{rev_database_function} -\usage{ -rev_database_function(input) -} -\arguments{ -\item{input}{Input to test for database name} -} -\description{ -rev_database_function -}