#! /usr/bin/tclsh
+#----- Miscellaneous utilities ----------------------------------------------
+
+# die MSG
+#
+# Something didn't work. Exit right now.
+
proc die {msg} {
global argv0
puts stderr "$argv0: $msg"
exit 1
}
+# usage FILE
+#
+# Write a usage message to FILE, which is a file handle.
+
proc usage {file} {
global argv0
puts $file "Usage: \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]
-}
+# clear-arrays ARRAY ...
+#
+# Make each named ARRAY exist and be empty.
proc clear-arrays {args} {
foreach i $args {
}
}
+#------ Write-safe ----------------------------------------------------------
+
+# write-safe STUFF [TIDY]
+#
+# Do some safe I/O. If STUFF succeeds, do TIDY and commit the modifications;
+# otherwise, do TIDY and back out all the changes. See also write-safe-open,
+# write-safe-file and write-safe-delete.
+
proc write-safe {stuff {tidy {}}} {
global _ws_close _ws_del _ws_new
clear-arrays _ws_del _ws_new
return {}
}
+# write-safe-open NAME [TRANS]
+#
+# Open file NAME for writing, with the translation mode TRANS (default is
+# `auto'); return the file handle. The file NAME is not destroyed until the
+# changes are committed by an enclosing write-safe completing. You can close
+# the file handle if you like; write-safe will close it automatically anyway.
+
proc write-safe-open {name {trans auto}} {
global _ws_close _ws_new
if {[file isdirectory $name]} { error "`$name' is a directory" }
return $f
}
+# write-safe-delete NAME
+#
+# Delete file NAME. The file isn't actually removed until the enclosing
+# write-safe completes.
+
proc write-safe-delete {name} {
global _ws_del
set _ws_del($name) 0
}
+# write-safe-file NAME CONTENTS [TRANS]
+#
+# Write CONTENTS to FILE, using translation mode TRANS (default `auto'). The
+# file isn't actually replaced until the changes are committed by an
+# enclosing write-safe completing.
+
proc write-safe-file {name contents {trans auto}} {
set f [write-safe-open $name $trans]
puts -nonewline $f $contents
close $f
}
+# read-file NAME [TRANS]
+#
+# Evaluates to the contents of the file NAME under translation mode TRANS
+# (default `auto').
+
proc read-file {name {trans auto}} {
set f [open $name]
fconfigure $f -translation $trans
return $c
}
+#----- Splitconf-specific stuff ---------------------------------------------
+
+# write-safe-manifest F L
+#
+# Writes the list of filenames L to the manifest file associated with config
+# file F.
+
proc write-safe-manifest {f l} {
set f [write-safe-open $f.files]
foreach i $l { puts $f $i }
close $f
}
+# old-files CONF
+#
+# Returns the filenames in the current manifest of the config file CONF.
+
proc old-files {conf} {
set old {}
if {[file exists $conf.files]} {
return $old
}
+#----- Main code ------------------------------------------------------------
+
+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]
+}
+
set rc 0
clear-arrays opt
array set opt {
set old [old-files $conf]
set c [open $conf r]
catch { unset o }
- set file ""
set spill ""
+ set donebefore 0
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
+ } elseif {!$donebefore} {
+ exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
+ set donebefore 1
+ }
+ if {[string equal $name ""]} {
+ catch { unset o }
} else {
- exec "sh" "-c" $opt(before)
+ set name "$opt(prefix)$name"
+ set o [write-safe-open $name]
+ set new($name) 1
+ set spill ""
}
- 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" }
+ {^\!} {
+ puts -nonewline $o "$spill[string range $line 1 end]\n"
+ set spill ""
+ }
+ default { puts -nonewline $o "$spill$line\n"; set spill "" }
}
} elseif {[regexp -- {^\s*(\#|$)} $line]} {
continue
- } elseif {[regexp -- {^\s*([-\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} {
+ } 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
}
+ } elseif {[regexp -- \
+ {^\s*([-./\w]+)\s*:\s*(.*\S|)\s*$} $line . name d]} {
+ if {!$donebefore} {
+ exec "sh" "-c" $opt(before) <@ stdin >@ stdout 2>@ stderr
+ set donebefore 1
+ }
+ set name "$opt(prefix)$name"
+ set new($name) 1
+ write-safe-file $name "$d\n"
} else {
error "unknown preamble directive"
}
}
if {[info exists o]} {
- puts -nonewline $o $file
close $o
}
close $c
}
write-safe-manifest $conf [array names new]
} {
- exec "sh" "-c" $opt(after)
+ exec "sh" "-c" $opt(after) <@ stdin >@ stdout 2>@ stderr
}
}
}
+
+#----- That's all, folks ----------------------------------------------------
~mdw / misc / blobdiff