Question

由于我们的企业防病毒软件，我的团队在安装R软件包时遇到问题。我们可以通过使用命令trace(utils:::unpackPkgZip, edit=TRUE)以交互方式编辑函数来临时解决此问题（解决方案来自：https://stackoverflow.com/a/46037327/4872343）。

我尝试使用以下方式编辑功能（下面的玩具示例）

myfunc <- function(x)
{
    line1 <- x
    line2 <- 0
    line3 <- line1 + line2
    return(line3)
}

as.list(body(f)) 
body(foo)[[3]] <- substitute(line2 <- 2)

（来源：What ways are there to edit a function in R?）

我的替换“行”明显更复杂（我需要做的小改变是“行”14的一部分：

  if (desc[1L, "Type"] %in% "Translation") {
    fp <- file.path(pkgname, "share", "locale")
    if (file.exists(fp)) {
      langs <- dir(fp)
      for (lang in langs) {
        path0 <- file.path(fp, lang, "LC_MESSAGES")
        mos <- dir(path0, full.names = TRUE)
        path <- file.path(R.home("share"), "locale", 
          lang, "LC_MESSAGES")
        if (!file.exists(path)) 
          if (!dir.create(path, FALSE, TRUE)) 
            warning(gettextf("failed to create %s", 
              sQuote(path)), domain = NA)
        res <- file.copy(mos, path, overwrite = TRUE)
        if (any(!res)) 
          warning(gettextf("failed to create %s", paste(sQuote(mos[!res]), 
            collapse = ",")), domain = NA)
      }
    }
    fp <- file.path(pkgname, "library")
    if (file.exists(fp)) {
      spkgs <- dir(fp)
      for (spkg in spkgs) {
        langs <- dir(file.path(fp, spkg, "po"))
        for (lang in langs) {
          path0 <- file.path(fp, spkg, "po", lang, "LC_MESSAGES")
          mos <- dir(path0, full.names = TRUE)
          path <- file.path(R.home(), "library", spkg, 
            "po", lang, "LC_MESSAGES")
          if (!file.exists(path)) 
            if (!dir.create(path, FALSE, TRUE)) 
              warning(gettextf("failed to create %s", 
                sQuote(path)), domain = NA)
          res <- file.copy(mos, path, overwrite = TRUE)
          if (any(!res)) 
            warning(gettextf("failed to create %s", 
              paste(sQuote(mos[!res]), collapse = ",")), 
              domain = NA)
        }
      }
    }
  }
  else {
    instPath <- file.path(lib, pkgname)
    if (identical(lock, "pkglock") || isTRUE(lock)) {
      lockdir <- if (identical(lock, "pkglock")) 
        file.path(lib, paste0("00LOCK-", pkgname))
      else file.path(lib, "00LOCK")
      if (file.exists(lockdir)) {
        stop(gettextf("ERROR: failed to lock directory %s for modifying\nTry removing %s", 
          sQuote(lib), sQuote(lockdir)), domain = NA)
      }
      dir.create(lockdir, recursive = TRUE)
      if (!dir.exists(lockdir)) 
        stop(gettextf("ERROR: failed to create lock directory %s", 
          sQuote(lockdir)), domain = NA)
      if (file.exists(instPath)) {
        file.copy(instPath, lockdir, recursive = TRUE)
        on.exit({
          if (restorePrevious) {
            try(unlink(instPath, recursive = TRUE))
            savedcopy <- file.path(lockdir, pkgname)
            file.copy(savedcopy, lib, recursive = TRUE)
            warning(gettextf("restored %s", sQuote(pkgname)), 
              domain = NA, call. = FALSE, immediate. = TRUE)
          }
        }, add = TRUE)
        restorePrevious <- FALSE
      }
      on.exit(unlink(lockdir, recursive = TRUE), add = TRUE)
    }
    if (libs_only) {
      if (!file_test("-d", file.path(instPath, "libs"))) 
        warning(gettextf("there is no 'libs' directory in package %s", 
          sQuote(pkgname)), domain = NA, call. = FALSE, 
          immediate. = TRUE)
      for (sub in c("i386", "x64")) if (file_test("-d", 
        file.path(tmpDir, pkgname, "libs", sub))) {
        unlink(file.path(instPath, "libs", sub), recursive = TRUE)
        ret <- file.copy(file.path(tmpDir, pkgname, 
          "libs", sub), file.path(instPath, "libs"), 
          recursive = TRUE)
        if (any(!ret)) {
          warning(gettextf("unable to move temporary installation %s to %s", 
            sQuote(normalizePath(file.path(tmpDir, pkgname, 
              "libs", sub), mustWork = FALSE)), sQuote(normalizePath(file.path(instPath, 
              "libs"), mustWork = FALSE))), domain = NA, 
            call. = FALSE, immediate. = TRUE)
          restorePrevious <- TRUE
        }
      }
      fi <- file.info(Sys.glob(file.path(instPath, "libs", 
        "*")))
      dirs <- row.names(fi[fi$isdir %in% TRUE])
      if (length(dirs)) {
        descfile <- file.path(instPath, "DESCRIPTION")
        olddesc <- readLines(descfile)
        olddesc <- grep("^Archs:", olddesc, invert = TRUE, 
          value = TRUE, useBytes = TRUE)
        newdesc <- c(olddesc, paste("Archs:", paste(basename(dirs), 
          collapse = ", ")))
        writeLines(newdesc, descfile, useBytes = TRUE)
      }
    }
    else {
      ret <- unlink(instPath, recursive = TRUE, force = TRUE)
      if (ret == 0) {
        Sys.sleep(0.5)
        ret <- file.rename(file.path(tmpDir, pkgname), 
          instPath)
        if (!ret) {
          warning(gettextf("unable to move temporary installation %s to %s", 
            sQuote(normalizePath(file.path(tmpDir, pkgname), 
              mustWork = FALSE)), sQuote(normalizePath(instPath, 
              mustWork = FALSE))), domain = NA, call. = FALSE, 
            immediate. = TRUE)
          restorePrevious <- TRUE
        }
      }
      else {
        warning(gettextf("cannot remove prior installation of package %s", 
          sQuote(pkgname)), domain = NA, call. = FALSE, 
          immediate. = TRUE)
        restorePrevious <- TRUE
      }
    }
  }
}

我试图将该块包装在引号中并分配给变量名，但出现以下错误：

Error: unexpected '}' in:
"}
}"

我可以将原始代码块（antivirus_problem）和已修改版本（antivirus_fix）分配给变量名称，方法是将它们包装在as.symbol()或expression()中（两者都是在上面提到的问题的答案中出现了潜在的修复方法）。

运行以下命令导致错误：

body(utils:::unpackPkgZip)[[14]] <- substitute(antivirus_problem <- antivirus_fix)
Error in body(utils:::unpackPkgZip)[[14]] <- substitute(antivirus_problem <- antivirus_fix) : 
  object 'utils' not found

然后我根据Richie Cotton的回答（https://stackoverflow.com/a/8743858/4872343）尝试使用fixInNamespace() 但它也返回了一个错误（也是一个交互式修复，我希望通过没有GUI依赖的脚本执行此操作）：

fixInNamespace("unpackPkgZip", "utils")
Error in assignInNamespace(subx, x, ns) : 
  locked binding of ‘unpackPkgZip’ cannot be changed

我相信在加载包之后锁定包命名空间，但是卸载utils以编辑unpackPkgZip也会卸载fixInNamespace()。

鉴于此信息，我可以：

永久编辑unpackPkgZip功能？
通过脚本/非交互方式编辑函数（可能将其添加到我们的Rprofile.site中，以便每次有人启动R时都应用此修复程序。）
覆盖unpackPkgZip中utils的版本，并告诉utils使用固定版本。

Answer 1

对我来说，一个非常快速和肮脏的解决方法可能适合您：

首先编辑该函数，将编辑过的函数保存为带有RDS的完整可恢复对象，并在每个R会话启动时覆盖默认函数（使用Rprofile.SITE）。

在必要时进行编辑：

trace(utils:::unpackPkgZip, edit=TRUE) # your edits
unpackPkg <- utils:::unpackPkgZip # copy function

saveRDS(unpackPkg, file = "C:/Users/myself/Documents/R/R-3.4.4/etc/unpack.rds") # save edited function to file

进入C：\ Users \ _自己\ Documents \ R \ R-3.4.4 \ etc \ Rprofile.SITE：

unpack <- readRDS(file = "C:/Users/myself/Documents/R/R-3.4.4/etc/unpack.rds")
utils::assignInNamespace("unpackPkgZip",unpack, ns="utils") # overwrite default function

utils :: assignInNamespace而不是assignInNamespace，作为R，在会话开始时找不到assignInNamespace ....

希望这很有帮助，我在unpackPkgZip上遇到了类似的问题

非交互式编辑/修复不可见（和锁定）功能

1 个答案: