Files
sics/mcstas/dmc/log.tcl
2012-11-15 12:39:51 +11:00

85 lines
2.7 KiB
Tcl

#-----------------------------------------------------------------------------
# This file implements a LogBook facility for SICS.
# Usage:
# LogBook - lists the current status
# LogBook filename - sets the logbook file name
# LogBook on - starts logging, creates new file
# LogBook off - closes log file
#
# Mark Koennecke, June 1997, initially developed for SANS
# works using one procedure and an array for data. All internal procedures
# start with cli
#----------------------------------------------------------------------------
set cliArray(file) default.log
set cliArray(status) off
set cliArray(number) 0
#---------------------------------------------------------------------------
proc cliList { } {
global cliArray
# ClientPut [format " LogBook file: %s\n" $cliArray(file)]
# ClientPut [format " Logging: %s " $cliArray(status)] ]
append res [format " LogBook file: %s\n" $cliArray(file)] \
[format " Logging: %s " $cliArray(status)]
return $res
}
#-------------------------------------------------------------------------
proc cliLogOn { } {
global cliArray
set cmd [list config File $cliArray(file)]
set ret [catch {eval $cmd} msg]
if { $ret != 0 } {
error $msg
} else {
set l [ split $msg = ]
set cliArray(number) [lindex $l 1]
set cliArray(status) on
}
}
#--------------------------------------------------------------------------
proc cliLogOff { } {
global cliArray
set cmd [list config close $cliArray(number)]
set ret [catch {eval $cmd} msg]
if { $ret != 0 } {
error $msg
} else {
set cliArray(status) off
}
}
#-------------------------------------------------------------------------
proc logbook args {
global cliArray
#---- first case: a listing
if { [llength $args] == 0} {
return [cliList]
}
#---- there must be an argument
set argument [lindex $args 0]
#---- on/ off
if {[string compare "on" $argument] == 0} {
set ret [catch {cliLogOn} msg]
if { $ret != 0 } {
error $msg
} else {
ClientPut OK
}
} elseif {[string compare "off" $argument] == 0} {
set ret [catch {cliLogOff} msg]
if { $ret != 0 } {
error $msg
} else {
ClientPut OK
}
} elseif {[string compare "file" $argument] >= 0} {
if {[llength $args] < 1} {
error "ERROR: nor filename specified for LogBook"
}
set cliArray(file) [lindex $args 1]
} elseif {[string compare "no" $argument] == 0} {
ClientPut $cliArray(number)
} else {
error [format "ERROR: unknown argument %s to LogBook" $argument]
}
}