add functions to build html reference manuals

DESCRIPTION

@@ -19,10 +19,12 @@ Maintainer: Bioconductor Package Maintainer <[email protected]>
 Depends: R (>= 3.6.0)
 Imports: Biobase, graph (>= 1.9.26), methods, RBGL (>= 1.13.5), tools,
         utils, XML, RCurl, RUnit, BiocManager
-Suggests: BiocGenerics, knitr, commonmark, BiocStyle
+Suggests: BiocGenerics, BiocPkgTools, knitr, commonmark, BiocStyle
 Collate: AllClasses.R AllGenerics.R as-methods.R htmlDoc-methods.R
         htmlFilename-methods.R htmlValue-methods.R show-methods.R
         getPackNames.R packageDetails.R pump.R repository.R showvoc.R
         getPackageNEWS.R validation_tests.R recommendBiocViews.R
-	dump_concept.R
+	dump_concept.R build_dbs.R
 VignetteBuilder: knitr
+RoxygenNote: 7.3.2
+Encoding: UTF-8

NAMESPACE

@@ -39,6 +39,9 @@ exportMethods("coerce", "show", "htmlDoc", "htmlValue", "htmlFilename")
 
 export("writeBiocViews", "getBiocViews", "write_VIEWS", "write_REPOSITORY",
        "genReposControlFiles", "extractVignettes", "extractManuals",
+       ## build db functions
+       "build_db_from_source", "build_meta_aliases_db", "build_meta_rdxrefs_db",
+       ##
        "extractCitations", "getCurrentbiocViews",
        "extractNEWS", "extractHTMLDocuments", "extractTopLevelFiles",
        "writeRepositoryHtml", "writePackageDetailHtml", "getSubTerms",

R/build_dbs.R

@@ -0,0 +1,169 @@
+#' @name build-dbs
+#'
+#' @title Helper functions to generate HTML pages for reference manuals
+#'
+#' @param package_dir `character(1)` The local path to a package for which to
+#'   build the aliases and cross-ref databases (`rds` files).
+#'
+#' @param reposRoot `character(1)` The path to the base hosting directory for
+#'   the package repository. This is typically a location on the BBS server.
+#'
+#' @details
+#' These functions are used to generate the `aliases.rds` and `rdxrefs.rds`
+#' files for each package. These files are used to generate a metadata database
+#' `Rds` file via the `build_meta_aliases_db` and `build_meta_rdxrefs_db`
+#' functions for all packages. The `aliases.rds` file is a list of aliases
+#' within each `.Rd` page in the package. The `rdxrefs.rds` file is a matrix of
+#' cross-references between an external topic and the originating `.Rd` page.
+#' The individual package databases are then combined into a single database
+#' file for the entire repository. Each package's database is stored in the
+#' `web/packages` directory in `reposRoot`. The collective metadata database
+#' files are stored in the `src/contrib/Meta` directory in `reposRoot`.
+#'
+#' The alias and cross-reference files are generated from the package source
+#' directory but may also be generated from a built package tarball
+#' (functionality not included). The code is meant to run on the BBS, typically
+#' after a package has been built or updated.
+#'
+#' @examples
+#' if (interactive()) {
+#'     library(BiocPkgTools)
+#'     bioc_sub <- pkgBiocDeps(
+#'         "SummarizedExperiment", pkgType = "software",
+#'         recursive = TRUE, only.bioc = TRUE
+#'     )
+#'     bioc_sub <- unlist(bioc_sub, use.names = FALSE)
+#'
+#'     ## generate from Bioc package source dirs
+#'     packages <- file.path(normalizePath("~/bioc"), bioc_sub)
+#'     reposRoot <- "~/minibioc/packages/3.20/bioc"
+#'
+#'     for (package in packages) {
+#'        build_db_from_source(package, reposRoot)
+#'     }
+#' }
+#' @export
+build_db_from_source <- function(package_dir, reposRoot) {
+    tmp_dir <- tempdir()
+    package <- basename(package_dir)
+    package_web_dir <- file.path(reposRoot, "web", "packages", package)
+    if (!dir.exists(package_web_dir))
+        dir.create(package_web_dir, recursive = TRUE)
+    db <- tools::Rd_db(dir = package_dir)
+
+    ## aliases.rds
+    aliases <- lapply(db, tools:::.Rd_get_metadata, "alias")
+    afile <- file.path(tmp_dir, "aliases.rds")
+    saveRDS(aliases, file = afile, version = 2)
+    atofile <- file.path(package_web_dir, "aliases.rds")
+    file.copy(
+        from = afile,
+        to = atofile
+    )
+    message(atofile)
+
+    ## rdxrefs.rds
+    rdxrefs <- lapply(db, tools:::.Rd_get_xrefs)
+    rdxrefs <- cbind(do.call(rbind, rdxrefs),
+                     Source = rep.int(names(rdxrefs), sapply(rdxrefs, NROW)))
+    xfile <- file.path(tmp_dir, "rdxrefs.rds")
+    saveRDS(rdxrefs, file = xfile, version = 2)
+    xtofile <- file.path(package_web_dir, "rdxrefs.rds")
+    file.copy(
+        from = xfile,
+        to = xtofile
+    )
+    message(xtofile)
+}
+
+#' @rdname build-dbs
+#'
+#' @param web_dir `character(1)` The `web/packages` local directory that is
+#'   also hosted on the website e.g., for CRAN
+#'   \url{https://cran.r-project.org/web/packages/}
+#'
+#' @param aliases_db_file `character(1)` The file path to `aliases.rds` file
+#'   generated by the `build_db_from_source` function.
+#'
+#' @param force `logical(1)` If `FALSE`, the function will only update the
+#'   database entries for which the aliases/rdxrefs file is more recent than the
+#'   database file. If `TRUE`, the function will read all aliases/rdxrefs files.
+#'
+#' @examples
+#' if (interactive()) {
+#'     reposRoot <- "~/minibioc/packages/3.20/bioc/"
+#'     web_dir <- file.path(reposRoot, "web", "packages")
+#'
+#'     meta_folder <- file.path(contrib.url(reposRoot), "Meta")
+#'     if (!dir.exists(meta_folder)) dir.create(meta_folder, recursive = TRUE)
+#'     aliases_db_file <- file.path(meta_folder, "aliases.rds")
+#'
+#'     meta_aliases_db <- build_meta_aliases_db(web_dir, aliases_db_file)
+#'
+#'     saveRDS(meta_aliases_db, aliases_db_file, version = 2)
+#' }
+#' @export
+build_meta_aliases_db <-
+    function(web_dir, aliases_db_file, force = FALSE)
+{
+    files <- Sys.glob(file.path(web_dir, "*", "aliases.rds"))
+    packages <- basename(dirname(files))
+    if (force || !is_file(aliases_db_file)) {
+        db <- lapply(files, readRDS)
+        names(db) <- packages
+    } else {
+        db <- readRDS(aliases_db_file)
+        ## Drop entries in db not in package web area.
+        db <- db[!is.na(match(names(db), packages))]
+        ## Update entries for which aliases file is more recent than the
+        ## db file.
+        mtimes <- file.mtime(files)
+        files <- files[mtimes >= file.mtime(aliases_db_file)]
+        db[basename(dirname(files))] <- lapply(files, readRDS)
+    }
+
+    db[sort(names(db))]
+}
+
+is_file <- function(x) file.exists(x) && !file.info(x)[["isdir"]]
+
+#' @rdname build-dbs
+#'
+#' @param rdxrefs_db_file `character(1)` The file path to `rdxrefs.rds` file
+#'   generated by the `build_db_from_source` function.
+#'
+#' @examples
+#' if (interactive()) {
+#'     reposRoot <- "~/minibioc/packages/3.20/bioc/"
+#'     web_dir <- file.path(reposRoot, "web", "packages")
+#'
+#'     meta_folder <- file.path(contrib.url(reposRoot), "Meta")
+#'     if (!dir.exists(meta_folder)) dir.create(meta_folder, recursive = TRUE)
+#'     rdxrefs_db_file <- file.path(meta_folder, "rdxrefs.rds")
+#'
+#'     meta_rdxrefs_db <- build_meta_rdxrefs_db(web_dir, rdxrefs_db_file)
+#'
+#'     saveRDS(meta_rdxrefs_db, rdxrefs_db_file, version = 2)
+#' }
+#' @export
+build_meta_rdxrefs_db <-
+    function(web_dir, rdxrefs_db_file, force = FALSE)
+{
+    files <- Sys.glob(file.path(web_dir, "*", "rdxrefs.rds"))
+    packages <- basename(dirname(files))
+    if(force || !is_file(rdxrefs_db_file)) {
+        db <- lapply(files, readRDS)
+        names(db) <- packages
+    } else {
+        db <- readRDS(rdxrefs_db_file)
+        ## Drop entries in db not in package web area.
+        db <- db[!is.na(match(names(db), packages))]
+        ## Update entries for which rdxrefs file is more recent than the
+        ## db file.
+        mtimes <- file.mtime(files)
+        files <- files[mtimes >= file.mtime(rdxrefs_db_file)]
+        db[basename(dirname(files))] <- lapply(files, readRDS)
+    }
+
+    db[sort(names(db))]
+}