Purpose: Demo using [XML] style output for '''ls''' information.

----

[RS] wrote the basic structure of this, and [LV] did some hacking to extend it.  
Feel free to correct or extend this example to make it even more useful.  
See [Formatting file information in CSV] for a variation using the [tcllib] [csv] package.

----

 #! /usr/tcl83/bin/tclsh
 #simple sample, produces well-formed XML
 # Date formatting by ls is somehow tricky, might be done in other ways

 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-xml { {directory {.}} {pat {*}} } {
  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
  puts! <files>
  set filelist [glob -nocomplain $pat]
  if {[llength $filelist]} {
      foreach i [split [eval exec /bin/ls -dl $filelist] \n] {
        foreach {priv links uid gid size Mon Day Hr} [lrange $i 0 7] break
        set name [lrange $i 8 end] ;#name may contain whitespace.
        file lstat $name stat
        set Yr [clock format $stat(mtime) -format %Y]
        switch -regexp -- $priv {
            "^d" { set Type "directory" }
            "^-" { set Type "file" }
            "^l" { set Type "symbolic_link" }
            default { set Type $stat(type) }
        }
        puts! "<file \
              name=\"$name\" \
              size=\"$size\" \
              uid=\"$uid\" \
              gid=\"$gid\" \
              privstring=\"$priv\" \
              privnumeric=\"[format %o $stat(mode)]\" \
              links=\"$links\" \
              month=\"$Mon\" \
              day=\"$Day\" \
              year=\"$Yr\" \
              type=\"$Type\" \
              atime=\"$stat(atime)\" \
              mtime=\"$stat(mtime)\" \
              ctime=\"$stat(ctime)\" \
              inode=\"$stat(ino)\" \
              device=\"$stat(dev)\" \
              >"
      }
  }
  puts! </files>
 }

  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 outputFileName?"]"
                   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-xml $directory $filter

 exit 0

----
[JMN] 2005-12-04 Modified to produce valid xml (no error raised) for empty (or no filter match) directory, fixed argv0 to be global in putserr!, fixed to handle filenames containing whitespace.
Note also that this code can be used on windows if Cygwin ls is present by changing '/bin/ls' to 'ls' assuming it's on the path - also this could probably be rewritten to be more portable by removing the call to exec ls and retrieving info using 'file stat' etc.


----
[[
[Category XML] | [Category File]
]]