1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: logger - log user activities within the Rappture program |
---|
3 | # |
---|
4 | # This library is used throughout a Rappture application to log |
---|
5 | # things that the user does. This is useful for debugging, and also |
---|
6 | # for studying the effectiveness of simulation in education. The |
---|
7 | # information is logged only if the RAPPTURE_LOG environment variable |
---|
8 | # is set. |
---|
9 | # ====================================================================== |
---|
10 | # AUTHOR: Michael McLennan, Purdue University |
---|
11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
12 | # |
---|
13 | # See the file "license.terms" for information on usage and |
---|
14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
15 | # ====================================================================== |
---|
16 | namespace eval Rappture::Logger { |
---|
17 | # by default, the logger is off |
---|
18 | variable enabled 0 |
---|
19 | |
---|
20 | # log file name |
---|
21 | variable fileName "" |
---|
22 | |
---|
23 | # all activitiy is logged to this file channel |
---|
24 | variable fid "" |
---|
25 | } |
---|
26 | |
---|
27 | # |
---|
28 | # HACK ALERT! Many of the BLT graph-related widgets rely on BLT |
---|
29 | # bindings for zoom. If we want to log these, we need to catch |
---|
30 | # them at the push/pop zoom level. We do this once, here, by |
---|
31 | # wrapping the usual BLT procs in logging procs. |
---|
32 | # |
---|
33 | package require BLT |
---|
34 | auto_load Blt_ZoomStack |
---|
35 | |
---|
36 | rename ::blt::PushZoom ::blt::RealPushZoom |
---|
37 | proc ::blt::PushZoom {graph} { |
---|
38 | # do the BLT call first |
---|
39 | ::blt::RealPushZoom $graph |
---|
40 | |
---|
41 | # now, log the results |
---|
42 | foreach {x0 x1} [$graph axis limits x] break |
---|
43 | foreach {y0 y1} [$graph axis limits y] break |
---|
44 | ::Rappture::Logger::log zoomrect -in $x0,$y0 $x1,$y1 |
---|
45 | } |
---|
46 | |
---|
47 | rename ::blt::PopZoom ::blt::RealPopZoom |
---|
48 | proc ::blt::PopZoom {graph} { |
---|
49 | # do the BLT call first |
---|
50 | ::blt::RealPopZoom $graph |
---|
51 | |
---|
52 | # now, log the results |
---|
53 | foreach {x0 x1} [$graph axis limits x] break |
---|
54 | foreach {y0 y1} [$graph axis limits y] break |
---|
55 | ::Rappture::Logger::log zoomrect -out $x0,$y0 $x1,$y1 |
---|
56 | } |
---|
57 | |
---|
58 | # ---------------------------------------------------------------------- |
---|
59 | # USAGE: init ?on|off|auto? |
---|
60 | # |
---|
61 | # Called within the main program to initialize the logger package. |
---|
62 | # Can be given the value "on" or "off" to turn logging on/off, or |
---|
63 | # "auto" to rely on the RAPPTURE_LOG environment variable to control |
---|
64 | # logging. The default is "auto". |
---|
65 | # ---------------------------------------------------------------------- |
---|
66 | proc Rappture::Logger::init {{state "auto"}} { |
---|
67 | global env tcl_platform |
---|
68 | variable enabled |
---|
69 | variable fileName |
---|
70 | variable fid |
---|
71 | |
---|
72 | if {$state eq "auto"} { |
---|
73 | set state "off" |
---|
74 | if {[info exists env(RAPPTURE_LOG)] && $env(RAPPTURE_LOG) ne ""} { |
---|
75 | if {[file isdirectory $env(RAPPTURE_LOG)]} { |
---|
76 | set state "on" |
---|
77 | } else { |
---|
78 | error "can't log: RAPPTURE_LOG directory does not exist" |
---|
79 | } |
---|
80 | } |
---|
81 | } |
---|
82 | if {![string is boolean -strict $state]} { |
---|
83 | error "bad value \"$state\": should be on, off, or auto" |
---|
84 | } |
---|
85 | |
---|
86 | if {$state} { |
---|
87 | # turn logging on |
---|
88 | package require base32 |
---|
89 | package require md5 |
---|
90 | |
---|
91 | # make a date subdir within the log dir |
---|
92 | if {![info exists env(RAPPTURE_LOG)]} { |
---|
93 | set env(RAPPTURE_LOG) /tmp |
---|
94 | } |
---|
95 | set dir [clock format [clock seconds] -format "%Y-%m-%d"] |
---|
96 | set dir [file join $env(RAPPTURE_LOG) $dir] |
---|
97 | if {![file isdirectory $dir]} { |
---|
98 | file mkdir $dir |
---|
99 | } |
---|
100 | |
---|
101 | # generate a unique random file name for the log |
---|
102 | set app [Rappture::Tool::resources -appname] |
---|
103 | if {$app eq ""} { |
---|
104 | error "app name not set before logging -- init logging after initializing tool resources" |
---|
105 | } |
---|
106 | |
---|
107 | for {set ntries 0} {$ntries < 5} {incr ntries} { |
---|
108 | set unique [string map {= _} [base32::encode [md5::md5 "$tcl_platform(user):$app:[clock seconds]:[clock clicks]"]]] |
---|
109 | |
---|
110 | set fileName [file join $dir $unique.log] |
---|
111 | if {![file exists $fileName]} { |
---|
112 | break |
---|
113 | } |
---|
114 | } |
---|
115 | if {[file exists $fileName]} { |
---|
116 | error "can't seem to create a unique log file name in $dir" |
---|
117 | } |
---|
118 | |
---|
119 | # open the log file |
---|
120 | set fid [open $fileName w] |
---|
121 | |
---|
122 | # set the buffer size low so we don't lose much output if the |
---|
123 | # program suddenly terminates |
---|
124 | fconfigure $fid -buffersize 1024 |
---|
125 | |
---|
126 | # set permissions on the file so that it's not readable |
---|
127 | # NOTE: middleware should do this automatically |
---|
128 | ##file attributes $fileName -permissions 0400 |
---|
129 | |
---|
130 | # logging is now turned on |
---|
131 | set enabled 1 |
---|
132 | |
---|
133 | # create the logging proc -- this is faster than checking "enabled" |
---|
134 | proc ::Rappture::Logger::log {event args} { |
---|
135 | variable fid |
---|
136 | # limit the side of log messages (which could be really large) |
---|
137 | set shortArgs "" |
---|
138 | foreach str $args { |
---|
139 | if {[string length $str] > 255} { |
---|
140 | set str "[string range $str 0 255]..." |
---|
141 | } |
---|
142 | lappend shortArgs $str |
---|
143 | } |
---|
144 | catch { |
---|
145 | set t [clock seconds] |
---|
146 | set tstr [clock format $t -format "%T"] |
---|
147 | puts $fid "$t = $tstr>> $event $shortArgs" |
---|
148 | } |
---|
149 | } |
---|
150 | |
---|
151 | # save out some info about the user and the session |
---|
152 | puts $fid "# Application: $app" |
---|
153 | puts $fid "# User: $tcl_platform(user)" |
---|
154 | if {[info exists env(SESSION)]} { |
---|
155 | puts $fid "# Session: $env(SESSION)" |
---|
156 | } |
---|
157 | puts $fid "# Date: [clock format [clock seconds]]" |
---|
158 | Rappture::Logger::log started |
---|
159 | |
---|
160 | } else { |
---|
161 | # turn logging off |
---|
162 | if {$fid ne ""} { |
---|
163 | catch {close $fid} |
---|
164 | set fid "" |
---|
165 | } |
---|
166 | set enabled 0 |
---|
167 | |
---|
168 | # null out the logging proc -- this is faster than checking "enabled" |
---|
169 | proc ::Rappture::Logger::log {event args} { # do nothing } |
---|
170 | } |
---|
171 | } |
---|
172 | |
---|
173 | # ---------------------------------------------------------------------- |
---|
174 | # USAGE: log <event> ?<detail> <detail> ...? |
---|
175 | # |
---|
176 | # Used throughout the Rappture application to log various activities. |
---|
177 | # Each <event> is a short name like "tooltip" or "inputChanged" that |
---|
178 | # indicates what happened. All remaining arguments are appended to |
---|
179 | # the log as details about what happened or what changed. |
---|
180 | # ---------------------------------------------------------------------- |
---|
181 | proc Rappture::Logger::log {event args} { |
---|
182 | # do nothing by default until turned on by init |
---|
183 | } |
---|