From: Vince Darley <vincentdarley@sourceforge.net>
Date: Wed, 15 Aug 2001 09:31:52 +0000 (+0000)
Subject: code cleanup
X-Git-Tag: vfs-1-2~124
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=30481686ec8d605b25a4a528a8cd0245f0710e6e;p=tclvfs

code cleanup
---

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 3ff9f1d..41f02ca 100644
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -129,7 +129,7 @@ proc vfs::mk4::handler {db cmd root relative actualpath args} {
 }
 
 proc vfs::mk4::utime {db path actime modtime} {
-    #puts [list utime $path]
+    #::vfs::log [list utime $path]
     ::mk4vfs::stat $db $path sb
     
     if { $sb(type) == "file" } {
@@ -141,21 +141,21 @@ proc vfs::mk4::utime {db path actime modtime} {
 # virtual file system for zip files.
 
 proc vfs::mk4::matchindirectory {db path actualpath pattern type} {
-    #puts stderr [list matchindirectory $path $actualpath $pattern $type]
+    #::vfs::log [list matchindirectory $path $actualpath $pattern $type]
     set res [::mk4vfs::getdir $db $path $pattern]
-    #puts stderr "got $res"
+    #::vfs::log "got $res"
     set newres [list]
     foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
 	lappend newres "$actualpath$p"
     }
-    #puts "got $newres"
+    #::vfs::log "got $newres"
     return $newres
 }
 
 proc vfs::mk4::stat {db name} {
-    #puts "stat $name"
+    #::vfs::log "stat $name"
     ::mk4vfs::stat $db $name sb
-    #puts [array get sb]
+    #::vfs::log [array get sb]
 
     # for new vfs:
     set sb(dev) 0
@@ -164,7 +164,7 @@ proc vfs::mk4::stat {db name} {
 }
 
 proc vfs::mk4::access {db name mode} {
-    #puts "mk4-access $name $mode"
+    #::vfs::log "mk4-access $name $mode"
     # This needs implementing better.  
     #tclLog "mk4vfs::driver $db access $name $mode"
     switch -- $mode {
@@ -198,7 +198,7 @@ proc vfs::mk4::access {db name mode} {
 }
 
 proc vfs::mk4::open {db file mode permissions} {
-    #puts "open $file $mode $permissions"
+    #::vfs::log "open $file $mode $permissions"
     # return a list of two elements:
     # 1. first element is the Tcl channel name which has been opened
     # 2. second element (optional) is a command to evaluate when
@@ -297,22 +297,22 @@ proc vfs::mk4::open {db file mode permissions} {
 }
 
 proc vfs::mk4::createdirectory {db name} {
-    #puts stderr "createdirectory $name"
+    #::vfs::log "createdirectory $name"
     mk4vfs::mkdir $db $name
 }
 
 proc vfs::mk4::removedirectory {db name} {
-    #puts stderr "removedirectory $name"
+    #::vfs::log "removedirectory $name"
     mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::deletefile {db name} {
-    #puts "deletefile $name"
+    #::vfs::log "deletefile $name"
     mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::fileattributes {db root relative args} {
-    #puts "fileattributes $args"
+    #::vfs::log "fileattributes $args"
     switch -- [llength $args] {
 	0 {
 	    # list strings
@@ -491,7 +491,7 @@ proc mk4vfs::stat {db path arr} {
     
     #foreach n [array names cache] {
     #if {[lsearch -exact $pre $n] == -1} {
-    #puts "added $path $n $cache($n)"
+    #::vfs::log "added $path $n $cache($n)"
     #}
     #}
 }
diff --git a/library/tclIndex b/library/tclIndex
index 73659ea..063c8b0 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -74,7 +74,6 @@ set auto_index(::vfs::test::deletefile) [list source [file join $dir testvfs.tcl
 set auto_index(::vfs::test::fileattributes) [list source [file join $dir testvfs.tcl]]
 set auto_index(::vfs::test::utime) [list source [file join $dir testvfs.tcl]]
 set auto_index(::vfs::debug) [list source [file join $dir vfs.tcl]]
-set auto_index(::vfs::log) [list source [file join $dir vfs.tcl]]
 set auto_index(::vfs::autoMountExtension) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::log) [list source [file join $dir vfsUtils.tcl]]
diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index 54455a6..aea4c62 100644
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -13,7 +13,7 @@ proc vfs::tclproc::Mount {ns local} {
     if {![namespace exists ::$ns]} {
 	error "No such namespace"
     }
-    puts "tclproc $ns mounted at $local"
+    ::vfs::log "tclproc $ns mounted at $local"
     vfs::filesystem mount $local [list vfs::tclproc::handler $ns]
     vfs::RegisterMount $local [list vfs::tclproc::Unmount]
 }
@@ -35,14 +35,12 @@ proc vfs::tclproc::handler {ns cmd root relative actualpath args} {
 # virtual file system for remote tclproc sites.
 
 proc vfs::tclproc::stat {ns name} {
-    puts stderr "stat $name"
+    ::vfs::log "stat $name"
     if {[namespace exists ::${ns}::${name}]} {
-	puts "directory"
 	return [list type directory size 0 mode 0777 \
 	  ino -1 depth 0 name $name atime 0 ctime 0 mtime 0 dev -1 \
 	  uid -1 gid -1 nlink 1]
     } elseif {[llength [info procs ::${ns}::${name}]]} {
-	puts "file"
 	return [list type file]
     } else {
 	return -code error "could not read \"$name\": no such file or directory"
@@ -50,7 +48,7 @@ proc vfs::tclproc::stat {ns name} {
 }
 
 proc vfs::tclproc::access {ns name mode} {
-    puts stderr "access $name $mode"
+    ::vfs::log "access $name $mode"
     if {[namespace exists ::${ns}::${name}]} {
 	return 1
     } elseif {[llength [info procs ::${ns}::${name}]]} {
@@ -74,7 +72,7 @@ proc vfs::tclproc::exists {ns name} {
 }
 
 proc vfs::tclproc::open {ns name mode permissions} {
-    puts stderr "open $name $mode $permissions"
+    ::vfs::log "open $name $mode $permissions"
     # return a list of two elements:
     # 1. first element is the Tcl channel name which has been opened
     # 2. second element (optional) is a command to evaluate when
@@ -111,7 +109,7 @@ proc vfs::tclproc::_generate {p} {
 }
 
 proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} {
-    puts stderr "matchindirectory $path $actualpath $pattern $type"
+    ::vfs::log "matchindirectory $path $actualpath $pattern $type"
     set res [list]
 
     if {[::vfs::matchDirectories $type]} {
@@ -128,28 +126,28 @@ proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} {
 	regsub "^(::)?${ns}(::)?${path}(::)?" $r $actualpath rr
 	lappend realres $rr
     }
-    #puts $realres
+    #::vfs::log $realres
     
     return $realres
 }
 
 proc vfs::tclproc::createdirectory {ns name} {
-    puts stderr "createdirectory $name"
+    ::vfs::log "createdirectory $name"
     namespace eval ::${ns}::${name} {}
 }
 
 proc vfs::tclproc::removedirectory {ns name} {
-    puts stderr "removedirectory $name"
+    ::vfs::log "removedirectory $name"
     namespace delete ::${ns}::${name}
 }
 
 proc vfs::tclproc::deletefile {ns name} {
-    puts stderr "deletefile $name"
+    ::vfs::log "deletefile $name"
     rename ::${ns}::${name} {}
 }
 
 proc vfs::tclproc::fileattributes {ns name args} {
-    puts stderr "fileattributes $args"
+    ::vfs::log "fileattributes $args"
     switch -- [llength $args] {
 	0 {
 	    # list strings
@@ -184,6 +182,6 @@ proc vfs::tclproc::fileattributes {ns name args} {
 }
 
 proc vfs::tclproc::utime {what name actime mtime} {
-    puts stderr "utime $name"
+    ::vfs::log "utime $name"
     error ""
 }
diff --git a/library/vfs.tcl b/library/vfs.tcl
index c5b3f47..7d886e5 100644
--- a/library/vfs.tcl
+++ b/library/vfs.tcl
@@ -1,5 +1,5 @@
 # Only useful for TclKit
-# (this file is include in tclvfs so this entire package can be
+# (this file is included in tclvfs so this entire package can be
 # use in tclkit if desired).
 #
 # Initialization script normally executed in the interpreter for each
@@ -13,22 +13,17 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 # Insist on running with compatible version of Tcl.
-
 package require Tcl 8.4
-
 package provide vfslib 0.1
 
-# So I can debug on command line!
+# So I can debug on command line when starting up Tcl from a vfs
+# when I might not have the history procedures loaded yet!
 #proc history {args} {}
 
 lappend auto_path [file dirname [info script]]
 
+# This stuff is for TclKit
 namespace eval ::vfs {
-    variable debug	0
-    if {[info exists env(VFS_DEBUG)]} {
-	set debug $env(VFS_DEBUG)
-    }
-
     variable temp
     global env
 
@@ -65,9 +60,3 @@ namespace eval ::vfs {
 	return -code $rc -errorcode $ec -errorinfo $ei $ret
     }
 }
-
-proc vfs::log {msg {lvl 0}} {
-    if {$lvl < ${::vfs::debug}} {
-	tclLog "vfs($lvl): $msg"
-    }
-}
diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 0895e81..829df59 100644
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -1,6 +1,14 @@
 
+package require Tcl 8.4
 package require vfs
 
+namespace eval ::vfs {
+    variable debug 0
+    if {[info exists env(VFS_DEBUG)]} {
+	set debug $env(VFS_DEBUG)
+    }
+}
+
 proc ::vfs::autoMountExtension {ext cmd {pkg ""}} {
     variable extMounts
     set extMounts($ext) [list $cmd $pkg]
@@ -11,8 +19,11 @@ proc ::vfs::autoMountUrl {type cmd {pkg ""}} {
     set urlMounts($type) [list $cmd $pkg]
 }
 
-proc ::vfs::log {str} {
-    puts stderr $str
+proc ::vfs::log {msg {lvl 0}} {
+    if {$lvl < ${::vfs::debug}} {
+	#tclLog "vfs($lvl): $msg"
+	puts stderr $msg
+    }
 }
 
 proc ::vfs::RegisterMount {mountpoint unmountcmd} {
@@ -37,7 +48,7 @@ proc ::vfs::haveMount {url} {
 }
 
 proc ::vfs::urlMount {url args} {
-    puts "$url $args"
+    ::vfs::log "$url $args"
     variable urlMounts
     if {[regexp {^([a-zA-Z]+)://(.*)} $url "" urltype rest]} {
 	if {[info exists urlMounts($urltype)]} {
@@ -128,7 +139,6 @@ proc vfs::matchCorrectTypes {types filelist {inDir ""}} {
 		}
 	    } else {
 		foreach r $filelist {
-		    #puts [file join $inDir $r]
 		    if {[::file isdirectory [file join $inDir $r]]} {
 			lappend newres $r
 		    }
@@ -228,7 +238,7 @@ proc vfs::attributesGet {root stem index} {
 proc vfs::attributesSet {root stem index val} {
     # Return standard Tcl result, or error.
     set attribute [indexToAttribute $index]
-    #puts "$attribute"
+    #::vfs::log "$attribute"
     switch -- $attribute {
 	"-owner" {
 	    return
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 1ded361..d698081 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -28,7 +28,7 @@ proc vfs::zip::Unmount {fd local} {
 }
 
 proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
-    #puts [list $zipfd $cmd $root $relative $actualpath $args]
+    #::vfs::log [list $zipfd $cmd $root $relative $actualpath $args]
     #update
     if {$cmd == "matchindirectory"} {
 	eval [list $cmd $zipfd $relative $actualpath] $args
@@ -41,26 +41,26 @@ proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
 # virtual file system for zip files.
 
 proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} {
-    #puts stderr [list matchindirectory $path $actualpath $pattern $type]
+    #::vfs::log [list matchindirectory $path $actualpath $pattern $type]
     set res [::zip::getdir $zipfd $path $pattern]
-    #puts stderr "got $res"
+    #::vfs::log "got $res"
     set newres [list]
     foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
 	lappend newres "$actualpath$p"
     }
-    #puts "got $newres"
+    #::vfs::log "got $newres"
     return $newres
 }
 
 proc vfs::zip::stat {zipfd name} {
-    #puts "stat $name"
+    #::vfs::log "stat $name"
     ::zip::stat $zipfd $name sb
-    #puts [array get sb]
+    #::vfs::log [array get sb]
     array get sb
 }
 
 proc vfs::zip::access {zipfd name mode} {
-    #puts "zip-access $name $mode"
+    #::vfs::log "zip-access $name $mode"
     if {$mode & 2} {
 	error "read-only"
     }
@@ -75,7 +75,7 @@ proc vfs::zip::access {zipfd name mode} {
 }
 
 proc vfs::zip::open {zipfd name mode permissions} {
-    #puts "open $name $mode $permissions"
+    #::vfs::log "open $name $mode $permissions"
     # return a list of two elements:
     # 1. first element is the Tcl channel name which has been opened
     # 2. second element (optional) is a command to evaluate when
@@ -112,22 +112,22 @@ proc vfs::zip::open {zipfd name mode permissions} {
 }
 
 proc vfs::zip::createdirectory {zipfd name} {
-    #puts stderr "createdirectory $name"
+    #::vfs::log "createdirectory $name"
     error "read-only"
 }
 
 proc vfs::zip::removedirectory {zipfd name} {
-    #puts stderr "removedirectory $name"
+    #::vfs::log "removedirectory $name"
     error "read-only"
 }
 
 proc vfs::zip::deletefile {zipfd name} {
-    #puts "deletefile $name"
+    #::vfs::log "deletefile $name"
     error "read-only"
 }
 
 proc vfs::zip::fileattributes {zipfd name args} {
-    #puts "fileattributes $args"
+    #::vfs::log "fileattributes $args"
     switch -- [llength $args] {
 	0 {
 	    # list strings
@@ -287,8 +287,8 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
 	if { [catch {
 	    set data [zip -mode decompress -nowrap 1 $data]
 	} err] } {
-	    puts "$sb(name): inflate error: $err"
-	    puts [hexdump $data]
+	    ::vfs::log "$sb(name): inflate error: $err"
+	    ::vfs::log [hexdump $data]
 	}
     }
     return
@@ -402,7 +402,7 @@ proc zip::FAKEDIR {arr path} {
 }
 
 proc zip::exists {fd path} {
-    #puts stderr "$fd $path"
+    #::vfs::log "$fd $path"
     if {$path == ""} {
 	return 1
     } else {
@@ -436,7 +436,7 @@ proc zip::stat {fd path arr} {
 }
 
 proc zip::getdir {fd path {pat *}} {
-#    puts stderr [list getdir $fd $path $pat]
+#    ::vfs::log [list getdir $fd $path $pat]
     upvar #0 zip::$fd.toc toc
 
     if { $path == "." || $path == "" } {
@@ -462,7 +462,7 @@ proc zip::getdir {fd path {pat *}} {
 	    }
 	    lappend ret [file tail $sb(name)]
 	} else {
-	    #puts "$sb(depth) vs $depth for $sb(name)"
+	    #::vfs::log "$sb(depth) vs $depth for $sb(name)"
 	}
 	unset sb
     }