R/RspProduct.R

In R.rsp: Dynamic Generation of Scientific Reports

###########################################################################/**
# @RdocClass RspProduct
#
# @title "The RspProduct class"
#
# \description{
#  @classhierarchy
#
#  An RspProduct object represents an RSP product generated by processing
#  an RSP document.
# }
#
# @synopsis
#
# \arguments{
#   \item{object}{The RSP product.}
#   \item{...}{Arguments passed to @see "RspObject".}
# }
#
# \section{Fields and Methods}{
#  @allmethods
# }
#
# @author
#
# @keyword internal
#*/###########################################################################
setConstructorS3("RspProduct", function(object=NA, ...) {
  extend(RspObject(object, ...), "RspProduct")
})


setMethodS3("print", "RspProduct", function(x, ...) {
  s <- sprintf("%s:", class(x)[1L])
  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)



#########################################################################/**
# @RdocMethod view
# @alias view.RspFileProduct
# @alias !.RspProduct
#
# @title "Views the RSP product"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns the RSP product (invisibly).
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#*/#########################################################################
setMethodS3("view", "RspProduct", abstract=TRUE)


setMethodS3("!", "RspProduct", function(x) {
  view(x)
}, appendVarArgs=FALSE, protected=TRUE)



#########################################################################/**
# @RdocMethod getType
# @alias getType.RspFileProduct
#
# @title "Gets the type of an RSP product"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{default}{If unknown/not set, the default content type to return.}
#   \item{...}{Not used.}
# }
#
# \value{
#  Returns a @character string.
# }
#
# @author
#
# \seealso{
#   @seeclass
# }
#*/#########################################################################
setMethodS3("getType", "RspProduct", function(object, default=NA_character_, as=c("text", "IMT"), ...) {
  as <- match.arg(as)
  res <- getAttribute(object, "type", default=as.character(default))
  res <- tolower(res)
  if (as == "IMT" && !is.na(res)) {
    res <- parseInternetMediaType(res)
  }
  res
}, protected=TRUE)



###########################################################################/**
# @RdocMethod hasProcessor
#
# @title "Checks whether a processor exist or not for an RSP product"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns @TRUE if one exists, otherwise @FALSE.
# }
#
# @author
#
# @keyword file
# @keyword IO
#*/###########################################################################
setMethodS3("hasProcessor", "RspProduct", function(object, ...) {
  !is.null(findProcessor(object, ...))
}, protected=TRUE)



###########################################################################/**
# @RdocMethod findProcessor
# @alias findProcessor.RspFileProduct
#
# @title "Locates a processor for an RSP product"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{...}{Not used.}
# }
#
# \value{
#   Returns a @function that takes an @see "RspProduct" as input,
#   or @NULL if no processor was found.
# }
#
# @author
#
# @keyword file
# @keyword IO
#*/###########################################################################
setMethodS3("findProcessor", "RspProduct", function(object, ...) {
  NULL
}, protected=TRUE) # findProcessor()




###########################################################################/**
# @RdocMethod process
#
# @title "Processes an RSP file product"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{type}{A @character string specifying the content type.}
#   \item{workdir}{A temporary working directory to use during processing.
#      If @NULL, the working directory is not changed.}
#   \item{...}{Optional arguments passed to the processor @function.}
#   \item{recursive}{
#      If a positive number (or +@Inf), then processed output that can be
#      processed will be processed recursively (with this argument being
#      decreased by one).
#      A value @TRUE corresponds to +@Inf (infinite processing if possible).
#      A value @FALSE corresponds to 0 (no further processing).
#   }
#   \item{verbose}{See @see "R.utils::Verbose".}
# }
#
# \value{
#   Returns the processed RSP product output as another @see "RspProduct".
#   If no processor exists, the input object itself is returned.
# }
#
# @author
#
# @keyword file
# @keyword IO
#*/###########################################################################
setMethodS3("process", "RspProduct", function(object, type=NULL, envir=parent.frame(), workdir=NULL, ..., recursive=TRUE, verbose=FALSE) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Validate arguments
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Arguments 'type':
  if (is.null(type)) {
    type <- getType(object)
  }
  type <- Arguments$getCharacter(type, length=c(1L,1L))
  type <- tolower(type)

  # Arguments 'envir':
  stop_if_not(is.environment(envir))

  # Arguments 'workdir':
  if (!is.null(workdir)) {
    workdir <- Arguments$getWritablePath(workdir)
    if (is.null(workdir)) workdir <- getwd()
    workdir <- getAbsolutePath(workdir)
  }

  # Argument 'recursive':
  if (is.numeric(recursive)) {
    recursive <- Arguments$getNumeric(recursive)
  } else {
    recursive <- Arguments$getLogical(recursive)
    if (recursive) {
      recursive <- Inf
    } else {
      recursive <- 0
    }
  }

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


  verbose && enter(verbose, "Processing RSP product")
  verbose && print(verbose, object)

  processor <- findProcessor(object, verbose=verbose)

  # Nothing to do?
  if (is.null(processor)) {
    verbose && cat(verbose, "There is no known processor for this content type: ", type)
    verbose && exit(verbose)
    return(object)
  }

  verbose && enter(verbose, "Processing")

  # Change working directory?
  if (!is.null(workdir)) {
    opwd <- getwd()
    on.exit({ if (!is.null(opwd)) setwd(opwd) }, add=TRUE)
    setwd(workdir)
  }

  # Override type with user argument type, if given.
  if (identical(type, getType(object))) {
    object <- setAttribute(object, "type", type)
  }

  verbose && print(verbose, object)
  verbose && print(verbose, processor)
  res <- processor(object, envir=envir, ..., verbose=verbose)
  verbose && print(verbose, res)

  # Reset working directory
  if (!is.null(workdir)) {
    if (!is.null(opwd)) {
      setwd(opwd)
      opwd <- NULL
    }
  }

  if (!is.null(res) && recursive > 0L && hasProcessor(res)) {
    verbose && enter(verbose, "Recursive processing")
    verbose && cat(verbose, "Recursive depth: ", recursive)
    object <- res
    res <- process(object, type=type, envir=envir, workdir=workdir, ..., recursive=(recursive - 1), verbose=verbose)
    verbose && exit(verbose)
  }

  verbose && exit(verbose)

  verbose && exit(verbose)

  res
}) # process()