R/q.ls.R

In okux/qrmarkdown: Job Queue Management For Rmarkdown

q.ls <- function(jid=NULL,detail=FALSE, view.output=FALSE)
{
  require(dplyr)

  # check error invalid data type
  if (class(jid) == 'data.frame')
    stop("jid is path to log object. not data.frame!")

  # often factor passed, we need to collect them
  jid <- as.character(jid)

  full.name=TRUE
  # we don't want full path name only, jid.

  if(!is.null(jid) && length(jid) > 0  )
  {
    if(jid == 'success')
      jid = 'outbox' else
    jid <- basename(jid)
  } else
      jid = "*"

  FLIST <- list.files(q.wd(), recursive = TRUE, full.names = TRUE)
  FLIST <- FLIST[grep(jid,FLIST)]

  # exclude extention not job ticket
  FLIST <- FLIST[grep('[.html$][.Rmd$]', FLIST, invert = TRUE)]

  # build job history knowledge
  read.ticket <- function(i)
  {
    #message(i)   # remind user what's happening

    tryCatch({

      i <- as.character(i) # factor to character
      load(file=i) # read job ticket log

      ticket$params <- NULL

      ticket <- as.data.frame(ticket, stringsAsFactors = FALSE)

      # handing exception error, no output output file
      if(!any(names(ticket) == 'output.file'))
        ticket$output.file <- ""


      if(!detail)
        ret <- ticket %>% select ( status,
                          name,
                          jid,
                          secs,
                          output.file,
                          log,
                          ctime) else
        ret <- data.frame(status=ticket$status,
                          name=ticket$name,
                          jid=ticket$jid,
                          secs=ticket$secs,
                          output.file=ticket$output.file,
                          log=ticket$log,
                          script=ticket$script,
                          ctime=ticket$ctime,
                          wdir=ticket$wdir,
                          auto.recovery=ticket$auto.recovery,
                          stringsAsFactors = FALSE)

      return(ret)
    },
      error=function(e)
      {
        print(e)
        return(NULL)
      })
  }

  # build historical
  suppressWarnings({
    RET <- lapply(FLIST, read.ticket)

    if(length(RET) > 1)
      RET <- bind_rows(RET) else
        RET <- data.frame(RET)
  })

  # specific JID status
  if( nrow(RET) > 0 )
  {

    # let's segment by different job status at first
    success  <- RET %>% filter(status == !! as.character(q.status$completed)) %>% select(output.file)
    failed   <- RET %>% filter(status == !! as.character(q.status$failed) ) %>% select(output.file)
    running  <- RET %>% filter(status == !! as.character(q.status$running)) %>% select(output.file)
    waiting  <- RET %>% filter(status == !! as.character(q.status$waiting)) %>% select(output.file)

    # summary
    msg <- sprintf('**Summary**\ncompleted:%s\t failed:%s\t running:%s\twaiting:%s',
                   nrow(success),nrow(failed),nrow(running),nrow(waiting))
    message(msg)

    # if multiple, only show last item
    if(view.output && nrow(success) >0 )
    {
      # find success job output
      success <- success %>% select(output.file)

      if( length(success)==1)
        rstudioapi::viewer(success$output.file[1]) else if(length(success) > 0)
        {
          message('only showing first item from multiple matched')
          rstudioapi::viewer(success$output.file[1])
        }
    }

    # visualize failed cause
    if( nrow(failed) > 0 )
    {
      issues        <- RET %>% filter(status == !!q.status$failed) %>% select(jid, log, ctime)
      issues$log <- gsub('\n','',issues$log)
      #print(issues %>% select(ctime, jid,log))
    }

    return(RET)

  } else
    return(NULL)

}