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