source: trunk/p2p/log.tcl @ 5348

Last change on this file since 5348 was 3177, checked in by mmc, 7 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.