如何生成与 devtools::install-version 兼容的 Meta/archive.rds？

Question

我正在尝试管理 CRAN 存储库以供内部使用。

在 devtools::install-version 中，它指的是 Meta/archive.rds。是怎么产生的？

我知道writePackages 用于为源代码库或 Mac/Windows 二进制包的存储库生成“PACKAGES”和“PACKAGES.gz”文件。

是否有类似的功能可以根据存档文件夹中的包生成Meta/archive.rds？

Answer 1

我们最终实施的解决方案是在本地下载存档，然后手动操作，上传到我们的个人 CRAN 实例。

archive <- readRDS('archive.rds')
archive <- create_metadata_for_package(archive, "package_name", "package_name/package_name_0.9.2.tar.gz", "user")
saveRDS(archive, 'archive.rds')

create_metadata_for_package <- function(archive, package_name, package_path, uname) {

  package_to_add <- structure(
    list(
      size = c(1680436)
      , isdir = c(FALSE)
      , mode = structure(c(436L), class = "octmode")
      , mtime = Sys.time()
      , ctime = Sys.time()
      , atime = Sys.time()
      , uid = c(1001L)
      , gid = c(1001L)
      , uname = c(uname)
      , grname = c("cranadmin")
    )
    , .Names = c("size", "isdir", "mode", "mtime", "ctime", "atime", "uid", "gid", "uname", "grname")
    , row.names = c(package_path)
    , class = "data.frame"
  )

  #check if package_name exists in archive
  new_package_name <- is.null(archive[[package_name]])

  if(new_package_name) { # new package_name
    new_package_meta_data <- data.frame(size=double()
                                       , isdir=logical()
                                       , mode=double()
                                       , mtime=as.Date(character())
                                       , ctime=as.Date(character())
                                       , atime=as.Date(character())
                                       , uid=double()
                                       , gid=double()
                                       , uname=character()
                                       , grname=character())
    archive[[package_name]] <- new_package_meta_data
  } else { # existing package_name
    package_metadata <- archive[[package_name]]
    package_versions <- rownames(package_metadata)

    #check if package_path is duplicate in existing metadata
    if(package_path %in% rownames(archive[[package_name]])) {
      return
    }
  }

  # append package_to_add to metadata
  archive[[package_name]] <- rbind(archive[[package_name]], package_to_add)

  archive
}

Answer 2

它没有那么复杂。 archive.rds 存储数据框的命名列表，其中名称是没有版本的包的名称，数据框是包存档文件夹中文件的base::file.info(files) 方法的结果。只是这些数据帧的行名是相对于Archive 目录的，所以格式为${packageName}/${packageName}_${packageVersion}.tar.gz

这里是如何重新生成archive.rds的示例代码

library(plyr)

generateArchive <- function(archiveDir) {
  dirs <- dir(archiveDir, recursive = FALSE, full.names = TRUE, no.. = TRUE)

  archive <- llply(dirs, function(dir) {
    files <- list.files(dir, recursive = FALSE, full.names = TRUE, pattern = "*.tar.gz")
    if (length(files) == 0) {
      print(paste0("Error: Empty directory: ", dir))
      return(NULL)
    }
    info <- file.info(files)

    tryCatch({
      rownames(info) <- paste0(basename(dirname(files)), "/", basename(files))
    }, error = function(e) {
      print(paste0("Error: Exception catched for Archived directory: ", dir))
      print(e)
      return(NULL)
    })

    info
  })

  names(archive) <- basename(dirs)
  archive[sapply(archive, is.null)] <- NULL  
  archive
}

archivePath <- "/tmp/15dev/src/contrib/Archive"
metaPath <- "/tmp/15dev/src/contrib/Meta"
dir.create(metaPath, showWarnings = FALSE)
archive <- generateArchive("/tmp/15dev/src/contrib/Archive")
saveRDS(archive, file.path(metaPath, "archive.rds"))

编辑： 更短的版本（不处理特殊情况）：

generateArchive <- function(archiveDir) {
  archive <- file.info(list.files(archiveDir, recursive = TRUE, full.names = TRUE, pattern = "*.tar.gz"))
  archive$packageName <- basename(dirname(rownames(archive)))
  archive$packageFile <- basename(rownames(archive))
  archive <- dlply(archive, "packageName", function(x) {
    rownames(x) <- paste0(x$packageName, "/", x$packageFile)
    x$packageName <- NULL
    x$packageFile <- NULL
    x
  })
}

archiveDir <- "/tmp/15dev/src/contrib/Archive"
metaPath <- "/tmp/15dev/src/contrib/Meta"
dir.create(metaPath, showWarnings = FALSE)
archive <- generateArchive("/tmp/15dev/src/contrib/Archive")
attr(archive, "split_type") <- NULL
attr(archive, "split_labels") <- NULL
saveRDS(archive, file.path(metaPath, "archive.rds"))