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\t$argv0 \[-s\] FILE\n\t$argv0 -u OUTPUT FILE FILE ..."
24 # clear-arrays ARRAY ...
26 # Make each named ARRAY exist and be empty.
28 proc clear-arrays {args} {
36 #------ Write-safe ----------------------------------------------------------
38 # write-safe STUFF [TIDY]
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.
44 proc write-safe {stuff {tidy {}}} {
45 global _ws_close _ws_del _ws_new
46 clear-arrays _ws_del _ws_new
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 }
57 foreach f $_ws_close { catch { close $f } }
59 foreach f [concat [array names _ws_old] [array names _ws_del]] {
63 foreach f [array names all] {
64 if {[file exists $f]} {
66 file copy -force -- $f $f.old
70 foreach f [array names _ws_new] { file rename -force -- $f.new $f }
71 foreach f [array names _ws_del] { file delete -- $f }
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 }
78 foreach i [array names all] { catch { file delete -- $i.old } }
79 catch { uplevel 1 $tidy }
83 # write-safe-open NAME [TRANS]
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.
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
100 # write-safe-delete NAME
102 # Delete file NAME. The file isn't actually removed until the enclosing
103 # write-safe completes.
105 proc write-safe-delete {name} {
110 # write-safe-file NAME CONTENTS [TRANS]
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.
116 proc write-safe-file {name contents {trans auto}} {
117 set f [write-safe-open $name $trans]
118 puts -nonewline $f $contents
122 # read-file NAME [TRANS]
124 # Evaluates to the contents of the file NAME under translation mode TRANS
127 proc read-file {name {trans auto}} {
129 fconfigure $f -translation $trans
135 #----- Splitconf-specific stuff ---------------------------------------------
137 # write-safe-manifest F L
139 # Writes the list of filenames L to the manifest file associated with config
142 proc write-safe-manifest {f l} {
143 set f [write-safe-open $f.files]
144 foreach i $l { puts $f $i }
150 # Returns the filenames in the current manifest of the config file CONF.
152 proc old-files {conf} {
154 if {[file exists $conf.files]} {
155 set f [open $conf.files]
156 while {[gets $f line] >= 0} { lappend old $line }
162 #----- Main code ------------------------------------------------------------
165 while {[llength $argv]} {
166 switch -glob -- [lindex $argv 0] {
169 if {[llength $argv] < 2} { die "option `-u' needs an argument" }
170 set output [lindex $argv 1]
171 set argv [lrange $argv 1 end]
173 "-d" - "--delete" { set job "delete" }
174 "-s" - "--split" { set job "split" }
175 "-h" - "--help" { usage stdout; exit 0 }
177 "--" { set argv [lrange $argv 1 end]; break }
178 "-*" { die "unknown option `[lindex $argv 0]'"; exit 1 }
181 set argv [lrange $argv 1 end]
193 set f "\#\# automatically generated by splitconf\n\n"
198 append f "\[$i\]\n$c\n"
205 write-safe-file $output $f
206 write-safe-manifest $output $ff
210 if {[llength $argv] != 1} { die "need exactly one filename" }
211 set conf [lindex $argv 0]
212 set old [old-files $conf]
214 foreach i $old { write-safe-delete $i }
215 write-safe-delete $conf.files
219 if {[llength $argv] != 1} { die "need exactly one filename" }
220 set conf [lindex $argv 0]
221 set old [old-files $conf]
228 while {[gets $c line] >= 0} {
229 if {[regexp -- {^\[(.*)\]\s*$} $line . name]} {
230 if {[info exists o]} { close $o }
231 if {[string equal $name ""]} {
235 exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
238 set name "$opt(prefix)$name"
239 set o [write-safe-open $name]
243 } elseif {[info exists o]} {
244 switch -regexp -- $line {
245 {^\s*$} { append spill "$line\n" }
248 puts -nonewline $o "$spill[string range $line 1 end]\n"
251 default { puts -nonewline $o "$spill$line\n"; set spill "" }
253 } elseif {[regexp -- {^\s*(\#|$)} $line]} {
255 } elseif {[regexp -- \
256 {^\s*([-./\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} {
257 if {![info exists opt($k)]} {
258 error "unknown configuration option `$k'"
262 } elseif {[regexp -- \
263 {^\s*([-./\w]+)\s*:\s*(.*\S|)\s*$} $line . name d]} {
265 exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
268 set name "$opt(prefix)$name"
270 write-safe-file $name "$d\n"
272 error "unknown preamble directive"
275 if {[info exists o]} {
280 if {![info exists new($i)]} { write-safe-delete $i }
282 write-safe-manifest $conf [array names new]
285 exec "sh" "-c" $opt(after) <@ stdin >@ stdout 2>@ stderr
291 #----- That's all, folks ----------------------------------------------------