Add conversion function 18927() (PR#18927).

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

Author: hornik

src/library/tools/R/license.R

@@ -1,7 +1,7 @@
 #  File src/library/tools/R/license.R
 #  Part of the R package, https://www.R-project.org
 #
-#  Copyright (C) 1995-2019 The R Core Team
+#  Copyright (C) 1995-2015 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
@@ -931,3 +931,66 @@ function(file, keep = TRUE)
          licenses =
              select(x, - c(1L, pos), fields_in_license_para, keep))
 }
+
+spdx2r <-
+function(spdx)
+{
+    if(!is.character(spdx)) {
+        stop("Input must be character")
+    }
+
+    db <- read.dcf(file.path(R.home("share"), "licenses", "license.db"))
+
+    ## output = basename(File) if available, else SPDX identifier
+    r_format <- ifelse(!is.na(db[, "File"]),
+                       basename(db[, "File"]),
+                       db[, "SPDX"])
+    names(r_format) <- db[, "SPDX"]
+
+    convert_single <- function(single_id) {
+        single_id <- toupper(trimws(single_id))
+        if(is.na(single_id) || !nzchar(single_id))
+            return(NA_character_)
+
+        single_id <- sub("-only", "", single_id)
+
+        ## Return if perfect match to license.db
+        idx <- match(toupper(single_id), toupper(names(r_format)))
+        if (!is.na(idx))
+            return(r_format[idx])
+
+        ## -or-later + license.db does not always retain trailing zeros
+        if(grepl("-or-later$", single_id, ignore.case = TRUE)) {
+            base_id <- sub("-or-later", "",
+                           single_id, ignore.case = TRUE)
+            base_id_nozero <-
+                c(base_id, sub("-(\\d)\\.0", "-\\1", base_id))
+            full_id <- sub("-(\\d)\\.0-or-later", " (>= \\1)",
+                           single_id, ignore.case = TRUE)
+            full_id <- sub("-(\\d\\.\\d)-or-later", " (>= \\1)",
+                           full_id, ignore.case = TRUE)
+            if(any(toupper(base_id_nozero) %in% toupper(r_format)))
+                return(full_id)
+        }
+
+        return(NA_character_)
+    }
+
+    convert_compound <- function(compound_id) {
+        compound_id <- trimws(compound_id)
+        ## OR -> |
+        if(grepl(" OR ", compound_id, ignore.case = TRUE)) {
+            parts <- strsplit(compound_id, " [Oo][Rr] ", perl = TRUE)[[1L]]
+            converted_parts <-
+                vapply(parts, convert_single, "", USE.NAMES = FALSE)
+            if(any(is.na(converted_parts)))
+                return(NA_character_)
+            return(paste(converted_parts, collapse = " | "))
+        }
+        convert_single(compound_id)
+    }
+
+    result <- vapply(spdx, convert_compound, "", USE.NAMES = FALSE)
+    names(result) <- NULL
+    result
+}