archive/install.tcl

   1 #!/bin/sh
   2 # comment \
   3 exec wish8.0 "$0" "$@"
   4 # this file extracts a bunch of files at the end of it
   5 # and then uses these.
   6 proc main { } {
   7     global argv0 argv files
   8     set done ""
   9     set fi [open $argv0 r]
  10     fconfigure $fi -translation binary
  11     set data [read $fi 2000]
  12     set outdir /tmp/jim
  13     assureExists $outdir directory
  14     while { [outputOneFile $fi $outdir] } { }
  15     if {[llength $done] > 0 } {
  16         puts "unpacked $done"
  17         exit 0
  18     } else {
  19         puts "failed"
  20         exit 1
  21     }
  22 }
  23
  24 proc outputOneFile {  stream outdir } {
  25     upvar 1 done done
  26     upvar 1 data data
  27     set exp  "\n>>>Begin (\[^ ]*) (\[0-9]+)\r?\n"
  28     puts "entering:[string length $data],[string range $data 0 200]"
  29     if { [regexp -indices $exp $data all] } {
  30         regexp $exp $data junk filename filesize
  31         set data [string range $data [expr 1 + [lindex $all 1]] end]
  32     } else { return 0 }
  33     set outfile [file join $outdir $filename]
  34     assureExists [file dirname $outfile] directory
  35     set ff [open $outfile w]
  36     fconfigure $ff -translation binary
  37     set remains $filesize
  38     while { 1 } {
  39         if { [string length $data] >= $remains } {
  40             puts -nonewline $ff [string range $data 0 [expr $remains -1]]
  41             set data [string range $data $remains end]
  42             lappend done [list $filename $filesize $outfile]
  43             close $ff
  44             return 1
  45         } else { puts -nonewline $ff $data
  46                  incr remains -[string length $data]
  47                   #puts "writing [string length $data]"
  48                  set data ""
  49         }
  50         set read [read $stream 5000]
  51         append data $read
  52         if { [string length $read] == 0 } {
  53             close $ff
  54             file delete $outfile
  55             error "Terminates in middle of reading $filename: remains $remains"
  56         }
  57     }
  58 }
  59
  60
  61
  62 proc assureExists { dir type } {
  63     if { [catch {file stat $dir stat} ] } {
  64         if { "$type" == "directory" } {
  65             file mkdir $dir
  66             return 1
  67         }
  68     }
  69     if { "$stat(type)" != "directory" }  {
  70         error "not a $type it is a $stat(type)"
  71 }   }
  72
  73
  74
  75 main
  76
  77
  78
  79
  80 >>>Begin xmcd.tgz 651163
  81 jimmy
  82
  83 >>>Begin billy 8
  84 hi there
  85
  86