Somewhat like the UNIX command du - returns number of bytes, kilobytes, or megabytes in a directory hierarchy. Intentionally does NOT count links!!
proc du { args } {
switch -exact [ llength $args ] {
0 {
set dir .
set switch -k
}
1 {
set dir $args
set switch -k
}
2 {
set switch [ lindex $args 0 ]
set dir [ lindex $args 1 ]
}
default {
set msg "only one switch and one dir "
append msg "currently supported"
return -code error $msg
}
}
set switch [ string tolower $switch ]
set -b 1
set -k 1024
set -m [ expr 1024*1024 ]
set result [ list ]
if { ! [ file isdirectory $dir ] } {
set ary($dir,bytes) [ file size $dir ]
set globpats [ list ]
} else {
set globpats $dir/*
}
while { [ llength $globpats ] } {
foreach globpat $globpats {
set cwd [ string trim $globpat */ ]
set ary($cwd,bytes) 0
set files [ glob -nocomplain $globpat ]
set globpats [ list ]
foreach file $files {
if { ! [ catch {
file readlink $file
} ] } {
continue
}
if { [ file isdirectory $file ] } {
lappend globpats $file/*
} else {
incr ary($cwd,bytes) [ file size $file ]
}
}
}
}
set dirs [ array names ary ]
if { [ llength $dirs ] > 1 } {
foreach dir $dirs {
set dir [ lindex [ split $dir , ] 0 ]
foreach Dir $dirs {
set Dir [ lindex [ split $Dir , ] 0 ]
if { [ string match $dir/* $Dir ] } {
incr ary($dir,bytes) $ary($Dir,bytes)
}
}
}
}
foreach dir $dirs {
set name [ lindex [ split $dir , ] 0 ]
set size [ expr { $ary($dir) / [ set $switch ] } ]
lappend retval [ list $name $size ]
}
# copyright 2002 by The LIGO Laboratory
return $retval
}anyone that cares to may fill in the missing command line switches...