[iTCL] globbing example

[darkone]

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

[b>d>>s]

http://inferno.slug.org/cgi-bin/wiki?Du_In_Tcl

thats cool too. ^^ quite handy.