Add and use tools for working with ROR identifiers.

git-svn-id: https://svn.r-project.org/R/trunk@87621 00db46b3-68df-0310-9c12-caf00c1e9a41

src/library/tools/R/Rd2HTML.R

@@ -1625,24 +1625,33 @@ function(dir)
     ## achieve this by adding the canonicalized ORCID id (URL) to the
     ## 'family' element and simultaneously dropping the ORCID id from
     ## the 'comment' element, and then re-format.
-    .format_authors_at_R_field_with_expanded_ORCID_identifier <- function(a) {
+    ## See <https://ror.readme.io/docs/display> for ROR display
+    ## guidelines.
+    .format_authors_at_R_field_with_expanded_identifiers <- function(a) {
         x <- utils:::.read_authors_at_R_field(a)
         format_person1 <- function(e) {
-            comment <- e$comment
-            pos <- which((names(comment) == "ORCID") &
-                         grepl(.ORCID_iD_variants_regexp, comment))
-            if((len <- length(pos)) > 0L) {
+            cmt <- e$comment
+            pos <- which((names(cmt) == "ORCID") &
+                         grepl(.ORCID_iD_variants_regexp, cmt))
+            if(length(pos) == 1L) {
                 e$family <-
                     c(e$family,
-                      paste0("<",
-                             paste0("https://replace.me.by.orcid.org/",
-                                    .ORCID_iD_canonicalize(comment[pos])),
-                             ">"))
-                e$comment <- if(len < length(comment))
-                                 comment[-pos]
-                             else
-                                 NULL
+                      sprintf("<https://replace.me.by.orcid.org/%s>",
+                              .ORCID_iD_canonicalize(cmt[pos])))
+                cmt <- cmt[-pos]
             }
+            ## Of course, a person should not have both ORCID and ROR
+            ## identifiers: could check for that.
+            pos <- which((names(cmt) == "ROR") &
+                         grepl(.ROR_ID_variants_regexp, cmt))
+            if(length(pos) == 1L) {
+                e$family <-
+                    c(e$family,
+                      sprintf("<https://replace.me.by.ror.org/%s>",
+                              .ROR_ID_canonicalize(cmt[pos])))
+                cmt <- cmt[-pos]
+            }
+            e$comment <- if(length(cmt)) cmt else NULL
             e
         }
         x <- lapply(unclass(x), format_person1)
@@ -1675,7 +1684,7 @@ function(dir)
 
     if(!is.na(aatr))
         desc["Author"] <-
-            .format_authors_at_R_field_with_expanded_ORCID_identifier(aatr)
+            .format_authors_at_R_field_with_expanded_identifiers(aatr)
 
     ## Take only Title and Description as *text* fields.
     desc["Title"] <- htmlify_text(desc["Title"])
@@ -1723,6 +1732,18 @@ function(dir)
                         "style=\"width:16px; height:16px; margin-left:4px; margin-right:4px; vertical-align:middle\"",
                         " /></a>"),
                  desc["Author"])
+        desc["Author"] <-
+            gsub(sprintf("&lt;https://replace.me.by.ror.org/(%s)&gt;",
+                         .ROR_ID_regexp),
+                 paste0("<a href=\"https://ror.org/\\1\">",
+                        "<img alt=\"ROR ID\" ",
+                        if(dynamic)
+                            " src=\"/doc/html/ror.svg\" "
+                        else
+                            " src=\"https://cloud.R-project.org/web/ror.svg\" ",
+                        "style=\"width:20px; height:20px; margin-left:4px; margin-right:4px; vertical-align:middle\"",
+                        " /></a>"),
+                 desc["Author"])
     }
 
     desc["License"] <- htmlify_license_spec(desc["License"], pack)

src/library/tools/R/rortools.R

@@ -0,0 +1,82 @@
+#  File src/library/tools/R/rortools.R
+#  Part of the R package, https://www.R-project.org
+#
+#  Copyright (C) 2025 The R Core Team
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  A copy of the GNU General Public License is available at
+#  https://www.R-project.org/Licenses/
+
+## See <https://ror.org/about/faqs/#what-is-a-ror-identifier>:
+##   A ROR ID consists of a unique 9-character string appended to the
+##   ROR domain. The preferred form of a ROR identifier is the entire
+##   URL: https://ror.org/02mhbdp94 rather than ror.org/02mhbdp94 or
+##   02mhbdp94, although the ROR API will recognize all three of these
+##   forms as ROR IDs. 
+## So apparently the unique 9-character string is not the ROR ID and has 
+## no name to refer to ... argh.  For now, name things as we do for
+## ORCID iDs.
+
+### ** .ROR_ID_regexp
+
+.ROR_ID_regexp <-
+    ".{9}"
+
+### ** .ROR_ID_variants_regexp
+
+.ROR_ID_variants_regexp <-
+    sprintf("^<?((https://|)ror.org/)?(%s)>?$", .ROR_ID_regexp)
+
+### ** .ROR_ID_canonicalize
+
+.ROR_ID_canonicalize <- function(x)
+    sub(.ROR_ID_variants_regexp, "\\3", x)
+
+### ** .ROR_ID_is_valid
+
+.ROR_ID_is_valid <- function(x)
+    grepl(.ROR_ID_variants_regexp, x)
+
+### ** .ROR_ID_is_alive
+
+## See <https://ror.readme.io/v2/docs/rest-api>
+
+### ** ROR_ID_from_person
+
+ROR_ID_from_person <- function(x)
+    vapply(unclass(x),
+           function(e) e$comment["ROR"] %||% NA_character_,
+           "")
+
+### ** ROR_ID_db_from_package_sources
+
+ROR_ID_db_from_package_sources <-
+function(dir, add = FALSE)
+{
+    ids1 <- ROR_ID_from_person(.persons_from_metadata(dir))
+    ids1 <- ids1[!is.na(ids1)]
+    ids2 <- ROR_ID_from_person(.persons_from_citation(dir))
+    ids2 <- ids2[!is.na(ids2)]
+    db  <- data.frame(ID = c(character(), ids1, ids2),
+                      Parent = c(rep_len("DESCRIPTION",
+                                         length(ids1)),
+                                 rep_len("inst/CITATION",
+                                         length(ids2))))
+    if(add)
+        db$Parent <- file.path(basename(dir), db$Parent)
+    db
+}
+
+### Local variables: ***
+### mode: outline-minor ***
+### outline-regexp: "### [*]+" ***
+### End: ***

src/library/utils/R/citation.R

@@ -140,6 +140,18 @@ function(given = NULL, family = NULL, middle = NULL,
                             domain = NA)
                 }
             }
+            if(any(ind <- (names(comment) == "ROR"))) {
+                ids <- comment[ind]
+                bad <- which(!tools:::.ROR_ID_is_valid(ids))
+                if(length(bad)) {
+                    warning(sprintf(ngettext(length(bad),
+                                             "Invalid ROR ID: %s.",
+                                             "Invalid ROR IDs: %s."),
+                                    paste(sQuote(ids[bad]),
+                                          collapse = ", ")),
+                            domain = NA)
+                }
+            }
         }
 
         rval <- list(given = given, family = family, role = role,
@@ -419,6 +431,12 @@ function(x)
                 names(chunks)[i] <- "ORCID"
                 comment <- chunks
             }
+            if(any(i <- grepl(tools:::.ROR_ID_variants_regexp,
+                              chunks))) {
+                chunks[i] <- tools:::.ROR_ID_canonicalize(chunks[i])
+                names(chunks)[i] <- "ROR"
+                comment <- chunks
+            }
         }
         x <- sub("[[:space:]]*\\([^)]*\\)", "", x)
         email <- if(grepl("<.*>", x))
@@ -538,7 +556,8 @@ function(x,
     if(any(include == "comment"))
         x <- lapply(x,
                     function(e) {
-                        u <- .expand_ORCID_identifier(e$comment, style)
+                        u <- .expand_person_comment_identifiers(e$comment,
+                                                                style)
                         if(!is.null(v <- names(u))) {
                             i <- which(nzchar(v))
                             if(length(i))
@@ -602,7 +621,7 @@ function(object, escape = FALSE, ...)
     y
 }
 
-.expand_ORCID_identifier <-
+.expand_person_comment_identifiers <-
 function(x, style = "text")
 {
     if(any(ind <- ((names(x) == "ORCID") &
@@ -614,6 +633,15 @@ function(x, style = "text")
                   else
                       sprintf("<https://orcid.org/%s>", oid)
     }
+    if(any(ind <- ((names(x) == "ROR") &
+                   grepl(tools:::.ROR_ID_variants_regexp, x)))) {
+        rid <- tools:::.ROR_ID_canonicalize(x[ind])
+        x[ind] <- if(style == "md")
+                      sprintf("[ROR %s](https://ror.org/%s)",
+                              rid, rid)
+                  else
+                      sprintf("<https://ror.org/%s>", rid)
+    }
     x
 }
 

src/library/utils/man/person.Rd

@@ -171,7 +171,8 @@ as.person(x)
   taken to give \abbr{ORCID} identifiers (see \url{https://orcid.org/} for more
   information), and be displayed as the corresponding \abbr{URI}s by the
   \code{print()} and \code{format()} methods (see \bold{Examples}
-  below).
+  below).  Similarly, elements named \code{"ROR"} will be taken to give
+  \abbr{ROR} identifiers (see \url{https://ror.org/}).
 
   Where more than one entity is given a \code{"cph"} role, the
   \code{comment} field should be used to delimit who owns the copyright
@@ -221,4 +222,8 @@ toBibtex(b)
 ## ORCID identifiers.
 (p3 <- person("Achim", "Zeileis",
               comment = c(ORCID = "0000-0003-0918-3766")))
+
+## ROR identifiers.
+(p4 <- person("R Core Team",
+              comment = c(ROR = "02zz1nj61")))
 }