#  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))
}