# 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
#
# 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/
## <NOTE>
## We want *standardized* license specs so that we can compute on them.
## In particular, we want to know whether licenses are recognizable as
## FOSS (https://en.wikipedia.org/wiki/Free_and_open-source_software)
## licenses.
##
## A license spec is standardized ("canonical") if it is an alternative
## of component specs which are one of the following:
##
## A. "Unlimited"
## B. "file LICENSE" or "file LICENCE"
## C. A specification based on the R license db
## * A standard short specification (SSS field)
## * The name or abbreviation of an unversioned license
## * The name of abbreviation of a versioned license, optionally
## followed by a version spec
## * The name of a versioned license followed by the version
## * The abbrevation of a versioned license combined with '-',
## optionally followed by an extension spec as in B (in principle,
## only if the base license is extensible).
##
## A license spec is standardizable if we know to transform it to
## standardized form.
##
## Note that the R license db also contains non-FOSS licenses, and hence
## information (FOSS field) on the FOSS status of the licenses.
## Ideally, a license taken as FOSS would be approved as free by the FSF
## and as open by the OSI: we also take licenses as FOSS when approved
## by the FSF (and not rejected by the OSI).
##
## See
## https://www.gnu.org/licenses/license-list.html
## https://opensource.org/licenses/alphabetical
## fot the FSF and OSI license lists, and also
## https://www.fsf.org/licensing/licenses
## https://en.wikipedia.org/wiki/List_of_FSF_approved_software_licences
## https://en.wikipedia.org/wiki/List_of_OSI_approved_software_licences
## for more information.
## </NOTE>
re_anchor <-
function(s)
if(length(s)) paste0("^", s, "$") else character()
re_group <-
function(s)
if(length(s)) paste0("(", s, ")") else character()
re_or <-
function(s, group = TRUE) {
if(!length(s))
character()
else if(group)
re_group(paste(s, collapse = "|"))
else
paste(s, collapse = "|")
}
.make_R_license_db <-
function(paths = NULL)
{
if(is.null(paths))
paths <- unlist(strsplit(Sys.getenv("R_LICENSE_DB_PATHS"),
.Platform$path.sep, fixed = TRUE))
paths <- c(paths,
file.path(R.home("share"), "licenses", "license.db"))
ldb <- Reduce(function(u, v) merge(u, v, all = TRUE),
lapply(unique(normalizePath(paths)), read.dcf))
## Merging matrices gives a data frame.
ldb <- as.matrix(ldb)
ldb[is.na(ldb)] <- ""
## (Could also keep NAs and filter on is.finite() in subsequent
## computations.)
## FOSS == "yes" implues Restricts_use = "no":
ldb[ldb[, "FOSS"] == "yes", "Restricts_use"] <- "no"
ldb <- data.frame(ldb, stringsAsFactors = FALSE)
ldb$Labels <- R_license_db_labels(ldb)
ldb[!duplicated(ldb$Labels), ]
}
R_license_db_labels <-
function(ldb)
{
if(is.null(ldb)) return(NULL)
lab <- ldb$SSS
pos <- which(lab == "")
abbrevs <- ldb$Abbrev[pos]
versions <- ldb$Version[pos]
lab[pos] <- ifelse(nzchar(abbrevs), abbrevs, ldb$Name[pos])
ind <- nzchar(versions)
pos <- pos[ind]
lab[pos] <- sprintf("%s version %s", lab[pos], versions[ind])
lab
}
R_license_db <- local({
val <- NULL
function(new) {
if(!missing(new))
val <<- new
else
val
}
})
R_license_db(.make_R_license_db())
.make_R_license_db_vars <-
function()
{
## Build license regexps and tables according to the specs.
ldb <- R_license_db()
## Standard short specification (SSS field) from the R license db.
pos <- which(nzchar(ldb$SSS))
names(pos) <- ldb$SSS[pos]
tab_sss <- pos
has_version <- nzchar(ldb$Version)
has_abbrev <- nzchar(ldb$Abbrev)
## Name or abbreviation of an unversioned license from the R license
## db.
pos <- which(!has_version)
names(pos) <- ldb$Name[pos]
tab_unversioned <- pos
pos <- which(has_abbrev & !has_version)
tab_unversioned[ldb$Abbrev[pos]] <- pos
## Versioned licenses from the R license db.
## Style A: Name of abbreviation of a versioned license, optionally
## followed by a version spec
## Style B: Name of a versioned license followed by the version.
## Style C: Abbrevation of a versioned license combined with '-'.
pos <- which(has_version)
names(pos) <- ldb$Name[pos]
tab_versioned_style_A <- split(pos, names(pos))
tab_versioned_style_B <- pos
names(tab_versioned_style_B) <-
paste(names(pos), ldb$Version[pos])
pos <- which(has_version & has_abbrev)
tab_versioned_style_A <-
c(tab_versioned_style_A, split(pos, ldb$Abbrev[pos]))
tab_versioned_style_C <- pos
names(tab_versioned_style_C) <-
sprintf("%s-%s",
ldb$Abbrev[pos],
ldb$Version[pos])
operators <- c("<", "<=", ">", ">=", "==", "!=")
re_numeric_version <- .standard_regexps()$valid_numeric_version
re_single_version_spec <-
paste0("[[:space:]]*",
re_or(operators),
"[[:space:]]*",
re_group(re_numeric_version),
"[[:space:]]*")
re_version_spec <-
paste0("\\(",
paste0("(", re_single_version_spec, ",)*"),
re_single_version_spec,
"\\)")
re_sss <- re_or(names(tab_sss))
re_unversioned <- re_or(names(tab_unversioned))
re_versioned_style_A <-
paste0(re_or(names(tab_versioned_style_A)),
"[[:space:]]*",
paste0("(", re_version_spec, ")*"))
## Let's be nice ...
re_versioned_style_B <-
re_or(paste0(ldb$Name[has_version],
"[[:space:]]+([Vv]ersion[[:space:]]+)?",
ldb$Version[has_version]))
re_versioned_style_C <- re_or(names(tab_versioned_style_C))
re_license_in_db <-
re_or(c(re_sss,
re_unversioned,
re_versioned_style_A,
re_versioned_style_B,
re_versioned_style_C))
re_license_file <- "file LICEN[CS]E"
re_license_extension <-
sprintf("[[:space:]]*\\+[[:space:]]*%s", re_license_file)
## <NOTE>
## Many standard licenses actually do not allow extensions.
## Ideally, we would only allow the extension markup for extensible
## standard licenses, as identified via an Extensible: TRUE field in
## the license db. But version ranges make this tricky: e.g.,
## GPL (>= 2) + file LICENSE
## is not right as GPL-2 does not allow extensions ...
## Hence, for now allow the extension markup with all standard
## licenses.
## </NOTE>
re_component <-
re_anchor(re_or(c(sprintf("%s(%s)?",
re_license_in_db,
re_license_extension),
re_license_file,
"Unlimited")))
list(re_component = re_component,
re_license_file = re_license_file,
re_license_extension = re_license_extension,
re_single_version_spec = re_single_version_spec,
re_sss = re_sss,
re_unversioned = re_unversioned,
re_versioned_style_A = re_versioned_style_A,
re_versioned_style_B = re_versioned_style_B,
re_versioned_style_C = re_versioned_style_C,
tab_sss = tab_sss,
tab_unversioned = tab_unversioned,
tab_versioned_style_A = tab_versioned_style_A,
tab_versioned_style_B = tab_versioned_style_B,
tab_versioned_style_C = tab_versioned_style_C)
}
R_license_db_vars <- local({
val <- NULL
function(new) {
if(!missing(new))
val <<- new
else
val
}
})
R_license_db_vars(.make_R_license_db_vars())
R_license_db_refresh_cache <-
function(paths = NULL)
{
R_license_db(.make_R_license_db(paths))
R_license_db_vars(.make_R_license_db_vars())
}
## Standardizable license specs:
## License specifications found on CRAN/BioC/Omegahat and manually
## classified as standardizable software licenses (even though not
## standardized/canonical), provided as a list of license specs named by
## the respective standardizations.
## With ongoing standardization this should gradually be eliminated.
## Last updated: 2009-02-19.
## Nasty issues.
## * There really is no GPL version 2.0.
## Unfortunately, the FSF uses 2.0 in URLs or links
## (https://www.gnu.org/licenses/old-licenses/gpl-2.0.html)
## The text clearly says "Version 2, June 1991".
## * There really is no LGPL version 2.0.
## Unfortunately, the FSF uses 2.0 in URLs or links
## (https://www.gnu.org/licenses/old-licenses/).
## The text clearly says "Version 2, June 1991".
## * CeCILL is a bit of a mess: the current version is referred to as
## "version 2" (http://www.cecill.info/licences.en.html) but
## internally uses "Version 2.0 dated 2006-09-05"
## (http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt).
.standardizable_license_specs <-
list("Artistic-2.0" =
c("The Artistic License, Version 2.0",
"Artistic 2.0",
"Artistic-2.0, see https://opensource.org/licenses/artistic-license-2.0.php"
),
"BSL" =
c("Boost Software License",
"Boost Software License 1.0",
"BSL 1.0"
),
"CeCILL-2" =
c("CeCILL-2.0"
),
"GPL" =
c("GNU Public License",
"Gnu GPL",
"GNU GPL",
"GPL (https://www.gnu.org/copyleft/gpl.html)"
),
"GPL-2" =
c(## <NOTE>
## There is no GPL 2.0, see above.
"GNU General Public License 2.0.",
"GPL 2.0",
"GPL version 2.0",
"GPL2.0",
## </NOTE>
"GPL Version 2",
"GNU GPL Version 2",
"GNU GPL version 2",
"GNU GPL version 2.",
"GPL (version 2)",
"GPL 2",
"GPL 2.",
"GPL version 2",
"GPL version 2 (June, 1991)",
"GPL version 2.",
"GPL2",
## BioC:
"GPL V2",
"GPL, version 2"
),
"GPL-3" =
c("GPL Version 3",
"GPL version 3",
"GNU General Public Licence (GPLv3)",
"GPL 3",
"GPL v3"
),
"GPL (>= 2)" =
c(## <NOTE>
## There is no GPL 2.0, see above.
"GNU GPL v2.0 or greater",
"GPL 2.0 or higher",
"GPL 2.0 or newer",
"GPL version 2.0 or later",
"GPL version 2.0 or newer",
## </NOTE>
"GNU GPL (version 2 or later)",
"GNU GPL (version 2 or later); see the file COPYING for details",
"GNU GPL version 2 or newer",
"GNU General Public License version 2 or newer",
"GPL version 2 or later",
"GPL ( version 2 or later)",
"GPL (Version 2 or above)",
"GPL (Version 2 or later)",
"GPL (version 2 or higher)",
"GPL (version 2 or later)",
"GPL (version 2 or later, see the included file GPL)",
"GPL (version 2 or newer)",
"GPL 2 or later",
"GPL 2 or newer",
"GPL version 2 or any later version",
"GPL Version 2 or later",
"GPL Version 2 or later.",
"GPL Version 2 or newer",
"GPL Version 2 or newer.",
"GPL version 2 (June, 1991) or later",
"GPL version 2 (or newer)",
"GPL version 2 or later.",
"GPL version 2 or newer",
"GPL version 2 or newer (https://www.gnu.org/copyleft/gpl.html)",
"GPL version 2 or newer (see README).",
"GPL version 2 or newer.",
"GPL version 2 or newer. https://www.gnu.org/copyleft/gpl.html",
"GPL version 2, or, at your option, any newer version.",
"GPL Version 2 (or later)",
"GPL version 2 (or later)",
"GPL version 2 or higher",
"GPL2 or later",
"GPL>=2",
"GNU General Public License (version 2 or later)"
),
"GPL (>= 3)" =
c("GPL (version 3 or later)",
"GPL >=3"
),
"GPL | LGPL" =
c("GPL or LGPL by your choice"
),
"GPL | BSD" =
c("GPL, BSD"
),
"GPL-2 | file LICENSE" =
c("use under GPL2, or see file LICENCE"
),
"LGPL" =
c("LGPL (see <https://opensource.org/licenses/lgpl-license.php>).",
"GNU LGPL (same as wxWidgets)."
),
"LGPL-2" =
c("LGPL2",
"LGPL2.0"
),
"LGPL-2.1" =
c("LGPL version 2.1"
),
"LGPL-3" =
c("LGPL-v3"
),
"LGPL (>= 2.0)" =
c(## <NOTE>
## There is no LGPL-2.0, see above.
"LGPL >= 2.0",
## </NOTE>
"LGPL Version 2 or later.",
"LGPL version 2 or newer",
"LGPL (version 2 or later)",
"LGPL version 2 or later"
),
"LGPL (>= 2.1)" =
c("LGPL version 2.1 or later"
),
"LGPL (>= 3.0)" =
c("LGPL >=3"
),
"X11" =
c("X11 (http://www.x.org/Downloads_terms.html)"
),
"Unlimited" =
c("Unlimited use and distribution."
)
)
.standardizable_license_specs_db <-
data.frame(ispecs =
unlist(.standardizable_license_specs),
ospecs =
rep.int(names(.standardizable_license_specs),
lengths(.standardizable_license_specs)),
stringsAsFactors = FALSE)
analyze_license <-
function(x)
{
.make_results <- function(is_empty = FALSE,
is_canonical = FALSE,
bad_components = character(),
is_standardizable = FALSE,
is_verified = FALSE,
standardization = NA_character_,
components = NULL,
expansions = NULL,
extensions = NULL,
pointers = NULL,
is_FOSS = NA,
restricts_use = NA)
list(is_empty = is_empty,
is_canonical = is_canonical,
bad_components = bad_components,
is_standardizable = is_standardizable,
is_verified = is_verified,
standardization = standardization,
components = components,
expansions = expansions,
extensions = extensions,
pointers = pointers,
is_FOSS = is_FOSS,
restricts_use = restricts_use)
x <- trimws(x)
if(is.na(x) || (x == "")) {
## Not really a lot to check ...
## (Note that non-standardizable license specs are dropped by
## writePACKAGES() and friends.)
return(.make_results(is_empty = TRUE))
}
pointers <- NULL
extensions <- NULL
expansions <- NULL
is_verified <- FALSE
is_FOSS <- NA
restricts_use <- NA
## Try splitting into the individual components.
components <-
trimws(unlist(strsplit(gsub("[[:space:]]*\\+[[:space:]]*",
" + ", x),
"|", fixed = TRUE)))
## Now analyze the individual components.
ok <- grepl(R_license_db_vars()$re_component, components)
bad_components <- components[!ok]
is_canonical <- all(ok)
## Is the license specification standardizable?
standardizable <-
components %in% .standardizable_license_specs_db$ispecs
is_standardizable <- (is_canonical || all(standardizable))
standardization <- if(is_standardizable) {
## Standardize the ones which are standardizable but not yet
## standardized.
ind <- !ok & standardizable
if(any(ind))
components[ind] <-
.standardize_license_components(components[ind])
## Canonicalize the standardized ones a bit more (as we are
## rather generous about using whitespace).
ind <- ok & grepl("\\(", components)
if(any(ind)) {
s <- sub("[[:space:]]*\\([[:space:]]*", " \\(",
components[ind])
s <- sub("[[:space:]]*\\)", "\\)", s)
s <- gsub("[[:space:]]*,[[:space:]]*", ", ", s)
## Really re_or(operators) ...
s <- gsub("[[:space:]]+(<=?|>=?|==|!=)", " \\1", s)
components[ind] <-
gsub(sprintf("[[:space:]]*(%s)",
.standard_regexps()$valid_numeric_version),
" \\1", s)
}
paste(components, collapse = " | ")
} else NA_character_
## Analyze components provided that we know we can standardize.
if(is_standardizable) {
verifiable <- function(x, v = "yes")
!is.null(x) && all(!is.na(x) & (x == v))
## (More generally we could test for positive length of x: but
## a length test is needed because all(NULL) |=> TRUE.)
expansions <- lapply(components,
expand_license_spec_component_from_db)
## The license is FOSS if there is one component which is
## "Unlimited" or has a positive number of expansions all of
## which are FOSS.
## If all components have a positive number of expansions where
## at least one is not FOSS, the license is not FOSS.
## Otherwise we do not know.
is_FOSS <- if(any(components == "Unlimited")) {
TRUE
} else if(any(vapply(expansions,
function(e) verifiable(e$FOSS),
NA))) {
TRUE
} else if(all(vapply(expansions,
function(e) any(e$FOSS == "no"),
NA))) {
FALSE
} else
NA
## The license is verified (as FOSS) if it was verified as FOSS.
is_verified <- !is.na(is_FOSS) && is_FOSS
## The license does not restrict use if it is verified as FOSS,
## or if there is one component with a positive number of
## expansions all of which do not restrict use.
## If all components have a positive number of expansions where
## at least one of which restricts use, the license restricts
## use.
## Otherwise, we do not know.
restricts_use <- if(is_verified) {
FALSE
} else if(any(vapply(expansions,
function(e)
(length(e) &&
all(e$Restricts_use == "no")),
NA))) {
FALSE
} else if(all(vapply(expansions,
function(e)
any(e$Restricts_use == "yes"),
NA))) {
TRUE
} else
NA
re <- R_license_db_vars()$re_license_file
pos <- grep(sprintf("%s$", re), components)
if(length(pos)) {
elements <- components[pos]
## Components with license file pointers.
pointers <- sub(".*file ", "", elements)
## Components with license extensions.
ind <- grepl("+", elements, fixed = TRUE)
if(any(ind))
extensions <-
data.frame(components = elements[ind],
extensible =
vapply(expansions[pos[ind]],
function(e)
verifiable(e$Extensible),
NA),
stringsAsFactors = FALSE)
}
## Replace expansions by their labels from the license db.
## (As these are unique, we can always easily get the full
## expansions back.)
expansions <- lapply(expansions, `[[`, "Labels")
## Components which are "Unlimited" or "file LICEN[CS]E" have
## empty expansions:
ind <- grepl(sprintf("^(Unlimited|%s)$", re), components)
if(any(ind)) expansions[ind] <- as.list(components[ind])
## Components with license extensions have this dropped in the
## expansion.
m <- regexpr(sprintf("\\+ *%s$", re), components)
ind <- (m > -1L)
expansions[ind] <-
Map(paste, expansions[ind], regmatches(components, m))
}
if(any(startsWith(components, "Part of R"))) { # base package
is_verified <- is_FOSS <- TRUE
restricts_use <- FALSE
}
.make_results(is_canonical = is_canonical,
bad_components = bad_components,
is_standardizable = is_standardizable,
standardization = standardization,
is_verified = is_verified,
components = components,
expansions = expansions,
extensions = extensions,
pointers = pointers,
is_FOSS = is_FOSS,
restricts_use = restricts_use)
}
.standardize_license_components <-
function(x)
{
with(.standardizable_license_specs_db,
ospecs[match(x, ispecs)])
}
analyze_licenses <-
function(x, db = NULL)
{
x <- as.character(x)
if(!length(x)) return(NULL)
## As analyzing licenses is costly, only analyze the unique specs.
v <- unique(x)
out <- as.data.frame(do.call(rbind, lapply(v, analyze_license)),
stringsAsFactors = FALSE)
pos <- match(c("is_empty", "is_canonical", "is_standardizable",
"is_verified", "standardization", "is_FOSS",
"restricts_use"),
names(out))
out[pos] <- lapply(out[pos], unlist)
## And re-match specs to the unique specs.
out <- out[match(x, v), ]
rownames(out) <- NULL
if(!is.null(db)) {
## db should be a package db (data frame or character matrix)
## with rows corresponding to the elements of x.
cnms <- colnames(db)
if(!is.na(pos <- match("License_is_FOSS", cnms))) {
lif <- db[, pos]
pos <- which(!is.na(lif))
out$is_FOSS[pos] <- out$is_verified[pos] <-
(lif[pos] == "yes")
## is_FOSS implies !restricts_use:
pos <- pos[lif[pos] == "yes"]
out$restricts_use[pos] <- FALSE
}
if(!is.na(pos <- match("License_restricts_use", cnms))) {
lru <- db[, pos]
pos <- which(!is.na(lru))
out$restricts_use[pos] <- (lru[pos] == "yes")
## restricts_use implies !is_FOSS:
pos <- pos[lru[pos] == "yes"]
out$is_FOSS[pos] <- out$is_verified[pos] <- FALSE
}
}
out
}
build_license_db <-
function(dir, unpacked = FALSE)
{
CRAN <- getOption("repos")["CRAN"]
if(missing(dir) && substr(CRAN, 1L, 7L) == "file://")
dir <- file.path(substring(CRAN, 8L), "src", "contrib")
fields <- c("License", "License_is_FOSS", "License_restricts_use",
"Maintainer")
db <- .build_repository_package_db(dir, fields, unpacked = unpacked)
## Actually, for Omegehat this is not a good idea as this retains
## old versions in the "main" src/contrib directory. But let's not
## worry about this for now ...
db <- do.call(rbind, db)
## Retain what is needed ...
data.frame(db[ , c("Package", "Version", fields)],
stringsAsFactors = FALSE)
}
analyze_licenses_in_license_db <-
function(db)
{
results <- cbind(db, analyze_licenses(db$License, db))
## Keep License_is_FOSS and License_restricts_use columns for now,
## so that we can identify the is_FOSS and restricts_use values
## obtained from these.
results
}
analyze_licenses_in_repository <-
function(dir, unpacked = FALSE, full = TRUE)
{
db <- build_license_db(dir, unpacked)
if(!full) {
## Only keep the highest available versions.
## Such an option might be useful for build_license_db()
## itself.
db <- .remove_stale_dups(db)
}
analyze_licenses_in_license_db(db)
}
summarize_license_db <-
function(db)
{
packages <- db$Package
if(any(duplicated(packages)))
packages <- sprintf("%s_%s", packages, db$Version)
packages <- split(packages, db$License)
licenses <- names(packages)
out <- data.frame(Licenses = licenses, stringsAsFactors = FALSE)
## To get the 'packages' list into a data frame without I() ...
out$Packages <- packages
cat(formatDL(out$Licenses,
vapply(out$Packages,
function(p) paste(unique(p), collapse = " "),
""),
style = "list"),
sep = "\n\n")
invisible(out)
}
expand_license_spec_component_from_db <-
function(x)
{
## Determine the license from the db matching a license spec
## component.
ldb <- R_license_db()
ldb_vars <- R_license_db_vars()
.numeric_version_meets_constraints_p <-
function(version, constraints)
{
version <- as.numeric_version(version)
for(term in constraints) {
re <- ldb_vars$re_single_version_spec
op <- sub(re, "\\1", term)
target <- sub(re, "\\2", term)
if(!do.call(op, list(version, target)))
return(FALSE)
}
TRUE
}
if(x == "Unlimited" ||
grepl(x, ldb_vars$re_license_file))
return(NULL)
## Drop possible license extension.
x <- sub(ldb_vars$re_license_extension, "", x)
if(grepl(re_anchor(ldb_vars$re_sss), x)) {
pos <- ldb_vars$tab_sss[x]
ldb[pos, ]
}
else if(grepl(re_anchor(ldb_vars$re_unversioned), x)) {
pos <- ldb_vars$tab_unversioned[x]
ldb[pos, ]
}
else if(grepl(re <-
re_anchor(ldb_vars$re_versioned_style_A),
x)) {
## Extract name/abbrev and version spec.
v <- sub(re, "\\2", x)
x <- sub(re, "\\1", x)
## First, find the matching entries matching the name/abbrev.
pos <- ldb_vars$tab_versioned_style_A[[x]]
entries <- ldb[pos, ]
## Now determine the entries satisfying the version spec.
v <- sub("[[:space:]]*\\((.*)\\)[[:space:]]*", "\\1", v)
if(nzchar(v)) {
constraints <-
unlist(strsplit(v, "[[:space:]]*,[[:space:]]*"))
entries <-
entries[vapply(entries$Version,
.numeric_version_meets_constraints_p,
constraints,
FUN.VALUE = NA), ]
}
entries
}
else if(grepl(re_anchor(ldb_vars$re_versioned_style_B),
x)) {
re <- sprintf("[[:space:]]+([Vv]ersion[[:space:]]+)?(%s)",
.standard_regexps()$valid_numeric_version)
x <- sub(re, " \\2", x)
pos <- ldb_vars$tab_versioned_style_B[x]
ldb[pos, ]
}
else if(grepl(re_anchor(ldb_vars$re_versioned_style_C),
x)) {
pos <- ldb_vars$tab_versioned_style_C[x]
ldb[pos, ]
}
}
.license_component_is_for_stub_and_ok <-
function(com, dir)
{
parts <-
unlist(strsplit(com, "[[:space:]]*\\+[[:space:]]*file *"))
## Should really allow getting this from R_license_db_vars().
fields_for_stubs <-
c(rep.int(list(c("YEAR", "COPYRIGHT HOLDER")),
4L),
rep.int(list(c("YEAR", "COPYRIGHT HOLDER", "ORGANIZATION")),
2L))
names(fields_for_stubs) <-
c("MIT License", "MIT",
"BSD 2-clause License", "BSD_2_clause",
"BSD 3-clause License", "BSD_3_clause")
fields_to_have <- fields_for_stubs[[parts[1L]]]
if(is.null(fields_to_have)) return(1L)
fields <- tryCatch(read.dcf(file.path(dir, parts[2L])),
error = identity)
if(inherits(fields, "error"))
return(2L)
if(!identical(sort(colnames(fields)),
sort(fields_to_have)))
return(3L)
if(!all(!is.na(fields) & nzchar(fields)))
return(4L)
0L
}
read_debian_copyright_file <-
function(file, keep = TRUE)
{
## See
## <https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/>.
select <- function(x, i, vars, keep = TRUE) {
pos <- match(vars, colnames(x), nomatch = 0L)
if(keep && any(!pos)) {
x <- cbind(x, NA_character_)
pos[!pos] <- ncol(x)
}
y <- x[i, pos, drop = FALSE]
colnames(y) <- vars
y
}
fields_in_header_para <-
c("Format", "Upstream-Name", "Upstream-Contact", "Source",
"Disclaimer", "Comment", "License", "Copyright")
fields_in_files_para <-
c("Files", "Copyright", "License", "Comment")
fields_in_license_para <-
c("License", "Comment")
x <- tryCatch(read.dcf(file, keep.white = TRUE),
error = identity)
if(inherits(x, "error") || !length(x)) return()
header <- drop(select(x, 1L, fields_in_header_para, keep))
if(is.na(fmt <- header["Format"]) ||
!grepl("copyright-format", fmt))
return()
pos <- which(!is.na(x[, "Files"]))
list(header = header,
files =
select(x, pos, fields_in_files_para, keep),
licenses =
select(x, - c(1L, pos), fields_in_license_para, keep))
}