PURPOSE: Provide an example of the glob and file commands, particularly [file join] and [file stat].
The following little script does more or less the same thing as the Unix command:
ls -l $directory
except that it's written in Tcl.
proc ls-l { dir } {
# Get the current year, because the date format depends on it.
set thisYear [clock format [clock seconds] -format %Y]
# Walk the files in the given directory, accumulating lines
# in $retval
set retval {}
set sep {}
# In Tcl older than 8.3 use 'glob [file join $dir *]'
foreach fileName [lsort [glob -dir $dir *]] {
append retval $sep
set sep \n
# Get status of the file
#file stat $fileName stat
# use 'file lstat' instead: if the file is a symbolic link we don't want info about its target
file lstat $fileName stat
# Put in one character for file type. Use - for a plain file.
set type -
if { [info exists stat(type)]
&& [string compare file $stat(type)] } {
set type [string index $stat(type) 0]
}
append retval $type
# Decode $stat(mode) into permissions the way that ls does it.
foreach { mask pairs } {
00400 { 00400 r }
00200 { 00200 w }
04100 { 04100 s 04000 S 00100 x }
00040 { 00040 r }
00020 { 00020 w }
02010 { 02010 s 02000 S 00010 x }
00004 { 00004 r }
00002 { 00002 w }
01001 { 01001 t 01000 T 00001 x }
} {
set value [expr $stat(mode) & $mask]
set bit -
foreach { x b } $pairs {
if { $value == $x } {
set bit $b
}
}
append retval $bit
}
# Put in link count, user ID, and size. Note that the UID
# will be numeric. If you know how to back-translate this
# from Tcl, please feel free to edit it in!
# LV writes - use file userid and file groupid to convert the numbers back to names.
# I don't know what version of Tcl added those commands...
append retval [format %4d $stat(nlink)] { }
array set attribs [file attributes $fileName]
if {[info exists attribs(-owner)]} {
append retval [format %-8s $attribs(-owner)]
append retval [format %-8s $attribs(-group)]
} else {
append retval [format %8d $stat(uid)]
append retval [format %8d $stat(gid)]
}
append retval [format %9d $stat(size)]
# Put in the date. The current year is formatted differently
# from prior years.
set year [clock format $stat(mtime) -format "%Y"]
if { $year == $thisYear } {
set modified [clock format $stat(mtime) -format "%h %e %H:%M"]
} else {
set modified [clock format $stat(mtime) -format "%h %e %Y"]
}
# glennj: see note below
append retval { } $modified { }
# Finally, put in the file name, stripping off the directory.
append retval [file tail $fileName]
if {[string compare $stat(type) link] == 0} {
append retval " -> [file readlink $fileName]"
}
unset stat attribs
}
return $retval
}
puts [ls-l ~]glennj: According to solaris ls, the year is displayed if the mtime is greater than six months, so this might be better to display the mtime of the file:
set fmt {%b %e %H:%M}
if {$stat(mtime) < [clock scan "6 months ago"]} {
set fmt {%b %e %Y}
}
set modified [clock format $stat(mtime) -format $fmt]