From 2c57e1ae94ee5829da037e3d66055decad67deb7 Mon Sep 17 00:00:00 2001 From: JulianUmbhau Date: Mon, 23 Feb 2026 14:30:38 +0100 Subject: [PATCH 1/3] adding labels to calls, check_labels function, default NULL for labels and tests for check_labels function --- R/bq-parse.R | 2 +- R/bq-perform.R | 57 +++++++++++++++++++++++++++++++------ R/utils.R | 33 +++++++++++++++++++++ R/zzz.R | 3 +- tests/testthat/test-utils.R | 16 +++++++++++ 5 files changed, 101 insertions(+), 10 deletions(-) diff --git a/R/bq-parse.R b/R/bq-parse.R index def50560..8e94850e 100644 --- a/R/bq-parse.R +++ b/R/bq-parse.R @@ -1,6 +1,6 @@ bq_parse_single <- function(value, type, ...) { field <- bq_field("", type, ...) - field_j <- jsonlite::toJSON(as_json(field)) + field_j <- jsonlite::toJSON(as_json(field), auto_unbox = TRUE) value_j <- jsonlite::toJSON(value, auto_unbox = TRUE) bq_field_init(field_j, value_j) diff --git a/R/bq-perform.R b/R/bq-perform.R index b478b1f4..5b41ea3b 100644 --- a/R/bq-perform.R +++ b/R/bq-perform.R @@ -72,6 +72,8 @@ bq_perform_extract <- function( check_bool(print_header) check_string(billing) + labels <- check_labels(getOption("bigrquery.labels")) + url <- bq_path(billing, jobs = "") body <- list( configuration = list( @@ -81,7 +83,8 @@ bq_perform_extract <- function( destinationFormat = unbox(destination_format), compression = unbox(compression), printHeader = unbox(print_header) - ) + ), + labels = labels ) ) @@ -140,6 +143,8 @@ bq_perform_upload <- function( check_string(billing) json_digits <- check_digits(json_digits) + labels <- check_labels(getOption("bigrquery.labels")) + load <- list( sourceFormat = unbox(source_format), destinationTable = tableReference(x), @@ -154,11 +159,16 @@ bq_perform_upload <- function( load$autodetect <- unbox(TRUE) } - metadata <- list(configuration = list(load = load)) + metadata <- list( + configuration = list( + load = load, + labels = labels + ) + ) metadata <- bq_body(metadata, ...) metadata <- list( "type" = "application/json; charset=UTF-8", - "content" = jsonlite::toJSON(metadata, pretty = TRUE, digits = json_digits) + "content" = jsonlite::toJSON(metadata, auto_unbox = TRUE, pretty = TRUE) ) if (source_format == "NEWLINE_DELIMITED_JSON") { @@ -261,6 +271,8 @@ bq_perform_load <- function( check_string(create_disposition) check_string(write_disposition) + labels <- check_labels(getOption("bigrquery.labels")) + load <- list( sourceUris = as.list(source_uris), sourceFormat = unbox(source_format), @@ -280,7 +292,12 @@ bq_perform_load <- function( load$autodetect <- TRUE } - body <- list(configuration = list(load = load)) + body <- list( + configuration = list( + load = load, + labels = labels + ) + ) url <- bq_path(billing, jobs = "") res <- bq_post( @@ -332,6 +349,8 @@ bq_perform_query <- function( check_bool(use_legacy_sql) check_string(priority) + labels <- check_labels(getOption("bigrquery.labels")) + query <- list( query = unbox(query), useLegacySql = unbox(use_legacy_sql), @@ -357,7 +376,12 @@ bq_perform_query <- function( } url <- bq_path(billing, jobs = "") - body <- list(configuration = list(query = query)) + body <- list( + configuration = list( + query = query, + labels = labels + ) + ) res <- bq_post( url, @@ -383,9 +407,16 @@ bq_perform_query_dry_run <- function( parameters = parameters, use_legacy_sql = use_legacy_sql ) + labels <- check_labels(getOption("bigrquery.labels")) url <- bq_path(billing, jobs = "") - body <- list(configuration = list(query = query, dryRun = unbox(TRUE))) + body <- list( + configuration = list( + query = query, + labels = labels, + dryRun = unbox(TRUE) + ) + ) res <- bq_post( url, @@ -412,8 +443,16 @@ bq_perform_query_schema <- function( use_legacy_sql = FALSE ) + labels <- check_labels(getOption("bigrquery.labels")) + url <- bq_path(billing, jobs = "") - body <- list(configuration = list(query = query, dryRun = unbox(TRUE))) + body <- list( + configuration = list( + query = query, + labels = labels, + dryRun = unbox(TRUE) + ) + ) res <- bq_post( url, @@ -463,6 +502,7 @@ bq_perform_copy <- function( ) { billing <- billing %||% dest$project url <- bq_path(billing, jobs = "") + labels <- check_labels(getOption("bigrquery.labels")) body <- list( configuration = list( @@ -471,7 +511,8 @@ bq_perform_copy <- function( destinationTable = tableReference(dest), createDisposition = unbox(create_disposition), writeDisposition = unbox(write_disposition) - ) + ), + labels = labels ) ) diff --git a/R/utils.R b/R/utils.R index d0b1b14b..623dff26 100644 --- a/R/utils.R +++ b/R/utils.R @@ -85,3 +85,36 @@ as_query <- function(x, error_arg = caller_arg(x), error_call = caller_env()) { has_bigrquerystorage <- function() { is_installed("bigrquerystorage") } + +check_labels <- function(labels) { + # Handle NULL, NA, or empty inputs + if (is.null(labels) || length(labels) == 0 || (length(labels) == 1 && is.na(labels))) { + return(NULL) + } + + if (!is.list(labels)) { + warning(paste0("Labels must to be a dictionary list; dropping labels"), immediate. = TRUE) + return(NULL) + } + nms <- names(labels) + if (is.null(nms) || anyNA(nms) || any(nms == "")) { + warning("Label keys must be non-empty strings; dropping labels", immediate. = TRUE, call. = FALSE) + return(NULL) + } + for (nm in names(labels)) { + if (!is.character(labels[[nm]]) || length(labels[[nm]]) != 1) { + warning(sprintf("Label '%s' must be a single string; dropping labels", nm), immediate. = TRUE) + return(NULL) + } + if (nm != tolower(nm)) { + warning(sprintf("Label key '%s' must match ^[a-z0-9_-]{0,62}$; dropping labels", nm), immediate. = TRUE) + return(NULL) + } + if (labels[[nm]] != tolower(labels[[nm]])) { + warning(sprintf("Label value '%s' must be empty or match ^[a-z0-9_-]{0,62}$; dropping labels", labels[[nm]]), immediate. = TRUE) + return(NULL) + } + } + + return(labels) +} diff --git a/R/zzz.R b/R/zzz.R index e3b1c8e2..043e5675 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -23,7 +23,8 @@ op <- options() defaults <- list( bigrquery.quiet = NA, - bigrquery.page.size = 1e4 + bigrquery.page.size = 1e4, + bigrquery.labels = NULL ) toset <- !(names(defaults) %in% names(op)) if (any(toset)) { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c9a644ba..3a4440aa 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -5,3 +5,19 @@ test_that("bq_check_namespace() works", { error = TRUE ) }) + +test_that("check_labels() accepts valid labels and NULL-like inputs", { + expect_null(check_labels(NULL)) + expect_null(check_labels(NA)) + expect_null(check_labels(list())) + + expect_equal(check_labels(list(env = "prod")), list(env = "prod")) + expect_equal(check_labels(list(env = "prod", team = "data")), list(env = "prod", team = "data")) +}) + +test_that("check_labels() warns and returns NULL for invalid inputs", { + expect_warning(check_labels("not-a-list"), "dictionary list") + expect_warning(check_labels(list("no-name")), "non-empty strings") + expect_warning(check_labels(list(ENV = "prod")), "must match") + expect_warning(check_labels(list(env = "Prod")), "must be empty or match") +}) From ad400e8a177897fe288903b7322f8a2225ab0038 Mon Sep 17 00:00:00 2001 From: JulianUmbhau Date: Mon, 2 Mar 2026 11:25:55 +0100 Subject: [PATCH 2/3] changing from list to named vector --- R/utils.R | 29 +++++++++++------------------ tests/testthat/test-utils.R | 14 +++++++------- 2 files changed, 18 insertions(+), 25 deletions(-) diff --git a/R/utils.R b/R/utils.R index 623dff26..40463ccd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -87,33 +87,26 @@ has_bigrquerystorage <- function() { } check_labels <- function(labels) { - # Handle NULL, NA, or empty inputs if (is.null(labels) || length(labels) == 0 || (length(labels) == 1 && is.na(labels))) { return(NULL) } - if (!is.list(labels)) { - warning(paste0("Labels must to be a dictionary list; dropping labels"), immediate. = TRUE) + if (!is.character(labels) || is.null(names(labels)) || anyNA(names(labels)) || any(names(labels) == "")) { + warning("Labels must be a named character vector; dropping labels", immediate. = TRUE, call. = FALSE) return(NULL) } + nms <- names(labels) - if (is.null(nms) || anyNA(nms) || any(nms == "")) { - warning("Label keys must be non-empty strings; dropping labels", immediate. = TRUE, call. = FALSE) + bad_keys <- nms[nms != tolower(nms)] + if (length(bad_keys) > 0) { + warning(sprintf("Label key '%s' must match ^[a-z0-9_-]{0,62}$; dropping labels", bad_keys[[1]]), immediate. = TRUE, call. = FALSE) return(NULL) } - for (nm in names(labels)) { - if (!is.character(labels[[nm]]) || length(labels[[nm]]) != 1) { - warning(sprintf("Label '%s' must be a single string; dropping labels", nm), immediate. = TRUE) - return(NULL) - } - if (nm != tolower(nm)) { - warning(sprintf("Label key '%s' must match ^[a-z0-9_-]{0,62}$; dropping labels", nm), immediate. = TRUE) - return(NULL) - } - if (labels[[nm]] != tolower(labels[[nm]])) { - warning(sprintf("Label value '%s' must be empty or match ^[a-z0-9_-]{0,62}$; dropping labels", labels[[nm]]), immediate. = TRUE) - return(NULL) - } + + bad_vals <- labels[labels != tolower(labels)] + if (length(bad_vals) > 0) { + warning(sprintf("Label value '%s' must be empty or match ^[a-z0-9_-]{0,62}$; dropping labels", bad_vals[[1]]), immediate. = TRUE, call. = FALSE) + return(NULL) } return(labels) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 3a4440aa..d6112c24 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -9,15 +9,15 @@ test_that("bq_check_namespace() works", { test_that("check_labels() accepts valid labels and NULL-like inputs", { expect_null(check_labels(NULL)) expect_null(check_labels(NA)) - expect_null(check_labels(list())) + expect_null(check_labels(character())) - expect_equal(check_labels(list(env = "prod")), list(env = "prod")) - expect_equal(check_labels(list(env = "prod", team = "data")), list(env = "prod", team = "data")) + expect_equal(check_labels(c(env = "prod")), c(env = "prod")) + expect_equal(check_labels(c(env = "prod", team = "data")), c(env = "prod", team = "data")) }) test_that("check_labels() warns and returns NULL for invalid inputs", { - expect_warning(check_labels("not-a-list"), "dictionary list") - expect_warning(check_labels(list("no-name")), "non-empty strings") - expect_warning(check_labels(list(ENV = "prod")), "must match") - expect_warning(check_labels(list(env = "Prod")), "must be empty or match") + expect_warning(check_labels(list(env = "prod")), "named character vector") + expect_warning(check_labels(c("no-name")), "named character vector") + expect_warning(check_labels(c(ENV = "prod")), "must match") + expect_warning(check_labels(c(env = "Prod")), "must be empty or match") }) From d621e0849e10a2525b6016b2e0940d854e059213 Mon Sep 17 00:00:00 2001 From: JulianUmbhau Date: Fri, 6 Mar 2026 23:50:32 +0100 Subject: [PATCH 3/3] Corrections based on PR comments. Returned to use list, cleaned up check_labels and corrected tests --- R/bq-parse.R | 2 +- R/bq-perform.R | 2 +- R/utils.R | 22 ++++------------------ tests/testthat/test-utils.R | 16 +++++++--------- 4 files changed, 13 insertions(+), 29 deletions(-) diff --git a/R/bq-parse.R b/R/bq-parse.R index 8e94850e..def50560 100644 --- a/R/bq-parse.R +++ b/R/bq-parse.R @@ -1,6 +1,6 @@ bq_parse_single <- function(value, type, ...) { field <- bq_field("", type, ...) - field_j <- jsonlite::toJSON(as_json(field), auto_unbox = TRUE) + field_j <- jsonlite::toJSON(as_json(field)) value_j <- jsonlite::toJSON(value, auto_unbox = TRUE) bq_field_init(field_j, value_j) diff --git a/R/bq-perform.R b/R/bq-perform.R index 5b41ea3b..b9eaa8ca 100644 --- a/R/bq-perform.R +++ b/R/bq-perform.R @@ -168,7 +168,7 @@ bq_perform_upload <- function( metadata <- bq_body(metadata, ...) metadata <- list( "type" = "application/json; charset=UTF-8", - "content" = jsonlite::toJSON(metadata, auto_unbox = TRUE, pretty = TRUE) + "content" = jsonlite::toJSON(metadata, auto_unbox = TRUE, pretty = TRUE, digits = json_digits) ) if (source_format == "NEWLINE_DELIMITED_JSON") { diff --git a/R/utils.R b/R/utils.R index 40463ccd..5876e4a8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -87,27 +87,13 @@ has_bigrquerystorage <- function() { } check_labels <- function(labels) { - if (is.null(labels) || length(labels) == 0 || (length(labels) == 1 && is.na(labels))) { + if (is.null(labels) || length(labels) == 0) { return(NULL) } - if (!is.character(labels) || is.null(names(labels)) || anyNA(names(labels)) || any(names(labels) == "")) { - warning("Labels must be a named character vector; dropping labels", immediate. = TRUE, call. = FALSE) - return(NULL) - } - - nms <- names(labels) - bad_keys <- nms[nms != tolower(nms)] - if (length(bad_keys) > 0) { - warning(sprintf("Label key '%s' must match ^[a-z0-9_-]{0,62}$; dropping labels", bad_keys[[1]]), immediate. = TRUE, call. = FALSE) - return(NULL) - } - - bad_vals <- labels[labels != tolower(labels)] - if (length(bad_vals) > 0) { - warning(sprintf("Label value '%s' must be empty or match ^[a-z0-9_-]{0,62}$; dropping labels", bad_vals[[1]]), immediate. = TRUE, call. = FALSE) - return(NULL) + if (!is.list(labels) || any(names2(labels) == "")) { + cli::cli_abort("Labels must be a named list.") } - return(labels) + labels } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index d6112c24..fe73cbcb 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -8,16 +8,14 @@ test_that("bq_check_namespace() works", { test_that("check_labels() accepts valid labels and NULL-like inputs", { expect_null(check_labels(NULL)) - expect_null(check_labels(NA)) - expect_null(check_labels(character())) + expect_null(check_labels(list())) - expect_equal(check_labels(c(env = "prod")), c(env = "prod")) - expect_equal(check_labels(c(env = "prod", team = "data")), c(env = "prod", team = "data")) + expect_equal(check_labels(list(env = "prod")), list(env = "prod")) + expect_equal(check_labels(list(env = "prod", team = "data")), list(env = "prod", team = "data")) + expect_equal(check_labels(list(env = "")), list(env = "")) }) -test_that("check_labels() warns and returns NULL for invalid inputs", { - expect_warning(check_labels(list(env = "prod")), "named character vector") - expect_warning(check_labels(c("no-name")), "named character vector") - expect_warning(check_labels(c(ENV = "prod")), "must match") - expect_warning(check_labels(c(env = "Prod")), "must be empty or match") +test_that("check_labels() errors on invalid inputs", { + expect_error(check_labels(c(env = "prod")), "named list") + expect_error(check_labels(list("no-name")), "named list") })