###########################################################################/**
# @RdocDefault touchFile
#
# @title "Updates the timestamp of a file"
#
# \description{
# @get "title".
# Currently, it is only possible to change the timestamp specifying when
# the file was last modified, and time can only be set to the current time.
# }
#
# @synopsis
#
# \arguments{
# \item{pathname}{A @character @vector specifying files to be updated.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns (invisibly) a @vector of the old timestamps.
# }
#
# @examples "../incl/touchFile.Rex"
#
# @author
#
# \seealso{
# Internally, @see "base::Sys.setFileTime" (iff available) and
# @see "base::file.info" are utilized.
# }
#
# \references{
# [1] R-devel mailing list thread
# \emph{Unix-like touch to update modification timestamp of file?},
# started on 2008-02-26.
# \url{https://stat.ethz.ch/pipermail/r-devel/2008-February/048542.html}\cr
# }
#
# @keyword programming
# @keyword IO
# @keyword file
#*/###########################################################################
setMethodS3("touchFile", "default", function(pathname, ...) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local functions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Sys.setFileTime() exists in R (>= 2.14.0)
if (!exists("Sys.setFileTime", mode="function")) {
Sys.setFileTime <- function(path, ...) {
info <- file.info(pathname)
if (info$isdir) {
stop(sprintf("In R v%s, it is not possible to change the timestamp of a directory: %s", getRversion(), pathname))
}
con <- NULL
on.exit({
if (!is.null(con))
close(con)
})
# Zero-sized files have to be treated specially
if (info$size == 0) {
con <- file(pathname, open="w")
} else {
con <- file(pathname, open="r+b")
seek(con=con, where=0, origin="start", rw="read")
bfr <- readBin(con=con, what=raw(), n=1)
seek(con=con, where=0, origin="start", rw="write")
writeBin(con=con, bfr)
}
invisible(TRUE)
} # Sys.setFileTime()
} # if (!exists("Sys.setFileTime", ...))
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'pathname':
pathname <- as.character(pathname)
nPathnames <- length(pathname)
# Nothing to do?
if (nPathnames == 0L) return(invisible(NULL))
# Multiple files?
if (nPathnames > 1L) {
res <- lapply(pathname, FUN=touchFile, ...)
res <- Reduce(c, res)
return(invisible(res))
}
# Sanity check
if (!file.exists(pathname))
stop("No such file: ", pathname)
info <- file.info(pathname)
oldTimestamp <- info$mtime
if (!Sys.setFileTime(pathname, time=Sys.time())) {
stop("Failed to set timestamp: ", pathname)
}
invisible(oldTimestamp)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.