Merge pull request #55 from inbo/live-test

Update main with live-test for usage in production
inbo · Nov 6, 2024 · 525e06e · 525e06e
2 parents df46c09 + f3c69de
commit 525e06e
Show file tree

Hide file tree

Showing 77 changed files with 2,621 additions and 105 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: etnservice
 Title: Serve Data from the European Tracking Network
-Version: 0.0.0.9000
+Version: 0.1.0
 Authors@R: c(
     person("Pieter", "Huybrechts", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-6658-6062")),
@@ -9,21 +9,26 @@ Authors@R: c(
     person("Research Institute for Nature and Forest (INBO)", role = "cph",
            comment = "https://www.vlaanderen.be/inbo/en-gb/"),
     person("LifeWatch Belgium", role = "fnd",
-           comment = "https://lifewatch.be"))
-Description: Provides API endpoints to the European Tracking Network. Designed 
-    to be used with OpenCPU and the 'etn' package.
+           comment = "https://lifewatch.be")
+  )
+Description: Provides API endpoints to the European Tracking Network.
+    Designed to be used with OpenCPU and the 'etn' package.
 License: MIT + file LICENSE
-Encoding: UTF-8
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
 Imports: 
     assertthat,
     DBI,
     dplyr,
     glue,
     httr,
+    jsonlite,
     lubridate,
     methods,
     odbc,
     readr,
     stringr
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.2
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,14 +6,20 @@ export(get_acoustic_detections)
 export(get_acoustic_projects)
 export(get_acoustic_receivers)
 export(get_animal_projects)
+export(get_animals)
+export(get_cpod_projects)
+export(get_tags)
 export(list_acoustic_project_codes)
 export(list_acoustic_tag_ids)
 export(list_animal_ids)
 export(list_animal_project_codes)
+export(list_cpod_project_codes)
 export(list_deployment_ids)
 export(list_receiver_ids)
 export(list_scientific_names)
 export(list_station_names)
+export(list_tag_serial_numbers)
+export(write_dwc)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
 importFrom(dplyr,distinct)

diff --git a/NEWS.md b/NEWS.md
@@ -0,0 +1,5 @@
+# etnservice v0.1.0
+
+- This is the first version of etnservice used in the beta of etn v2.3.0.
+- This version is still lagging behind it's contemporary version of etn v2.2.1, which means that database queries made via etnservice, or via the OpenCPU API are not guaranteed to be identical as the results of the same queries made via the etn R package.
+
diff --git a/R/connect_to_etn.R b/R/connect_to_etn.R
@@ -19,11 +19,28 @@
 #' con <- connect_to_etn(username = "my_username", password = "my_password")
 #' }
 connect_to_etn <- function(username, password) {
-  connection <- DBI::dbConnect(
-    odbc::odbc(),
-    "ETN",
-    uid = paste("", tolower(username), "", sep = ""),
-    pwd = paste("", password, "", sep = "")
+  tryCatch(
+    {
+      # Attempt to connect to the database with the provided credentials
+      connection <- DBI::dbConnect(
+        odbc::odbc(),
+        "ETN",
+        uid = paste("", tolower(username), "", sep = ""),
+        pwd = paste("", password, "", sep = "")
+      )
+      return(connection)
+    },
+    error = function(e) {
+        # When the database connection fails, return the error message and some
+        # directions to try again. This is usually due to a wrong password, so
+        # let's include that as a clue in the error message.
+        stop(glue::glue(e$message,
+                        "Failed to connect to the database.",
+                        "Did you enter the right username/password?",
+                        "Please try again.",
+                        .sep = "\n"),
+        call. = FALSE)
+
+    }
   )
-  return(connection)
 }
diff --git a/R/get_acoustic_deployments.R b/R/get_acoustic_deployments.R
@@ -20,26 +20,29 @@
 #' @export
 #'
 #' @examples
-#' # Set default connection variable
-#' con <- connect_to_etn()
+#' # Set credentials
+#' credentials <- list(
+#'    username = Sys.getenv("userid"),
+#'    password = Sys.getenv("pwd")
+#'  )
 #'
 #' # Get all acoustic deployments
-#' get_acoustic_deployments(con)
+#' get_acoustic_deployments(credentials)
 #'
 #' # Get specific acoustic deployment
-#' get_acoustic_deployments(con, deployment_id = 1437)
+#' get_acoustic_deployments(credentials, deployment_id = 1437)
 #'
 #' # Get acoustic deployments for a specific receiver
-#' get_acoustic_deployments(con, receiver_id = "VR2W-124070")
+#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070")
 #'
 #' # Get open acoustic deployments for a specific receiver
-#' get_acoustic_deployments(con, receiver_id = "VR2W-124070", open_only = TRUE)
+#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070", open_only = TRUE)
 #'
 #' # Get acoustic deployments for a specific acoustic project
-#' get_acoustic_deployments(con, acoustic_project_code = "demer")
+#' get_acoustic_deployments(credentials, acoustic_project_code = "demer")
 #'
 #' # Get acoustic deployments for two specific stations
-#' get_acoustic_deployments(con, station_name = c("de-9", "de-10"))
+#' get_acoustic_deployments(credentials, station_name = c("de-9", "de-10"))
 get_acoustic_deployments <- function(
     credentials = list(username = Sys.getenv("userid"),
                        password = Sys.getenv("pwd")),
@@ -49,6 +52,9 @@ get_acoustic_deployments <- function(
     station_name = NULL,
     open_only = FALSE) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # create connection object
   connection <-
     connect_to_etn(credentials$username, credentials$password)
@@ -189,6 +195,9 @@ get_acoustic_deployments <- function(
     ", .con = connection)
   deployments <- DBI::dbGetQuery(connection, query)
 
+  # Close connection
+  DBI::dbDisconnect(connection)
+
   # Filter on open deployments
   if (open_only) {
     deployments <- filter(deployments, is.na(.data$recover_date_time))

diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R
@@ -90,6 +90,8 @@ get_acoustic_detections <- function(credentials = list(
                                     station_name = NULL,
                                     limit = FALSE) {
 
+  # Check if credentials object has right shape
+  check_credentials(credentials)
 
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
@@ -215,7 +217,7 @@ get_acoustic_detections <- function(credentials = list(
   }
 
   acoustic_tag_id_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")),
+    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")),
     .con = connection
   )
 
@@ -272,6 +274,9 @@ 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_projects.R b/R/get_acoustic_projects.R
@@ -13,19 +13,26 @@
 #' @export
 #'
 #' @examples
-#' # Set default connection variable
-#' con <- connect_to_etn()
+#' # Set credentials
+#' credentials <- list(
+#'    username = Sys.getenv("userid"),
+#'    password = Sys.getenv("pwd")
+#'  )
 #'
 #' # Get all acoustic projects
-#' get_acoustic_projects(con)
+#' get_acoustic_projects(credentials)
 #'
 #' # Get a specific acoustic project
-#' get_acoustic_projects(con, acoustic_project_code = "demer")
+#' get_acoustic_projects(credentials, acoustic_project_code = "demer")
 get_acoustic_projects <- function(credentials = list(
                                     username = Sys.getenv("userid"),
                                     password = Sys.getenv("pwd")
                                   ),
                                   acoustic_project_code = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # create connection object
   connection <-
     connect_to_etn(credentials$username, credentials$password)
@@ -50,7 +57,7 @@ get_acoustic_projects <- function(credentials = list(
   }
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
 
@@ -66,6 +73,9 @@ get_acoustic_projects <- function(credentials = list(
     ", .con = connection)
   projects <- DBI::dbGetQuery(connection, query)
 
+  # Close connection
+  DBI::dbDisconnect(connection)
+
   # Sort data
   projects <-
     projects %>%

diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R
@@ -15,17 +15,20 @@
 #' @export
 #'
 #' @examples
-#' # Set default connection variable
-#' con <- connect_to_etn()
+#' # Set credentials
+#' credentials <- list(
+#'    username = Sys.getenv("userid"),
+#'    password = Sys.getenv("pwd")
+#'  )
 #'
 #' # Get all acoustic receivers
-#' get_acoustic_receivers(con)
+#' get_acoustic_receivers(credentials)
 #'
 #' # Get lost and broken acoustic receivers
-#' get_acoustic_receivers(con, status = c("lost", "broken"))
+#' get_acoustic_receivers(credentials, status = c("lost", "broken"))
 #'
 #' # Get a specific acoustic receiver
-#' get_acoustic_receivers(con, receiver_id = "VR2W-124070")
+#' get_acoustic_receivers(credentials, receiver_id = "VR2W-124070")
 get_acoustic_receivers <- function(credentials = list(
                                      username = Sys.getenv("userid"),
                                      password = Sys.getenv("pwd")
@@ -63,11 +66,11 @@ get_acoustic_receivers <- function(credentials = list(
   }
 
   receiver_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "receiver.sql", package = "etn")),
+    readr::read_file(system.file("sql", "receiver.sql", package = "etnservice")),
     .con = connection
   )
   acoustic_tag_id_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")),
+    readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")),
     .con = connection
   )
 
@@ -124,5 +127,9 @@ get_acoustic_receivers <- function(credentials = list(
     receivers %>%
     dplyr::arrange(.data$receiver_id)
 
+  # Close connection
+  DBI::dbDisconnect(connection)
+
+  # Return receivers
   dplyr::as_tibble(receivers)
 }
diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R
@@ -13,19 +13,26 @@
 #' @export
 #'
 #' @examples
-#' # Set default connection variable
-#' con <- connect_to_etn()
+#' # Set credentials
+#' credentials <- list(
+#'    username = Sys.getenv("userid"),
+#'    password = Sys.getenv("pwd")
+#'  )
 #'
 #' # Get all animal projects
-#' get_animal_projects(con)
+#' get_animal_projects(credentials)
 #'
 #' # Get a specific animal project
-#' get_animal_projects(con, animal_project_code = "2014_demer")
+#' get_animal_projects(credentials, animal_project_code = "2014_demer")
 get_animal_projects <- function(credentials = list(
                                   username = Sys.getenv("userid"),
                                   password = Sys.getenv("pwd")
                                 ),
                                 animal_project_code = NULL) {
+
+  # Check if credentials object has right shape
+  check_credentials(credentials)
+
   # Create connection object
   connection <- connect_to_etn(credentials$username, credentials$password)
 
@@ -38,7 +45,7 @@ get_animal_projects <- function(credentials = list(
   } else {
     animal_project_code <- check_value(
       animal_project_code,
-      list_animal_project_codes(connection),
+      list_animal_project_codes(credentials),
       "animal_project_code",
       lowercase = TRUE
     )
@@ -49,7 +56,7 @@ get_animal_projects <- function(credentials = list(
   }
 
   project_sql <- glue::glue_sql(
-    readr::read_file(system.file("sql", "project.sql", package = "etn")),
+    readr::read_file(system.file("sql", "project.sql", package = "etnservice")),
     .con = connection
   )
 
@@ -65,6 +72,9 @@ get_animal_projects <- function(credentials = list(
     ", .con = connection)
   projects <- DBI::dbGetQuery(connection, query)
 
+  # Close connection
+  DBI::dbDisconnect(connection)
+
   # Sort data
   projects <-
     projects %>%