|
| 1 | +#' @name build-dbs |
| 2 | +#' |
| 3 | +#' @title Helper functions to generate HTML pages for reference manuals |
| 4 | +#' |
| 5 | +#' @param package_dir `character(1)` The local path to a package for which to |
| 6 | +#' build the aliases and cross-ref databases (`rds` files). |
| 7 | +#' |
| 8 | +#' @param reposRoot `character(1)` The path to the base hosting directory for |
| 9 | +#' the package repository. This is typically a location on the BBS server. |
| 10 | +#' |
| 11 | +#' @details |
| 12 | +#' These functions are used to generate the `aliases.rds` and `rdxrefs.rds` |
| 13 | +#' files for each package. These files are used to generate a metadata database |
| 14 | +#' `Rds` file via the `build_meta_aliases_db` and `build_meta_rdxrefs_db` |
| 15 | +#' functions for all packages. The `aliases.rds` file is a list of aliases |
| 16 | +#' within each `.Rd` page in the package. The `rdxrefs.rds` file is a matrix of |
| 17 | +#' cross-references between an external topic and the originating `.Rd` page. |
| 18 | +#' The individual package databases are then combined into a single database |
| 19 | +#' file for the entire repository. Each package's database is stored in the |
| 20 | +#' `web/packages` directory in `reposRoot`. The collective metadata database |
| 21 | +#' files are stored in the `src/contrib/Meta` directory in `reposRoot`. |
| 22 | +#' |
| 23 | +#' The alias and cross-reference files are generated from the package source |
| 24 | +#' directory but may also be generated from a built package tarball |
| 25 | +#' (functionality not included). The code is meant to run on the BBS, typically |
| 26 | +#' after a package has been built or updated. |
| 27 | +#' |
| 28 | +#' @examples |
| 29 | +#' if (interactive()) { |
| 30 | +#' library(BiocPkgTools) |
| 31 | +#' bioc_sub <- pkgBiocDeps( |
| 32 | +#' "SummarizedExperiment", pkgType = "software", |
| 33 | +#' recursive = TRUE, only.bioc = TRUE |
| 34 | +#' ) |
| 35 | +#' bioc_sub <- unlist(bioc_sub, use.names = FALSE) |
| 36 | +#' |
| 37 | +#' ## generate from Bioc package source dirs |
| 38 | +#' packages <- file.path(normalizePath("~/bioc"), bioc_sub) |
| 39 | +#' reposRoot <- "~/minibioc/packages/3.20/bioc" |
| 40 | +#' |
| 41 | +#' for (package in packages) { |
| 42 | +#' build_db_from_source(package, reposRoot) |
| 43 | +#' } |
| 44 | +#' } |
| 45 | +#' @export |
| 46 | +build_db_from_source <- function(package_dir, reposRoot) { |
| 47 | + tmp_dir <- tempdir() |
| 48 | + package <- basename(package_dir) |
| 49 | + package_web_dir <- file.path(reposRoot, "web", "packages", package) |
| 50 | + if (!dir.exists(package_web_dir)) |
| 51 | + dir.create(package_web_dir, recursive = TRUE) |
| 52 | + db <- tools::Rd_db(dir = package_dir) |
| 53 | + |
| 54 | + ## aliases.rds |
| 55 | + aliases <- lapply(db, tools:::.Rd_get_metadata, "alias") |
| 56 | + afile <- file.path(tmp_dir, "aliases.rds") |
| 57 | + saveRDS(aliases, file = afile, version = 2) |
| 58 | + atofile <- file.path(package_web_dir, "aliases.rds") |
| 59 | + file.copy( |
| 60 | + from = afile, |
| 61 | + to = atofile |
| 62 | + ) |
| 63 | + message(atofile) |
| 64 | + |
| 65 | + ## rdxrefs.rds |
| 66 | + rdxrefs <- lapply(db, tools:::.Rd_get_xrefs) |
| 67 | + rdxrefs <- cbind(do.call(rbind, rdxrefs), |
| 68 | + Source = rep.int(names(rdxrefs), sapply(rdxrefs, NROW))) |
| 69 | + xfile <- file.path(tmp_dir, "rdxrefs.rds") |
| 70 | + saveRDS(rdxrefs, file = xfile, version = 2) |
| 71 | + xtofile <- file.path(package_web_dir, "rdxrefs.rds") |
| 72 | + file.copy( |
| 73 | + from = xfile, |
| 74 | + to = xtofile |
| 75 | + ) |
| 76 | + message(xtofile) |
| 77 | +} |
| 78 | + |
| 79 | +#' @rdname build-dbs |
| 80 | +#' |
| 81 | +#' @param web_dir `character(1)` The `web/packages` local directory that is |
| 82 | +#' also hosted on the website e.g., for CRAN |
| 83 | +#' \url{https://cran.r-project.org/web/packages/} |
| 84 | +#' |
| 85 | +#' @param aliases_db_file `character(1)` The file path to `aliases.rds` file |
| 86 | +#' generated by the `build_db_from_source` function. |
| 87 | +#' |
| 88 | +#' @param force `logical(1)` If `FALSE`, the function will only update the |
| 89 | +#' database entries for which the aliases/rdxrefs file is more recent than the |
| 90 | +#' database file. If `TRUE`, the function will read all aliases/rdxrefs files. |
| 91 | +#' |
| 92 | +#' @examples |
| 93 | +#' if (interactive()) { |
| 94 | +#' reposRoot <- "~/minibioc/packages/3.20/bioc/" |
| 95 | +#' web_dir <- file.path(reposRoot, "web", "packages") |
| 96 | +#' |
| 97 | +#' meta_folder <- file.path(contrib.url(reposRoot), "Meta") |
| 98 | +#' if (!dir.exists(meta_folder)) dir.create(meta_folder, recursive = TRUE) |
| 99 | +#' aliases_db_file <- file.path(meta_folder, "aliases.rds") |
| 100 | +#' |
| 101 | +#' meta_aliases_db <- build_meta_aliases_db(web_dir, aliases_db_file) |
| 102 | +#' |
| 103 | +#' saveRDS(meta_aliases_db, aliases_db_file, version = 2) |
| 104 | +#' } |
| 105 | +#' @export |
| 106 | +build_meta_aliases_db <- |
| 107 | + function(web_dir, aliases_db_file, force = FALSE) |
| 108 | +{ |
| 109 | + files <- Sys.glob(file.path(web_dir, "*", "aliases.rds")) |
| 110 | + packages <- basename(dirname(files)) |
| 111 | + if (force || !is_file(aliases_db_file)) { |
| 112 | + db <- lapply(files, readRDS) |
| 113 | + names(db) <- packages |
| 114 | + } else { |
| 115 | + db <- readRDS(aliases_db_file) |
| 116 | + ## Drop entries in db not in package web area. |
| 117 | + db <- db[!is.na(match(names(db), packages))] |
| 118 | + ## Update entries for which aliases file is more recent than the |
| 119 | + ## db file. |
| 120 | + mtimes <- file.mtime(files) |
| 121 | + files <- files[mtimes >= file.mtime(aliases_db_file)] |
| 122 | + db[basename(dirname(files))] <- lapply(files, readRDS) |
| 123 | + } |
| 124 | + |
| 125 | + db[sort(names(db))] |
| 126 | +} |
| 127 | + |
| 128 | +is_file <- function(x) file.exists(x) && !file.info(x)[["isdir"]] |
| 129 | + |
| 130 | +#' @rdname build-dbs |
| 131 | +#' |
| 132 | +#' @param rdxrefs_db_file `character(1)` The file path to `rdxrefs.rds` file |
| 133 | +#' generated by the `build_db_from_source` function. |
| 134 | +#' |
| 135 | +#' @examples |
| 136 | +#' if (interactive()) { |
| 137 | +#' reposRoot <- "~/minibioc/packages/3.20/bioc/" |
| 138 | +#' web_dir <- file.path(reposRoot, "web", "packages") |
| 139 | +#' |
| 140 | +#' meta_folder <- file.path(contrib.url(reposRoot), "Meta") |
| 141 | +#' if (!dir.exists(meta_folder)) dir.create(meta_folder, recursive = TRUE) |
| 142 | +#' rdxrefs_db_file <- file.path(meta_folder, "rdxrefs.rds") |
| 143 | +#' |
| 144 | +#' meta_rdxrefs_db <- build_meta_rdxrefs_db(web_dir, rdxrefs_db_file) |
| 145 | +#' |
| 146 | +#' saveRDS(meta_rdxrefs_db, rdxrefs_db_file, version = 2) |
| 147 | +#' } |
| 148 | +#' @export |
| 149 | +build_meta_rdxrefs_db <- |
| 150 | + function(web_dir, rdxrefs_db_file, force = FALSE) |
| 151 | +{ |
| 152 | + files <- Sys.glob(file.path(web_dir, "*", "rdxrefs.rds")) |
| 153 | + packages <- basename(dirname(files)) |
| 154 | + if(force || !is_file(rdxrefs_db_file)) { |
| 155 | + db <- lapply(files, readRDS) |
| 156 | + names(db) <- packages |
| 157 | + } else { |
| 158 | + db <- readRDS(rdxrefs_db_file) |
| 159 | + ## Drop entries in db not in package web area. |
| 160 | + db <- db[!is.na(match(names(db), packages))] |
| 161 | + ## Update entries for which rdxrefs file is more recent than the |
| 162 | + ## db file. |
| 163 | + mtimes <- file.mtime(files) |
| 164 | + files <- files[mtimes >= file.mtime(rdxrefs_db_file)] |
| 165 | + db[basename(dirname(files))] <- lapply(files, readRDS) |
| 166 | + } |
| 167 | + |
| 168 | + db[sort(names(db))] |
| 169 | +} |
0 commit comments