X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=tags%2Fpre-dual%2FR%2Flog.R;fp=tags%2Fpre-dual%2FR%2Flog.R;h=3d74bae7221123116434b59d94747fdb38bdd532;hb=ab9547f1dd3779e34528a7a638ed085d5b9c5e26;hp=0000000000000000000000000000000000000000;hpb=4baac28764128067cb2fd6343321e7e0f522bdfd;p=cran2deb.git

diff --git a/tags/pre-dual/R/log.R b/tags/pre-dual/R/log.R
new file mode 100644
index 0000000..3d74bae
--- /dev/null
+++ b/tags/pre-dual/R/log.R
@@ -0,0 +1,66 @@
+log_messages <- list()
+
+log_clear <- function() {
+    assign('log_messages',list(),envir=.GlobalEnv)
+}
+
+log_add <- function(text,print=T) {
+    if (print) {
+        message(text)
+    }
+    assign('log_messages',c(log_messages, text),envir=.GlobalEnv)
+}
+
+log_retrieve <- function() {
+    return(log_messages)
+}
+
+notice <- function(...) {
+    log_add(paste('N:',...))
+}
+
+warn <- function(...) {
+    log_add(paste('W:',...))
+}
+
+error <- function(...) {
+    log_add(paste('E:',...))
+}
+
+fail <- function(...) {
+    txt <- paste('E:',...)
+    log_add(txt)
+    stop(txt)
+}
+
+log_system <- function(...) {
+    r <- try((function() {
+        # pipe() does not appear useful here, since
+        # we want the return value!
+        # XXX: doesn't work with ; or | !
+        tmp <- tempfile('log_system')
+        on.exit(unlink(tmp))
+        cmd <- paste(...)
+        # unfortunately this destroys ret
+        #cmd <- paste(cmd,'2>&1','| tee',tmp)
+        cmd <- paste(cmd,'>',tmp,'2>&1')
+        ret <- system(cmd)
+        f <- file(tmp)
+        output <- readLines(f)
+        close(f)
+        unlink(tmp)
+        return(list(ret,output))
+    })())
+    if (inherits(r,'try-error')) {
+        fail('system failed on:',paste(...))
+    }
+    log_add(paste('C:',...))
+    for (line in r[[2]]) {
+        if (!length(grep('^[WENI]:',line))) {
+            line = paste('I:',line)
+        }
+        log_add(line) #,print=F)
+    }
+    return(r[[1]])
+}
+