Below is a synchronized thread logger based on example 21-9, page 333 in the book Practical Programming in Tcl and Tk 4th edition, by Brent B. Welch, Ken Jones with Jeffrey Hobbs. This thread logger allows the synchronized screen prints to the main thread (needed for Windows and Maconintosh), synchronized file access, and provides the date time, thread id, a custom log message with each log command. Comments ore suggestions welcome.
package require Thread
# logPath parameter should include the file name in the path.
# If not provided the file name will be today's date.
# Set to false if you only want to do screen prints
tsv::set logging ID true
# File Path and File to use for logging.
tsv::set logPath ID ./myFile
# Put this code in the main thread only.
# Needed for screen prints from other threads.
tsv::set mainThread ID [thread::id]
set ::threadLogger [::thread::create {
proc log { value logging {logPath "./"}} {
global yesterday logid
if { [catch {
set currentday [clock seconds]
set seconds $currentday
thread::send -async [tsv::get mainThread ID] [list puts "-------------------------------------------------------------------------------"]
thread::send -async [tsv::get mainThread ID] [list puts "[clock format $seconds -format "%D|%T|"]$value"]
if { $logging } {
set currentday [clock format $currentday -format %d]
if { ! [info exists logid] } {
set logid [open "${logPath}[clock format $seconds -format %m-%d-%y].log" a+]
}
# Create new file
if { [info exists yesterday] } {
if { $currentday != $yesterday } {
set yesterday $currentday
close $fileid
set logid [open "${logPath}[clock format $seconds -format %m-%d-%y].log" a+]
}
} else {
set yesterday $currentday
}
puts $logid "-------------------------------------------------------------------------------"
puts $logid "[clock format $seconds -format "%D|%T|"]$value"
}
} errorString] } {
thread::send -async [tsv::get mainThread ID] [list puts puts "proc log ERROR: \"$errorString\""]
}
}
::thread::wait
}]
tsv::set loggerThread ID $::threadLogger
proc log { value } {
if { [catch {
thread::send -async [tsv::get loggerThread ID] [list log "Thread[thread::id]|$value" [tsv::get logging ID] [tsv::get logPath ID]]
} errorString] } {
puts "proc log ERROR: \"$errorString\""
}
}
log "Hello. This is a test"