FtpURI.st
changeset 1268 48b43aebf125
parent 1267 5e7f102e094d
child 1271 ca2e206e7c7f
--- a/FtpURI.st	Thu Jul 10 16:33:01 2003 +0200
+++ b/FtpURI.st	Fri Jul 11 14:48:15 2003 +0200
@@ -111,7 +111,7 @@
     ].
 
     "
-     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
+     'ftp://stefan:password@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
          self halt
       ].
     "
@@ -142,6 +142,10 @@
 
     requestDirectory := false.
     path := self path.
+    "kludge"
+    (path startsWith:'/~') ifTrue:[
+        path := path copyFrom:2.
+    ].
     attributes := self class attributes.
     list := OrderedCollection new.
 
@@ -261,22 +265,33 @@
     ]
 
     "
-     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
+     'ftp://stefan:password@hippo/etc/group' asURI writeStreamDo:[:stream :attributes | 
          self halt
       ].
     "
 !
 
 writeStreamDo:aBlock create:doCreate
-    "use FTPClient for now"
+
+    ^ self writeStreamDo:aBlock create:doCreate atomic:false.
+!
 
-    |path absDir absPath|
+writeStreamDo:aBlock create:doCreate atomic:doAtomic
+    "use FTPClient for now.
+
+     If doCreate is true, a nonExistent directory will be created.
+     If doAtomic is true, files will appear atomically, by using
+        an intermediate file theat will be renamed"
+
+    |path toPath directory|
 
     path := self path.
-    (path startsWith:'/') 
-        ifTrue:[  absPath := path] 
-        ifFalse:[ absPath := '/', path ].
-    absDir := absPath asFilename directory.
+    doAtomic ifTrue:[
+        toPath := self directoryPath, '/.transferFile'.
+    ] ifFalse:[
+        toPath := path.
+    ].
+        
     self connectThenDo:[:ftp| |stream|
         [
             ftp connectTo:self host 
@@ -284,36 +299,42 @@
                 user:(self user ? self defaultUser)
                 password:(self password ? self defaultPassword).
 
-            FTPClient filePutErrorSignal handle:[:ex| |str|
+            [
+                stream := ftp putStreamFor:toPath.
+            ] on:FTPClient filePutErrorSignal do:[:ex|
                 doCreate ifFalse:[
                     ex reject
-                ]. 
+                ].
+                "create the missing directory on the fly"
+                directory := self directoryPath.
                 FTPClient fileNotFoundErrorSignal handle:[:ex| ] do:[
-                    ftp mkdir:absDir.
+                    ftp mkdir:directory.
                 ].
-                ftp cd:absDir.
-                stream := ftp putStreamFor:absPath.
-            ] do:[
-                stream := ftp putStreamFor:absPath.
+                ftp cd:directory.
+                stream := ftp putStreamFor:toPath.
             ].
-
             aBlock value:stream value:self class attributes.
+            doAtomic ifTrue:[
+                ftp rename:toPath to:path
+            ].
         ] ensure:[
             stream notNil ifTrue:[
                 stream close.
             ].
         ].
     ]
+! !
 
-    "
-     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
-         self halt
-      ].
-    "
+!FtpURI methodsFor:'testing'!
+
+isAbsolute
+    "there is nothing like a relative ftp URI"
+
+    ^ true
 ! !
 
 !FtpURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.7 2003-07-10 14:32:44 tm Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.8 2003-07-11 12:48:15 stefan Exp $'
 ! !