*** empty log message ***
authortm
Thu, 10 Jul 2003 14:07:39 +0200
changeset 1266 4522fd38deef
parent 1265 f0ea5f786b16
child 1267 5e7f102e094d
*** empty log message ***
FileURI.st
FtpURI.st
--- a/FileURI.st	Thu Jul 10 12:24:21 2003 +0200
+++ b/FileURI.st	Thu Jul 10 14:07:39 2003 +0200
@@ -129,7 +129,7 @@
      - a collection with a stream on a single file,
      - or a collection with streams on a directorie's files, but not recursive"
 
-    |attributes fn files list|
+    |attributes fn files list dirPath|
 
     fn := self asFilename.
     files := OrderedCollection new.
@@ -137,8 +137,9 @@
     attributes := self class attributes.
 
     fn isDirectory ifTrue:[
+        dirPath := fn pathName.
         attributes at:#requestDirectory put:true.
-        (DirectoryContents directoryNamed:fn pathName) filesDo:[:aFile|
+        (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
             files add:aFile
         ].
     ] ifFalse:[
@@ -151,8 +152,9 @@
         (bName startsWith:'*') ifTrue:[
             files removeAll.
             fn := fn directory.
+            dirPath := fn pathName.
             attributes at:#requestDirectory put:true.
-            (DirectoryContents directoryNamed:fn pathName) filesDo:[:aFile|
+            (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
                 files add:aFile
             ].
         ].
@@ -172,8 +174,13 @@
             attributes at:#baseName put:baseName.  
             (self pathSegements includes:baseName) ifTrue:[
                 attributes at:#uriInfo put:self.  
-            ] ifFalse:[
-                attributes at:#uriInfo put:((self copy) addComponent:baseName).  
+            ] ifFalse:[ |uri col|
+                uri := self copy.
+                col := self pathSegements copy.
+                col removeLast.
+                col add:baseName.
+                uri pathSegements:col.
+                attributes at:#uriInfo put:uri.  
             ].
             stream := aFile readStream.
             aBlock value:stream value:attributes.
@@ -256,5 +263,5 @@
 !FileURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.4 2003-07-10 09:42:36 tm Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.5 2003-07-10 12:07:29 tm Exp $'
 ! !
--- a/FtpURI.st	Thu Jul 10 12:24:21 2003 +0200
+++ b/FtpURI.st	Thu Jul 10 14:07:39 2003 +0200
@@ -138,7 +138,7 @@
      The streams are closed after aBlock has been evaluated.
      Attributes may be the mime type (key #MIME)"
 
-    |attributes list requestDirectory path|
+    |attributes list requestDirectory path dirPath|
 
     requestDirectory := false.
     path := self path.
@@ -150,7 +150,8 @@
             list add:path.
             attributes at:#requestDirectory put:false.
         ] do:[
-            ftp cd:path.
+            dirPath := path.
+            ftp cd:dirPath.
             requestDirectory := true.
             attributes at:#requestDirectory put:true.
             list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
@@ -162,7 +163,8 @@
                 list removeAll.
                 requestDirectory := true.
                 attributes at:#requestDirectory put:true.
-                ftp cd:(path asFilename directory) pathName.
+                dirPath := (path asFilename directory) pathName.
+                ftp cd:dirPath.
                 list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
             ].
             (bName startsWith:'*.') ifTrue:[ |rest|
@@ -192,10 +194,13 @@
 
             stream notNil ifTrue:[ |src srcPath|
                 (self pathSegements includes:baseName) ifTrue:[ 
-                    srcPath := self path.
+                    srcPath := (dirPath asFilename) pathName.
                     attributes at:#uriInfo put:self.  
-                ] ifFalse:[
-                    src := ((self copy) addComponent:baseName).
+                ] ifFalse:[ |pathSegements|
+                    src := self copy.
+                    pathSegements := (dirPath asFilename construct:baseName) components.
+                    pathSegements removeFirst.
+                    src pathSegements:pathSegements.
                     srcPath := src path.
                     attributes at:#uriInfo put:src.  
                 ].
@@ -259,10 +264,48 @@
          self halt
       ].
     "
+!
+
+writeStreamDo:aBlock create:doCreate
+    "use FTPClient for now"
+
+    |path|
+
+    path := self path.
+    self connectThenDo:[:ftp| |stream|
+        [
+            ftp connectTo:self host 
+                port:self port 
+                user:(self user ? self defaultUser)
+                password:(self password ? self defaultPassword).
+
+            Stream streamErrorSignal handle:[:ex|
+                doCreate ifFalse:[
+                    ex reject
+                ]. 
+                ftp mkdir:path asFilename directory pathName.
+                stream := ftp putStreamFor:path.
+            ] do:[
+                stream := ftp putStreamFor: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
+      ].
+    "
 ! !
 
 !FtpURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.5 2003-07-10 10:24:21 tm Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.6 2003-07-10 12:07:39 tm Exp $'
 ! !