source: trunk/p2p/log.tcl @ 1251

Last change on this file since 1251 was 1251, checked in by mmc, 12 years ago

Added first cut of P2P network for job management. See README in this
directory for details.

File size: 5.2 KB
Line 
1# ----------------------------------------------------------------------
2#  LIBRARY: logging routines
3# ----------------------------------------------------------------------
4#  Michael McLennan (mmclennan@purdue.edu)
5# ======================================================================
6#  Copyright (c) 2008  Purdue Research Foundation
7# ======================================================================
8# ----------------------------------------------------------------------
9#  USAGE: log channel <channel> ?on|off?
10#  USAGE: log <channel> <message>
11#  USAGE: log retrieve
12#  USAGE: log clear
13#
14#  Used to handle log messages within this package.  Typical usage
15#  sequence starts with one or more "log channel" statements, which
16#  define a series of message channels and whether they are on or off.
17#  Then, as "log <channel>" statements are encountered within the code,
18#  they are either passed along to the log file or ignored.  At any
19#  point, the contents of the log file can be retrieved by calling
20#  "log retrieve", and it can be cleared by calling "log clear".
21# ----------------------------------------------------------------------
22
23set log_options(tmpdir) "/tmp"
24set log_options(logfile) ""
25set log_options(logfid) ""
26
27proc log {option args} {
28    global log_options log_channels
29
30    switch -- $option {
31        channel {
32            # ----------------------------------------------------------
33            #  HANDLE: log channel
34            # ----------------------------------------------------------
35            if {[llength $args] > 2} {
36                error "wrong # args: should be \"log channel name ?state?\""
37            }
38            set channel [lindex $args 0]
39            if {[llength $args] == 1} {
40                if {[info exists log_channels($channel)]} {
41                    return $log_channels($channel)
42                }
43                return "off"
44            }
45
46            set state [lindex $args 1]
47            if {![string is boolean $state]} {
48                error "bad value \"$state\": should be on/off"
49            }
50            set log_channels($channel) $state
51
52            # make sure the log file is open and ready
53            if {"" == $log_options(logfid)} {
54                log clear
55            }
56            return $log_channels($channel)
57        }
58        retrieve {
59            # ----------------------------------------------------------
60            #  HANDLE: log retrieve
61            # ----------------------------------------------------------
62            if {[llength $args] != 0} {
63                error "wrong # args: should be \"log retrieve\""
64            }
65            if {[string length $log_options(logfile)] == 0} {
66                return ""
67            }
68            if {[catch {
69                close $log_options(logfid)
70                set fid [open $log_options(logfile) r]
71                set info [read $fid]
72                close $fid
73                set log_options(logfid) [open $log_options(logfile) a]
74              } result]} {
75                return "ERROR: $result"
76            }
77            return $info
78        }
79        clear {
80            # ----------------------------------------------------------
81            #  HANDLE: log clear
82            # ----------------------------------------------------------
83            if {[llength $args] != 0} {
84                error "wrong # args: should be \"log clear\""
85            }
86
87            # close any existing file
88            if {"" != $log_options(logfid)} {
89                catch {close $log_options(logfid)}
90                set log_options(logfid) ""
91            }
92
93            # don't have a log file name yet?  then look for a good name
94            if {[string length $log_options(logfile)] == 0} {
95                set counter 0
96                while {[incr counter] < 500} {
97                    set fname [file join $log_options(tmpdir) log[pid].$counter]
98                    if {[catch {
99                        set fid [open $fname w]; close $fid
100                      } result] == 0} {
101                        # success! use this name
102                        set log_options(logfile) $fname
103                        break
104                    }
105                }
106            }
107            if {[string length $log_options(logfile)] == 0} {
108                error "couldn't open log file in directory $log_options(tmpdir)"
109            }
110            set log_options(logfid) [open $log_options(logfile) w]
111            return ""
112        }
113        default {
114            # ----------------------------------------------------------
115            #  HANDLE: log <channel> <message>
116            # ----------------------------------------------------------
117            if {![info exists log_channels($option)] &&
118                  [lsearch {channel retrieve clear} $option] < 0} {
119                error "bad option \"$option\": should be a channel defined by \"log channel\" or one of channel, retrieve, or clear"
120            }
121            if {$log_channels($option)} {
122                if {[llength $args] != 1} {
123                    error "wrong # args: should be \"log chan message\""
124                }
125                set date [clock format [clock seconds] -format "%m/%d/%Y %H:%M:%S"]
126                puts $log_options(logfid) "$date [lindex $args 0]"
127                flush $log_options(logfid)
128            }
129        }
130    }
131}
Note: See TracBrowser for help on using the repository browser.