## This class provides logging functionality (Stata's log and cmdlog commands).
## R's sink() doesn't quite do what we want - a) it doesn't let us distinguish
## between command and output result streams, but we want to handle these
## separately, and b) it can only have one sink at the top of the stack at any
## given time.
Logger <-
R6::R6Class("Logger",
public=list(
initialize = function()
{
private$logs <- list()
private$cmdlogs <- list()
private$use_log <- TRUE
private$use_cmdlog <- TRUE
},
has_sink = function(filename, type = NULL)
{
raiseifnot(is.null(type) || type %in% c("log", "cmdlog"),
msg="Invalid log type")
pth <- normalizePath(filename)
if(is.null(type))
{
return(pth %in% names(private$logs) ||
pth %in% names(private$cmdlogs))
} else if(type == "log")
{
return(pth %in% names(private$logs))
} else
{
return(pth %in% names(private$cmdlogs))
}
},
sink_type = function(filename)
{
raiseifnot(self$has_sink(filename),
msg="No such logging sink")
pth <- normalizePath(filename)
if(pth %in% names(private$logs))
{
return("log")
} else
{
return("cmdlog")
}
},
register_sink = function(filename, type = "log", header = TRUE)
{
raiseif(type %not_in% c("log", "cmdlog"),
msg="Invalid logging type")
raiseif(self$has_sink(filename),
msg="Log already exists")
pth <- normalizePath(filename)
ret <-
tryCatch(
{
con <- file(pth, open="wb")
},
error=function(e) e
)
raiseif(inherits(ret, "error"),
msg="Could not open logging sink " %p% pth)
if(type == "log")
{
private$logs[[pth]] = con
} else
{
private$cmdlogs[[pth]] = con
}
if(header)
{
msg <- paste0(rep('-', 80), collapse="") %p% '\n'
msg <- msg %p% ifelse(type == 'log', 'log: ', 'cmdlog: ')
msg <- msg %p% pth %p% '\n'
msg <- msg %p% 'log type: text\n' #SMCL isn't supported
msg <- msg %p% 'opened on: ' %p% date() %p% '\n'
msg <- msg %p% '\n'
cat(msg, file=con, sep="")
}
return(invisible(NULL))
},
deregister_sink = function(filename)
{
type <- self$sink_type(filename)
pth <- normalizePath(filename)
if(type == "log")
{
close(private$logs[[pth]])
private$logs[[pth]] <- NULL
} else
{
close(private$cmdlogs[[pth]])
private$cmdlogs[[pth]] <- NULL
}
return(invisible(NULL))
},
deregister_all_sinks = function(type = NULL)
{
raiseifnot(is.null(type) || type %in% c("log", "cmdlog"),
msg="Invalid log type")
if(is.null(type))
{
for(con in names(private$logs))
{
self$deregister_sink(con)
}
for(con in names(private$cmdlogs))
{
self$deregister_sink(con)
}
} else if(type == "log")
{
for(con in names(private$logs))
{
self$deregister_sink(con)
}
} else
{
for(con in names(private$cmdlogs))
{
self$deregister_sink(con)
}
}
return(invisible(NULL))
},
log_command = function(msg, echo = FALSE)
{
if(echo)
cat(msg, sep="")
if(self$log_enabled)
{
for(con in private$logs)
{
cat(msg, file=con, sep="", append=TRUE)
}
}
if(self$cmdlog_enabled)
{
for(con in private$cmdlogs)
{
cat(msg, file=con, sep="", append=TRUE)
}
}
return(invisible(NULL))
},
log_result = function(msg, print_results = FALSE)
{
if(print_results)
{
cat(msg, sep="")
cat("\n")
}
if(self$log_enabled)
{
for(con in private$logs)
{
cat(msg, file=con, sep="", append=TRUE)
cat("\n")
}
}
return(invisible(NULL))
}
),
active = list(
log_sinks = function() names(private$logs),
cmdlog_sinks = function() names(private$cmdlog_sinks),
log_enabled = function(value)
{
if(missing(value))
{
return(private$use_log)
} else
{
private$use_log <- as.logical(value)
}
},
cmdlog_enabled = function(value)
{
if(missing(value))
{
return(private$use_cmdlog)
} else
{
private$use_cmdlog <- as.logical(value)
}
}
),
private = list(
#The log and command log sink lists. These aren't stacks or queues;
#really they're hash tables: we just need to be able to a) get a
#connection given its name, and b) loop over all currently
#registered connections.
logs = NULL,
cmdlogs = NULL,
use_log = NULL,
use_cmdlog = NULL
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.