source: trunk/p2p/log.tcl

Last change on this file was 3177, checked in by mmc, 10 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

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