1 2package provide vfs::test 1.0 3 4package require vfs 1.0 5 6namespace eval vfs::test {} 7 8proc vfs::test::Mount {what local} { 9 vfs::filesystem mount $local [list ::vfs::test::handler $what] 10 vfs::RegisterMount $local [list ::vfs::test::Unmount] 11} 12 13proc vfs::test::Unmount {local} { 14 vfs::filesystem unmount $local 15} 16 17proc vfs::test::handler {what cmd root relative actualpath args} { 18 eval [list $cmd $what $relative] $args 19} 20 21# If we implement the commands below, we will have a perfect 22# virtual file system. 23 24proc vfs::test::stat {what name} { 25 puts "stat $name" 26} 27 28proc vfs::test::access {what name mode} { 29 puts "access $name $mode" 30} 31 32proc vfs::test::open {what name mode permissions} { 33 puts "open $name $mode $permissions" 34 # return a list of two elements: 35 # 1. first element is the Tcl channel name which has been opened 36 # 2. second element (optional) is a command to evaluate when 37 # the channel is closed. 38 return [list] 39} 40 41proc vfs::test::matchindirectory {what path pattern type} { 42 puts "matchindirectory $path $pattern $type" 43 set res [list] 44 45 if {[::vfs::matchDirectories $type]} { 46 # add matching directories to $res 47 } 48 49 if {[::vfs::matchFiles $type]} { 50 # add matching files to $res 51 } 52 return $res 53} 54 55proc vfs::test::createdirectory {what name} { 56 puts "createdirectory $name" 57} 58 59proc vfs::test::removedirectory {what name recursive} { 60 puts "removedirectory $name" 61} 62 63proc vfs::test::deletefile {what name} { 64 puts "deletefile $name" 65} 66 67proc vfs::test::fileattributes {what args} { 68 puts "fileattributes $args" 69 switch -- [llength $args] { 70 0 { 71 # list strings 72 } 73 1 { 74 # get value 75 set index [lindex $args 0] 76 } 77 2 { 78 # set value 79 set index [lindex $args 0] 80 set val [lindex $args 1] 81 } 82 } 83} 84 85proc vfs::test::utime {what name actime mtime} { 86 puts "utime $name" 87} 88