+#! /usr/bin/tclsh
+
+proc die {msg} {
+ global argv0
+ puts stderr "$argv0: $msg"
+ exit 1
+}
+
+proc usage {file} {
+ global argv0
+ puts $file "Usage: \n\
+ $argv0 [-s] FILE\n
+ $argv0 -u OUTPUT FILE FILE ..."
+}
+
+set job "split"
+while {[llength $argv]} {
+ switch -glob -- [lindex $argv 0] {
+ "-u" - "--unsplit" {
+ set job "unsplit"
+ if {[llength $argv] < 2} { die "option `-u' needs an argument" }
+ set output [lindex $argv 1]
+ set argv [lrange $argv 1 end]
+ }
+ "-d" - "--delete" { set job "delete" }
+ "-s" - "--split" { set job "split" }
+ "-h" - "--help" { usage stdout; exit 0 }
+ "-" { break }
+ "--" { set argv [lrange $argv 1 end]; break }
+ "-*" { die "unknown option `[lindex $argv 0]'"; exit 1 }
+ default { break }
+ }
+ set argv [lrange $argv 1 end]
+}
+
+proc clear-arrays {args} {
+ foreach i $args {
+ upvar 1 $i v
+ unset i
+ array set v {}
+ }
+}
+
+proc write-safe {stuff {tidy {}}} {
+ global _ws_close _ws_del _ws_new
+ clear-arrays _ws_del _ws_new
+ set _ws_close {}
+
+ if {[set rc [catch {
+ uplevel 1 $stuff
+ } err]]} {
+ foreach f $_ws_close { catch { close $f } }
+ foreach f [array names _ws_new] { catch { file delete -- $f.new } }
+ catch { uplevel 1 $tidy }
+ return -code $rc $err
+ }
+ foreach f $_ws_close { catch { close $f } }
+ clear-arrays all
+ foreach f [concat [array names _ws_old] [array names _ws_del]] {
+ set all($f) 0
+ }
+ if {[set rc [catch {
+ foreach f [array names all] {
+ if {[file exists $f]} {
+ file delete -- $f.old
+ file copy -force -- $f $f.old
+ }
+ set old($f) 0
+ }
+ foreach f [array names _ws_new] { file rename -force -- $f.new $f }
+ foreach f [array names _ws_del] { file delete -- $f }
+ } err]]} {
+ foreach f [array names _ws_new] { catch { file delete -- $f.new } }
+ foreach f [array names old] { file rename -force -- $f.old $f }
+ catch { uplevel 1 $tidy }
+ return -code $rc $err
+ }
+ foreach i [array names all] { catch { file delete -- $i.old } }
+ catch { uplevel 1 $tidy }
+ return {}
+}
+
+proc write-safe-open {name {trans auto}} {
+ global _ws_close _ws_new
+ if {[file isdirectory $name]} { error "`$name' is a directory" }
+ set f [open $name.new w]
+ fconfigure $f -translation $trans
+ lappend _ws_close $f
+ set _ws_new($name) 0
+ return $f
+}
+
+proc write-safe-delete {name} {
+ global _ws_del
+ set _ws_del($name) 0
+}
+
+proc write-safe-file {name contents {trans auto}} {
+ set f [write-safe-open $name $trans]
+ puts -nonewline $f $contents
+ close $f
+}
+
+proc read-file {name {trans auto}} {
+ set f [open $name]
+ fconfigure $f -translation $trans
+ set c [read $f]
+ close $f
+ return $c
+}
+
+proc write-safe-manifest {f l} {
+ set f [write-safe-open $f.files]
+ foreach i $l { puts $f $i }
+ close $f
+}
+
+proc old-files {conf} {
+ set old {}
+ if {[file exists $conf.files]} {
+ set f [open $conf.files]
+ while {[gets $f line] >= 0} { lappend old $line }
+ close $f
+ }
+ return $old
+}
+
+set rc 0
+clear-arrays opt
+array set opt {
+ prefix ""
+ before ""
+ after ""
+}
+switch $job {
+ "unsplit" {
+ set f "\#\# automatically generated by splitconf\n\n"
+ set ff {}
+ foreach i $argv {
+ if {[catch {
+ set c [read-file $i]
+ append f "\[$i\]\n$c\n"
+ lappend ff $i
+ } msg]} {
+ set rc 1
+ }
+ }
+ write-safe {
+ write-safe-file $output $f
+ write-safe-manifest $output $ff
+ }
+ }
+ "delete" {
+ if {[llength $argv] != 1} { die "need exactly one filename" }
+ set conf [lindex $argv 0]
+ set old [old-files $conf]
+ write-safe {
+ foreach i $old { write-safe-delete $i }
+ write-safe-delete $conf.files
+ }
+ }
+ "split" {
+ if {[llength $argv] != 1} { die "need exactly one filename" }
+ set conf [lindex $argv 0]
+ set old [old-files $conf]
+ set c [open $conf r]
+ catch { unset o }
+ set file ""
+ set spill ""
+ array set new {}
+ write-safe {
+ while {[gets $c line] >= 0} {
+ if {[regexp -- {^\[(.*)\]\s*$} $line . name]} {
+ if {[info exists o]} {
+ puts -nonewline $o $file
+ close $o
+ } else {
+ exec "sh" "-c" $opt(before)
+ }
+ set name "$opt(prefix)$name"
+ set o [write-safe-open $name]
+ set new($name) 1
+ set file ""
+ set spill ""
+ } elseif {[info exists o]} {
+ switch -regexp -- $line {
+ {^\s*$} { append spill "$line\n" }
+ {^\#\#} { }
+ {^\!} { append file "$spill[string range $line 1 end]\n" }
+ default { append file "$spill$line\n" }
+ }
+ } elseif {[regexp -- {^\s*(\#|$)} $line]} {
+ continue
+ } elseif {[regexp -- {^\s*([-\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} {
+ if {![info exists opt($k)]} {
+ error "unknown configuration option `$k'"
+ } else {
+ set opt($k) $v
+ }
+ } else {
+ error "unknown preamble directive"
+ }
+ }
+ if {[info exists o]} {
+ puts -nonewline $o $file
+ close $o
+ }
+ close $c
+ foreach i $old {
+ if {![info exists new($i)]} { write-safe-delete $i }
+ }
+ write-safe-manifest $conf [array names new]
+ } {
+ exec "sh" "-c" $opt(after)
+ }
+ }
+}