Add a time stamp to each line of output

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!