R/rcat.R

In R.rsp: Dynamic Generation of Scientific Reports

###########################################################################/**
# @RdocDefault rcat
# @alias rcat.RspString
# @alias rcat.RspDocument
# @alias rcat.RspRSourceCode
# @alias rcat.function
# @alias rcat.expression
# @alias rsource
# @alias rsource.default
# @alias rsource.RspString
# @alias rsource.RspDocument
# @alias rsource.RspRSourceCode
# @alias rsource.function
# @alias rsource.expression
#
# @title "Evaluates an RSP string and outputs the generated string"
#
# \description{
#  @get "title".
# }
#
# \usage{
#  @usage rcat,default
#  @usage rsource,default
# }
#
# \arguments{
#   \item{...}{A @character string with RSP markup.}
#   \item{file, path}{Alternatively, a file, a URL or a @connection from
#      with the strings are read.
#      If a file, the \code{path} is prepended to the file, iff given.}
#   \item{envir}{The @environment in which the RSP string is
#     preprocessed and evaluated.}
#   \item{args}{A named @list of arguments assigned to the environment
#     in which the RSP string is parsed and evaluated.
#     See @see "R.utils::cmdArgs".}
#   \item{output}{A @connection, or a pathname where to direct the output.
#               If \code{""}, the output is sent to the standard output.}
#   \item{buffered}{If @TRUE, and \code{output=""}, then the RSP output is
#     outputted as soon as possible, if possible.}
#   \item{append}{Only applied if \code{output} specifies a pathname.
#     If @TRUE, then the output is appended to the file, otherwise
#     the files content is overwritten.}
#   \item{verbose}{See @see "R.utils::Verbose".}
# }
#
# \value{
#   Returns (invisibly) the outputted @see "RspStringProduct".
# }
#
# \section{Processing RSP strings from the command line}{
#   Using @see "Rscript" and \code{rcat()}, it is possible to process
#   an RSP string and output the result from the command line.  For example,
#
#   \code{Rscript -e "R.rsp::rcat('A random integer in [1,<\%=K\%>]: <\%=sample(1:K, size=1)\%>')" --args --K=50}
#
#   parses and evaluates the RSP string and outputs the result to
#   standard output.
#   A CLI-friendly alternative to the above is:
#
#   \code{Rscript -e R.rsp::rcat "A random integer in [1,<\%=K\%>]: <\%=sample(1:K, size=1)\%>" --args --K=50}
# }
#
# \section{rsource()}{
#   The \code{rsource(file, ...)} is a convenient wrapper
#   for \code{rcat(file=file, ..., output="", buffered=FALSE)}.
#   As an analogue, \code{rsource()} is to an RSP file what
#   \code{source()} is to an R script file.
# }
#
# @examples "../incl/rcat.Rex"
#
# @author
#
# \seealso{
#  To store the output in a string (instead of displaying it), see
#  @see "rstring".
#  For evaluating and postprocessing an RSP document and
#  writing the output to a file, see @see "rfile".
# }
#
# @keyword print
# @keyword IO
# @keyword file
#*/###########################################################################
setMethodS3("rcat", "default", function(..., file=NULL, path=NULL, envir=parent.frame(), args="*", output="", buffered=TRUE, append=FALSE, verbose=FALSE) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Validate arguments
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Argument 'file' & 'path':
  if (inherits(file, "connection")) {
  } else if (is.character(file)) {
    if (!is.null(path)) {
      file <- file.path(path, file)
    }
    if (!isUrl(file)) {
      file <- Arguments$getReadablePathname(file, absolute=TRUE)
    }
  }

  # Argument 'verbose':
  verbose <- Arguments$getVerbose(verbose)
  if (verbose) {
    pushState(verbose)
    on.exit(popState(verbose))
  }


  verbose && enter(verbose, "rcat() for default")

  if (is.null(file)) {
    s <- RspString(...)
  } else {
    verbose && cat(verbose, "Input file: ", file)
    s <- .readText(file)
    s <- RspString(s, source=file, ...)
    s <- setMetadata(s, name="source", value=file)
  }
  verbose && cat(verbose, "Length of RSP string: ", nchar(s))

  res <- rcat(s, output=output, buffered=buffered, append=append, envir=envir, args=args, verbose=verbose)

  verbose && exit(verbose)

  invisible(res)
}) # rcat()


setMethodS3("rcat", "RspString", function(..., envir=parent.frame(), args="*", output="", buffered=TRUE, append=FALSE, verbose=FALSE) {
  # Argument 'buffered':
  if (!buffered) {
    isStdout <- FALSE
    if (is.character(output) && output == "") {
      isStdout <- TRUE
    } else if (inherits(output, "connection")) {
      ci <- summary(output)
      isStdout <- identical(ci$class, "terminal") &&
                  identical(ci$description, "stdout")
    }
    if (!isStdout) {
      throw("Argument 'buffered' must be TRUE unless 'output' directs to the standard output.")
    }
  }

  # Argument 'verbose':
  verbose <- Arguments$getVerbose(verbose)
  if (verbose) {
    pushState(verbose)
    on.exit(popState(verbose))
  }

  verbose && enter(verbose, "rcat() for RspString")

  outputP <- ifelse(buffered, "RspStringProduct", "stdout")
  verbose && printf(verbose, "Buffered: %s\n", buffered)
  verbose && printf(verbose, "Type of output: %s\n", outputP)
  verbose && cat(verbose, "Arguments:")
  verbose && str(verbose, args)

  s <- rstring(..., envir=envir, args=args, output=outputP,
               verbose=less(verbose, 10))

  verbose && cat(verbose, "Result:")
  verbose && str(verbose, s)

  if (!is.null(s)) {
    verbose && enter(verbose, "Outputting")
    outputT <- output
    if (is.character(output)) {
      if (output == "")
        outputT <- "<stdout>"
    } else {
      outputT <- "<connection>"
    }
    verbose && printf(verbose, "Output: %s\n", outputT)
    verbose && printf(verbose, "Appending: %s\n", append)
    verbose && printf(verbose, "String: (nchars = %d) %s\n", nchar(s), sQuote(substring(s, first = 1L, last = 60L)))
    
    tryCatch({
      ## WORKAROUND: Avoid infinite loop of warnings on "invalid char string
      ## in output conversion" by cat().  Reported to R-devel on 2017-01-03
      ## https://stat.ethz.ch/pipermail/r-devel/2017-January/073571.html
      oopts <- options(warn = 2)
      on.exit(options(oopts))
     
      base::cat(s, file=output, append=append)
    }, error = function(ex) {
      pattern <- gettextf("invalid char string in output conversion")
      msg <- conditionMessage(ex)
      if (any(grepl(pattern, msg))) {
        options(oopts)
        msg <- sprintf("Failed to output RSP product (<string of length %s character> with encoding %s) under encoding %s using cat(), because %s. Used writeBin(charToRaw(.)) as a fallback, but please validate output.", nchar(s), hpaste(sQuote(unique(Encoding(s)))), sQuote(getOption("encoding")), sQuote(msg))
        warning(msg)
        r <- charToRaw(s)
        writeBin(r, con = output)
      } else {
        throw(msg)
      }
    })
    
    verbose && exit(verbose)
  }

  verbose && exit(verbose)

  invisible(s)
}) # rcat()


setMethodS3("rcat", "RspDocument", rcat.RspString)
setMethodS3("rcat", "RspRSourceCode", rcat.RspString)
setMethodS3("rcat", "RspShSourceCode", rcat.RspString)
setMethodS3("rcat", "function", rcat.RspString)
setMethodS3("rcat", "expression", rcat.RspString)