logger

logger , a Tcllib module, is a system to control logging of events

Documentation

official reference

Description

logger attempts to improve on the log package by providing a configurable, hierarchical approach to logging, meaning that one can have not only levels such as critical, error, and warn, but also 'services', such as irc, mime, or whatever one wishes to specify.

These services can also have a tree-like structure, so that you could have 'sub' services that are all also configurable via the root of that tree. Furthermore, the code attempts to minimize impact on performance when logging is turned off for a particular service.

If all the stops are pulled out, it approaches the speed of not having the logging code at all.

Basic Example

package require logger 0.3

# initialize logger subsystems
# two loggers are created
# 1. main
# 2. a separate logger for plugins
set log [logger::init main]
 
namespace eval ::plugin {
    variable name "MyPlugin"
    variable log
    set log [logger::init main::plugins]

    proc pluginlogproc {txt} {
          variable name
          puts stdout "[clock format [clock seconds]] : $name : $txt"
    }
 
    proc foo {} {
       variable log
       ${log}::notice "A simple message"
    }
}

# Testing the logger
puts "Known log levels: [logger::levels]"
puts "Known services: [logger::services]" 

puts "Showing logger configuration"
${log}::notice "A simple message from the main logger"
plugin::foo
 
puts "Switching logproc for plugin"
# change the configuration of the logproc
${::plugin::log}::logproc notice ::plugin::pluginlogproc

${log}::notice "A simple message from the main logger"
plugin::foo

# switching loglevels
puts "Current loglevel for main: [${log}::currentloglevel]"
puts "Current loglevel for main::plugin: [${::plugin::log}::currentloglevel]"
 
${::log}::setlevel notice

puts "Current loglevel for main: [${log}::currentloglevel]"
puts "Current loglevel for main::plugin: [${::plugin::log}::currentloglevel]"

${::plugin::log}::setlevel warn

puts "Current loglevel for main: [${log}::currentloglevel]"
puts "Current loglevel for main::plugin: [${::plugin::log}::currentloglevel]"

Example: Logging to a File

package require logger
proc log_to_file {lvl txt} {
    set logfile "mylog.log"
    set msg "\[[clock format [clock seconds]]\] $txt"
    set f [open $logfile {WRONLY CREAT APPEND}] ;# instead of "a"
    fconfigure $f -encoding utf-8
    puts $f $msg
    close $f
}

set log [logger::init global]
foreach lvl [logger::levels] {
    interp alias {} log_to_file_$lvl {} log_to_file $lvl
    ${log}::logproc $lvl log_to_file_$lvl
}

${log}::info "Logging to a file" 

Time and Date Formats

RLH: These are a couple of different time/date formats used in logging:

# ISO8601 
# 2006-11-28T11:04:53
clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"

# APACHE
# Tue Nov 28 11:14:04 2006
clock format [clock seconds] -format "%a %b %d %H:%M:%S %Y"

User Interface for Changing the loglevels

hae: A simple approach for setting the log levels. If somebody wishes this could go into tcllib/tklib.

#
# $Id:$
#
# Requirements:
#    - Tcl/tk 8.5
#    - logger package
#    - inplace.tcl from https://wiki.tcl-lang.org/23475
#
# SYNOPSIS
# logger::show pathname args
# 
# DESCRIPTION
#    Show a dialog with a list of logger services and allow
#    to change the log level of each service
#
# SPECIFIC OPTIONS
#    -title
#    -parent
##

package require Tk 8.5
package require Ttk

package require logger

set dir [file dirname [info script]]
source [file join $dir inplace.tcl]

#
# 
#
##
proc ::logger::show { w args } {

    array set defaults [list -parent "" -title "Logger Options"]
    array set options  [array get defaults]

    foreach {option value} $args {
        if { $option ni [array names defaults] } {
            error "unknown option \"$option\""
        }
    }
    if { ([llength $args] % 2) != 0 } {
        error "value missing for \"[lindex $args [llength $args]]\""
    }
    
    array set options $args

    toplevel    $w -class LoggerUI
    wm title    $w $options(-title)
    wm iconname $w $options(-title)
    wm withdraw $w

    if { $options(-parent) ne "" } {
        wm transient $w $options(-parent)
        wm group     $w $options(-parent)
    }
    set xf [ttk::frame $w.f]

    set headings [list Service Level]
    set columns  [list text list]
    set f   [ttk::frame     $xf.f]
    set tv  [ttk::treeview  $f.tv -show headings \
                                  -columns $columns \
                                  ]
    set vsb [ttk::scrollbar $f.vsb -orient vertical \
                                   -command [list logger::UpdateTreeview $tv] \
            ]

    FillTreeview $tv
    xtreeview::_treeheaders $tv true $headings
    bind $tv <<TreeviewInplaceEdit>> [list logger::EditTreeviewItem %W %d]
    set col 1
    foreach h $headings {
        set column #$col
        $tv heading $column -text $h
        incr col
    }

    grid $tv  -row 0 -column 0 -sticky news
    grid $vsb -row 0 -column 1 -sticky  ns
    grid rowconfigure    $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1

    set bf        [ttk::frame  $xf.bf]
    set btnOk     [ttk::button $bf.btnOk     -text " Ok " \
                                             -command [list logger::OnButtonClick $w $tv ok] \
                  ]
    set btnCancel [ttk::button $bf.btnCancel -text " Cancel " \
                                             -command [list logger::OnButtonClick $w $tv cancel] \
                  ]
    bind $btnOk     <Key-Return>     [list logger::OnButtonClick $w $tv ok]
    bind $btnCancel <Key-Escape>     [list logger::OnButtonClick $w $tv cancel]

    grid $btnCancel $btnOk -sticky news -padx 10 -pady 5

    grid $f  -row 0 -column 0 -sticky news
    grid $bf -row 1 -column 0 -sticky ew
    grid rowconfigure    $xf 0 -weight 1
    grid columnconfigure $xf 0 -weight 1

    pack $xf -expand 1 -fill both

    wm protocol  $w  WM_DELETE_WINDOW [list logger::OnButtonClick $w $tv cancel]

    Place $w $options(-parent)
}

#
#
#
##
proc logger::Place { w parent } {

    update idletasks
    if { $parent eq "" } {
        set parent "."

        set W [winfo screenwidth $parent]
        set H [winfo screenheight $parent]
        set X 0
        set Y 0
    } else {
        set W [winfo width $parent]
        set H [winfo height $parent]
        set X [winfo rootx $parent]
        set Y [winfo rooty $parent]
    }
    set xpos "+[ expr {$X+($W-[winfo reqwidth $w])/2}]"
    set ypos "+[ expr {$Y+($H-[winfo reqheight $w])/2}]"

    wm geometry $w "$xpos$ypos"
    wm deiconify $w 
}

#
#
#
##
proc logger::FillTreeview { tv } {

    foreach svc [logger::services] {
       set svccmd [logger::servicecmd $svc]

       set lvl [${svccmd}::currentloglevel]

       $tv insert {} end -values [list $svc $lvl]
    }

}

#
#
#
##
proc logger::UpdateTreeview { tv args } {
    ::xtreeview::updateWnds $tv
    $tv yview
}

#
#
#
##
proc logger::EditTreeviewItem { tv data } {

    puts [info level 0]
    if {[$tv children [lindex $data 1]] eq ""} {
        switch [lindex $data 0] {
            {#0} {
                xtreeview::_inplaceEntry $tv {*}$data
            }
            {bool} {
                xtreeview::_inplaceCheckbutton $tv {*}$data true false
            }
            {int} {
                xtreeview::_inplaceSpinbox $tv {*}$data 0 100 1 
            }
            {list} {
                set a [xtreeview::_inplaceList $tv {*}$data [logger::levels]]
            }
        }
    } elseif {[lindex $data 0] eq "list"} {
        puts "list"
        xtreeview::_inplaceEntryButton $tv {*}$data {
            #set %%v "tree: %W, column,item=%d"
            puts "list: tree: $tv, item '$data'"
        }
    }
}

#
#
#
##
proc logger::Close { w } {
    destroy $w
}

#
#
#
##
proc logger::OnButtonClick { w tv action } {

    if { $action eq "cancel" } {
        Close $w
        return
    }

    # update last changed item
    set item [$tv focus]
    xtreeview::_clear $tv $item
    xtreeview::_update_value $tv list $item


    # set new log levels foreach service
    foreach item [$tv children {}] {
        set values [$tv item $item -values]
        lassign $values svc lvl
        
        set svccmd [logger::servicecmd $svc]
        ${svccmd}::setlevel $lvl
    }

    Close $w
}

# Demo code
if { $argv0 eq [info script] } {

    catch {console show}
    for { set i 0 } { $i < 5 } { incr i } {
        set log($i) [logger::init L$i]
    }

    logger::show .logUI
}