[iTCL] globbing example
Press quote to get more readable version of source..
set mtab "d:/ioFTPD/etc/default.vfs"
set gpath "/home/"
# Load mount table
if { [catch { mountfile open $mtab }] != 0 } {
putlog "Warning! Script failed to load $mtab"
return 1
}
# Resolve root (sanity check)
if { [catch { set path [resolve pwd $gpath]}] != 0 } {
putlog "Warning! Failed to resolve $gpath"
return 1
}
unset path
# Globber proc
proc symglobber { vpath depth } {
# Limit max globbing depth
if { [incr depth] > 5 } { return 1 }
# Resolve path
if { [catch { set path [resolve pwd $vpath]}] != 0 } { return 1 }
# Resolve link
if { [catch { set result [glob -types d $path/*]}] != 0 } { return 1 }
set lpath [string length $path]
foreach item $result {
# Get context
if { [catch { set ldest [vfs chattr $item 1]}] != 0 } { return 1 }
# Check context
if { "$ldest" != "(null)" } {
# Resolve destination
if { [string index $ldest 0] == "/" } {
# Link is not relative to current directory
if { [catch { set dpath [resolve pwd $ldest]}] != 0 } { return 1 }
} else {
if { [catch { set dpath [resolve $vpath/$ldest]}] != 0 } { return 1 }
}
# Delete inexistant links
if {$dpath == "" || [file exists $dpath] == 0} {
catch { file delete $item/.ioFTPD }
if { [catch { file delete $item}] == 0} {
iputs "Removed $item"
} else {
iputs "Unexpected error while deleting $item"
}
}
} else {
# Get new virtual path
set litem [string length $item]
set newvpath $vpath[string range $item $lpath end]
# Glob subdirectory
symglobber $newvpath $depth
}
}
}
symglobber $gpath 0
|