###########################################################################/**
# @RdocClass ChecksumFile
# @aliasmethod getChecksum
#
# @title "The ChecksumFile class"
#
# \description{
# @classhierarchy
#
# A ChecksumFile is an object referring to a file that contains a checksum
# for a corresponding "main" file.
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Arguments passed to @see "GenericDataFile".}
# }
#
# \section{Fields and Methods}{
# @allmethods "public"
# }
#
# @author
#*/###########################################################################
setConstructorS3("ChecksumFile", function(...) {
extend(GenericDataFile(...), "ChecksumFile")
})
setMethodS3("as.character", "ChecksumFile", function(x, ...) {
s <- NextMethod()
if (isFile(x)) {
checksum <- readChecksum(x)
} else {
checksum <- "NA (checksum file missing)"
}
s <- c(s, sprintf("Checksum on record: %s", checksum))
s
}, protected=TRUE)
setMethodS3("getMainFile", "ChecksumFile", function(this, mustExist=TRUE, ...) {
pathname <- getPathname(this)
pathnameM <- gsub("[.]md5$", "", pathname)
pathnameM <- Arguments$getReadablePathname(pathnameM, mustExist=mustExist)
GenericDataFile(pathnameM)
}, protected=TRUE)
# Checks whether the timestamp of the checksum file is older than
# the main file or not.
setMethodS3("isOld", "ChecksumFile", function(this, ...) {
pathname <- getPathname(this)
if (!isFile(pathname)) {
throw("Checksum file does not exist: ", pathname)
}
main <- getMainFile(this, mustExist=TRUE)
pathnameM <- getPathname(main)
isOld <- file_test("-nt", pathnameM, pathname)
isOld
})
setMethodS3("getChecksum", "ChecksumFile", function(this, write=FALSE, ...) {
.validate_nextmethod_call()
NextMethod("getChecksum", write=write)
})
###########################################################################/**
# @RdocMethod readChecksum
#
# @title "Reads the checksum value"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Not used.}
# }
#
# \value{
# Returns a lower-case @character string.
# }
#
# \details{
# The content of the checksum file is trimmed from comment lines,
# whitespaces and then validated that the remaining part contains a
# hexadecimal value.
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#*/###########################################################################
setMethodS3("readChecksum", "ChecksumFile", function(this, ...) {
pathname <- getPathname(this)
if (!isFile(this)) {
throw("Cannot read stored checksum. File does not exist: ", pathname)
}
checksum <- readLines(pathname, warn=FALSE)
# Trim all lines
checksum <- trim(checksum)
# Drop empty lines
checksum <- checksum[nchar(checksum) > 0L]
# Drop comments
checksum <- checksum[regexpr("^#", checksum) == -1L]
if (length(checksum) == 0L) {
throw("File format error. No checksum found: ", pathname)
} else if (length(checksum) > 1L) {
throw("File format error. Too many checksums: ", pathname)
}
# Always return lower-case checksums
checksum <- tolower(checksum)
# A checksum should only consist of hexadecimal characters
if (regexpr("^[0-9abcdef]+$", checksum) == -1L) {
throw(sprintf("File format error. Invalid checksum (%s): %s", sQuote(checksum), pathname))
}
# Validate number of character
checksumD <- digest(0L)
if (nchar(checksum) != nchar(checksumD)) {
throw(sprintf("File format error. Checksum (%s) contains %d characters not %d: %s", sQuote(checksum), nchar(checksum), nchar(checksumD), pathname))
}
checksum
})
###########################################################################/**
# @RdocMethod validate
#
# @title "Asserts that the checksum matches the checksum of file"
#
# \description{
# @get "title".
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Not used.}
# \item{verbose}{...}
# }
#
# \value{
# Returns @TRUE.
# If checksum on record does not match the file, an exception is thrown.
# }
#
# @author
#
# \seealso{
# @seeclass
# }
#*/###########################################################################
setMethodS3("validate", "ChecksumFile", function(this, ..., verbose=FALSE) {
# Argument 'verbose':
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
verbose && enter(verbose, "Validating checksum")
# Read checksum already on file
checksum <- readChecksum(this)
verbose && cat(verbose, "Checksum already on file: ", checksum)
verbose && enter(verbose, "Generating checksum for main file")
main <- getMainFile(this, mustExist=TRUE)
pathnameM <- getPathname(main)
verbose && cat(verbose, "Main file: ", pathnameM)
checksumM <- digest(pathnameM, file=TRUE)
checksumM <- tolower(checksumM)
verbose && cat(verbose, "Checksum for main file: ", checksumM)
verbose && exit(verbose)
verbose && enter(verbose, "Comparing")
if (checksumM != checksum) {
throw(sprintf("Generated checksum for %s does not match the one on file: %s != %s", sQuote(pathnameM), checksumM, checksum))
}
verbose && exit(verbose)
verbose && exit(verbose)
invisible(checksum)
})
setMethodS3("create", "ChecksumFile", function(static, file, ..., force=TRUE, verbose=FALSE) {
# Argument 'file':
if (inherits(file, "GenericDataFile")) {
pathnameM <- getPathname(file)
} else {
pathnameM <- as.character(file)
}
pathnameM <- Arguments$getReadablePathname(pathnameM)
# Argument 'verbose':
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
verbose && enter(verbose, "Create checksum file")
verbose && cat(verbose, "Main file: ", pathnameM)
pathname <- sprintf("%s.md5", pathnameM)
pathname <- Arguments$getWritablePathname(pathname, mustNotExist=FALSE)
verbose && cat(verbose, "Checksum file: ", pathname)
# Skip?
if (!force && isFile(pathname)) {
res <- newInstance(static, pathname)
verbose && exit(verbose)
return(res)
}
verbose && enter(verbose, "Generating checksum for main file")
checksumM <- digest(pathnameM, file=TRUE)
checksumM <- tolower(checksumM)
verbose && cat(verbose, "Checksum for main file: ", checksumM)
verbose && exit(verbose)
verbose && enter(verbose, "Writing checksum to file")
verbose && cat(verbose, "Pathname: ", pathname)
cat(checksumM, file=pathname)
verbose && exit(verbose)
res <- newInstance(static, pathname)
verbose && exit(verbose)
invisible(res)
}, static=TRUE) # create()
setMethodS3("hasChecksumFile", "default", function(...) {
isFile(getChecksumFile(..., onMissing="NA"))
})
setMethodS3("getChecksumFile", "GenericDataFile", function(this, ..., force=FALSE) {
pathname <- getPathname(this)
if (!force) force <- hasBeenModified(this, update=FALSE)
getChecksumFile(pathname, ..., force=force)
})
setMethodS3("getChecksumFile", "default", function(pathname, onMissing=c("write", "error", "NA"), onOld=c("write", "error", "ignore"), ..., force=FALSE, verbose=FALSE) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'pathname':
pathname <- Arguments$getReadablePathname(pathname)
# Argument 'onMissing':
onMissing <- match.arg(onMissing)
# Argument 'onOld':
onOld <- match.arg(onOld)
# Argument 'force':
force <- Arguments$getLogical(force)
# Argument 'verbose':
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
verbose && enter(verbose, "Getting checksum file")
verbose && cat(verbose, "Pathname: ", pathname)
# Has checksum file?
pathnameC <- sprintf("%s.md5", pathname)
res <- ChecksumFile(pathnameC, mustExist=FALSE)
write <- FALSE
if (!force && isFile(res)) {
verbose && enter(verbose, "Detected existing checksum file")
if (isOld(res)) {
verbose && cat(verbose, "The checksum file is outdated. Its timestamp is older than the timestamp of the main file")
if (onOld == "error") {
throw("The checksum file is outdated. Its timestamp is older than the timestamp of the main file: ", pathname)
} else if (onOld == "write") {
write <- TRUE
}
}
verbose && exit(verbose)
} else {
verbose && enter(verbose, "No checksum file exists (or force=TRUE)")
if (force) {
write <- TRUE
} else {
if (onMissing == "error") {
throw("Checksum file not found: ", pathname)
} else if (onMissing == "write") {
write <- TRUE
} else if (onMissing == "NA") {
}
}
verbose && exit(verbose)
}
if (write) {
verbose && enter(verbose, "Creating new checksum file")
res <- ChecksumFile$create(pathname, force=TRUE, verbose=verbose)
verbose && exit(verbose)
}
verbose && exit(verbose)
res
}) # getChecksumFile() for default
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.