【发布时间】：2018-05-25 09:58:25
【问题描述】：
由于我们的公司防病毒软件，我的团队在安装 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 时应用修复）。
- 覆盖
utils中unpackPkgZip的版本，并告诉utils改用固定版本。
【问题讨论】：
标签： r