Close connections earlier, add fallback to close upon function exit, increase defensiveness.

DESCRIPTION

@@ -31,7 +31,8 @@ Imports:
     readr,
     rlang,
     stringr,
-    utils
+    utils,
+    withr
 Suggests: 
     jsonlite,
     purrr,

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)
 

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)
 

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)
 
@@ -268,15 +275,16 @@ 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 |>
     dplyr::arrange(
       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)

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)
 

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)
 

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)
 
@@ -122,14 +128,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)
 }

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)
 

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)
 
@@ -221,6 +228,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 +257,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
 }

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)
 

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)
 
@@ -72,12 +79,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)

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)
 

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")),

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

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

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

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)
 

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

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