Merge pull request #130 from RobLBaker/main

bugfix for set_doi()
nationalparkservice · Apr 8, 2024 · db8e35b · db8e35b
2 parents 45f31da + 4e86907
commit db8e35b
Show file tree

Hide file tree

Showing 10 changed files with 178 additions and 143 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+# EMLeditor v0.1.6 (in progress)
+
+## 2024-04-08
+  * Bug fix for `set_doi()`, which was not always updating dataTable URLs.
+
 # EMLeditor v0.1.5 "Little Bighorn"
 
 ## 2024-04-01
@@ -20,7 +25,7 @@
 
 ## 2024-02-22
   * Added function `set_missing_data()` which allows users to add missing data codes and missing data code definitions to metadata.
-  * Added utility functions `.get_user_input()` and `.get_user_input3()`. Refactored all set_ class functions to use these sub-functions rather than readlines() to get user input.
+  * Added utility functions `.get_user_input()` and `.get_user_input3()`. Refactored all set_ class functions to use these sub-functions rather than readLines() to get user input.
 
 ## 2024-02-13
   * Deprecated `set_cui()` in favor of `set_cui_dissem()`, which does the exact same thing as `set_cui()` but the function name has been updated to distinguish the action of the function from the newly added `set_cui_code()` function.

diff --git a/R/datastore_interactions.R b/R/datastore_interactions.R
@@ -26,7 +26,10 @@
 #' \dontrun{
 #' eml_object <- set_datastore_doi(eml_object)
 #' }
-set_datastore_doi <- function(eml_object, force = FALSE, NPS = TRUE, dev = FALSE){
+set_datastore_doi <- function(eml_object,
+                              force = FALSE,
+                              NPS = TRUE,
+                              dev = FALSE){
   # check for existing DOI:
   doc <- utils::capture.output(EMLeditor::get_doi(eml_object))
   #get data package title from metadata:
@@ -36,10 +39,16 @@ set_datastore_doi <- function(eml_object, force = FALSE, NPS = TRUE, dev = FALSE
     if(length(seq_along(doc)) > 1 ){
       cat("Your metadata does not have a previously specified DOI.\n",
           sep = "")
-      cat("Are you sure you want to create a new draft reference on DataStore and insert the corresponding DOI into your metadata?\n")
+      response <- paste0("Are you sure you want to create a new draft",
+                         " reference on DataStore and insert the",
+                         " corresponding DOI into your metadata?\n")
+      cat(response)
       var1 <- .get_user_input() #1 = yes, 2 = no
       if (var1 == 2){
-        cat("Function terminated. You have not created a new draft reference on DataStore and a DOI has not been added to your metadata.")
+        response <- paste0("Function terminated. You have not created a new",
+                          " draft reference on DataStore and a DOI has not",
+                          " been added to your metadata.\n")
+        cat(response)
         return()
       }
     }
@@ -54,7 +63,7 @@ set_datastore_doi <- function(eml_object, force = FALSE, NPS = TRUE, dev = FALSE
 
       #if API call fails, alert user and remind them to log on to VPN:
       if(!status_code == 200){
-        stop("ERROR: DataStore connection failed. Are you logged in to the VPN?\n")
+        stop("DataStore connection failed.")
       }
 
       test_json <- httr::content(test_req, "text")
@@ -153,7 +162,8 @@ set_datastore_doi <- function(eml_object, force = FALSE, NPS = TRUE, dev = FALSE
   # handle case when there is only one data table:
   else {
     for(i in seq_along(data_table)){
-      eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <- data_url
+      eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <-
+        data_url
     }
   }
   if(force == FALSE){

diff --git a/R/editEMLfunctions.R b/R/editEMLfunctions.R
@@ -88,21 +88,6 @@ set_doi <- function(eml_object, ds_ref, force = FALSE, NPS = TRUE) {
   if (force == TRUE) {
     eml_object$dataset$alternateIdentifier <- paste0(
       "doi: https://doi.org/10.57830/", ds_ref)
-    # update data URLs to correspond to new DOI:
-    data_table <- EML::eml_get(eml_object, "dataTable")
-    data_table <- within(data_table, rm("@context"))
-    data_url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/",
-                       ds_ref)
-    #handle case when there is only one data table:
-    if("physical" %in% names(data_table)){
-      eml_object$dataset$dataTable$physical$distribution$online$url <- data_url
-    }
-    # handle case when there are multiple data tables:
-    else {
-      for(i in seq_along(data_table)){
-        eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <- data_url
-      }
-    }
   }
   # interactive route:
   if (force == FALSE) {
@@ -115,6 +100,7 @@ set_doi <- function(eml_object, ds_ref, force = FALSE, NPS = TRUE) {
         "doi: https://doi.org/10.57830/",
         ds_ref
       )
+
       #get new doi:
       doi <- eml_object$dataset$alternateIdentifier
       doi <- sub(".*? ", "", doi)
@@ -150,30 +136,36 @@ set_doi <- function(eml_object, ds_ref, force = FALSE, NPS = TRUE) {
         doi <- eml_object$dataset$alternateIdentifier
         doi <- sub(".*? ", "", doi)
 
-        # update data URLs to correspond to new DOI:
-        data_table <- EML::eml_get(eml_object, "dataTable")
-        data_table <- within(data_table, rm("@context"))
-
-        data_url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/",
-                           ds_ref)
-        #handle case when there is only one data table:
-        if("physical" %in% names(data_table)){
-          eml_object$dataset$dataTable$physical$distribution$online$url <- data_url
-        }
-        # handle case when there are multiple data tables:
-        else {
-            for(i in seq_along(data_table)){
-              eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <- data_url
-            }
-        }
         # print the new DOI to the screen:
         cat("Your newly specified DOI is: ", crayon::blue$bold(doi),
             ".\n", sep = "")
-        cat("Your data files url also been updated to: ",
-            crayon::blue$bold(data_url), ".\n", sep = "")
       }
     }
   }
+  # update data URLs to correspond to new DOI
+  # (this should probably be a separate function)
+  data_table <- EML::eml_get(eml_object, "dataTable")
+  data_table <- within(data_table, rm("@context"))
+
+  data_url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/",
+                     ds_ref)
+  #handle case when there is only one data table:
+  if("physical" %in% names(data_table)){
+    eml_object$dataset$dataTable$physical$distribution$online$url <-
+      data_url
+  }
+  # handle case when there are multiple data tables:
+  else {
+    for(i in seq_along(data_table)){
+      eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <-
+        data_url
+    }
+  }
+  if (force == FALSE) {
+    cat("Your data files url also been updated to: ",
+        crayon::blue$bold(data_url), ".\n", sep = "")
+  }
+
   # Set NPS publisher, if it doesn't already exist
   if (NPS == TRUE) {
     eml_object <- .set_npspublisher(eml_object)
@@ -834,7 +826,12 @@ set_cui_marking <- function (eml_object,
 #' drr_title <- "Data Release Report for Data Package 1234"
 #' set_drr(eml_object, "2293234", drr_title)
 #' }
-set_drr <- function(eml_object, drr_ref_id, drr_title, org_name = "NPS", force = FALSE, NPS = TRUE) {
+set_drr <- function(eml_object,
+                    drr_ref_id,
+                    drr_title,
+                    org_name = "NPS",
+                    force = FALSE,
+                    NPS = TRUE) {
   doi <- paste0("DRR: https://doi.org/10.36967/", drr_ref_id)
 
   cite <- EML::eml$usageCitation(
@@ -857,9 +854,11 @@ set_drr <- function(eml_object, drr_ref_id, drr_title, org_name = "NPS", force =
     if (is.null(doc) == TRUE) {
       cat("No previous DRR was detected")
       eml_object$dataset$usageCitation <- cite
-      cat("Your DRR, ", crayon::blue$bold(drr_title), " has been added.", sep = "")
+      cat("Your DRR, ", crayon::blue$bold(drr_title),
+          " has been added.", sep = "")
     } else {
-      cat("Your current DRR is: ", crayon::blue$bold(doc$title), ".\n", sep = "")
+      cat("Your current DRR is: ", crayon::blue$bold(doc$title),
+          ".\n", sep = "")
       cat("The current DOI is: ", crayon::blue$bold(doc$alternateIdentifier),
         ".\n",
         sep = ""
@@ -1354,13 +1353,16 @@ set_protocol <- function(eml_object, protocol_id, force = FALSE, NPS = TRUE) {
   # get data to construct project:
 
   # get protocol profile via rest services:
-  ds_reference <- httr::content(httr::GET(paste0(.ds_api(), "Profile/", protocol_id)))
+  ds_reference <- httr::content(httr::GET(paste0(.ds_api(),
+                                                 "Profile/",
+                                                 protocol_id)))
 
   # extract project title
   proj_title <- ds_reference$bibliography$title
 
   # generate URL for the DataStore landing page:
-  url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/", protocol_id)
+  url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/",
+                protocol_id)
 
   # get DataStore ref number for the organization Name:
   ref <- ds_reference$series$referenceId
@@ -1590,12 +1592,17 @@ set_publisher <- function(eml_object,
         eml_object$dataset$publisher <- pubset
         cat("No publisher information was detected\n\n")
         cat("Your publisher has been set to:\n")
-        cat("Organization Name: ", crayon::blue$bold(pubset$organizationName), "\n", sep = "")
-        cat("Street address: ", crayon::blue$bold(pubset$address$deliveryPoint), "\n", sep = "")
+        cat("Organization Name: ", crayon::blue$bold(pubset$organizationName),
+            "\n", sep = "")
+        cat("Street address: ", crayon::blue$bold(pubset$address$deliveryPoint),
+            "\n", sep = "")
         cat("City: ", crayon::blue$bold(pubset$address$city), "\n", sep = "")
-        cat("State: ", crayon::blue$bold(pubset$address$administrativeArea), "\n", sep = "")
-        cat("Zip Code: ", crayon::blue$bold(pubset$address$postalCode), "\n", sep = "")
-        cat("Country: ", crayon::blue$bold(pubset$address$country), "\n", sep = "")
+        cat("State: ", crayon::blue$bold(pubset$address$administrativeArea),
+            "\n", sep = "")
+        cat("Zip Code: ", crayon::blue$bold(pubset$address$postalCode),
+            "\n", sep = "")
+        cat("Country: ", crayon::blue$bold(pubset$address$country),
+            "\n", sep = "")
         cat("URL: ", crayon::blue$bold(pubset$onlineUrl), "\n", sep = "")
         cat("email: ", crayon::blue$bold(pubset$email), "\n", sep = "")
         cat("ROR ID: ", crayon::blue$bold(pubset$userID), "\n", sep = "")
@@ -1820,7 +1827,8 @@ set_int_rights <- function(eml_object,
           if(license == "public"){
             eml_object$dataset$intellectualRights <- pub_domain
             eml_object$dataset$licensed$licenseName <- "Public Domain"
-            cat("Your license has been set to:", crayon::blue$bold("Public Domain"))
+            cat("Your license has been set to:",
+                crayon::blue$bold("Public Domain"))
           }
         }
         # warn user license not set, CUI and license don't agree:
@@ -1840,7 +1848,8 @@ set_int_rights <- function(eml_object,
         }
         if(cui2 != "PUBLIC"){
           eml_object$dataset$intellectualRights <- restrict
-          eml_object$dataset$licensed$licenseName <- "No License/Controlled Unclassified Information"
+          eml_object$dataset$licensed$licenseName <-
+            "No License/Controlled Unclassified Information"
           cat("Your license has been set to ",
               crayon::bold$blue("Restricted"), ".", sep="")
         }
@@ -1944,7 +1953,8 @@ set_data_urls <- function(eml_object, url = NULL, force = FALSE, NPS = TRUE){
     # handle case when there are multiple data tables:
     else {
       for(i in seq_along(data_table)){
-        eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <- data_url
+        eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <-
+          data_url
       }
     }
     if(force == FALSE){
@@ -1959,7 +1969,8 @@ set_data_urls <- function(eml_object, url = NULL, force = FALSE, NPS = TRUE){
     # handle case when there are multiple data tables:
     else {
       for(i in seq_along(data_table)){
-        eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <- url
+        eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <-
+          url
       }
     }
   }
@@ -2190,7 +2201,8 @@ set_creator_orgs <- function(eml_object,
     result <- XML::xmlParse(file = f)
     dat <- XML::xmlToDataFrame(result) # xml to dataframe
 
-    alpha <- dat %>% dplyr::filter(grepl(paste(park_units, collapse = '|'), UnitCode, ignore.case = TRUE))
+    alpha <- dat %>% dplyr::filter(grepl(paste(park_units, collapse = '|'),
+                                         UnitCode, ignore.case = TRUE))
 
     park_name <- alpha$FullName
     creator_orgs <- append(creator_orgs, park_name)
@@ -2229,7 +2241,8 @@ set_creator_orgs <- function(eml_object,
         creator_list <- append(creator_list, creator_new[[i]][["individualName"]][["surName"]])
       }
       else{
-        creator_list <- append(creator_list, creator_new[[i]][["organizationName"]])
+        creator_list <- append(creator_list,
+                               creator_new[[i]][["organizationName"]])
       }
     }
     if(force == FALSE){

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -1,4 +1,4 @@
-url: https://roblbaker.github.io/EMLeditor/
+url: https://nationalparkservice.github.io/EMLeditor/
 template:
   bootstrap: 5