ftp listing cache

diff --git a/ChangeLog b/ChangeLog
index 9f7451af16ce0c84cf97b88e8ee346e4980ac6c8..be3ba22ccaf2af7898cdbea0d9a00b267fbdabc3 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2006-03-12  Vince Darley <vincentdarley@sourceforge.net>
+
+       * library/ftpvfs.tcl: provide caching of listings to improve
+       performance for many standard use cases.
+
 2006-02-27  Jean-Claude Wippler  <jcw@equi4.com>
 
        * library/mkclvfs.tcl: Small optimization so a writable starkit

diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 12903e92d5a585f2c1e56f53d9bde26377981717..34ba6180fbe08d81c0c78b60c99d6c93dc409a05 100644 (file)
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -4,7 +4,10 @@ package provide vfs::ftp 1.0
 package require vfs 1.0
 package require ftp
 
-namespace eval vfs::ftp {}
+namespace eval vfs::ftp {
+    # Number of milliseconds for which to cache listings
+    variable cacheListingsFor 1000
+}
 
 proc vfs::ftp::Mount {dirurl local} {
     set dirurl [string trim $dirurl]
@@ -182,7 +185,7 @@ proc vfs::ftp::_closing {fd name filed action} {
 
 proc vfs::ftp::_findFtpInfo {fd name} {
     ::vfs::log "findFtpInfo $fd $name"
-    set ftpList [ftp::List $fd [file dirname $name]]
+    set ftpList [cachedList $fd [file dirname $name]]
     foreach p $ftpList {
        foreach {pname other} [_parseListLine $p] {}
        if {$pname == [file tail $name]} {
@@ -192,6 +195,22 @@ proc vfs::ftp::_findFtpInfo {fd name} {
     return ""
 }
 
+proc vfs::ftp::cachedList {fd dir} {
+    variable cacheList
+    variable cacheListingsFor
+    
+    # Caches response to prevent going back to the ftp server
+    # for common use cases: foreach {f} [glob *] { file stat $f s }
+    if {[info exists cacheList($dir)]} {
+       return $cacheList($dir)
+    }
+    set listing [ftp::List $fd $dir]
+
+    set cacheList($dir) $listing
+    after $cacheListingsFor [list unset -nocomplain ::vfs::ftp::cacheList($dir)]
+    return $listing
+}
+
 # Currently returns a list of name and a list of other
 # information.  The other information is currently a 
 # list of:
@@ -239,7 +258,7 @@ proc vfs::ftp::matchindirectory {fd path actualpath pattern type} {
        }
     } else {
        # matching all files in the given directory
-       set ftpList [ftp::List $fd $path]
+       set ftpList [cachedList $fd $path]
        ::vfs::log "ftpList: $ftpList"
 
        foreach p $ftpList {