Robustify.

[misc] / splitconf

#! /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)
    }
  }
}