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