chiark - git - mdw - misc/blob - splitconf

   1 #! /usr/bin/tclsh
   2
   3 proc die {msg} {
   4   global argv0
   5   puts stderr "$argv0: $msg"
   6   exit 1
   7 }
   8
   9 proc usage {file} {
  10   global argv0
  11   puts $file "Usage: \n\
  12         $argv0 [-s] FILE\n
  13         $argv0 -u OUTPUT FILE FILE ..."
  14 }
  15
  16 set job "split"
  17 while {[llength $argv]} {
  18   switch -glob -- [lindex $argv 0] {
  19     "-u" - "--unsplit" {
  20       set job "unsplit"
  21       if {[llength $argv] < 2} { die "option `-u' needs an argument" }
  22       set output [lindex $argv 1]
  23       set argv [lrange $argv 1 end]
  24     }
  25     "-d" - "--delete" { set job "delete" }
  26     "-s" - "--split" { set job "split" }
  27     "-h" - "--help" { usage stdout; exit 0 }
  28     "-" { break }
  29     "--" { set argv [lrange $argv 1 end]; break }
  30     "-*" { die "unknown option `[lindex $argv 0]'"; exit 1 }
  31     default { break }
  32   }
  33   set argv [lrange $argv 1 end]
  34 }
  35
  36 proc clear-arrays {args} {
  37   foreach i $args {
  38     upvar 1 $i v
  39     unset i
  40     array set v {}
  41   }
  42 }
  43
  44 proc write-safe {stuff {tidy {}}} {
  45   global _ws_close _ws_del _ws_new
  46   clear-arrays _ws_del _ws_new
  47   set _ws_close {}
  48
  49   if {[set rc [catch {
  50     uplevel 1 $stuff
  51   } err]]} {
  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 }
  55     return -code $rc $err
  56   }
  57   foreach f $_ws_close { catch { close $f } }
  58   clear-arrays all
  59   foreach f [concat [array names _ws_old] [array names _ws_del]] {
  60     set all($f) 0
  61   }
  62   if {[set rc [catch {
  63     foreach f [array names all] {
  64       if {[file exists $f]} {
  65         file delete -- $f.old
  66         file copy -force -- $f $f.old
  67       }
  68       set old($f) 0
  69     }
  70     foreach f [array names _ws_new] { file rename -force -- $f.new $f }
  71     foreach f [array names _ws_del] { file delete -- $f }
  72   } err]]} {
  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 }
  76     return -code $rc $err
  77   }
  78   foreach i [array names all] { catch { file delete -- $i.old } }
  79   catch { uplevel 1 $tidy }
  80   return {}
  81 }
  82
  83 proc write-safe-open {name {trans auto}} {
  84   global _ws_close _ws_new
  85   if {[file isdirectory $name]} { error "`$name' is a directory" }
  86   set f [open $name.new w]
  87   fconfigure $f -translation $trans
  88   lappend _ws_close $f
  89   set _ws_new($name) 0
  90   return $f
  91 }
  92
  93 proc write-safe-delete {name} {
  94   global _ws_del
  95   set _ws_del($name) 0
  96 }
  97
  98 proc write-safe-file {name contents {trans auto}} {
  99   set f [write-safe-open $name $trans]
 100   puts -nonewline $f $contents
 101   close $f
 102 }
 103
 104 proc read-file {name {trans auto}} {
 105   set f [open $name]
 106   fconfigure $f -translation $trans
 107   set c [read $f]
 108   close $f
 109   return $c
 110 }
 111
 112 proc write-safe-manifest {f l} {
 113   set f [write-safe-open $f.files]
 114   foreach i $l { puts $f $i }
 115   close $f
 116 }
 117
 118 proc old-files {conf} {
 119   set old {}
 120   if {[file exists $conf.files]} {
 121     set f [open $conf.files]
 122     while {[gets $f line] >= 0} { lappend old $line }
 123     close $f
 124   }
 125   return $old
 126 }
 127
 128 set rc 0
 129 clear-arrays opt
 130 array set opt {
 131   prefix ""
 132   before ""
 133   after ""
 134 }
 135 switch $job {
 136   "unsplit" {
 137     set f "\#\# automatically generated by splitconf\n\n"
 138     set ff {}
 139     foreach i $argv {
 140       if {[catch {
 141         set c [read-file $i]
 142         append f "\[$i\]\n$c\n"
 143         lappend ff $i
 144       } msg]} {
 145         set rc 1
 146       }
 147     }
 148     write-safe {
 149       write-safe-file $output $f
 150       write-safe-manifest $output $ff
 151     }
 152   }
 153   "delete" {
 154     if {[llength $argv] != 1} { die "need exactly one filename" }
 155     set conf [lindex $argv 0]
 156     set old [old-files $conf]
 157     write-safe {
 158       foreach i $old { write-safe-delete $i }
 159       write-safe-delete $conf.files
 160     }
 161   }
 162   "split" {
 163     if {[llength $argv] != 1} { die "need exactly one filename" }
 164     set conf [lindex $argv 0]
 165     set old [old-files $conf]
 166     set c [open $conf r]
 167     catch { unset o }
 168     set file ""
 169     set spill ""
 170     array set new {}
 171     write-safe {
 172       while {[gets $c line] >= 0} {
 173         if {[regexp -- {^\[(.*)\]\s*$} $line . name]} {
 174           if {[info exists o]} {
 175             puts -nonewline $o $file
 176             close $o
 177           } else {
 178             exec "sh" "-c" $opt(before)
 179           }
 180           set name "$opt(prefix)$name"
 181           set o [write-safe-open $name]
 182           set new($name) 1
 183           set file ""
 184           set spill ""
 185         } elseif {[info exists o]} {
 186           switch -regexp -- $line {
 187             {^\s*$} { append spill "$line\n" }
 188             {^\#\#} { }
 189             {^\!} { append file "$spill[string range $line 1 end]\n" }
 190             default { append file "$spill$line\n" }
 191           }
 192         } elseif {[regexp -- {^\s*(\#|$)} $line]} {
 193           continue
 194         } elseif {[regexp -- {^\s*([-\w]+)\s*=\s*(.*\S|)\s*$} $line . k v]} {
 195           if {![info exists opt($k)]} {
 196             error "unknown configuration option `$k'"
 197           } else {
 198             set opt($k) $v
 199           }
 200         } else {
 201           error "unknown preamble directive"
 202         }
 203       }
 204       if {[info exists o]} {
 205         puts -nonewline $o $file
 206         close $o
 207       }
 208       close $c
 209       foreach i $old {
 210         if {![info exists new($i)]} { write-safe-delete $i }
 211       }
 212       write-safe-manifest $conf [array names new]
 213     } {
 214       exec "sh" "-c" $opt(after)
 215     }
 216   }
 217 }