Purpose: to gather various information about a file, format it into CSV (comma seperated value) format, and output it for processing by someone else. This work is intended to parallel Formatting ls information in XML, though there may be some features in one that haven't made it into the other version yet.
#! /usr/tcl84/bin/tclsh
#simple sample, produces a series of comma seperated value lines
# Date formatting by ls is somehow tricky, might be done in other ways
package require csv
proc formatpriv {args} {
global stats
# Put in one character for file type. Use - for a plain file.
set type -
if { [info exists stats(type) ]
&& [string compare "file" $stats(type)] } {
set type [string index $stats(type) 0]
}
append retval $type
# Decode $stats(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 {$stats(mode) & $mask}]
set bit -
foreach { x b } $pairs {
if { $value == $x } {
set bit $b
}
}
append retval $bit
}
return $retval
}
proc puts! s {global file;catch {puts $file $s}}
proc putserr! s {catch {puts stderr [format "%s: %s" $argv0 $s]}}
proc putsdebug! s {global debugfile debug;if { $debug } { puts $debugfile $s}}
proc ls-l-csv { {directory {.}} {pat {*}} } {
global stats
if { ! [file isdirectory $directory] } {
putserr! [format "Invalid directory: .%s." $directory]
return
}
if { ! [file executable $directory] } {
putserr! [format "Unable to access directory: .%s." $directory]
return
}
cd $directory
putsdebug! [format "currently in .%s." [pwd]]
putsdebug! [format "pat is .%s." $pat]
set special false
set redirect {}
set filelist {}
if { [catch {glob -- $pat} filelist] } {
set filelist $pat
putsdebug! [format "glob .%s. failed" $pat]
if { [catch {file readlink $pat} redirect] } {
putsdebug! [format "file readlink .%s. failed" $pat]
set filelist $pat
set special true
set redirect {}
}
}
putsdebug! [format "list is .%s." $filelist]
foreach i $filelist {
array unset stats
if { [file exists $i] } {
putsdebug! [format "existing name = .%s." $i]
array set stats [file attributes $i]
set redirect {}
if { [file type $i] == "link"} {
set i2 [file readlink $i]
if {[catch {glob -- $i2}]} {
set redirect {}
} else {
set redirect $i2
}
}
file lstat $i stats
} else {
putsdebug! [format "file .%s. does not exist" $i]
set stats(-group) -1
set stats(-owner) -1
set stats(-permissions) 000000
if { $special } {
set stats(atime) 0
set stats(ctime) 0
set stats(dev) 0
set stats(gid) -1
set stats(ino) 0
set stats(mode) 0000000
set stats(mtime) 0
set stats(nlink) 0
set stats(size) 0
set stats(type) "no_file"
set stats(uid) -1
} else {
file lstat $i stats
}
}
# stats(-group) = dept26
# stats(-owner) = lwv26
# stats(-permissions) = 040755
# stats(atime) = 992777043
# stats(ctime) = 992777307
# stats(dev) = 66586340
# stats(gid) = 288
# stats(ino) = 219026
# stats(mode) = 16877
# stats(mtime) = 992777307
# stats(nlink) = 103
# stats(size) = 12288
# stats(type) = directory
# stats(uid) = 203
set name [list $i]
set priv [formatpriv stats]
set links $stats(nlink)
set size $stats(size)
set uid $stats(-owner)
set gid $stats(-group)
set Mon [clock format $stats(mtime) -format %b]
set Day [clock format $stats(mtime) -format %d]
set Yr [clock format $stats(mtime) -format %Y]
set Type $stats(type)
puts! [ ::csv::join [list $name \
$size \
$uid \
$gid \
$priv \
[format %o $stats(mode)] \
$links \
$Mon \
$Day \
$Yr \
$Type \
$stats(atime) \
$stats(mtime) \
$stats(ctime) \
$stats(ino) \
$stats(dev) \
$redirect \
] ]
}
}
# To handle the command line args, do this:
# Parse out Boolean flags
# Parse out Option arguments
# For each remaining argument
# invoke ls-l-csv with appropriate arguments
set flag {}
set help 0
set directory {.}
set filter {*}
set file stdout
set debugfile stderr
set filename {}
set debug 0
# If this script was executed, and not just "source"'d, handle argv
if { [string compare [info script] $argv0] == 0} {
while {[llength $argv] > 0 } {
set flag [lindex $argv 0]
putsdebug! [format "flag = %s" $flag]
switch -- $flag {
"-help" {
putserr! "[format "USAGE: ?-directory dirName? ?-filter globPat? ?-file fileName? ?-debug? ?-debugfile fileName?"]"
exit 1
}
"-debug" {
set debug 1
set argv [lrange $argv 1 end]
}
"-directory" {
set directory [lindex $argv 1]
putsdebug! [format "directory is %s" $directory]
set argv [lrange $argv 2 end]
}
"-filter" {
set filter [lindex $argv 1]
putsdebug! [format "filter is %s" $filter]
set argv [lrange $argv 2 end]
}
"-file" {
set filename [lindex $argv 1]
putsdebug! [format "filename is %s" $filename]
if { [file isdirectory $filename] } {
putsdebug! "filename is a directory"
putserr! [format "file must not be directory: .%s." $filename]
exit 2
}
if { [file exists $filename] && ! [file writable $filename] } {
putsdebug! "filename is not writable"
putserr! [format "file must be writable: .%s." $filename]
exit 3
}
set file [open $filename "w"]
putsdebug! "filename is open"
set argv [lrange $argv 2 end]
}
"-debugfile" {
set debugfilename [lindex $argv 1]
putsdebug! [format "debugfilename is %s" $debugfilename]
if { [file isdirectory $debugfilename] } {
putsdebug! "debugfilename is a directory"
putserr! [format "file must not be directory: .%s." $debugfilename]
exit 4
}
if { [file exists $debugfilename] && ! [file writable $debugfilename] } {
putsdebug! "debugfilename is not writable"
putserr! [format "file must be writable: .%s." $debugfilename]
exit 5
}
set debugfile [open $debugfilename "w"]
putsdebug! "debugfilename is open"
set argv [lrange $argv 2 end]
}
default { break }
}
}
}
if { [llength $argv] != 0 } {
putserr! "[format "WARNING! Extraneous arguments ignored; .%s." $argv]"
}
ls-l-csv $directory $filter
exit 0
# record layout is:
# filename
# file size
# file's owner
# file's group
# file's symbolic permission
# file's numeric permission
# Number of links to file
# File's Last Modification Month
# File's Last Modification Day
# File's Last Modification Year
# File type
# File's Last Access time stamp
# File's Last Modification time stamp
# File's "creation' time stamp
# File's inode number
# File's device number
# File to which symbolic link is pointing (or null string)