Formatting file information in CSV

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)
 #
 # If no error is found, an entry similar to the following is output:
 # YOURFILTER,0,-1,-1,n---------,0,0,Dec,31,1969,no_file,0,0,0,0,0,
 #
 ##############################################################################
 
 #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 -directory $directory -- $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$" {
                  putsdebug! "flag matches help case"
                  putserr! "[format "USAGE: ?-directory dirName? ?-filter globPat? ?-file fileName? ?-debug? ?-debugfile fileName?"]"
                   exit 1
                   }
           "-debug" {
                   set debug 1
                   set argv [lrange $argv 1 end]
                   putsdebug! "flag matches debug case"
                     }
           "-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]
                  }

            "-*" {
                    putserr! [format "Invalid flag .%s." $flag ]
                    set argv [lrange $argv 1 end]
                }

            default {
                  putsdebug! "default case"
                  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

 # test cases:
 # csvls
 #      should produce on stdout a series of lines about each file in the
 #      current directory
 # csvls -debug
 #      should produce on stdout a series of lines about each file in the
 #      current directory, along with a series of debug msgs to stderr
 # csvls -filter '.*'
 #      should produce on stdout a series of lines about each file in the
 #      current directory that begins with a period
 # csvls -directory /tmp
 #      should produce on stdout a series of lines about each file in the
 #      /tmp directory 
 # csvls -directory /tmp -filter '*a*'
 #      should produce on stdout a series of lines about each file in the
 #      /tmp directory which contains an a in its name
 # csvls -directory /tmp -filter '*a*' -file /tmp/stuff
 #      should produce in /tmp/stuff a series of lines about each file in the
 #      /tmp directory which contains an a in its name
 # csvls -h
 #      should produce a usage statement
 # csvls -j
 #      should produce an error statement about invalid flag
 # csvls -directory /something_not_there
 #      should produce an error statement about invalid directory