Merge pull request #75 from RobLBaker/master

Author: RobLBaker

DESCRIPTION

@@ -43,12 +43,17 @@ Imports:
     lifecycle
 RoxygenNote: 7.3.2
 Suggests: 
+    httptest,
     knitr,
+    leaflet,
     rmarkdown,
-    testthat (>= 3.0.0),
     sf,
-    leaflet,
-    stringr
+    stringr,
+    testthat (>= 3.0.0),
+    withr,
+    randgeo,
+    mockr,
+    EML
 VignetteBuilder: knitr
 URL: https://nationalparkservice.github.io/NPSutils/
 BugReports: https://github.com/nationalparkservice/NPSutils/issues

NEWS.md

@@ -1,4 +1,6 @@
 # NPSutils 1.0.1 (development version)
+## 2025-05-08
+  * add unit tests for all functions. Add packages necessary for unit tests to Suggests in DESCRIPTION file.
 
 ## 2025-03-25
   * fix bug that caused some functions to fail to detect certain .csv files

R/getParkUnitInfo.R

@@ -16,7 +16,7 @@
 #' @export
 #' @examples
 #' \dontrun{
-#' get_unit_code("ROMO")
+#' get_unit_code("Rocky")
 #' }
 get_unit_code <- function(unit) { # input must have quotes to indicate strings
   # To do:

R/getReferenceInfo.R

@@ -1,6 +1,6 @@
 #' Get DS References for a park-species combination
 #'
-#' @description \code{get_park_taxon_refs} returns a data frame of metadata for references in Data Store corresponding to a particular taxon at a park.
+#' @description \code{get_park_taxon_refs} returns a tibble of metadata for references in Data Store corresponding to a particular taxon at a park.
 #' The resultant data frame is then usable by other functions to extract metadata from the records.
 #'
 #' Because `get_park_taxon_refs()` accesses restricted data on the secure DataStore server, results of these queries need to be considered for potential park-specific data protection protocols. 
@@ -79,13 +79,13 @@ get_park_taxon_url <- function(park_code, taxon_code) {
   return(URLs)
 }
 
-#' Get citation for Data Store holding info by HoldingID
+#' Get citation for Data Store holding info by reference ID
 #'
-#' @description \code{get_ref_info} returns a character string or a vector with information from one of the
+#' @description `get_ref_info` returns a character string or a vector with information from one of the
 #' metadata fields in a Data Store reference's associated xml file.
 #'
 #'
-#' @param holding_id The six-seven digit reference / holding ID number unique to the data store record.
+#' @param reference_id The six-seven digit reference ID number unique to the data store record.
 #' @param field is one of the following: "Title" returns the title of the data store reference as a string value;
 #' "Abstract" returns the abstract as a string value; "Citation" returns the citation as a string value, and "Keywords" returns a vector containing
 #' all keywords as character values.
@@ -96,10 +96,10 @@ get_park_taxon_url <- function(park_code, taxon_code) {
 #' \dontrun{
 #' get_ref_info(2266196, "Title")
 #' }
-get_ref_info <- function(holding_id, field) {
+get_ref_info <- function(reference_id, field) {
   url <- paste0(.ds_api(),
                 "Profile/",
-                holding_id)
+                reference_id)
   DSReference <- httr::content(httr::GET(
     url, httr::authenticate(":", ":", "ntlm")
   ))

R/get_data_packages.R

@@ -38,15 +38,10 @@ get_data_packages <- function(reference_id,
                               path = here::here(),
                               force = FALSE,
                               dev = FALSE) {
-  # capture original working directory
-  orig_wd <- getwd()
-  # set directory back to original working directory on exit.
-  on.exit(setwd(orig_wd), add = TRUE)
-  # set wd to path; defaults to wd.
-  setwd(path)
+  
   # create "data" directory, if necessary:
-  if (!file.exists("data")) {
-    dir.create("data")
+  if (!file.exists(file.path(path, "data"))) {
+    dir.create(file.path(path, "data"))
   }
 
   # enforce proper specification of TRUE/FALSE parameters:
@@ -124,7 +119,7 @@ get_data_packages <- function(reference_id,
     }
 
     # if necessary, create a package-specific directory within the /data:
-    destination_dir <- paste("data/", reference_id[i], sep = "")
+    destination_dir <- file.path(path, "data", reference_id[i])
     # if the directory already exists, prompt user to overwrite:
     if (force == FALSE) {
       if (file.exists(destination_dir)) {
@@ -230,9 +225,10 @@ get_data_packages <- function(reference_id,
         file_id <- xml[[j]]$resourceId
         rest_file_download_url <- paste0(rest_file_download_base, file_id)
 
-        download_file_path <- paste0(
-          "data/",
-          reference_id[i], "/",
+        download_file_path <- file.path(
+          path,
+          "data",
+          reference_id[i],
           download_filename
         )
         # download the file:
@@ -241,6 +237,7 @@ get_data_packages <- function(reference_id,
           rest_file_download_url,
           httr::timeout(300),
           httr::progress(),
+          # during re-write use content not write_disk as write_disk is not well supported by httptest.
           httr::write_disk(download_file_path,
                            overwrite = TRUE
           ),
@@ -257,20 +254,11 @@ get_data_packages <- function(reference_id,
         # check to see if the downloaded file is a zip; unzip.
         if (tools::file_ext(tolower(download_filename)) == "zip") {
           utils::unzip(
-            zipfile = paste0(
-              "data\\",
-              reference_id[i], "\\",
-              download_filename
-            ),
-            exdir = paste0("data\\", reference_id[i])
+            zipfile = download_file_path,
+            exdir = dirname(download_file_path) 
           )
           # delete .zip file
-          file.remove(paste0(
-            "data/",
-            reference_id[i],
-            "/",
-            download_filename
-          ))
+          file.remove(download_file_path)
           if (force == FALSE) {
             cat("Unzipping ",
               crayon::blue$bold(download_filename),

R/load_core_metadata.R

@@ -20,18 +20,20 @@
 #' df <- load_core_metadata(1234567)
 #' }
 #' 
-load_core_metadata <- function(ds_ref, path = paste0(getwd(), "/data")){
+load_core_metadata <- function(ds_ref, path = here::here("data")){
   #construct path to downloaded data package:
   #capture current/original working directory:
-  origin_wd <- getwd()
+  
+  #origin_wd <- getwd()
   #set directory back to original working directory on exit.
-  on.exit(setwd(origin_wd), add=TRUE)
+  #on.exit(setwd(origin_wd), add=TRUE)
 
-  setwd(path)
-  directory <- paste0(path, "/", ds_ref)
+  #setwd(path)
+  #directory <- paste0(path, "/", ds_ref)
 
   #load metadata
-  metadata <- DPchecker::load_metadata(directory = directory)  
+  #metadata <- DPchecker::load_metadata(directory = directory)
+  metadata <- DPchecker::load_metadata(directory = here::here(path, ds_ref))
 
   title <- EMLeditor::get_title(metadata)
   pub_date <- metadata$dataset$pubDate
@@ -72,7 +74,9 @@ load_core_metadata <- function(ds_ref, path = paste0(getwd(), "/data")){
   license_name <- metadata$dataset$licensed$licenseName
 
   #get files lists:
-  files <- list.files(path=directory, pattern = "*\\.csv", ignore.case = TRUE)
+  #files <- list.files(path=directory, pattern = "*\\.csv", ignore.case = TRUE)
+  files <- list.files(path=here::here(path, ds_ref),
+                      pattern = "*\\.csv", ignore.case = TRUE)
   file_names <- data.frame(files, files)
   file_names$eml_element <- "data_file"
   file_names <- file_names[,c(3,1,2)]

R/load_pkg_metadata.R

@@ -2,7 +2,7 @@
 #' 
 #' @description `load_pkg_metadata()` is essentially a wrapper around `DPchecker::load_metadata` with the directory structure pre-set to work well the  default location that `get_data_package` stores downloaded data packages. If you did not use the default settings for `get_data_package` (or downloaded a data package manually) you may find it easier to adjust the directory structure pointing to your data package and load the metadata using `DPchecker::load_metadata()`. Much like `load_metadata`, `load_pkg_metadata` requires that there be a single .xml file in the data package directory, that the metadata file name end in *_metadata.xml, and that the file contain schema-valid EML metadata.
 #'
-#' @param holding_id is a 6-7 digit number corresponding to the holding ID of the data package zip file. Your data should be in a directory that that has the holding ID as its name.
+#' @param reference_id is a 6-7 digit number corresponding to the reference ID of the data package on DataStore. Your data should be in a directory that that has the reference ID as its name.
 #' @param directory String. Path to the data package directory, defaults to "data".
 #'
 #' @return one data frame to the global environment.
@@ -13,9 +13,10 @@
 #' \dontrun{
 #' load_pkg_metadata(2266200)
 #' }
-load_pkg_metadata <- function(holding_id, directory = "data") {
+load_pkg_metadata <- function(reference_id, directory = "data") {
 
-  meta <- DPchecker::load_metadata(directory = here::here("data", holding_id))
+  meta <- DPchecker::load_metadata(directory = here::here(directory,
+                                                          reference_id))
 
   return(invisible(meta))
 }  

R/map_wkt.R

@@ -22,7 +22,10 @@
 #' #map species observations - points only
 #' map_wkt(my_NPS_species_obs, wellknowntext = "footprintWKT", type = "points")
 #' }
-map_wkt <- function(df, wellknowntext = "footprintWKT", type = "all", remove.duplicates = TRUE) {
+map_wkt <- function(df,
+                    wellknowntext = "footprintWKT",
+                    type = "all",
+                    remove.duplicates = TRUE) {
   #filter to just wellknowntext column:
   wkt_grepl <- paste0('\\b', wellknowntext, '\\b')
   df <- df[grepl(wkt_grepl, colnames(df))]

R/rm_local_packages.R

@@ -25,7 +25,10 @@
 #' #delete data packages from a "data" directory in a custom location:
 #' rm_local_packages(1234567, path = "C:/Users/username/Documents")
 #' }
-rm_local_packages <- function (reference_id, all = FALSE, path = here::here(), force = FALSE){
+rm_local_packages <- function (reference_id,
+                               all = FALSE,
+                               path = here::here(),
+                               force = FALSE){
   if(all == FALSE){
     for(i in seq_along(reference_id)){
       d_path <- paste0(path, "/data/", reference_id[i])