b2ffb9b7 |
1 | #! @TCLSH@ |
8d769cc9 |
2 | |
f342fce2 |
3 | #----- Miscellaneous utilities ---------------------------------------------- |
4 | |
5 | # die MSG |
6 | # |
7 | # Something didn't work. Exit right now. |
8 | |
8d769cc9 |
9 | proc die {msg} { |
10 | global argv0 |
11 | puts stderr "$argv0: $msg" |
12 | exit 1 |
13 | } |
14 | |
f342fce2 |
15 | # usage FILE |
16 | # |
17 | # Write a usage message to FILE, which is a file handle. |
18 | |
8d769cc9 |
19 | proc usage {file} { |
20 | global argv0 |
ed04d555 |
21 | puts $file "Usage: \n\t$argv0 \[-s\] FILE\n\t$argv0 -u OUTPUT FILE FILE ..." |
8d769cc9 |
22 | } |
23 | |
f342fce2 |
24 | # clear-arrays ARRAY ... |
25 | # |
26 | # Make each named ARRAY exist and be empty. |
8d769cc9 |
27 | |
28 | proc clear-arrays {args} { |
29 | foreach i $args { |
30 | upvar 1 $i v |
31 | unset i |
32 | array set v {} |
33 | } |
34 | } |
35 | |
f342fce2 |
36 | #------ Write-safe ---------------------------------------------------------- |
37 | |
38 | # write-safe STUFF [TIDY] |
39 | # |
40 | # Do some safe I/O. If STUFF succeeds, do TIDY and commit the modifications; |
41 | # otherwise, do TIDY and back out all the changes. See also write-safe-open, |
42 | # write-safe-file and write-safe-delete. |
43 | |
8d769cc9 |
44 | proc write-safe {stuff {tidy {}}} { |
45 | global _ws_close _ws_del _ws_new |
46 | clear-arrays _ws_del _ws_new |
47 | set _ws_close {} |
48 | |
49 | if {[set rc [catch { |
50 | uplevel 1 $stuff |
51 | } err]]} { |
52 | foreach f $_ws_close { catch { close $f } } |
53 | foreach f [array names _ws_new] { catch { file delete -- $f.new } } |
54 | catch { uplevel 1 $tidy } |
55 | return -code $rc $err |
56 | } |
57 | foreach f $_ws_close { catch { close $f } } |
58 | clear-arrays all |
59 | foreach f [concat [array names _ws_old] [array names _ws_del]] { |
60 | set all($f) 0 |
61 | } |
62 | if {[set rc [catch { |
63 | foreach f [array names all] { |
64 | if {[file exists $f]} { |
65 | file delete -- $f.old |
66 | file copy -force -- $f $f.old |
67 | } |
68 | set old($f) 0 |
69 | } |
70 | foreach f [array names _ws_new] { file rename -force -- $f.new $f } |
71 | foreach f [array names _ws_del] { file delete -- $f } |
72 | } err]]} { |
73 | foreach f [array names _ws_new] { catch { file delete -- $f.new } } |
74 | foreach f [array names old] { file rename -force -- $f.old $f } |
75 | catch { uplevel 1 $tidy } |
76 | return -code $rc $err |
77 | } |
78 | foreach i [array names all] { catch { file delete -- $i.old } } |
79 | catch { uplevel 1 $tidy } |
80 | return {} |
81 | } |
82 | |
f342fce2 |
83 | # write-safe-open NAME [TRANS] |
84 | # |
85 | # Open file NAME for writing, with the translation mode TRANS (default is |
86 | # `auto'); return the file handle. The file NAME is not destroyed until the |
87 | # changes are committed by an enclosing write-safe completing. You can close |
88 | # the file handle if you like; write-safe will close it automatically anyway. |
89 | |
8d769cc9 |
90 | proc write-safe-open {name {trans auto}} { |
91 | global _ws_close _ws_new |
92 | if {[file isdirectory $name]} { error "`$name' is a directory" } |
93 | set f [open $name.new w] |
94 | fconfigure $f -translation $trans |
95 | lappend _ws_close $f |
96 | set _ws_new($name) 0 |
97 | return $f |
98 | } |
99 | |
f342fce2 |
100 | # write-safe-delete NAME |
101 | # |
102 | # Delete file NAME. The file isn't actually removed until the enclosing |
103 | # write-safe completes. |
104 | |
8d769cc9 |
105 | proc write-safe-delete {name} { |
106 | global _ws_del |
107 | set _ws_del($name) 0 |
108 | } |
109 | |
f342fce2 |
110 | # write-safe-file NAME CONTENTS [TRANS] |
111 | # |
112 | # Write CONTENTS to FILE, using translation mode TRANS (default `auto'). The |
113 | # file isn't actually replaced until the changes are committed by an |
114 | # enclosing write-safe completing. |
115 | |
8d769cc9 |
116 | proc write-safe-file {name contents {trans auto}} { |
117 | set f [write-safe-open $name $trans] |
118 | puts -nonewline $f $contents |
119 | close $f |
120 | } |
121 | |
f342fce2 |
122 | # read-file NAME [TRANS] |
123 | # |
124 | # Evaluates to the contents of the file NAME under translation mode TRANS |
125 | # (default `auto'). |
126 | |
8d769cc9 |
127 | proc read-file {name {trans auto}} { |
128 | set f [open $name] |
129 | fconfigure $f -translation $trans |
130 | set c [read $f] |
131 | close $f |
132 | return $c |
133 | } |
134 | |
f342fce2 |
135 | #----- Splitconf-specific stuff --------------------------------------------- |
136 | |
137 | # write-safe-manifest F L |
138 | # |
139 | # Writes the list of filenames L to the manifest file associated with config |
140 | # file F. |
141 | |
8d769cc9 |
142 | proc write-safe-manifest {f l} { |
143 | set f [write-safe-open $f.files] |
144 | foreach i $l { puts $f $i } |
145 | close $f |
146 | } |
147 | |
f342fce2 |
148 | # old-files CONF |
149 | # |
150 | # Returns the filenames in the current manifest of the config file CONF. |
151 | |
8d769cc9 |
152 | proc old-files {conf} { |
153 | set old {} |
154 | if {[file exists $conf.files]} { |
155 | set f [open $conf.files] |
156 | while {[gets $f line] >= 0} { lappend old $line } |
157 | close $f |
158 | } |
159 | return $old |
160 | } |
161 | |
f342fce2 |
162 | #----- Main code ------------------------------------------------------------ |
163 | |
164 | set job "split" |
165 | while {[llength $argv]} { |
166 | switch -glob -- [lindex $argv 0] { |
167 | "-u" - "--unsplit" { |
168 | set job "unsplit" |
169 | if {[llength $argv] < 2} { die "option `-u' needs an argument" } |
170 | set output [lindex $argv 1] |
171 | set argv [lrange $argv 1 end] |
172 | } |
173 | "-d" - "--delete" { set job "delete" } |
174 | "-s" - "--split" { set job "split" } |
175 | "-h" - "--help" { usage stdout; exit 0 } |
176 | "-" { break } |
177 | "--" { set argv [lrange $argv 1 end]; break } |
178 | "-*" { die "unknown option `[lindex $argv 0]'"; exit 1 } |
179 | default { break } |
180 | } |
181 | set argv [lrange $argv 1 end] |
182 | } |
183 | |
8d769cc9 |
184 | set rc 0 |
185 | clear-arrays opt |
186 | array set opt { |
187 | prefix "" |
188 | before "" |
189 | after "" |
190 | } |
191 | switch $job { |
192 | "unsplit" { |
193 | set f "\#\# automatically generated by splitconf\n\n" |
194 | set ff {} |
195 | foreach i $argv { |
196 | if {[catch { |
197 | set c [read-file $i] |
198 | append f "\[$i\]\n$c\n" |
199 | lappend ff $i |
200 | } msg]} { |
201 | set rc 1 |
202 | } |
203 | } |
204 | write-safe { |
205 | write-safe-file $output $f |
206 | write-safe-manifest $output $ff |
207 | } |
208 | } |
209 | "delete" { |
210 | if {[llength $argv] != 1} { die "need exactly one filename" } |
211 | set conf [lindex $argv 0] |
212 | set old [old-files $conf] |
213 | write-safe { |
214 | foreach i $old { write-safe-delete $i } |
215 | write-safe-delete $conf.files |
216 | } |
217 | } |
218 | "split" { |
219 | if {[llength $argv] != 1} { die "need exactly one filename" } |
220 | set conf [lindex $argv 0] |
221 | set old [old-files $conf] |
222 | set c [open $conf r] |
223 | catch { unset o } |
8d769cc9 |
224 | set spill "" |
f342fce2 |
225 | set donebefore 0 |
8d769cc9 |
226 | array set new {} |
227 | write-safe { |
228 | while {[gets $c line] >= 0} { |
229 | if {[regexp -- {^\[(.*)\]\s*$} $line . name]} { |
ed04d555 |
230 | if {[info exists o]} { close $o } |
f342fce2 |
231 | if {[string equal $name ""]} { |
232 | catch { unset o } |
8d769cc9 |
233 | } else { |
ed04d555 |
234 | if {!$donebefore} { |
235 | exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr |
236 | set donebefore 1 |
237 | } |
f342fce2 |
238 | set name "$opt(prefix)$name" |
239 | set o [write-safe-open $name] |
240 | set new($name) 1 |
241 | set spill "" |
8d769cc9 |
242 | } |
8d769cc9 |
243 | } elseif {[info exists o]} { |
244 | switch -regexp -- $line { |
245 | {^\s*$} { append spill "$line\n" } |
246 | {^\#\#} { } |
f342fce2 |
247 | {^\!} { |
248 | puts -nonewline $o "$spill[string range $line 1 end]\n" |
249 | set spill "" |
250 | } |
251 | default { puts -nonewline $o "$spill$line\n"; set spill "" } |
8d769cc9 |
252 | } |
253 | } elseif {[regexp -- {^\s*(\#|$)} $line]} { |
254 | continue |
f342fce2 |
255 | } elseif {[regexp -- \ |
256 | {^\s*([-./\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} { |
8d769cc9 |
257 | if {![info exists opt($k)]} { |
258 | error "unknown configuration option `$k'" |
259 | } else { |
260 | set opt($k) $v |
261 | } |
f342fce2 |
262 | } elseif {[regexp -- \ |
263 | {^\s*([-./\w]+)\s*:\s*(.*\S|)\s*$} $line . name d]} { |
264 | if {!$donebefore} { |
265 | exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr |
266 | set donebefore 1 |
267 | } |
268 | set name "$opt(prefix)$name" |
269 | set new($name) 1 |
270 | write-safe-file $name "$d\n" |
8d769cc9 |
271 | } else { |
272 | error "unknown preamble directive" |
273 | } |
274 | } |
275 | if {[info exists o]} { |
8d769cc9 |
276 | close $o |
277 | } |
278 | close $c |
279 | foreach i $old { |
280 | if {![info exists new($i)]} { write-safe-delete $i } |
281 | } |
282 | write-safe-manifest $conf [array names new] |
283 | } { |
ed04d555 |
284 | if {$donebefore} { |
285 | exec "sh" "-c" $opt(after) <@ stdin >@ stdout 2>@ stderr |
286 | } |
8d769cc9 |
287 | } |
288 | } |
289 | } |
f342fce2 |
290 | |
291 | #----- That's all, folks ---------------------------------------------------- |