1# Determine "version" of a starkit, i.e. a unique signature 2# Jan 2003, jcw@equi4.com 3 4package require Tcl 8.5- 5package require Trf 6 7proc traverse {args} { 8 # the following call will throw an error for non-mk files 9 #set sig [mk::file end [lindex $args 0]] 10 # cannot use the above, it depends on file size, i.e. it sees commit gaps 11 # the real problem is that we need start i.s.o. end, which is not available 12 set sig 0 13 set mod 0 14 while {[llength $args] > 0} { 15 set d [lindex $args 0] 16 set args [lrange $args 1 end] 17 foreach path [lsort [glob -nocomplain [file join $d *]]] { 18 set t [file tail $path] 19 switch -- $t CVS - RCS - core - a.out continue 20 lappend sig $t 21 if {[file isdir $path]} { 22 lappend args $path 23 } else { 24 set m [file mtime $path] 25 if {$m > $mod} { set mod $m } 26 lappend sig $m [file size $path] 27 } 28 } 29 } 30 binary scan [::crc-zlib [join $sig " "]] n c 31 list $c $mod 32} 33 34proc showvers {fn {name ""}} { 35 lassign [traverse $fn] sig mod 36 set time [clock format $mod -format {%Y/%m/%d %H:%M:%S} -gmt 1] 37 set v [format {%s %d-%d %s} $time [expr {(($sig>>16) & 0xFFFF) + 10000}] \ 38 [expr {($sig & 0xFFFF) + 10000}] $name] 39 puts $v 40 return $mod 41} 42 43if {[llength $argv] == 0} { 44 showvers $starkit::topdir 45} else { 46 if {[llength $argv] > 1 && [lindex $argv 0] eq "-fixtime"} { 47 set fixtime 1 48 set argv [lrange $argv 1 end] 49 } 50 51 if {[llength $argv] < 1} { 52 puts stderr "usage: $argv0 ?-fixtime? file ..." 53 exit 1 54 } 55 56 foreach fn $argv { 57 if {[file isdir [file join $fn .]]} { 58 set mod [showvers $fn $fn] 59 if {[info exists fixtime] && $mod} { 60 file mtime $fn $mod 61 } 62 } elseif {[file exists $fn]} { 63 # the following call will throw an error for non-mk files 64 if {[catch { mk::file end $fn }]} { 65 puts stderr "$fn: not a starkit" 66 return 0 67 } 68 # symlinks don't seem to work as mount point, so expand them 69 set nf $fn 70 catch { set nf [file normalize [file join \ 71 [file dirname $fn] [file readlink $fn]]] } 72 vfs::mk4::Mount $nf $nf -readonly 73 set mod [showvers $nf $fn] 74 vfs::unmount $nf 75 if {[info exists fixtime] && $mod} { 76 file mtime $fn $mod 77 } 78 } else { 79 puts stderr "$fn: not found" 80 } 81 } 82} 83