#! /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