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