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 0JMN 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.
