[Logging-commits] r86 - / pkg pkg/R pkg/inst/unitTest pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 3 15:16:48 CEST 2011
Author: mariotomo
Date: 2011-08-03 15:16:48 +0200 (Wed, 03 Aug 2011)
New Revision: 86
Added:
pkg/R/namedLevels.R
pkg/R/oo.R
pkg/R/updateOptions.R
pkg/R/utils.R
pkg/R/zzz.R
Removed:
oo/
proto/
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/logger.R
pkg/inst/unitTest/runit.data.interaction.R
pkg/man/addHandler.Rd
pkg/man/removeHandler.Rd
Log:
removing the two oo and proto subpackages and refactoring the library basing it on the object oriented version.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/DESCRIPTION 2011-08-03 13:16:48 UTC (rev 86)
@@ -1,10 +1,10 @@
Package: logging
-Version: 0.5-70
+Version: 0.6-85
Date: 2010-06-17
Title: a tentative logging package
Author: Mario Frasca <mariotomo at gmail.com>
Maintainer: Mario Frasca <mario.frasca at nelen-schuurmans.nl>
Description: a logging package emulating the python logging package.
License: GPL (>=2)
-Depends: R (>= 2.11.0)
+Depends: R (>= 2.12.0), methods
Suggests: svUnit
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/NAMESPACE 2011-08-03 13:16:48 UTC (rev 86)
@@ -11,18 +11,9 @@
basicConfig,
getLogger,
removeHandler,
- removeHandler.default,
- removeHandler.character,
addHandler,
- addHandler.default,
- addHandler.character,
getHandler,
- getHandler.default,
- getHandler.character,
setLevel,
- setLevel.numeric,
- setLevel.character,
- setLevel.default,
writeToFile,
writeToConsole,
updateOptions.environment,
Modified: pkg/R/logger.R
===================================================================
--- pkg/R/logger.R 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/R/logger.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -27,80 +27,14 @@
## initial date : 20100105
##
-## TODO: these constants must be exported and documented
-loglevels <- c(0, 1, 4, 7, 10, 20, 30, 30, 40, 50, 50)
-names(loglevels) <- c('NOTSET', 'FINEST', 'FINER', 'FINE', 'DEBUG', 'INFO', 'WARNING', 'WARN', 'ERROR', 'CRITICAL', 'FATAL')
-
-namedLevel <- function(value)
- UseMethod('namedLevel')
-
-namedLevel.character <- function(value) {
- position <- which(names(loglevels) == value)
- if(length(position) == 1)
- loglevels[position]
-}
-
-namedLevel.numeric <- function(value) {
- if(is.null(names(value))) {
- position <- which(loglevels == value)
- if(length(position) == 1)
- value = loglevels[position]
- }
- value
-}
-
-.logrecord <- function(record, logger)
-{
- ##
- config <- getLogger(logger)
-
- if (record$level >= config$level)
- for (handler in config[['handlers']])
- if (record$level >= with(handler, level)) {
- action <- with(handler, action)
- formatter <- with(handler, formatter)
- action(formatter(record), handler, record)
- }
-
- if(logger != '') {
- parts <- strsplit(logger, '.', fixed=TRUE)[[1]] # split the name on the '.'
- removed <- parts[-length(parts)] # except the last item
- parent <- paste(removed, collapse='.')
- .logrecord(record, logger=parent)
- }
- invisible(TRUE)
-}
-
## main log function, used by all other ones
## (entry points for messages)
-levellog <- function(level, msg, ..., logger='')
+levellog <- function(level, msg, ..., logger=getLogger())
{
- ## does the logger just drop the record?
- config <- getLogger(logger)
- if (level < config$level)
- return(invisible(FALSE))
+ if(is.character(logger))
+ logger <- getLogger(logger)
- ## fine, we create the record and pass it to all handlers attached to the
- ## loggers from here up to the root.
- record <- list()
-
- if (length(list(...)) > 0)
- msg <- do.call("sprintf", c(msg, lapply(list(...), function(x) if(length(x)==1) x else paste(x, collapse=','))))
-
- ## strip leading and trailing whitespace from the final message.
- msg <- sub("[[:space:]]+$", '', msg)
- msg <- sub("^[[:space:]]+", '', msg)
- record$msg <- msg
-
- record$timestamp <- sprintf("%s", Sys.time())
- record$logger <- logger
- record$level <- namedLevel(level)
- record$levelname <- names(which(loglevels == record$level)[1])
- if(is.na(record$levelname))
- record$levelname <- paste("NumericLevel(", level, ")", sep='')
-
- ## action is taken in private function.
- .logrecord(record, logger)
+ logger$log(level, msg, ...)
}
## using log
@@ -149,25 +83,6 @@
invisible()
}
-## set properties of a logger or a handler
-updateOptions <- function(container, ...)
- UseMethod('updateOptions')
-
-updateOptions.character <- function(container, ...) {
- ## container is really just the name of the container
- updateOptions.environment(getLogger(container), ...)
-}
-
-updateOptions.environment <- function(container, ...) {
- ## the container is a logger
- config <- list(...);
- if (! 'level' %in% names(config))
- config$level = loglevels['INFO']
- for (key in names(config))
- container[[key]] <- config[[key]]
- invisible()
-}
-
## Get a specific logger configuration
getLogger <- function(name='', ...)
{
@@ -177,152 +92,57 @@
fullname <- paste('logging.ROOT', name, sep='.')
if(!exists(fullname, envir=logging.options)) {
- logger <- logging.options[[fullname]] <- new.env()
- logger[['handlers']] <- NULL
+ logger <- Logger$new(name=name)
+ assign(fullname, logger, envir=logging.options)
+ logger[['handlers']] <- list()
+ logger[['level']] <- namedLevel('INFO')
updateOptions.environment(logger, ...)
}
logging.options[[fullname]]
}
-## set the level of a handler or a logger
-setLevel <- function(level, container='')
- UseMethod('setLevel')
-
-setLevel.character <- function(level, container='') {
- updateOptions(container, level=loglevels[level])
-}
-
-setLevel.numeric <- function(level, container='') {
- level <- namedLevel(level)
- updateOptions(container, level=level)
-}
-
-setLevel.default <- function(level, container='') {
- NA
-}
-
-#################################################################################
-
-## sample actions for handlers
-
-## a handler is a function that accepts a logging.record and a
-## configuration.
-
-## a logging.record contains the real message, its level, the name of the
-## logger that generated it, a timestamp.
-
-## a configuration contains a formatter (a function taking a
-## logging.record and returning a string), a numeric level (only records
-## with level equal or higher than that are taken into account), an
-## action (writing the formatted record to a stream).
-
-writeToConsole <- function(msg, handler, ...)
-{
- cat(paste(msg, '\n', sep=''))
-}
-
-writeToFile <- function(msg, handler, ...)
-{
- if (!exists('file', envir=handler))
- stop("handler with writeToFile 'action' must have a 'file' element.\n")
- cat(paste(msg, '\n', sep=''), file=with(handler, file), append=TRUE)
-}
-
-#################################################################################
-
-## the single predefined formatter
-
-defaultFormat <- function(record) {
- text <- paste(record$timestamp, paste(record$levelname, record$logger, record$msg, sep=':'))
-}
-
-#################################################################################
-
basicConfig <- function(level=20) {
- updateOptions('', level=namedLevel(level))
- addHandler('basic.stdout', writeToConsole)
+ rootLogger <- getLogger()
+ updateOptions(rootLogger, level=namedLevel(level))
+ rootLogger$addHandler('basic.stdout', writeToConsole)
invisible()
}
-## Add a new handler to the options config
-## The following values need to be provided:
-## name - the name of the logger to which the logger is to be attached
-## level - log level for new handler
-## action - the implementation for the handler. Either a function or a name of
-## a function
-## ... options to be stored as fields of new handler
-addHandler <- function(handler, ..., level=20, logger='', formatter=defaultFormat)
- UseMethod('addHandler')
+logReset <- function() {
+ ## reinizialize the whole logging system
-addHandler.default <- function(handler, ..., level=20, logger='', formatter=defaultFormat) {
- ## action <- handler # parameter 'handler' identifies the action
- ## user did not provide a name for this handler, extract it from action.
- addHandler.character(deparse(substitute(handler)), handler, ..., level=level, logger=logger, formatter=formatter)
-}
+ ## remove all content from the logging environment
+ rm(list=ls(logging.options), envir=logging.options)
-addHandler.character <- function(handler, action, ..., level=20, logger='', formatter=defaultFormat)
-{
- name <- handler # parameter 'handler' identifies the name
- handler <- new.env()
- updateOptions.environment(handler, ...)
- assign('level', namedLevel(level), handler)
- assign('action', action, handler)
- assign('formatter', formatter, handler)
- handlers <- with(getLogger(logger), handlers)
- handlers[[name]] <- handler
- assign('handlers', handlers, envir=getLogger(logger))
+ rootLogger <- getLogger()
+ rootLogger$setLevel(0)
invisible()
}
-removeHandler <- function(handler, logger='')
- UseMethod('removeHandler')
+## handler-related
-removeHandler.default <- function(handler, logger='') {
- ## action <- handler # parameter 'handler' identifies the action
- removeHandler.character(deparse(substitute(handler)), logger)
+addHandler <- function(handler, ..., logger='') {
+ if(is.character(logger))
+ logger <- getLogger(logger)
+ logger$addHandler(handler, ...)
}
-removeHandler.character <- function(handler, logger='') {
- # parameter 'handler' identifies the name
- handlers <- with(getLogger(logger), handlers)
- to.keep <- !(names(handlers) == handler)
- assign('handlers', handlers[to.keep], envir=getLogger(logger))
- invisible()
+removeHandler <- function(handler, logger='') {
+ if(is.character(logger))
+ logger <- getLogger(logger)
+ logger$removeHandler(handler)
}
-## retrieve a specific handler out of a logger. loggers are separated
-## environments and handlers with the same name may be associated to
-## different loggers.
-
-getHandler <- function(handler, logger='')
- UseMethod('getHandler')
-
-getHandler.default <- function(handler, logger='') {
- ## action <- handler # assume we got the handler by action
- getHandler.character(deparse(substitute(handler)), logger)
+getHandler <- function(handler, logger='') {
+ if(is.character(logger))
+ logger <- getLogger(logger)
+ logger$getHandler(handler)
}
-getHandler.character <- function(handler, logger='') {
- ## name <- handler # we got the handler by name
- with(getLogger(logger), handlers)[[handler]]
+## set the level of a logger
+setLevel <- function(level, container='') {
+ if(is.character(container))
+ container <- getLogger(container)
+ assign("level", namedLevel(level), container)
}
-
-#################################################################################
-
-logReset <- function() {
- ## reinizialize the whole logging system
-
- ## remove all content from the logging environment
- rm(list=ls(logging.options), envir=logging.options)
-
- ## create the root logger
- getLogger('', handlers=NULL, level=0)
- invisible()
-}
-
-## create the logging environment
-logging.options <- new.env()
-
-## initialize the module
-logReset()
Added: pkg/R/namedLevels.R
===================================================================
--- pkg/R/namedLevels.R (rev 0)
+++ pkg/R/namedLevels.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -0,0 +1,22 @@
+
+## TODO: these constants must be exported and documented
+loglevels <- c(0, 1, 4, 7, 10, 20, 30, 30, 40, 50, 50)
+names(loglevels) <- c('NOTSET', 'FINEST', 'FINER', 'FINE', 'DEBUG', 'INFO', 'WARNING', 'WARN', 'ERROR', 'CRITICAL', 'FATAL')
+
+namedLevel <- function(value)
+ UseMethod('namedLevel')
+
+namedLevel.character <- function(value) {
+ position <- which(names(loglevels) == value)
+ if(length(position) == 1)
+ loglevels[position]
+}
+
+namedLevel.numeric <- function(value) {
+ if(is.null(names(value))) {
+ position <- which(loglevels == value)
+ if(length(position) == 1)
+ value = loglevels[position]
+ }
+ value
+}
Added: pkg/R/oo.R
===================================================================
--- pkg/R/oo.R (rev 0)
+++ pkg/R/oo.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -0,0 +1,133 @@
+##***********************************************************************
+## this program is free software: you can redistribute it and/or
+## modify it under the terms of the GNU General Public License as
+## published by the Free Software Foundation, either version 3 of the
+## License, or (at your option) any later version.
+##
+## this program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with the nens libraray. If not, see
+## <http://www.gnu.org/licenses/>.
+##
+## Library : logging
+##
+## Purpose : the object oriented interface
+##
+## $Id: logger.R 75 2011-04-27 07:22:02Z mariotomo $
+##
+## initial programmer : Mario Frasca
+##
+## initial date : 20100105
+##
+
+Logger <- setRefClass("Logger",
+ fields=list(
+ name = "character"),
+ methods=list(
+
+ getParent = function() {
+ parts <- strsplit(name, '.', fixed=TRUE)[[1]] # split the name on the '.'
+ removed <- parts[-length(parts)] # except the last item
+ parentName <- paste(removed, collapse='.')
+ return(getLogger(parentName))
+ },
+
+ .logrecord = function(record) {
+ ##
+ if (record$level >= level)
+ for (handler in handlers)
+ if (record$level >= with(handler, level)) {
+ action <- with(handler, action)
+ formatter <- with(handler, formatter)
+ action(formatter(record), handler, record)
+ }
+
+ if(name != '') {
+ parentLogger <- getParent()
+ parentLogger$.logrecord(record)
+ }
+ invisible(TRUE)
+ },
+
+ log = function(msglevel, msg, ...) {
+ if (msglevel < level)
+ return(invisible(FALSE))
+
+ ## fine, we create the record and pass it to all handlers attached to the
+ ## loggers from here up to the root.
+ record <- list()
+
+ if (length(list(...)) > 0)
+ msg <- do.call("sprintf", c(msg, lapply(list(...), function(x) if(length(x)==1) x else paste(x, collapse=','))))
+
+ ## strip leading and trailing whitespace from the final message.
+ msg <- sub("[[:space:]]+$", '', msg)
+ msg <- sub("^[[:space:]]+", '', msg)
+ record$msg <- msg
+
+ record$timestamp <- sprintf("%s", Sys.time())
+ record$logger <- name
+ record$level <- namedLevel(msglevel)
+ record$levelname <- names(which(loglevels == record$level)[1])
+ if(is.na(record$levelname))
+ record$levelname <- paste("NumericLevel(", msglevel, ")", sep='')
+
+ ## cascade action in private method.
+ .logrecord(record)
+ },
+
+ setLevel = function(newLevel) {
+ if(is.character(newLevel))
+ newLevel <- loglevels[newLevel]
+ else if(is.numeric(newLevel))
+ newLevel <- namedLevel(level)
+ else newLevel <- NA
+ level <- newLevel
+ },
+
+ getLevel = function() level,
+
+ getHandler = function(handler) {
+ if(!is.character(handler))
+ handler <- deparse(substitute(handler))
+ handlers[[handler]]
+ },
+
+ removeHandler = function(handler) {
+ if(!is.character(handler)) # handler was passed as its action
+ handler <- deparse(substitute(handler))
+ handlers <<- handlers[!(names(handlers) == handler)]
+ },
+
+ addHandler = function(handler, ..., level=20, formatter=defaultFormat) {
+ handlerEnv <- new.env()
+ if(is.character(handler)){
+ ## first parameter is handler name
+ handlerName <- handler
+ ## and hopefully action is in the dots
+ params <- list(...)
+ if(!'action' %in% names(params) && is.null(names(params)[[1]]))
+ assign('action', params[[1]], handlerEnv)
+ } else {
+ ## first parameter is handler action, from which we extract the name
+ assign('action', handler, handlerEnv)
+ handlerName <- deparse(substitute(handler))
+ }
+ updateOptions.environment(handlerEnv, ...)
+ assign('level', namedLevel(level), handlerEnv)
+ assign('formatter', formatter, handlerEnv)
+ removeHandler(handlerName)
+ handlers[[handlerName]] <<- handlerEnv
+ },
+
+ finest = function(...) { log(loglevels['FINEST'], ...) },
+ finer = function(...) { log(loglevels['FINER'], ...) },
+ fine = function(...) { log(loglevels['FINE'], ...) },
+ debug = function(...) { log(loglevels['DEBUG'], ...) },
+ info = function(...) { log(loglevels["INFO"], ...) },
+ warn = function(...) { log(loglevels["WARN"], ...) },
+ error = function(...) { log(loglevels["ERROR"], ...) }))
Added: pkg/R/updateOptions.R
===================================================================
--- pkg/R/updateOptions.R (rev 0)
+++ pkg/R/updateOptions.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -0,0 +1,19 @@
+
+## set properties of a logger or a handler
+updateOptions <- function(container, ...)
+ UseMethod('updateOptions')
+
+updateOptions.character <- function(container, ...) {
+ ## container is really just the name of the container
+ updateOptions.environment(getLogger(container), ...)
+}
+
+updateOptions.environment <- function(container, ...) {
+ ## the container is a logger
+ config <- list(...);
+ if (! 'level' %in% names(config))
+ config[['level']] = loglevels['INFO']
+ for (key in names(config))
+ if(key != "") container[[key]] <- config[[key]]
+ invisible()
+}
Added: pkg/R/utils.R
===================================================================
--- pkg/R/utils.R (rev 0)
+++ pkg/R/utils.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -0,0 +1,39 @@
+
+#################################################################################
+
+## sample actions for handlers
+
+## a handler is a function that accepts a logging.record and a
+## configuration.
+
+## a logging.record contains the real message, its level, the name of the
+## logger that generated it, a timestamp.
+
+## a configuration contains a formatter (a function taking a
+## logging.record and returning a string), a numeric level (only records
+## with level equal or higher than that are taken into account), an
+## action (writing the formatted record to a stream).
+
+writeToConsole <- function(msg, handler, ...)
+{
+ cat(paste(msg, '\n', sep=''))
+}
+
+writeToFile <- function(msg, handler, ...)
+{
+ if (!exists('file', envir=handler))
+ stop("handler with writeToFile 'action' must have a 'file' element.\n")
+ cat(paste(msg, '\n', sep=''), file=with(handler, file), append=TRUE)
+}
+
+#################################################################################
+
+## the single predefined formatter
+
+defaultFormat <- function(record) {
+ text <- paste(record$timestamp, paste(record$levelname, record$logger, record$msg, sep=':'))
+}
+
+#################################################################################
+
+#################################################################################
Added: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R (rev 0)
+++ pkg/R/zzz.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -0,0 +1,6 @@
+
+## create the logging environment
+logging.options <- new.env()
+
+## initialize the module
+logReset()
Modified: pkg/inst/unitTest/runit.data.interaction.R
===================================================================
--- pkg/inst/unitTest/runit.data.interaction.R 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/inst/unitTest/runit.data.interaction.R 2011-08-03 13:16:48 UTC (rev 86)
@@ -22,14 +22,21 @@
checkEquals(rootLogger[['level']], expect)
}
-# end of functions that must be tested first
+test.003.sameNameMeansSameObject <- function() {
+ basicConfig()
+ root1 <- getLogger('abc')
+ root2 <- getLogger("abc")
+ checkIdentical(root1, root2)
+}
-test.canGetRootLoggerWithoutName <- function() {
+test.004.noNameMeansRoot <- function() {
rootLogger1 <- getLogger('')
rootLogger2 <- getLogger()
- checkEquals(rootLogger1, rootLogger2)
+ checkIdentical(rootLogger1, rootLogger2)
}
+# end of functions that must be tested first
+
test.canFindLoggingLevels <- function() {
checkEquals(logging:::loglevels[['NOTSET']], 0)
checkEquals(logging:::loglevels[['DEBUG']], 10)
Modified: pkg/man/addHandler.Rd
===================================================================
--- pkg/man/addHandler.Rd 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/man/addHandler.Rd 2011-08-03 13:16:48 UTC (rev 86)
@@ -3,8 +3,6 @@
\name{addHandler}
\alias{addHandler}
-\alias{addHandler.default}
-\alias{addHandler.character}
\title{add a handler to a logger}
\description{
@@ -15,6 +13,9 @@
}
\details{
+ \dots may contain extra parameters that will be passed to the handler
+ action. some elements in the \dots will be interpreted here.
+
a handler has a \var{name} and at least the three fields:
\describe{
\item{level}{all records at level lower than this are skipped.}
@@ -25,21 +26,13 @@
further a handler may have as many fields as you think you need. keep
in mind the handler (and all of its fields) are passed to the action
function.
-
}
\usage{
-addHandler(handler, ..., level = 20, logger = "", formatter = defaultFormat)
-\method{addHandler}{default}(handler, ..., level=20, logger='',
- formatter=defaultFormat)
-\method{addHandler}{character}(handler, action, ..., level=20, logger='',
- formatter=defaultFormat)
+addHandler(handler, ..., logger = "")
}
\arguments{
\item{handler}{the name of the handler, or its action}
- \item{action}{the action of the handler, if you provided its name}
\item{...}{extra parameters for the action, to be stored in the handler list}
- \item{level}{the level of the handler, defaults to 20 (INFO)}
\item{logger}{the name of the logger to which to attach the new
handler, defaults to the root logger}
- \item{formatter}{a function taking a record and producing a string.}
}
Modified: pkg/man/removeHandler.Rd
===================================================================
--- pkg/man/removeHandler.Rd 2011-08-02 14:36:09 UTC (rev 85)
+++ pkg/man/removeHandler.Rd 2011-08-03 13:16:48 UTC (rev 86)
@@ -3,8 +3,6 @@
\name{removeHandler}
\alias{removeHandler}
-\alias{removeHandler.default}
-\alias{removeHandler.character}
\title{remove a handler from a logger}
\description{
@@ -13,8 +11,6 @@
}
\usage{
removeHandler(handler, logger='')
-\method{removeHandler}{default}(handler, logger='')
-\method{removeHandler}{character}(handler, logger='')
}
\arguments{
\item{handler}{the name or the action of the handler}
More information about the Logging-commits
mailing list