FtpURI.st
changeset 1254 baf01931b9d6
parent 1005 7ed6fa7ccfba
child 1258 a0eda4db4dad
--- a/FtpURI.st	Wed Jun 18 21:04:56 2003 +0200
+++ b/FtpURI.st	Tue Jun 24 16:10:53 2003 +0200
@@ -15,6 +15,28 @@
     ^ #(ftp)
 ! !
 
+!FtpURI methodsFor:'connecting'!
+
+connectThenDo:aOneArgBlock
+
+    |ftp|
+
+    ftp := FTPClient new.
+
+
+    [
+        ftp connectTo:self host 
+            port:self port 
+            user:(self user ? self defaultUser)
+            password:(self password ? self defaultPassword).
+        aOneArgBlock value:ftp
+    ] ensure:[
+        ftp notNil ifTrue:[
+            ftp close.
+        ].
+    ]
+! !
+
 !FtpURI methodsFor:'defaults'!
 
 defaultPassword
@@ -33,29 +55,150 @@
     ^ 'anonymous'
 ! !
 
+!FtpURI methodsFor:'queries'!
+
+pathExists
+    "use FTPClient for now"
+
+    |exists|
+
+    self connectThenDo:[:ftp| |stream|
+        [
+            exists := (ftp getStreamFor:self path) isExists.
+        ] ensure:[
+            stream notNil ifTrue:[
+                stream close.
+            ].
+        ].
+    ].
+
+
+    ^ exists ? false
+! !
+
 !FtpURI methodsFor:'stream access'!
 
 readStreamDo:aBlock
     "use FTPClient for now"
 
-    |ftp stream|
+    self connectThenDo:[:ftp| |stream path attributes|
+        [
+            path := self path.
+            attributes := self class attributes.
+            attributes at:#fileSize put:(ftp sizeOf:path).
+            attributes at:#baseName put:self pathSegements last.  
+            attributes at:#uriInfo  put:self printString.  
+
+            stream := ftp getStreamFor:path.
+            aBlock value:stream value:attributes.
+        ] ensure:[
+            stream notNil ifTrue:[
+                stream close.
+            ].
+        ].
+    ].
 
-    ftp := FTPClient new.
-    [
+    "
+     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
+         self halt
+      ].
+    "
+!
+
+readStreamsDo:aBlock
+    "evaluate the block with a Collection of streams as first argument
+     and a dictionary containing attributes as second argument,
+     - a collection with a stream on a single file,
+     - or a collection with streams on a directorie's files, but not recursive
+
+     The streams are closed after aBlock has been evaluated.
+     Attributes may be the mime type (key #MIME)"
+
+    |attributes list requestDirectory path|
+
+    requestDirectory := false.
+    path := self path.
+    attributes := self class attributes.
+    list := OrderedCollection new.
+
+    self connectThenDo:[:ftp|
         ftp connectTo:self host 
             port:self port 
             user:(self user ? self defaultUser)
             password:(self password ? self defaultPassword).
-        stream := ftp getStreamFor:self path.
-        aBlock value:stream value:(Dictionary new at:#MIME put:'text/plain').
-    ] ensure:[
-        stream notNil ifTrue:[
-            stream close.
+
+        FTPClient fileErrorSignal handle:[:ex|
+            list add:path.
+            attributes at:#requestDirectory put:false.
+        ] do:[
+            ftp cd:path.
+            requestDirectory := true.
+            attributes at:#requestDirectory put:true.
+            list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
         ].
-        ftp notNil ifTrue:[
-            ftp close.
+
+        list do:[:aPathName| |baseName stream|
+            FTPClient fileErrorSignal handle:[:ex| 
+                "/ skip directories and the summary of the list
+"/                Transcript showCR:('%1, %2' bindWith:aPathName with:ex description)
+            ] do:[
+                stream := ftp getStreamFor:aPathName.
+                attributes at:#fileSize put:(ftp sizeOf:aPathName).
+                requestDirectory ifTrue:[
+                    baseName := aPathName.
+                ] ifFalse:[
+                    baseName := self pathSegements last.
+                ].
+                attributes at:#baseName put:baseName
+            ].
+
+            stream notNil ifTrue:[
+                (self pathSegements includes:baseName) ifTrue:[
+                    attributes at:#uriInfo put:self printString.  
+                ] ifFalse:[
+                    attributes at:#uriInfo put:((self copy) addComponent:baseName) printString.  
+                ].
+                [
+                    aBlock value:stream value:attributes.
+                ] ensure:[ stream close ].
+            ].
+        ].
+    ].
+
+
+
+    "
+        |pwd|
+
+        pwd := Dialog requestPassword:''. 
+        (URI fromString:('ftp://tm:%1@exept/home/tm/tmp' bindWith:pwd) ) 
+            readStreamsDo:[:stream :attributes | 
+                Transcript showCR:(attributes at:#baseName).
+                Transcript showCR:(attributes at:#fileSize).
+                Transcript showCR:(attributes at:#requestDirectory).
+                Transcript showCR:(attributes at:#uriInfo).
+            ].
+    "
+!
+
+writeStreamDo:aBlock
+    "use FTPClient for now"
+
+    self connectThenDo:[:ftp| |stream|
+        [
+            ftp connectTo:self host 
+                port:self port 
+                user:(self user ? self defaultUser)
+                password:(self password ? self defaultPassword).
+            stream := ftp putStreamFor:self path.
+            aBlock value:stream value:self class attributes.
+        ] ensure:[
+            stream notNil ifTrue:[
+                stream close.
+            ].
         ].
     ]
+
     "
      'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
          self halt
@@ -66,5 +209,5 @@
 !FtpURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.1 2002-01-17 14:25:12 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.2 2003-06-24 14:10:45 tm Exp $'
 ! !