1# -*- tcl -*- 2# (C) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> 3## 4# ### 5 6# Feedback modes 7# 8# [short] Animated short feedback on stdout, no logging 9# [log] Animated short feedback on stdout, logging to multiple files. 10# [verbose] Logging to stdout 11# 12# Output commands for various destinations: 13# 14# <v> Verbose Log 15# <s> Short Log 16# 17# Handling of the destinations per mode 18# 19# <s> <v> 20# [short] stdout, /dev/null 21# [log] stdout, file 22# [verbose] /dev/null, stdout 23 24# Log files for different things are opened on demand, i.e. on the 25# first write to them. We can configure (per possible log) a string to 26# be written before the first write. Reconfiguring that string for a 27# log clears the flag for that log and causes the string to be 28# rewritten on the next write. 29 30package require sak::animate 31 32namespace eval ::sak::feedback { 33 namespace import ::sak::animate::next ; rename next aNext 34 namespace import ::sak::animate::last ; rename last aLast 35} 36 37# ### 38 39proc ::sak::feedback::init {mode stem} { 40 variable prefix "" 41 variable short [expr {$mode ne "verbose"}] 42 variable verbose [expr {$mode ne "short"}] 43 variable tofile [expr {$mode eq "log"}] 44 variable lstem $stem 45 variable dst "" 46 variable lfirst 47 unset lfirst 48 array set lfirst {} 49 # Note: lchan is _not_ reset. We keep channels, allowing us to 50 # merge output from different modules, if they are run as 51 # one unit (Example: validate and its various parts, which 52 # can be run separately, and together). 53 return 54} 55 56proc ::sak::feedback::first {dst string} { 57 variable lfirst 58 set lfirst($dst) $string 59 return 60} 61 62### 63 64proc ::sak::feedback::summary {text} { 65 #=| $text 66 #log $text 67 68 variable short 69 variable verbose 70 if {$short} { puts $text } 71 if {$verbose} { puts [_channel log] $text } 72 return 73} 74 75 76proc ::sak::feedback::log {text {ext log}} { 77 variable verbose 78 if {!$verbose} return 79 set c [_channel $ext] 80 puts $c $text 81 flush $c 82 return 83} 84 85### 86 87proc ::sak::feedback::! {} { 88 variable short 89 if {!$short} return 90 variable prefix "" 91 sak::animate::init 92 return 93} 94 95proc ::sak::feedback::+= {string} { 96 variable short 97 if {!$short} return 98 variable prefix 99 append prefix " " $string 100 aNext $prefix 101 return 102} 103 104proc ::sak::feedback::= {string} { 105 variable short 106 if {!$short} return 107 variable prefix 108 aNext "$prefix $string" 109 return 110} 111 112proc ::sak::feedback::=| {string} { 113 variable short 114 if {!$short} return 115 116 variable prefix 117 aLast "$prefix $string" 118 119 variable verbose 120 if {$verbose} { 121 variable dst 122 if {[string length $dst]} { 123 # inlined 'log' 124 set c [_channel $dst] 125 puts $c "$prefix $string" 126 flush $c 127 set dst "" 128 } 129 } 130 131 set prefix "" 132 return 133} 134 135proc ::sak::feedback::>> {string} { 136 variable dst $string 137 return 138} 139 140# ### 141 142proc ::sak::feedback::_channel {dst} { 143 variable tofile 144 if {!$tofile} { return stdout } 145 variable lchan 146 if {[info exists lchan($dst)]} { 147 set c $lchan($dst) 148 } else { 149 variable lstem 150 set c [open ${lstem}.$dst w] 151 set lchan($dst) $c 152 } 153 variable lfirst 154 if {[info exists lfirst($dst)]} { 155 puts $c $lfirst($dst) 156 unset lfirst($dst) 157 } 158 return $c 159} 160 161# ### 162 163namespace eval ::sak::feedback { 164 namespace export >> ! += = =| init log summary 165 166 variable dst "" 167 variable prefix "" 168 variable short "" 169 variable verbose "" 170 variable tofile "" 171 variable lstem "" 172 variable lchan 173 array set lchan {} 174 175 variable lfirst 176 array set lfirst {} 177} 178 179## 180# ### 181 182package provide sak::feedback 1.0 183