R/extract.R

Defines functions extract

Documented in extract

#' extract
#'
#' Extracts parts from the file(s) based on their extension, writes them to disk and process further based on th eoptions given.
#' \code{extract} uses \code{extract.XXX} to extract the parts from a file based on the file extension \code{XXX}. 
#' \code{option.YYY} is used to process the file written to disk further.
#' 
#' Currently are supported:
#' \describe{
#' \item{\code{extract.tex}}{extraction from tex files}
#' \item{\code{option.R}}{further processing of \code{R} files}
#' }
#' You may provide further \code{extract.XXX} or \code{option.YYY} functions. 
#' 
#' @param files character: a vector with file name(s)
#' @param quiet logical: should be info messages suppressed? (default: \code{FALSE})
#' @param write logical: should be written to disk?  (default: \code{TRUE})
#' @param ... named parameters: the parameter {.XXX} should contain a regular expression to extract
#'
#' @return invisibly a list of files written to disk
#' @importFrom stringr str_extract
#' @export
#'
#' @examples
#' file  <- system.file("example.tex", package="extpro")
#' # use a temporary directory
#' dir <- setwd(tempdir(TRUE))
#' file.copy(file, "example.tex")
#' #
#' extract("example.tex")
#' # show results
#' list.files()
#' tools::texi2pdf("example.tex")
#' # if Linux (Ubuntu):  system('evince "example.pdf"')
#' # if Mac OS:          system('open "example.pdf"')
#' # if Windows:         system('start "example.pdf"')
#' setwd(dir)
extract <- function(files, quiet=FALSE, write=TRUE,  ...) {
  extfile <- list()
  args    <- list(...)
  for (file in files) {
    extfile[[file]] <- character(0)
    dir    <- dirname(file)
    base   <- basename(file)
    ext    <- str_extract(base, "\\.[^\\.]+$")
    if (is.na(ext)) {
       warning(sprintf("File %s has no extension", file))
    } else {
      extfun <- match.fun(paste0('extract', ext))
      extdf  <- extfun(paste0(suppressWarnings(readLines(file)), collapse="\n"), args[[ext]])
      if (anyDuplicated(extdf$file)) warning("duplicate file names found")
      if (nrow(extdf)) {
        if (!quiet) cat(file, "\n") 
        naopt <- is.na(extdf$option)
        if (sum(naopt)) extdf$option[naopt] <- "default"
        for (i in 1:nrow(extdf)) {
          outfile <- paste0(dir, '/', extdf$file[i])
          extfile[[file]] <- c(extfile[[file]], outfile)
          if (write) writeLines(extdf$contents[i], outfile)
          if (!quiet) cat(" ", outfile, "\n")
          try({
            optfun <- match.fun(paste0('option', str_extract(basename(outfile), "\\.[^\\.]+$")))
            if (extdf$option[i]!="") optfun(option(extdf$option[i]), outfile)            
          }, silent = TRUE)
        }
      }
    }
  }
  invisible(extfile)
}
sigbertklinke/extpro documentation built on Dec. 31, 2020, 7:26 a.m.