pkg/trunk/R/log.R

   1 log_messages <- list()
   2
   3 log_clear <- function() {
   4     assign('log_messages',list(),envir=.GlobalEnv)
   5 }
   6
   7 log_add <- function(text,print=T) {
   8     if (print) {
   9         message(text)
  10     }
  11     assign('log_messages',c(log_messages, text),envir=.GlobalEnv)
  12 }
  13
  14 log_retrieve <- function() {
  15     return(log_messages)
  16 }
  17
  18 notice <- function(...) {
  19     log_add(paste('N:',...))
  20 }
  21
  22 warn <- function(...) {
  23     log_add(paste('W:',...))
  24 }
  25
  26 error <- function(...) {
  27     log_add(paste('E:',...))
  28 }
  29
  30 fail <- function(...) {
  31     txt <- paste('E:',...)
  32     log_add(txt)
  33     stop(txt)
  34 }
  35
  36 log_system <- function(...) {
  37     r <- try((function() {
  38         # pipe() does not appear useful here, since
  39         # we want the return value!
  40         # XXX: doesn't work with ; or | !
  41         tmp <- tempfile('log_system')
  42         on.exit(unlink(tmp))
  43         cmd <- paste(...)
  44         cmd <- paste(cmd,'2>&1','| tee',tmp)
  45         ret <- system(cmd)
  46         f <- file(tmp)
  47         output <- readLines(f)
  48         close(f)
  49         unlink(tmp)
  50         return(list(ret,output))
  51     })())
  52     if (inherits(r,'try-error')) {
  53         fail('system failed on:',paste(...))
  54     }
  55     for (line in r[[2]]) {
  56         if (!length(grep('^[WENI]:',line))) {
  57             line = paste('I:',line)
  58         }
  59         log_add(line,print=F)
  60     }
  61     return(r[[1]])
  62 }
  63