Nothing
track.copy <- function(from, to=1, list=NULL, pattern=NULL,
glob=NULL, delete=FALSE, clobber=FALSE,
skipExisting=FALSE,
verbose=TRUE, do.untrackable=FALSE) {
if (!is.numeric(from) && !is.character(from))
stop("only implemented for numeric or char values for 'from'")
if (!is.numeric(to) && !is.character(to))
stop("only implemented for numeric or char values for 'to'")
if (length(from) > 1) {
res <- vector('list', length(from))
names(res) <- as.character(from)
for (i in seq(along=from)) {
x <- try(track.copy(from=from[[i]], to=to, list=list, pattern=pattern, glob=glob, delete=delete,
clobber=clobber, skipExisting=skipExisting, verbose=verbose, do.untrackable=do.untrackable))
if (!inherits(x, 'try-error'))
res[[i]] <- x
}
return(invisible(NULL))
}
if (do.untrackable)
warning("do.untrackable not yet implemented")
env.to <- as.environment(to)
env.from <- as.environment(from)
if (identical(env.to, env.from))
stop("'from' and 'to' are the same")
trackingEnv.to <- getTrackingEnv(env.to)
trackingEnv.from <- getTrackingEnv(env.from)
if (verbose)
cat(if (delete) "Moving" else "Copying", " objects from ",
track.datadir(env.from), " to ",
track.datadir(env.to), "\n", sep="")
opt.to <- track.options(trackingEnv=trackingEnv.to)
opt.from <- track.options(trackingEnv=trackingEnv.from)
if (opt.to$readonly)
stop("cannot copy into a readonly tracking env '", to, "'")
if (opt.from$readonly && delete)
stop("cannot move (i.e., copy & delete) from readonly tracking env '", from, "'")
all.objs.from <- ls(envir=env.from, all.names=TRUE)
all.objs.from <- all.objs.from[!isReservedName(all.objs.from)]
all.objs.from <- setdiff(all.objs.from, c(".Last", ".Last.sys"))
fileMap.from <- getFileMapObj(trackingEnv.from)
# don't limit to just tracked objs
# all.objs.from <- intersect(all.objs.from, names(fileMap.from))
if (is.null(pattern) && is.null(glob) && is.null(list))
list <- all.objs.from
if (!is.null(pattern))
list <- unique(c(list, grep(pattern, all.objs.from, value=TRUE)))
if (!is.null(glob))
list <- unique(c(list, grep(glob2rx(glob), all.objs.from, value=TRUE)))
if (!is.null(list)) {
if (any(isReservedName(list))) {
warning("omitting objects with reserved names: ", paste(list[isReservedName(list)], collapse=", "))
list <- list[!isReservedName(list)]
}
if (any(!(list %in% all.objs.from))) {
warning("omitting objects not present in 'from': ", paste(setdiff(list, all.objs.from), collapse=", "))
list <- setdiff(list, all.objs.from)
}
}
if (length(list)==0) {
if (verbose)
cat("Nothing to copy\n")
return(invisible(list))
}
fileMap.to <- getFileMapObj(trackingEnv.to)
all.objs.to <- ls(envir=env.to, all.names=TRUE)
if (skipExisting)
list <- setdiff(list, all.objs.to)
if (!clobber && any(list %in% all.objs.to))
stop("clobber=FALSE and some objects to be copied already exist in 'to': ", paste(intersect(list, all.objs.to), collapse=", "))
# make sure objects in the source are flushed out to files
track.flush(envir=env.from, list=intersect(list, names(fileMap.from)))
objSmy.to <- getObjSummary(trackingEnv.to, opt=opt.to)
objSmy.from <- getObjSummary(trackingEnv.from, opt=opt.from)
dir.to <- getDataDir(getTrackingDir(trackingEnv.to))
dir.from <- getDataDir(getTrackingDir(trackingEnv.from))
auto.to <- track.auto(envir=env.to)
for (objName in list) {
if (verbose)
cat(if (delete) "Moving" else "Copying", " '", objName, "'...\n", sep="")
fileMap.to.changed <- FALSE
fileMap.from.i <- match(objName, names(fileMap.from))
trackedInSource <- !is.na(fileMap.from.i)
if (trackedInSource) {
file.from <- fileMap.from[fileMap.from.i]
file.from.abs <- file.path(dir.from, paste(file.from, opt.from$RDataSuffix, sep="."))
objSmy.from.i <- match(objName, rownames(objSmy.from))
objClasses <- strsplit(objSmy.from[objSmy.from.i, "class"], ",")[[1]]
smyRow <- objSmy.from[objSmy.from.i, ]
} else {
objSmy.from.i <- NA
objVal <- get(objName, envir=env.from, inherits=FALSE)
objClasses <- class(objVal)
smyRow <- summaryRow(objName, opt.from, obj=objVal, file=NULL, change=TRUE, times=NULL)
}
trackInDest <- (trackedInSource || auto.to) && !exclude.from.tracking(objName, objClasses, opt.to)
if (trackInDest) {
if (is.na(file.to <- fileMap.to[match(objName, names(fileMap.to))])) {
file.to <- makeObjFileName(objName, fileMap.to)
fileMap.to[objName] <- file.to
fileMap.to.Changed <- TRUE
}
file.to.abs <- file.path(dir.to, paste(file.to, opt.to$RDataSuffix, sep="."))
if (file.exists(file.to.abs) && !clobber)
stop("file '", file.to.abs, "' for obj '", objName, "' already exists and clobber=FALSE")
} else {
objVal <- get(objName, envir=env.from, inherits=FALSE)
}
deleteThis <- FALSE
if (trackedInSource && trackInDest) {
# move/copy the file
if (delete) {
deleteThis <- TRUE
# rename is nicest, but won't work across file systems, so just try it
ok <- file.rename(file.from.abs, file.to.abs)
if (!ok) {
ok <- file.copy(file.from.abs, file.to.abs, overwrite=TRUE)
if (!ok)
stop("could not copy file '", file.to.abs, "' for obj '", objName, "'")
# confirm that we were able to copy the file ok
if (!file.exists(file.to.abs))
stop("failed to copy file '", file.to.abs, "' for obj '", objName, "'")
info.from <- file.info(file.from.abs)
info.to <- file.info(file.to.abs)
if (info.from$size != info.to$size)
stop("copied file '", file.to.abs, "' for obj '", objName, "', but size of copy (",
info.to$size, " bytes) does not match size of original (", info.from$size, " bytes)")
ok <- file.remove(file.from.abs)
if (!ok) {
warning("could not remove file '", file.from.abs, "' for obj '", objName, "'")
deleteThis <- FALSE
}
}
} else {
ok <- file.copy(file.from.abs, file.to.abs, overwrite=TRUE)
if (!ok)
stop("could not copy file '", file.to.abs, "' for obj '", objName, "'")
}
} else {
deleteThis <- delete
}
if (trackInDest) {
# remove any cached object in the 'to' envir
if (exists(objName, envir=trackingEnv.to, inherits=FALSE))
remove(list=objName, envir=trackingEnv.to)
# and remove the active binding if it exists
if (exists(objName, envir=env.to, inherits=FALSE))
remove(list=objName, envir=env.to)
f <- createBindingClosure(objName, trackingEnv.to)
makeActiveBinding(objName, env=env.to, fun=f)
if (!trackedInSource) {
# modify options we give here to immediately write out to disk
setTrackedVar(objName, value=objVal, trackingEnv=trackingEnv.to, file=file.to,
opt=replace(opt.to, c("writeToDisk", "cachePolicy", "maintainSummary"),
list(TRUE, 'none', FALSE)))
}
}
if (!trackInDest)
assign(objName, objVal, envir=env.to)
if (trackInDest) {
# update & write objSmy.to & write fileMap.to
if (objName %in% rownames(objSmy.to)) {
objSmy.to[objName, ] <- smyRow
} else {
objSmy.to <- rbind(objSmy.to, smyRow)
}
assign.res <- try(assign(".trackingSummary", objSmy.to, envir=trackingEnv.to), silent=TRUE)
if (inherits(assign.res, "try-error")) {
stop("unable to assign .trackingSummary back to tracking env on ",
envname(trackingEnv.to), ": ", assign.res)
} else {
assign(".trackingSummaryChanged", TRUE, envir=trackingEnv.to)
save.res <- saveObjSummary(trackingEnv=trackingEnv.to, opt=opt.to, dataDir=getDataDir(dir.to))
if (inherits(save.res, "try-error"))
stop("unable to save .trackingSummary to ", dir.to)
else
assign(".trackingSummaryChanged", FALSE, envir=trackingEnv.to)
}
writeFileMapFile(fileMap.to, trackingEnv=trackingEnv.to, dataDir=getDataDir(dir.to))
}
if (trackedInSource && deleteThis) {
# update fileMap.from & objSmy.from
# can only get here if opt.from$readonly==TRUE
if (is.na(fileMap.from.i)) {
warning("tracked object '", objName, "' doesn't have fileMap entry??? - not deleting")
} else {
objSmy.from <- objSmy.from[-objSmy.from.i, , drop=FALSE]
assign.res <- try(assign(".trackingSummary", objSmy.from, envir=trackingEnv.from), silent=TRUE)
if (inherits(assign.res, "try-error")) {
stop("unable to assign .trackingSummary back to tracking env on ",
envname(trackingEnv.from), ": ", assign.res)
} else {
assign(".trackingSummaryChanged", TRUE, envir=trackingEnv.from)
save.res <- saveObjSummary(trackingEnv=trackingEnv.from, opt=opt.from, dataDir=getDataDir(dir.from))
if (inherits(save.res, "try-error"))
stop("unable to save .trackingSummary to ", dir.from)
else
assign(".trackingSummaryChanged", FALSE, envir=trackingEnv.from)
}
fileMap.from <- fileMap.from[-fileMap.from.i]
writeFileMapFile(fileMap.from, trackingEnv=trackingEnv.from, dataDir=getDataDir(dir.from))
if (exists(objName, envir=env.from, inherits=FALSE))
remove(list=objName, envir=env.from)
if (exists(objName, envir=trackingEnv.from, inherits=FALSE))
remove(list=objName, envir=trackingEnv.from)
}
}
if (!trackedInSource && deleteThis) {
remove(list=objName, envir=env.from, inherits=FALSE)
}
}
return(invisible(list))
}
track.move <- function(from, to=1, list=NULL, pattern=NULL, glob=NULL, delete=TRUE, clobber=FALSE, skipExisting=FALSE, verbose=TRUE, do.untrackable=FALSE)
track.copy(from=from, to=to, list=list, pattern=pattern, glob=glob, delete=delete, clobber=clobber, skipExisting=skipExisting, verbose=verbose, do.untrackable=do.untrackable)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.