From 27d56b5e50015402047e0b1222223f71a78a1b9d Mon Sep 17 00:00:00 2001 From: PietrH Date: Thu, 16 Jul 2026 11:56:54 +0200 Subject: [PATCH 1/5] Close connection after fetching result --- R/get_acoustic_detections.R | 5 +++-- R/get_acoustic_receivers.R | 6 +++--- R/get_animals.R | 6 +++--- R/get_cpod_projects.R | 5 +++-- 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index c120e89..52a78ac 100644 --- a/R/get_acoustic_detections.R +++ b/R/get_acoustic_detections.R @@ -268,6 +268,9 @@ get_acoustic_detections <- function(credentials = list( ", .con = connection) detections <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data (faster than in SQL) detections <- detections |> @@ -275,8 +278,6 @@ get_acoustic_detections <- function(credentials = list( factor(.data$acoustic_tag_id, levels = list_acoustic_tag_ids(credentials)), .data$date_time ) - # Close connection - DBI::dbDisconnect(connection) # Return detections dplyr::as_tibble(detections) diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R index 54e3a9d..2bc4aba 100644 --- a/R/get_acoustic_receivers.R +++ b/R/get_acoustic_receivers.R @@ -122,14 +122,14 @@ get_acoustic_receivers <- function(credentials = list( ", .con = connection) receivers <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data receivers <- receivers |> dplyr::arrange(.data$receiver_id) - # Close connection - DBI::dbDisconnect(connection) - # Return receivers dplyr::as_tibble(receivers) } diff --git a/R/get_animals.R b/R/get_animals.R index 22b2a86..d19f6b5 100644 --- a/R/get_animals.R +++ b/R/get_animals.R @@ -221,6 +221,9 @@ get_animals <- function(credentials = list( ", .con = connection) animals <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Collapse tag information, to obtain one row = one animal tag_cols <- animals |> @@ -247,9 +250,6 @@ get_animals <- function(credentials = list( factor(.data$tag_serial_number, levels = list_tag_serial_numbers(credentials)) ) - # Close connection - DBI::dbDisconnect(connection) - # Return animals dplyr::as_tibble(animals) # Is already a tibble, but added if code above changes } diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R index 3408186..9886f7e 100644 --- a/R/get_cpod_projects.R +++ b/R/get_cpod_projects.R @@ -72,12 +72,13 @@ get_cpod_projects <- function(credentials = list( ", .con = connection) projects <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data projects <- projects |> dplyr::arrange(.data$project_code) - # Close connection - DBI::dbDisconnect(connection) # Return data dplyr::as_tibble(projects) From 879298c68013186f5a9f296e35705d8b9fcde711 Mon Sep 17 00:00:00 2001 From: PietrH Date: Thu, 16 Jul 2026 14:48:06 +0200 Subject: [PATCH 2/5] Add failsafe for closing connection when function crashes --- R/get_acoustic_deployment_logs.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/get_acoustic_deployment_logs.R b/R/get_acoustic_deployment_logs.R index 6a7b50b..0cee597 100644 --- a/R/get_acoustic_deployment_logs.R +++ b/R/get_acoustic_deployment_logs.R @@ -29,6 +29,13 @@ get_acoustic_deployment_logs <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) From 0bb9cef83c796c6d16a6994018ee0902853fe829 Mon Sep 17 00:00:00 2001 From: PietrH Date: Thu, 16 Jul 2026 15:02:12 +0200 Subject: [PATCH 3/5] Add withr to deps: already indirect via vroom --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c915927..e134fdf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,7 +31,8 @@ Imports: readr, rlang, stringr, - utils + utils, + withr Suggests: jsonlite, purrr, From 959562b91274121b1710841d262d2c4b393af423 Mon Sep 17 00:00:00 2001 From: PietrH Date: Thu, 16 Jul 2026 15:02:28 +0200 Subject: [PATCH 4/5] Refactor to cleanly exit even when function crashes on connect_to_etn() --- R/validate_login.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/validate_login.R b/R/validate_login.R index a62a965..7ad7959 100644 --- a/R/validate_login.R +++ b/R/validate_login.R @@ -22,8 +22,8 @@ validate_login <- function(username, password) { tryCatch( { - connection <- connect_to_etn(username, password) - DBI::dbDisconnect(connection) + connection <- + withr::local_db_connection(connect_to_etn(username, password)) return(TRUE) }, error = function(e) { From 9864fcd34e52477dbe8467102efc2594bea109d4 Mon Sep 17 00:00:00 2001 From: PietrH Date: Thu, 16 Jul 2026 15:03:49 +0200 Subject: [PATCH 5/5] Add calls to make sure credentials are right shape, fail early on invalid connection, and add fallback for closing connection when function crashes. --- R/get_acoustic_deployments.R | 7 +++++++ R/get_acoustic_detections.R | 7 +++++++ R/get_acoustic_detections_page.R | 7 +++++++ R/get_acoustic_projects.R | 7 +++++++ R/get_acoustic_receivers.R | 8 +++++++- R/get_animal_projects.R | 9 ++++++++- R/get_animals.R | 9 ++++++++- R/get_archival_data_uuid.R | 7 +++++++ R/get_cpod_projects.R | 9 ++++++++- R/get_tags.R | 7 +++++++ R/list_acoustic_project_codes.R | 13 +++++++++++++ R/list_acoustic_tag_ids.R | 14 ++++++++++++++ R/list_animal_ids.R | 15 ++++++++++++--- R/list_animal_project_codes.R | 13 ++++++++++++- R/list_cpod_project_codes.R | 9 ++++++++- R/list_deployment_ids.R | 12 +++++++++++- R/list_receiver_ids.R | 12 ++++++++++++ R/list_scientific_names.R | 12 ++++++++++++ R/list_station_names.R | 13 ++++++++++++- R/list_tag_serial_numbers.R | 10 ++++++++++ 20 files changed, 189 insertions(+), 11 deletions(-) diff --git a/R/get_acoustic_deployments.R b/R/get_acoustic_deployments.R index a4ed9d6..ecf2cea 100644 --- a/R/get_acoustic_deployments.R +++ b/R/get_acoustic_deployments.R @@ -59,6 +59,13 @@ get_acoustic_deployments <- function( connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check if we can make a connection check_connection(connection) diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index 52a78ac..e7f0276 100644 --- a/R/get_acoustic_detections.R +++ b/R/get_acoustic_detections.R @@ -96,6 +96,13 @@ get_acoustic_detections <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check if we can make a connection check_connection(connection) diff --git a/R/get_acoustic_detections_page.R b/R/get_acoustic_detections_page.R index d4917a0..4fe47d5 100644 --- a/R/get_acoustic_detections_page.R +++ b/R/get_acoustic_detections_page.R @@ -60,6 +60,13 @@ get_acoustic_detections_page <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check if we can make a connection check_connection(connection) diff --git a/R/get_acoustic_projects.R b/R/get_acoustic_projects.R index ad658e6..78fc6cb 100644 --- a/R/get_acoustic_projects.R +++ b/R/get_acoustic_projects.R @@ -37,6 +37,13 @@ get_acoustic_projects <- function(credentials = list( connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R index 2bc4aba..93ea8dc 100644 --- a/R/get_acoustic_receivers.R +++ b/R/get_acoustic_receivers.R @@ -37,7 +37,13 @@ get_acoustic_receivers <- function(credentials = list( status = NULL) { # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) # Check connection check_connection(connection) diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R index c4c23b2..dd19427 100644 --- a/R/get_animal_projects.R +++ b/R/get_animal_projects.R @@ -35,7 +35,14 @@ get_animal_projects <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/get_animals.R b/R/get_animals.R index d19f6b5..46c92c1 100644 --- a/R/get_animals.R +++ b/R/get_animals.R @@ -58,7 +58,14 @@ get_animals <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/get_archival_data_uuid.R b/R/get_archival_data_uuid.R index 50a744c..e12b358 100644 --- a/R/get_archival_data_uuid.R +++ b/R/get_archival_data_uuid.R @@ -26,6 +26,13 @@ get_archival_data_uuid <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R index 9886f7e..867d222 100644 --- a/R/get_cpod_projects.R +++ b/R/get_cpod_projects.R @@ -35,7 +35,14 @@ get_cpod_projects <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/get_tags.R b/R/get_tags.R index 709b877..ddb689c 100644 --- a/R/get_tags.R +++ b/R/get_tags.R @@ -55,6 +55,13 @@ get_tags <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check connection check_connection(connection) diff --git a/R/list_acoustic_project_codes.R b/R/list_acoustic_project_codes.R index b52ce8f..34fd5a5 100644 --- a/R/list_acoustic_project_codes.R +++ b/R/list_acoustic_project_codes.R @@ -10,7 +10,20 @@ list_acoustic_project_codes <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + + check_connection(connection) project_sql <- glue::glue_sql( readr::read_file(system.file("sql", "project.sql", package = "etnservice")), diff --git a/R/list_acoustic_tag_ids.R b/R/list_acoustic_tag_ids.R index f7ad6e4..efd34b9 100644 --- a/R/list_acoustic_tag_ids.R +++ b/R/list_acoustic_tag_ids.R @@ -9,7 +9,21 @@ list_acoustic_tag_ids <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + + check_connection(connection) + acoustic_tag_id_sql <- glue::glue_sql( readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")), .con = connection diff --git a/R/list_animal_ids.R b/R/list_animal_ids.R index 6db1659..a918bfe 100644 --- a/R/list_animal_ids.R +++ b/R/list_animal_ids.R @@ -9,11 +9,20 @@ list_animal_ids <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { - stopifnot(is.list(credentials)) - stopifnot(any(names(credentials) == c("username", "password"))) - + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + check_connection(connection) query <- glue::glue_sql( "SELECT DISTINCT id_pk FROM common.animal_release", .con = connection diff --git a/R/list_animal_project_codes.R b/R/list_animal_project_codes.R index 2565157..3a44dc7 100644 --- a/R/list_animal_project_codes.R +++ b/R/list_animal_project_codes.R @@ -10,8 +10,19 @@ list_animal_project_codes <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { - connection <- connect_to_etn(credentials$username, credentials$password) + # Check if credentials object has right shape + check_credentials(credentials) + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + project_sql <- glue::glue_sql( readr::read_file(system.file("sql", "project.sql", package = "etnservice")), .con = connection diff --git a/R/list_cpod_project_codes.R b/R/list_cpod_project_codes.R index 2159368..d9ff404 100644 --- a/R/list_cpod_project_codes.R +++ b/R/list_cpod_project_codes.R @@ -16,7 +16,14 @@ list_cpod_project_codes <- function(credentials = list( # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + # Check if we can make a connection check_connection(connection) diff --git a/R/list_deployment_ids.R b/R/list_deployment_ids.R index 633788d..89cea0a 100644 --- a/R/list_deployment_ids.R +++ b/R/list_deployment_ids.R @@ -9,9 +9,19 @@ list_deployment_ids <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + query <- glue::glue_sql( "SELECT DISTINCT id_pk FROM acoustic.deployments", .con = connection diff --git a/R/list_receiver_ids.R b/R/list_receiver_ids.R index 21054b8..a96a391 100644 --- a/R/list_receiver_ids.R +++ b/R/list_receiver_ids.R @@ -9,7 +9,19 @@ list_receiver_ids <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + query <- glue::glue_sql( "SELECT DISTINCT receiver FROM acoustic.receivers", .con = connection diff --git a/R/list_scientific_names.R b/R/list_scientific_names.R index 53635e5..96f0053 100644 --- a/R/list_scientific_names.R +++ b/R/list_scientific_names.R @@ -10,7 +10,19 @@ list_scientific_names <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + query <- glue::glue_sql( "SELECT DISTINCT scientific_name FROM common.animal_release", .con = connection diff --git a/R/list_station_names.R b/R/list_station_names.R index bfb6337..57be053 100644 --- a/R/list_station_names.R +++ b/R/list_station_names.R @@ -10,8 +10,19 @@ list_station_names <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) - + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) + query <- glue::glue_sql( "SELECT DISTINCT station_name FROM acoustic.deployments WHERE station_name IS NOT NULL", .con = connection diff --git a/R/list_tag_serial_numbers.R b/R/list_tag_serial_numbers.R index 31ca309..222f739 100644 --- a/R/list_tag_serial_numbers.R +++ b/R/list_tag_serial_numbers.R @@ -10,8 +10,18 @@ list_tag_serial_numbers <- function(credentials = list( username = Sys.getenv("ETN_USER"), password = Sys.getenv("ETN_PWD") )) { + # Check if credentials object has right shape + check_credentials(credentials) + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) + + # Ensure the connection is closed when the function exits, even when it fails. + withr::defer( + if (DBI::dbIsValid(connection)) { + DBI::dbDisconnect(connection) + } + ) # Check if we can make a connection check_connection(connection)