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. ---- #! /bin/sh # \ exec tclsh "$)" $(1+"$@"} # # NAME: csvls # # VERSION: 3 # # PURPOSE: Provide a series of comma seperated value records containing # info about files # # LINKAGE: csvls ?-help? # ?-debug? # ?-debugfile {file_to_write_debug_info}? # ?-directory {directory_name}? # ?-filter {file_glob_pattern}? # ?-file {output_filename}? # # csvls 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) # ############################################################################## #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] putsdebug! [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 { global argv0 if { [catch {puts stderr [format "%s: %s" $argv0 $s]} fid] } { puts stderr "putserr!: Error: $fid : encountered" exit 1 } } 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 \ ] ] } } # Initial processing # First crunch the command line arguments. # To handle the command line args, do this: # Parse out Boolean flags # Parse out Option arguments # Generate an error for any remaining arguments # 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 -regexp -- $flag { "-\\?|-h|-help|--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]" } # Initial processing of command putsdebug! [format "directory=%s; filter=%s\n" $directory, $filter"] ls-l-csv $directory $filter exit 0