From 3f222c0834625e603c2a511aa03fd0153714e0e1 Mon Sep 17 00:00:00 2001 From: Jean-Claude Wippler Date: Thu, 22 Jun 2006 16:14:37 +0000 Subject: [PATCH] updated vfs::mkcl to 1.4 --- ChangeLog | 4 ++ library/mkclvfs.tcl | 92 ++++++++++++++++++++++++-------------------- library/pkgIndex.tcl | 2 +- pkgIndex.tcl.in | 2 +- 4 files changed, 56 insertions(+), 44 deletions(-) diff --git a/ChangeLog b/ChangeLog index c04a2ea..e3658f4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2006-06-22 Jean-Claude Wippler + + * library/mkclvfs.tcl: Updated to latest 1.4 revision + 2006-05-26 Jeff Hobbs * generic/vfs.c (VfsOpenFileChannel): handle closing channels that diff --git a/library/mkclvfs.tcl b/library/mkclvfs.tcl index 9c898b0..642e4ab 100644 --- a/library/mkclvfs.tcl +++ b/library/mkclvfs.tcl @@ -1,18 +1,17 @@ # mkclvfs.tcl -- Metakit Compatible Lite Virtual File System driver # Rewritten from mk4vfs.tcl, orig by by Matt Newman and Jean-Claude Wippler -# $Id$ # 1.0 initial release -# 1.1 view size renamed to count, vlerq package renamed to thrill -# 1.2 replace view calls by vget (simpler and slightly faster) +# 1.1 view size renamed to count +# 1.2 replace view calls by vget (simpler and faster) +# 1.3 modified to use the vlerq extension i.s.o. thrive +# 1.4 minor cleanup -package provide vfs::mkcl 1.2 +package provide vfs::mkcl 1.4 package require vfs -package require thrill +package require vlerq namespace eval vfs::mkcl { - namespace import ::thrill::* - namespace eval v { variable seq 0 ;# used to generate a unique db handle variable rootv ;# maps handle to root view (well, actually "dirs") @@ -23,9 +22,9 @@ namespace eval vfs::mkcl { # public proc Mount {mkfile local args} { set db mkclvfs[incr v::seq] - set v::rootv($db) [vget [vopen $mkfile] 0 dirs] - set v::dname($db) [vget $v::rootv($db) * 0] - set v::prows($db) [vget $v::rootv($db) * 1] + set v::rootv($db) [view $mkfile mapf | get 0 dirs] + set v::dname($db) [vget $v::rootv($db) * name] + set v::prows($db) [vget $v::rootv($db) * parent] ::vfs::filesystem mount $local [list ::vfs::mkcl::handler $db] ::vfs::RegisterMount $local [list ::vfs::mkcl::Unmount $db] return $db @@ -54,26 +53,35 @@ namespace eval vfs::mkcl { foreach e $elems { set r "" foreach r [lsearch -exact -int -all $v::prows($db) $parent] { - if {$e eq [lindex $v::dname($db) $r]} { - set parent $r - incr remain -1 - break - } + if {$e eq [lindex $v::dname($db) $r]} { + set parent $r + incr remain -1 + break + } } if {$parent != $r} { - if {$remain == 1} { - set files [vget $dirs $parent 2] - set i [lsearch -exact [vget $files * 0] $e] - if {$i >= 0} { - # evaluating this 3-item result returns the info about one file - return [list vget $files $i] - } - } - fail ENOENT + if {$remain == 1} { + set files [vget $dirs $parent files] + if 1 { + set i [lsearch -exact [vget $files * name] $e] + if {$i >= 0} { + # evaluating this 3-item result returns the info about one file + return [list vget $files $i] + } + } else { + view $files loop { + if {$(name) eq $e} { + # evaluating this 3-item result returns the info about one file + return [list vget $files $(#)] + } + } + } + } + fail ENOENT } } # evaluating this 4-item result returns the files subview - return [list vget $dirs $parent 2] + return [list vget $dirs $parent files] } proc isDir {tag} { return [expr {[llength $tag] == 4}] @@ -86,21 +94,21 @@ namespace eval vfs::mkcl { if {$pattern ne ""} { set c {} if {[isDir $tag]} { - # collect file names - if {$type & 16} { - set c [eval [linsert $tag end * 0]] - } - # collect directory names - if {$type & 4} { - foreach r [lsearch -exact -int -all $v::prows($db) [lindex $tag 2]] { - lappend c [lindex $v::dname($db) $r] - } - } + # collect file names + if {$type & 16} { + set c [eval [linsert $tag end * 0]] + } + # collect directory names + if {$type & 4} { + foreach r [lsearch -exact -int -all $v::prows($db) [lindex $tag 2]] { + lappend c [lindex $v::dname($db) $r] + } + } } foreach x $c { - if {[string match $pattern $x]} { - lappend o [file join $actual $x] - } + if {[string match $pattern $x]} { + lappend o [file join $actual $x] + } } } elseif {$type & ([isDir $tag]?4:16)} { set o [list $actual] @@ -111,7 +119,7 @@ namespace eval vfs::mkcl { switch -- [llength $args] { 0 { return [::vfs::listAttributes] } 1 { set index [lindex $args 0] - return [::vfs::attributesGet $root $path $index] } + return [::vfs::attributesGet $root $path $index] } 2 { fail EROFS } } } @@ -119,7 +127,7 @@ namespace eval vfs::mkcl { if {$mode ne "" && $mode ne "r"} { fail EROFS } set tag [lookUp $db $file] if {[isDir $tag]} { fail ENOENT } - foreach {name size date contents} [eval $tag] break + foreach {name size date contents} [eval $tag *] break if {[string length $contents] != $size} { set contents [vfs::zip -mode decompress $contents] } @@ -142,11 +150,11 @@ namespace eval vfs::mkcl { set s 0 set d 0 set c "" - incr l [eval [linsert $tag end #]] + incr l [eval [linsert $tag -1 #]] incr l [llength [lsearch -exact -int -all $v::prows($db) [lindex $tag 2]]] } else { set t file - foreach {n s d c} [eval $tag] break + foreach {n s d c} [eval $tag *] break } return [list type $t size $s atime $d ctime $d mtime $d nlink $l \ csize [string length $c] gid 0 uid 0 ino 0 mode 0777] diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl index 47b5e79..a20fd46 100644 --- a/library/pkgIndex.tcl +++ b/library/pkgIndex.tcl @@ -56,7 +56,7 @@ package ifneeded zipvfs 1.0 [list source [file join $dir zipvfs.tcl]] package ifneeded vfs::ftp 1.0 [list source [file join $dir ftpvfs.tcl]] package ifneeded vfs::http 0.5 [list source [file join $dir httpvfs.tcl]] package ifneeded vfs::mk4 1.10 [list source [file join $dir mk4vfs.tcl]] -package ifneeded vfs::mkcl 1.2 [list source [file join $dir mkclvfs.tcl]] +package ifneeded vfs::mkcl 1.4 [list source [file join $dir mkclvfs.tcl]] package ifneeded vfs::ns 0.5 [list source [file join $dir tclprocvfs.tcl]] package ifneeded vfs::tar 0.9 [list source [file join $dir tarvfs.tcl]] package ifneeded vfs::test 1.0 [list source [file join $dir testvfs.tcl]] diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in index 0e30a94..6984f58 100644 --- a/pkgIndex.tcl.in +++ b/pkgIndex.tcl.in @@ -40,7 +40,7 @@ package ifneeded zipvfs 1.0 [list source [file join $dir zipvfs.tcl]] package ifneeded vfs::ftp 1.0 [list source [file join $dir ftpvfs.tcl]] package ifneeded vfs::http 0.5 [list source [file join $dir httpvfs.tcl]] package ifneeded vfs::mk4 1.10 [list source [file join $dir mk4vfs.tcl]] -package ifneeded vfs::mkcl 1.2 [list source [file join $dir mkclvfs.tcl]] +package ifneeded vfs::mkcl 1.4 [list source [file join $dir mkclvfs.tcl]] package ifneeded vfs::ns 0.5 [list source [file join $dir tclprocvfs.tcl]] package ifneeded vfs::tar 0.9 [list source [file join $dir tarvfs.tcl]] package ifneeded vfs::test 1.0 [list source [file join $dir testvfs.tcl]] -- 2.23.0