Version 1 of Formatting file information in CSV

Updated 2001-06-22 14:07:23

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)