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 parray! {a {pattern *}} { upvar 1 $a array if {![array exists array]} { error "\"$a\" isn't an array" } set maxl 0 foreach name [lsort [array names array $pattern]] { if {[string length $name] > $maxl} { set maxl [string length $name] } } set maxl [expr {$maxl + [string length $a] + 2}] foreach name [lsort [array names array $pattern]] { set nameString [format %s(%s) $a $name] puts stderr [format "%-*s = %s" $maxl $nameString $array($name)] } } 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] # This mess is intended to help me work around the weird cases # that arise with symbolic links 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 } { # This handles the case of a pattern which matches nothing 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 { # This handles the case of a pattern which matches # a stale/orphan link 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 putsdebug! "setting csv record" parray! stats 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)