From: Vince Darley <vincentdarley@sourceforge.net>
Date: Sun, 12 Mar 2006 23:38:45 +0000 (+0000)
Subject: ftp listing cache
X-Git-Tag: vfs-1-4~59
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=dde90cb12f2892db42a6163b54b3af7739dba498;p=tclvfs

ftp listing cache
---

diff --git a/ChangeLog b/ChangeLog
index 9f7451a..be3ba22 100644
--- 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 12903e9..34ba618 100644
--- 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 {