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