R/q.push.R

In okux/qrmarkdown: Job Queue Management For Rmarkdown

q.push<-function(
                 script = NULL,
                 name   = NULL,
                 code   = NULL,
                 wdir   = '.',
                 params  = NULL,
                 jparams = TRUE,
                 auto.recovery=TRUE,
                 outputfile= 'a.out')
  # trap your script into ticket
{

  jid    = UUIDgenerate()

  if(is.null(name))
    name = jid

  if (is.null(script) && is.null(code))
    stop('no job to do')

  # create temp rmarkdown, insert code
  if (!is.null(code)) {
    template <- q.template(type='simple')
    script <- sprintf('%s/%s.Rmd',.pkg.log$script.dir, jid)
    RMD <- sprintf(template, script, code)

    sink(file=script)
    cat(RMD)
    sink()
  }

  if(is.null(params))
    params <- list(jid = jid) else
    {
      params$jid      <- jid
    }

  if (!is.null(script))
  {
    ticket <- list()
    ticket$jid    = jid
    ticket$script = script
    ticket$wdir   = wdir
    ticket$params = params
    ticket$jparams = jparams
    ticket$output.dir  = .pkg.log$output.dir
    ticket$output.file = outputfile
    ticket$status = q.status$waiting
    ticket$auto.recovery = auto.recovery
    ticket$log    = ""
    ticket$mtime  = Sys.time()
    ticket$ctime  = NA
    ticket$secs   = NA
    ticket$name   = name
    ticket$wday = NA
    ticket$hour = NA
  } else
    stop('no valid rmarkdown script file')

  fpath = sprintf('%s/inbox/%s',.pkg.log$log.dir, jid)
  ticket$jid             <- fpath

  save(ticket, file=fpath)
  return(fpath)
}

# jid <- q.push(name="test", code='ls()')