3 #----- Miscellaneous utilities ----------------------------------------------
7 # Something didn't work. Exit right now.
11 puts stderr "$argv0: $msg"
17 # Write a usage message to FILE, which is a file handle.
21 puts $file "Usage: \n\
23 $argv0 -u OUTPUT FILE FILE ..."
26 # clear-arrays ARRAY ...
28 # Make each named ARRAY exist and be empty.
30 proc clear-arrays {args} {
38 #------ Write-safe ----------------------------------------------------------
40 # write-safe STUFF [TIDY]
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.
46 proc write-safe {stuff {tidy {}}} {
47 global _ws_close _ws_del _ws_new
48 clear-arrays _ws_del _ws_new
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 }
59 foreach f $_ws_close { catch { close $f } }
61 foreach f [concat [array names _ws_old] [array names _ws_del]] {
65 foreach f [array names all] {
66 if {[file exists $f]} {
68 file copy -force -- $f $f.old
72 foreach f [array names _ws_new] { file rename -force -- $f.new $f }
73 foreach f [array names _ws_del] { file delete -- $f }
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 }
80 foreach i [array names all] { catch { file delete -- $i.old } }
81 catch { uplevel 1 $tidy }
85 # write-safe-open NAME [TRANS]
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.
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
102 # write-safe-delete NAME
104 # Delete file NAME. The file isn't actually removed until the enclosing
105 # write-safe completes.
107 proc write-safe-delete {name} {
112 # write-safe-file NAME CONTENTS [TRANS]
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.
118 proc write-safe-file {name contents {trans auto}} {
119 set f [write-safe-open $name $trans]
120 puts -nonewline $f $contents
124 # read-file NAME [TRANS]
126 # Evaluates to the contents of the file NAME under translation mode TRANS
129 proc read-file {name {trans auto}} {
131 fconfigure $f -translation $trans
137 #----- Splitconf-specific stuff ---------------------------------------------
139 # write-safe-manifest F L
141 # Writes the list of filenames L to the manifest file associated with config
144 proc write-safe-manifest {f l} {
145 set f [write-safe-open $f.files]
146 foreach i $l { puts $f $i }
152 # Returns the filenames in the current manifest of the config file CONF.
154 proc old-files {conf} {
156 if {[file exists $conf.files]} {
157 set f [open $conf.files]
158 while {[gets $f line] >= 0} { lappend old $line }
164 #----- Main code ------------------------------------------------------------
167 while {[llength $argv]} {
168 switch -glob -- [lindex $argv 0] {
171 if {[llength $argv] < 2} { die "option `-u' needs an argument" }
172 set output [lindex $argv 1]
173 set argv [lrange $argv 1 end]
175 "-d" - "--delete" { set job "delete" }
176 "-s" - "--split" { set job "split" }
177 "-h" - "--help" { usage stdout; exit 0 }
179 "--" { set argv [lrange $argv 1 end]; break }
180 "-*" { die "unknown option `[lindex $argv 0]'"; exit 1 }
183 set argv [lrange $argv 1 end]
195 set f "\#\# automatically generated by splitconf\n\n"
200 append f "\[$i\]\n$c\n"
207 write-safe-file $output $f
208 write-safe-manifest $output $ff
212 if {[llength $argv] != 1} { die "need exactly one filename" }
213 set conf [lindex $argv 0]
214 set old [old-files $conf]
216 foreach i $old { write-safe-delete $i }
217 write-safe-delete $conf.files
221 if {[llength $argv] != 1} { die "need exactly one filename" }
222 set conf [lindex $argv 0]
223 set old [old-files $conf]
230 while {[gets $c line] >= 0} {
231 if {[regexp -- {^\[(.*)\]\s*$} $line . name]} {
232 if {[info exists o]} {
234 } elseif {!$donebefore} {
235 exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
238 if {[string equal $name ""]} {
241 set name "$opt(prefix)$name"
242 set o [write-safe-open $name]
246 } elseif {[info exists o]} {
247 switch -regexp -- $line {
248 {^\s*$} { append spill "$line\n" }
251 puts -nonewline $o "$spill[string range $line 1 end]\n"
254 default { puts -nonewline $o "$spill$line\n"; set spill "" }
256 } elseif {[regexp -- {^\s*(\#|$)} $line]} {
258 } elseif {[regexp -- \
259 {^\s*([-./\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} {
260 if {![info exists opt($k)]} {
261 error "unknown configuration option `$k'"
265 } elseif {[regexp -- \
266 {^\s*([-./\w]+)\s*:\s*(.*\S|)\s*$} $line . name d]} {
268 exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
271 set name "$opt(prefix)$name"
273 write-safe-file $name "$d\n"
275 error "unknown preamble directive"
278 if {[info exists o]} {
283 if {![info exists new($i)]} { write-safe-delete $i }
285 write-safe-manifest $conf [array names new]
287 exec "sh" "-c" $opt(after) <@ stdin >@ stdout 2>@ stderr
292 #----- That's all, folks ----------------------------------------------------