Nothing
###########################################################################/**
# @RdocClass RspFileProduct
#
# @title "The RspFileProduct class"
#
# \description{
# @classhierarchy
#
# An RspFileProduct is an @see RspProduct that represents an
# RSP product in form of a file, e.g. LaTeX, Sweave and knitr documents.
# }
#
# @synopsis
#
# \arguments{
# \item{pathname}{An existing file.}
# \item{...}{Additional arguments passed to @see "RspProduct".}
# \item{mustExist}{If @TRUE, it is asserted that the file exists.}
# }
#
# \section{Fields and Methods}{
# @allmethods
# }
#
# @author
#
# @keyword internal
#*/###########################################################################
setConstructorS3("RspFileProduct", function(pathname=NA, ..., mustExist=TRUE) {
# Argument 'pathname':
if (!is.null(pathname) && !is.na(pathname)) {
if (!isUrl(pathname)) {
withoutGString({
pathname <- Arguments$getReadablePathname(pathname, mustExist=mustExist)
})
}
}
extend(RspProduct(pathname, ...), "RspFileProduct")
})
setMethodS3("print", "RspFileProduct", function(x, ...) {
s <- sprintf("%s:", class(x)[1L])
s <- c(s, sprintf("Pathname: %s", x))
# File size
fileSize <- getFileSize(x, "units")
if (!is.na(fileSize)) {
fileSizeB <- sprintf("%.0f bytes", getFileSize(x, "numeric"))
if (fileSizeB != fileSize) {
fileSize <- sprintf("%s (%s)", fileSize, fileSizeB)
}
}
s <- c(s, sprintf("File size: %s", fileSize))
s <- c(s, sprintf("Content type: %s", getType(x)))
md <- getMetadata(x, local=FALSE)
for (key in names(md)) {
s <- c(s, sprintf("Metadata '%s': '%s'", key, md[[key]]))
}
s <- c(s, sprintf("Has processor: %s", hasProcessor(x)))
s <- paste(s, collapse="\n")
cat(s, "\n", sep="")
}, protected=TRUE)
setMethodS3("view", "RspFileProduct", function(object, ...) {
# WORKAROUND: browseURL('foo/bar.html', browser=NULL), which in turn
# calls shell.exec('foo/bar.html'), does not work on Windows, because
# the OS expects backslashes. [Should shell.exec() convert to
# backslashes?] By temporarily setting the working directory to that
# of the file, view() for RspFileProduct works around this issue.
if (isFile(object)) {
path <- dirname(object)
pathname <- basename(object)
opwd <- getwd()
on.exit(setwd(opwd))
setwd(path)
} else {
pathname <- object
}
browseURL(pathname, ...)
invisible(object)
}, proctected=TRUE)
setMethodS3("getType", "RspFileProduct", function(object, default=NA_character_, as=c("text", "IMT"), ...) {
as <- match.arg(as)
res <- NextMethod("getType", default=NA_character_)
if (is.na(res)) {
# Infer type from the filename extension?
if (isFile(object) || isUrl(object)) {
res <- extensionToIMT(object)
}
}
# Fall back to a default?
if (is.na(res)) {
default <- as.character(default)
res <- default
}
if (as == "IMT" && !is.na(res)) {
res <- parseInternetMediaType(res)
}
res
}, protected=TRUE)
setMethodS3("getFileSize", "RspFileProduct", function(object, what=c("numeric", "units"), sep="", ...) {
# Argument 'what':
what <- match.arg(what)
pathname <- object
if (is.null(pathname) && isUrl(pathname)) {
fileSize <- NA_real_
} else {
fileSize <- file.info2(pathname)$size
}
if (what == "numeric")
return(fileSize)
if (is.na(fileSize))
return(fileSize)
units <- c("bytes", "kB", "MB", "GB", "TB")
scale <- 1
for (kk in seq_along(units)) {
unit <- units[kk]
if (fileSize < 1000)
break
fileSize <- fileSize/1024
}
fileSize <- sprintf("%.2f %s%s", fileSize, sep, unit)
fileSize <- gsub(".00 bytes", " bytes", fileSize, fixed=TRUE)
fileSize
})
setMethodS3("findProcessor", "RspFileProduct", function(object, ..., verbose=FALSE) {
isFALSE <- function(x) {
if (is.character(x)) return(toupper(x) == "FALSE")
if (is.logical(x) && !x) return(TRUE)
FALSE
}
localCompileLaTeX <- function(..., texinputs=NULL) {
if (!is.null(source)) {
path <- dirname(source)
pathA <- getAbsolutePath(path)
texinputs <- c(texinputs, pathA)
}
compileLaTeX(..., texinputs=texinputs)
} # localCompileLaTeX()
localCompressPDF <- function(pathname, ..., verbose=FALSE) {
# Argument 'verbose':
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
## Disabling further postprocessing after this,
## which avoids recursive loop.
metadata <- attr(pathname, "metadata")
metadata$postprocess <- FALSE
attr(pathname, "metadata") <- metadata
## Get compression level
compression <- metadata$compression
verbose && enter(verbose, "Trying to compress PDF")
verbose && cat(verbose, "Compression: ", compression)
pathT <- tempfile(pattern=".dir", tmpdir=".")
on.exit(removeDirectory(pathT, recursive=TRUE), add=TRUE)
## ROBUSTNESS: If compression fails for one reason or the
## other, fall back to keep the non-compressed version.
tryCatch({
verbose && enter(verbose, "R.utils::compressPDF()...")
suppressWarnings({
pathnameZ <- compressPDF(pathname, outPath=pathT,
compression=compression)
})
verbose && exit(verbose)
size <- file.info(pathname)$size
sizeZ <- file.info(pathnameZ)$size
if (!identical(sizeZ, size)) {
renameFile(pathnameZ, pathname, overwrite=TRUE)
}
}, error = function(ex) {
msg <- sprintf("Compression of '%s' using '%s' failed. Keeping the original PDF file. Reason was: %s", pathname, compression, ex$message)
verbose && cat(verbose, msg)
warning(msg)
})
verbose && exit(verbose)
pathname
} # localCompressPDF()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'verbose':
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
verbose && enter(verbose, "Locating document-type specific processor")
type <- getType(object)
verbose && cat(verbose, "RSP product content type: ", type)
# Nothing to do?
if (is.na(type)) {
verbose && cat(verbose, "Processor found: <none>")
verbose && exit(verbose)
return(NULL)
}
type <- parseInternetMediaType(type)$contentType
# Nothing to do?
postprocess <- getMetadata(object, "postprocess", local=TRUE)
if (isFALSE(postprocess)) {
verbose && cat(verbose, "Processing disabled: metadata variable 'postprocess' is FALSE")
verbose && exit(verbose)
return(NULL)
}
source <- getMetadata(object, "source", local=TRUE)
if (is.null(source)) {
verbose && cat(verbose, "Source document: <unknown>")
} else {
verbose && cat(verbose, "Source document: ", sQuote(source))
}
# Find a down-stream compiler/processor:
fcn <- switch(type,
# RSP documents:
# *<ext>.rsp => *.<ext>
"application/x-rsp" = function(...) { compileRsp(..., postprocess=FALSE) },
# LaTeX documents:
# *.tex => ... => *.pdf
"application/x-tex" = localCompileLaTeX,
"application/x-latex" = localCompileLaTeX,
## PDF documents:
# *.pdf => ... => *.pdf
"application/pdf" = localCompressPDF,
# Markdown documents:
# *.md => *.html
"application/x-markdown" = compileMarkdown,
# Markdown documents:
# *.txt => *.html, ...
"application/x-asciidoc" = function(...) { compileAsciiDoc(..., postprocess=FALSE) },
# Sweave Rnw documents:
# *.Rnw => *.tex
"application/x-sweave" = function(...) { compileSweave(..., postprocess=FALSE) },
# Knitr Rnw documents:
# *.Rnw => *.tex
"application/x-knitr" = function(...) { compileKnitr(..., postprocess=FALSE) },
# Knitr Rmd documents:
# *.Rmd => *.html
"application/x-rmd" = function(...) { compileKnitr(..., postprocess=FALSE) },
# Knitr Rhtml documents:
# *.Rhtml => *.html
"application/x-rhtml" = function(...) { compileKnitr(..., postprocess=FALSE) },
# Knitr Rtex documents:
# *.Rtex => *.tex
"application/x-rtex" = function(...) { compileKnitr(..., postprocess=FALSE) },
# Knitr Rrst documents:
# *.Rrst => *.rst
"application/x-rrst" = function(...) { compileKnitr(..., postprocess=FALSE) },
# AsciiDoc Rnw documents:
# *.Rnw => *.txt
"application/x-asciidoc-noweb" = function(...) { compileAsciiDocNoweb(..., postprocess=FALSE) },
# Sweave or Knitr Rnw documents:
# *.Rnw => *.tex
"application/x-rnw" = function(...) { compileRnw(..., postprocess=FALSE) }
)
if (is.null(fcn)) {
verbose && cat(verbose, "Processor found: <none>")
} else {
# Get the metadata attributes
metadata <- getMetadata(object, local=TRUE)
# Make sure the processor returns an RspFileProduct
fcnT <- fcn
processor <- function(...) {
do.call(fcnT, args=c(list(...), list(metadata=metadata)))
}
fcn <- function(pathname, ...) {
# Arguments 'pathname':
if (!isUrl(pathname)) {
withoutGString({
pathnameT <- Arguments$getReadablePathname(pathname)
pathname[1] <- pathnameT; ## Preserve class and attributes etc.
})
}
# NOTE: It is not sure that the processor supports URLs
pathnameR <- processor(pathname, ...)
## Check if further postprocessoring should be disabled
metadataR <- getMetadata(pathnameR)
postprocessR <- getMetadata(pathnameR, "postprocess", local=TRUE)
if (isFALSE(postprocessR)) metadata$postprocess <- FALSE
# Always return the relative path
pathnameR <- getAbsolutePath(pathnameR)
res <- RspFileProduct(pathnameR, attrs=list(metadata=metadata), mustExist=FALSE)
res <- setMetadata(res, name="source", value=pathname)
res
} # fcn()
verbose && cat(verbose, "Processor found: ", type)
}
verbose && exit(verbose)
fcn
}, protected=TRUE) # findProcessor()
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.