R/collect.R

Defines functions collect

#' 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 ... 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)
collect <- function(files, quiet=FALSE, ...) {
  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('collect', ext))
      extdf  <- extfun(file, args[[ext]])
      
      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)
          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)
}


files <- list.files("/home/sk/syncthing/datenanalyse-i_ii/Folien", "*\\.tex$", recursive = TRUE, full.names = TRUE)
files <- files[!grepl("/(archiv|alt)/", files)]
extract(files, write=FALSE)
sigbertklinke/extpro documentation built on Dec. 31, 2020, 7:26 a.m.