Merge pull request #156 from inbo/live-test

[WIP] Prepare for minor release; `get_archival_data_uuid()`, `get_acoustic_deployment_logs()`, increased db connection sanitation.

Author: PietrH

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: etnservice
 Title: Serve Data from the European Tracking Network
-Version: 0.6.0.9000
+Version: 0.6.0.9005
 Authors@R: c(
     person("Pieter", "Huybrechts", , "pieter.huybrechts@inbo.be", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6658-6062")),
@@ -31,12 +31,13 @@ Imports:
     readr,
     rlang,
     stringr,
-    utils
+    utils,
+    withr
 Suggests: 
     jsonlite,
     purrr,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.3
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -1,15 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
 export(connect_to_etn)
+export(get_acoustic_deployment_logs)
 export(get_acoustic_deployments)
 export(get_acoustic_detections)
 export(get_acoustic_detections_page)
 export(get_acoustic_projects)
 export(get_acoustic_receivers)
 export(get_animal_projects)
 export(get_animals)
+export(get_archival_data_uuid)
 export(get_cpod_projects)
-export(get_receiver_logs)
 export(get_tags)
 export(get_version)
 export(list_acoustic_project_codes)

NEWS.md

@@ -1,7 +1,9 @@
 # etnservice (development version)
+- Added `get_archival_data_uuid()` which fetches a table with UUID references to archival data files. These UUIDs can be used to construct paths to download the archival data CSV files hosted on lifewatch.com (#126).
 - The function `write_dwc()` has been updated in the `etn` package and is no longer needed in `etnservice`. (#141)
 - The `jsonlite` package is no longer a direct dependency, it is only used by a maintenance script. (#144)
 - etnservice now relies on R >= 4.1.0 and uses base pipes (`|>` rather than `%>%`) (#151).
+- The function `get_receiver_logs()` has been renamed to `get_acoustic_deployment_logs()` during the review process of the respective etn client function. `get_acoustic_deployment_logs()` also supports less arguments but has a greatly simplified user interface. (#160)
 # etnservice 0.6.0
 - Added `get_receiver_logs()` to fetch receiver logs from the database. The data is returned as a tibble with a column with logs in JSON format. (#117)
 

R/get_receiver_logs.R R/get_acoustic_deployment_logs.RR/get_receiver_logs.R renamed to R/get_acoustic_deployment_logs.R

@@ -1,4 +1,10 @@
-#' Retrieve log files/diagnostic information for acoustic receivers.
+#' Retrieve log files/diagnostic information for deployments of acoustic
+#' receivers.
+#'
+#' This function retrieves log files and diagnostic information for deployments
+#' of acoustic receivers from the ETN database. The returned data includes
+#' deployment ID, receiver ID, station name, datetime, record type, and log data
+#' in JSON format.
 #'
 #' @inheritParams get_acoustic_detections
 #' @inheritParams get_acoustic_deployments
@@ -9,24 +15,27 @@
 #' @export
 #'
 #' @examples
-#' get_receiver_logs(deployment_id = 6028,
-#'                   start_date = "2020",
-#'                   end_date = "2020-02-01")
-get_receiver_logs <- function(credentials = list(
+#' get_acoustic_deployment_logs(deployment_id = 6028)
+#'
+#' get_acoustic_deployment_logs(deployment_id = c(53790, 1758), limit = TRUE)
+get_acoustic_deployment_logs <- function(credentials = list(
                                 username = Sys.getenv("ETN_USER"),
                                 password = Sys.getenv("ETN_PWD")),
                               deployment_id,
-                              receiver_id = NULL,
-                              station_name = NULL,
-                              start_date = NULL,
-                              end_date = NULL,
                               limit = FALSE) {
   # 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
   check_connection(connection)
 
@@ -49,52 +58,6 @@ get_receiver_logs <- function(credentials = list(
     )
   }
 
-  # Check start_date
-  if (is.null(start_date)) {
-    start_date_query <- "True"
-  } else {
-    start_date <- check_date_time(start_date, "start_date")
-    start_date_query <- glue::glue_sql("log.datetime >= {start_date}", .con = connection)
-  }
-
-  # Check end_date
-  if (is.null(end_date)) {
-    end_date_query <- "True"
-  } else {
-    end_date <- check_date_time(end_date, "end_date")
-    end_date_query <- glue::glue_sql("log.datetime < {end_date}", .con = connection)
-  }
-
-  # Check receiver_id
-  if (is.null(receiver_id)) {
-    receiver_id_query <- "True"
-  } else {
-    receiver_id <- check_value(
-      receiver_id,
-      list_receiver_ids(credentials),
-      name = "receiver_id"
-    )
-    receiver_id_query <- glue::glue_sql(
-      "receiver.receiver IN ({receiver_id*})",
-      .con = connection
-    )
-  }
-
-  # Check station_name
-  if (is.null(station_name)) {
-    station_name_query <- "True"
-  } else {
-    station_name <- check_value(
-      station_name,
-      list_station_names(credentials),
-      "station_name"
-    )
-    station_name_query <- glue::glue_sql(
-      "dep.station_name IN ({station_name*})",
-      .con = connection
-    )
-  }
-
   # Check limit
   assertthat::assert_that(is.logical(limit),
                           msg = "limit must be a logical: TRUE/FALSE.")
@@ -121,27 +84,23 @@ get_receiver_logs <- function(credentials = list(
       LEFT JOIN acoustic.receivers AS receiver
         ON dep.receiver_fk = receiver.id_pk
     WHERE
-      {start_date_query}
-      AND {end_date_query}
-      AND {deployment_id_query}
-      AND {receiver_id_query}
-      AND {station_name_query}
+      {deployment_id_query}
     {limit_query}",
     .con = connection,
     .null = "NULL"
     )
 
   ## Query database
-  receiver_logs <- DBI::dbGetQuery(connection, query)
+  deployment_logs <- DBI::dbGetQuery(connection, query)
   # Close connection
   DBI::dbDisconnect(connection)
 
   # Sort data
-  receiver_logs <-
-    receiver_logs |>
+  deployment_logs <-
+    deployment_logs |>
     dplyr::arrange(factor(
       .data$deployment_id, levels = list_deployment_ids(credentials)
     ))
 
-  dplyr::as_tibble(receiver_logs)
+  dplyr::as_tibble(deployment_logs)
 }

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)
 
@@ -251,8 +258,7 @@ get_acoustic_detections_page <- function(credentials = list(
       AND det.detection_id_pk > {next_id_pk}
     {limit_query}
     ",
-    .con = connection,
-    page_size_query = ifelse(count, "ALL", page_size)
+    .con = connection
   )
 
   # Execute query -----

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)