sbron 2018-07-06: I made the following module and thought it might be a useful example of the
transchan functionality available in Tcl.
The module provides a
timestamp command that will transform a specified channel so each line of output will have a time stamp prepended. This can be useful for debugging output or log files. The format of the time stamp can be specified in the initial command and/or configured later.
timestamp-1.0.tm:
# Library to add a timestamp to each line of output
#
# Usage:timestamp channel <channelId> ?optionName value? ...
# timestamp configure <channelId> ?optionName value? ...
#
# Available options:
# -format <format>
# Specifies the format of the time stamp in a method similar to
# the [clock format] command, with two additional format groups:
# %n: three-digit number giving the current milliseconds within
# the second.
# %v: six-digit number giving the current microseconds within
# the second.
namespace eval timestamp {
# Ensemble for the user
namespace ensemble create -subcommands {channel configure}
# Ensemble for transchan
namespace ensemble create -command transchan -parameters fd \
-subcommands {initialize finalize write}
# Define the available options and their default values
variable defaultcfg {
-format {%Y-%m-%d %T.%n:}
}
}
proc timestamp::channel {fd args} {
set argc [llength $args]
if {$argc % 2} {
return -code error "wrong # args: should be\
\"timestamp channel channel ?-option value ...?\""
}
# Install the transchan
chan push $fd [list [namespace which transchan] $fd]
if {$argc == 0} return
tailcall configure $fd {*}$args
}
proc timestamp::configure {fd args} {
variable cfg
if {![info exists cfg($fd)]} {
return -code error "can not find channel named \"$fd\""
}
set argc [llength $args]
if {$argc == 0} {
return $cfg($fd)
}
if {$argc == 1} {
set opt [lindex $args 0]
if {[dict exists $cfg($fd) $opt]} {
return [dict get $cfg($fd) $opt]
} else {
return -code error "bad option \"$opt\""
}
}
if {$argc % 2} {
return -code error "wrong # args: should be\
\"timestamp configure ?-option value ...?\""
}
set newcfg [dict merge $cfg($fd) $args]
if {[dict size $newcfg] == [dict size $cfg($fd)]} {
set cfg($fd) $newcfg
return
}
set opt [lindex [dict keys $newcfg] [dict size $cfg($fd)]]
return -code error "bad option \"$opt\""
}
proc timestamp::initialize {fd chan mode} {
variable defaultcfg
variable cfg
variable newline
# Initialize the per channel data structures
set cfg($fd) $defaultcfg
set newline($fd) 1
# Return the available subcommands
return [namespace ensemble configure transchan -subcommands]
}
proc timestamp::finalize {fd chan} {
variable cfg
variable newline
# Clean up the used data structures
unset cfg($fd)
unset newline($fd)
}
proc timestamp::ts {fd} {
variable cfg
# Get the current time in microseconds resolution
set now [clock microseconds]
# Handle the additional format groups
# Determining if these are actually used will probably take more time than
# just assuming they are
set us [expr {$now % 1000000}]
lappend map %n [format %03d [expr {$us / 1000}]] %v [format %06d $us]
set tsformat [string map $map [dict get $cfg($fd) -format]]
# Create the timestamp
return [clock format [expr {$now / 1000000}] -format $tsformat]
}
proc timestamp::write {fd chan data} {
variable newline
# Ignore empty writes
if {$data eq ""} return
# Divide the received data into lines
set lines [lassign [split $data \n] line]
# Only build the timestamp once per block of data
set ts [ts $fd]
set out ""
# When starting on a new line, output the time stamp
if {$newline($fd)} {
append out $ts " "
}
append out $line
# Only do something more when there is a newline in the data
if {[llength $lines] > 0} {
# Don't ouput a timestamp after a final newline in the data block
if {[lindex $lines end] eq {}} {
set newline($fd) 1
set lines [lreplace $lines end end]
} else {
set newline($fd) 0
}
# Prepended a timestamp to each line
foreach line $lines {
append out \n $ts " " $line
}
if {$newline($fd)} {
# Add back the final newline
append out \n
}
} else {
# Not at the start of a new line
set newline($fd) 0
}
return $out
}Demo code:
package require timestamp
timestamp channel stdout -format %T.%v>
puts Hello!
after 1234
puts Bye!
Output:
15:41:50.145864> Hello!
15:41:51.410124> Bye!
