added recursive flag

diff --git a/ChangeLog b/ChangeLog
index 39cfb4ef42ec5250796cb45281913b72f0cc68f4..b6ae0138364f3ec264f1bda27e83acd31d31dfa2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-02-21  Vince Darley <vincentdarley@sourceforge.net>
+
+       * doc/vvs.n:
+       * library/*.tcl: added missing 'recursive' flag to most
+        .tcl 'removedirectory' implementations.
+       
 2003-02-21  Vince Darley <vincentdarley@sourceforge.net>
 
        * generic/vfs.c: some small cleanup

diff --git a/doc/vfs.n b/doc/vfs.n
index 810bdeb420cbc2e7b55901e2236afc3b0c772c9a..0706a209140b0b8a391804ad01f6d39b89ecd522 100644 (file)
--- a/doc/vfs.n
+++ b/doc/vfs.n
@@ -214,8 +214,12 @@ asycnhronously, with bgerror, for example), unless the 'internalerror'
 script has been specified, when they are passed to that script for
 further action.
 .TP
-\fIcommand\fR \fIremovedirectory\fR \fIr-r-a\fR
-Delete the given directory.
+\fIcommand\fR \fIremovedirectory\fR \fIr-r-a\fR \fIrecursive\fR
+Delete the given directory.  \fIrecursive\fR is either 0 or 1. If
+it is 1 then even if the directory is non-empty, an attempt should
+be made to recursively delete it and its contents.  If it is 0 and
+the directory is non-empty, a posix error (ENOTEMPTY) should be
+thrown.
 .TP
 \fIcommand\fR \fIstat\fR \fIr-r-a\fR
 Return a list of even length containing field-name and value pairs for

diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 9c7d65f5984b6aed8aa492169385285cec24ef08..c2bdb5997183edfbf0152f970c5dfdd302b60097 100644 (file)
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -83,7 +83,9 @@ proc vfs::ftp::stat {fd name} {
     }
     # get information on the type of this file
     set ftpInfo [_findFtpInfo $fd $name]
-    if {$ftpInfo == ""} { error "Couldn't find file info" }
+    if {$ftpInfo == ""} { 
+       vfs::filesystem posixerror $::vfs::posix(ENOENT)
+    }
     ::vfs::log $ftpInfo
     set perms [lindex $ftpInfo 0]
     if {[string index $perms 0] == "d"} {
@@ -106,7 +108,7 @@ proc vfs::ftp::access {fd name mode} {
     if {[string length $info]} {
        return 1
     } else {
-       error "No such file"
+       vfs::filesystem posixerror $::vfs::posix(ENOENT)
     }
 }
 
@@ -164,7 +166,10 @@ proc vfs::ftp::_closing {fd name filed action} {
        ::ftp::Type $fd binary
     }
     if {![::ftp::$action $fd -data $contents $name]} {
-       error "Failed to write to $name"
+       # Would be better if we could be more specific here, with
+       # one of ENETRESET ENETDOWN ENETUNREACH or whatever.
+       vfs::filesystem posixerror $::vfs::posix(EIO)
+       #error "Failed to write to $name"
     }
     if {[info exists oldType]} {
        ::ftp::Type $fd $oldType
@@ -262,8 +267,8 @@ proc vfs::ftp::createdirectory {fd name} {
     }
 }
 
-proc vfs::ftp::removedirectory {fd name} {
-    ::vfs::log "removedirectory $name"
+proc vfs::ftp::removedirectory {fd name recursive} {
+    ::vfs::log "removedirectory $name $recursive"
     if {![ftp::RmDir $fd $name]} {
        error "failed"
     }
@@ -272,6 +277,7 @@ proc vfs::ftp::removedirectory {fd name} {
 proc vfs::ftp::deletefile {fd name} {
     ::vfs::log "deletefile $name"
     if {![ftp::Delete $fd $name]} {
+       # Can we be more specific here?
        error "failed"
     }
 }
@@ -286,11 +292,13 @@ proc vfs::ftp::fileattributes {fd path args} {
        1 {
            # get value
            set index [lindex $args 0]
+           vfs::filesystem posixerror $::vfs::posix(ENODEV)
        }
        2 {
            # set value
            set index [lindex $args 0]
            set val [lindex $args 1]
+           vfs::filesystem posixerror $::vfs::posix(ENODEV)
        }
     }
 }

diff --git a/library/httpvfs.tcl b/library/httpvfs.tcl
index cf1bec031f2edb37d999788b23ef8050f6bb74d7..e47006e4c9ff7a63f03c20d54ff836dee6fe14bf 100644 (file)
--- a/library/httpvfs.tcl
+++ b/library/httpvfs.tcl
@@ -147,7 +147,7 @@ proc vfs::http::createdirectory {dirurl name} {
     vfs::filesystem posixerror $::vfs::posix(EROFS)
 }
 
-proc vfs::http::removedirectory {dirurl name} {
+proc vfs::http::removedirectory {dirurl name recursive} {
     ::vfs::log "removedirectory $name"
     vfs::filesystem posixerror $::vfs::posix(EROFS)
 }

diff --git a/library/tarvfs.tcl b/library/tarvfs.tcl
index 9ccd5aea066492255a4062985a52112a82359210..e8ca4e032a3275364d9688082996b7856788bae5 100644 (file)
--- a/library/tarvfs.tcl
+++ b/library/tarvfs.tcl
@@ -129,7 +129,7 @@ proc vfs::tar::createdirectory {tarfd name} {
     #error "tar-archives are read-only (not implemented)"
 }
 
-proc vfs::tar::removedirectory {tarfd name} {
+proc vfs::tar::removedirectory {tarfd name recursive} {
     #::vfs::log "removedirectory $name"
     vfs::filesystem posixerror $::vfs::posix(EROFS)
     #error "tar-archives are read-only (not implemented)"

diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index 9075212d9a8a758e5d5632397e17791b2293b1df..6ccf516531b35cba361f66354bdf127b894dde38 100644 (file)
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -147,7 +147,7 @@ proc vfs::ns::createdirectory {ns name} {
     namespace eval ::${ns}::${name} {}
 }
 
-proc vfs::ns::removedirectory {ns name} {
+proc vfs::ns::removedirectory {ns name recursive} {
     ::vfs::log "removedirectory $name"
     namespace delete ::${ns}::${name}
 }

diff --git a/library/testvfs.tcl b/library/testvfs.tcl
index 0758a8f65723adcc8dc4f1aadfc7556e1eb438eb..e57609c5466db8b1df526e7e9a36c0756f96c828 100644 (file)
--- a/library/testvfs.tcl
+++ b/library/testvfs.tcl
@@ -56,7 +56,7 @@ proc vfs::test::createdirectory {what name} {
     puts "createdirectory $name"
 }
 
-proc vfs::test::removedirectory {what name} {
+proc vfs::test::removedirectory {what name recursive} {
     puts "removedirectory $name"
 }
 

diff --git a/library/vfsUrl.tcl b/library/vfsUrl.tcl
index 0e2cc085e984b9908bbd0d308486e38202fbd771..749b110e4b3b2f158c203ab3cd0a2038c0378f52 100644 (file)
--- a/library/vfsUrl.tcl
+++ b/library/vfsUrl.tcl
@@ -128,7 +128,7 @@ proc vfs::urltype::createdirectory {type root name} {
     error ""
 }
 
-proc vfs::urltype::removedirectory {type root name} {
+proc vfs::urltype::removedirectory {type root name recursive} {
     ::vfs::log "removedirectory $name"
     # For ftp/http/file types we don't want to allow anything here.
     error ""

diff --git a/library/webdavvfs.tcl b/library/webdavvfs.tcl
index a59a2e973abd2ced72a6bd09b19e55b90c81a1c1..ae6dd20ab10eb5224a73d6e2931a1f1e0da21e74 100644 (file)
--- a/library/webdavvfs.tcl
+++ b/library/webdavvfs.tcl
@@ -253,7 +253,7 @@ proc vfs::webdav::createdirectory {dirurl extraHeadersList name} {
     error "write access not implemented"
 }
 
-proc vfs::webdav::removedirectory {dirurl extraHeadersList name} {
+proc vfs::webdav::removedirectory {dirurl extraHeadersList name recursive} {
     ::vfs::log "removedirectory $name"
     error "write access not implemented"
 }

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index b954f76df4bc8ef6a2082285b1a24509b9294080..27a21f49799a4a39045336c6b3362441091f4d03 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -129,7 +129,7 @@ proc vfs::zip::createdirectory {zipfd name} {
     vfs::filesystem posixerror $::vfs::posix(EROFS)
 }
 
-proc vfs::zip::removedirectory {zipfd name} {
+proc vfs::zip::removedirectory {zipfd name recursive} {
     #::vfs::log "removedirectory $name"
     vfs::filesystem posixerror $::vfs::posix(EROFS)
 }