store organisation defaults in an organisation class

NAMESPACE

@@ -31,6 +31,7 @@ export(is_workdir_clean)
 export(menu_first)
 export(new_branch)
 export(orcid2person)
+export(organisation)
 export(prepare_ghpages)
 export(read_checklist)
 export(set_tag)

R/organisation_class.R

@@ -0,0 +1,64 @@
+#' @title The organisation R6 class
+#' @description A class with the organisation defaults
+#' @export
+#' @importFrom R6 R6Class
+#' @family class
+organisation <- R6Class(
+  "organisation",
+  public = list(
+    #' @description Initialize a new `organisation` object.
+    initialize = function() {
+      invisible(self)
+    },
+    #' @description Print the `organisation` object.
+    #' @param ... currently ignored.
+    print = function(...) {
+      dots <- list(...)
+      c("rightsholder: %s", "funder:       %s", "email domain settings") |>
+        paste(collapse = "\n") |>
+        sprintf(self$get_rightsholder, self$get_funder) |>
+        cat()
+      org <- self$get_organisation
+      for (domain in names(org)) {
+        cat(
+          "\n-", domain, "\n  mandatory ORCID iD"[org[[domain]]$orcid],
+          "\n  affiliations",
+          sprintf(
+            "\n    %s: %s", names(org[[domain]]$affiliation),
+            org[[domain]]$affiliation
+          )
+        )
+      }
+      return(invisible(NULL))
+    }
+  ),
+  active = list(
+    #' @field get_funder The default funder.
+    get_funder = function() {
+      private$funder
+    },
+    #' @field get_organisation The organisation requirements.
+    get_organisation = function() {
+      private$organisation
+    },
+    #' @field get_rightsholder The default rightsholder.
+    get_rightsholder = function() {
+      private$rightsholder
+    }
+  ),
+  private = list(
+    funder = "Research Institute for Nature and Forest (INBO)",
+    organisation = list(
+      "inbo.be" = list(
+        affiliation = c(
+          en = "Research Institute for Nature and Forest (INBO)",
+          nl = "Instituut voor Natuur- en Bosonderzoek (INBO)",
+          fr = "Institut de Recherche sur la Nature et les For\u00eats (INBO)",
+          de = "Institut f\u00fcr Natur- und Waldforschung (INBO)"
+        ),
+        orcid = TRUE
+      )
+    ),
+    rightsholder = "Research Institute for Nature and Forest (INBO)"
+  )
+)

R/use_author.R

@@ -39,7 +39,7 @@ use_author <- function() {
       "\norcid:      ", current$orcid[selected],
       "\naffiliation:", current$affiliation[selected]
     )
-    current <- validate_inbo_author(current = current, selected = selected)
+    current <- validate_author(current = current, selected = selected)
     final <- menu_first(choices = c("use ", "update", "other"))
     if (final == 1) {
       break
@@ -82,7 +82,7 @@ update_author <- function(current, selected, root) {
       "\norcid:      ", current$orcid[selected],
       "\naffiliation:", current$affiliation[selected]
     )
-    current <- validate_inbo_author(current = current, selected = selected)
+    current <- validate_author(current = current, selected = selected)
     command <- menu(
       choices = c(item, "save and exit", "undo changes and exit"),
       title = "\nWhich item to update?"
@@ -117,14 +117,19 @@ new_author <- function(current, root) {
     email = readline(prompt = "e-mail:      "),
     orcid = ask_orcid(prompt = "orcid:       ")
   ) -> extra
-  if (grepl("inbo.be$", extra$email, ignore.case = TRUE)) {
-    while (extra$orcid == "") {
-      cat("An ORCID is required for INBO staff")
+  org <- organisation$new()$get_organisation
+  gsub(".*@", "", extra$email) |>
+    grepl(names(org), ignore.case = TRUE) |>
+    which() -> which_org
+  if (extra$email != "" && length(which_org) > 0) {
+    org <- org[which_org]
+    while (org[[1]]$orcid && extra$orcid == "") {
+      cat("An ORCID is required for", names(org))
       extra$orcid <- ask_orcid(prompt = "orcid: ")
     }
-    names(inbo_affiliation) |>
+    names(org[[1]]$affiliation) |>
       menu_first(title = "Which default language for the affiliation?") -> lang
-    extra$affiliation <- inbo_affiliation[lang]
+    extra$affiliation <- org[[1]]$affiliation[lang]
   } else {
     extra$affiliation <- readline(prompt = "affiliation: ")
   }
@@ -194,27 +199,38 @@ author2badge <- function(role = "aut") {
     )
 }
 
-validate_inbo_author <- function(current, selected) {
-  if (!grepl("inbo.be$", current$email[selected], ignore.case = TRUE)) {
+validate_author <- function(current, selected) {
+  org <- organisation$new()$get_organisation
+  names(org) |>
+    gsub(pattern = "\\.", replacement = "\\\\.") |>
+    paste(collapse = "|") |>
+    sprintf(fmt = "@%s$") -> rg
+  if (!grepl(rg, current$email[selected], ignore.case = TRUE)) {
     return(current)
   }
-  while (is.na(current$orcid[selected]) || current$orcid[selected] == "") {
-    cat("\nAn ORCID is required for INBO staff")
+  this_org <- org[gsub(".*@", "", current$email[selected])]
+  while (
+    this_org[[1]]$orcid &&
+    (is.na(current$orcid[selected]) || current$orcid[selected] == "")
+  ) {
+    cat("\nAn ORCID is required for", names(this_org))
     current$orcid[selected] <- ask_orcid(prompt = "orcid: ")
   }
-  if (current$affiliation[selected] %in% inbo_affiliation) {
+  if (current$affiliation[selected] %in% this_org[[1]]$affiliation) {
     return(current)
   }
-  names(inbo_affiliation) |>
+  names(this_org[[1]]$affiliation) |>
     menu_first(
-      title = "\nNon standard affiliation for INBO staff.
-Which default language for the affiliation?"
+      title = sprintf(
+        "\nNon standard affiliation for `%s`.\n
+Which default language for the affiliation?",
+        names(this_org)
+      )
     ) -> lang
-  current$affiliation[selected] <- inbo_affiliation[lang]
+  current$affiliation[selected] <- this_org[[1]]$affiliation[lang]
   return(current)
 }
 
-
 #' Validate the structure of an ORCiD id
 #'
 #' Checks whether the ORCiD has the proper format and the checksum.

data-raw/iso_639_3.R

@@ -43,13 +43,6 @@ sprintf("`%s`", graphics_ext) |>
 ") |>
   writeLines("man-roxygen/graphics.R")
 open_data_ext <- c("csv", "gpkg", "tsv", "txt")
-inbo_affiliation <- c(
-  en = "Research Institute for Nature and Forest (INBO)",
-  nl = "Instituut voor Natuur- en Bosonderzoek (INBO)",
-  fr = "Institut de Recherche sur la Nature et les For\u00eats (INBO)",
-  de = "Institut f\u00fcr Natur- und Waldforschung (INBO)"
-)
 save(
-  email_regexp, graphics_ext, inbo_affiliation, iso_639_3, open_data_ext,
-  file = "R/sysdata.rda"
+  email_regexp, graphics_ext, iso_639_3, open_data_ext, file = "R/sysdata.rda"
 )

tests/testthat/test_a_author.R

@@ -5,7 +5,8 @@ test_that("author tools", {
   expect_is(stored_authors(root), "data.frame")
   expect_true(is_dir(root))
   expect_is(stored_authors(root), "data.frame")
-  stub(new_author, "readline", mock("John", "Doe", "", "", ""))
+  stub(new_author, "readline", mock("John", "Doe", "", ""))
+  stub(new_author, "ask_orcid", "")
   expect_output(new_author(current = data.frame(), root = root))
   expect_true(file_exists(path(root, "author.txt")))
   current <- stored_authors(root)