*** empty log message ***
authortm
Tue, 24 Jun 2003 16:10:53 +0200
changeset 1254 baf01931b9d6
parent 1253 598408cdecc7
child 1255 32e0aa97ae82
*** empty log message ***
FileURI.st
FtpURI.st
HierarchicalURI.st
URI.st
--- a/FileURI.st	Wed Jun 18 21:04:56 2003 +0200
+++ b/FileURI.st	Tue Jun 24 16:10:53 2003 +0200
@@ -67,6 +67,13 @@
     "
 ! !
 
+!FileURI methodsFor:'queries'!
+
+pathExists
+
+    ^ self asFilename exists
+! !
+
 !FileURI methodsFor:'stream access'!
 
 readStream
@@ -83,13 +90,16 @@
      and a dictionary containing attributes as second argument.
      The stream is closed after aBlock has been evaluated."
 
-    |stream|
+    |attributes file stream|
 
-    ^ [
-        |stream attributes|
+    attributes := self class attributes.
+    file := self asFilename.
+    attributes at:#fileSize put:(file fileSize).
+    attributes at:#baseName put:file baseName.  
+    attributes at:#uriInfo  put:self printString.  
 
-        stream := self asFilename readStream.
-        attributes := Dictionary new at:#MIME put:'text/plain'.
+    ^ [ 
+        stream := file readStream.
         aBlock value:stream value:attributes
      ] ensure:[
         stream notNil ifTrue:[stream close]
@@ -104,13 +114,81 @@
     "
 !
 
-writeStream
+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"
+
+    |attributes fn files|
+
+    fn := self asFilename.
+    files := OrderedCollection new.
+    attributes := self class attributes.
+    fn isDirectory ifTrue:[
+        attributes at:#requestDirectory put:true.
+        (DirectoryContents directoryNamed:fn pathName) filesDo:[:aFile|
+            files add:aFile
+        ].
+    ] ifFalse:[
+        attributes at:#requestDirectory put:false.
+        files add:fn.
+    ].
 
-    ^ self asFilename writeStream
+    files do:[:aFile| |baseName stream|
+        [
+            baseName := aFile baseName.
+            attributes at:#fileSize put:(aFile fileSize).
+            attributes at:#baseName put:baseName.  
+            (self pathSegements includes:baseName) ifTrue:[
+                attributes at:#uriInfo put: self printString.  
+            ] ifFalse:[
+                attributes at:#uriInfo put: ((self copy) addComponent:baseName) printString.  
+            ].
+            stream := aFile readStream.
+            aBlock value:stream value:attributes
+        ] ensure:[
+            stream notNil ifTrue:[stream close]
+        ].
+    ].
+
+    "
+        (URI fromString:'file:/home/tm/tmp') 
+            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
+    "evaluate a block with the write stream as first argument
+     and a dictionary containing attributes as second argument.
+     The stream is closed after aBlock has been evaluated.
+     Attributes may be the mime type (key #MIME)"
+
+    |stream|
+
+    ^ [
+        stream := self asFilename writeStream.
+        aBlock value:stream value:self class attributes
+     ] ensure:[
+        stream notNil ifTrue:[stream close]
+     ].
+
+    "
+        (URI fromString:'file:/home/tm/tmp') 
+            readStreamsDo:[:stream :attributes| 
+                Transcript showCR:(attributes at:#MIME).
+                Transcript showCR:(stream isWritable).
+            ].
+    "
 ! !
 
 !FileURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.1 2002-01-17 14:24:59 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.2 2003-06-24 14:10:53 tm Exp $'
 ! !
--- 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 $'
 ! !
--- a/HierarchicalURI.st	Wed Jun 18 21:04:56 2003 +0200
+++ b/HierarchicalURI.st	Tue Jun 24 16:10:53 2003 +0200
@@ -31,8 +31,21 @@
 
   more examples to be added:
                                                                 [exBegin]
-    ... add code fragment for 
-    ... executable example here ...
+    |u1 u2|
+
+    u1 := URI fromString:'file:/phys/exept/tmp/'.
+    u2 := u1 construct:'test.txt'.
+    Transcript showCR:u1.
+    Transcript showCR:u2.
+                                                                [exEnd]
+
+                                                                [exBegin]
+    |u1 u2|
+
+    u1 := URI fromString:'file:/phys/exept/tmp'.
+    u2 := u1 construct:'test.txt'.
+    Transcript showCR:u1.
+    Transcript showCR:u2.
                                                                 [exEnd]
 "
 ! !
@@ -66,6 +79,16 @@
     authority := something.
 !
 
+examples
+"
+
+  more examples to be added:
+                                                                [exBegin]
+        URI fromString:'file:/phys/exept/home/tm/tmp'
+                                                                [exEnd]
+"
+!
+
 fragment
     "return the value of the instance variable 'fragment' (automatically generated)"
 
@@ -205,6 +228,13 @@
     "
 ! !
 
+!HierarchicalURI methodsFor:'copying'!
+
+postCopy
+
+    pathSegments := pathSegments copy
+! !
+
 !HierarchicalURI methodsFor:'defaults'!
 
 defaultPort
@@ -254,8 +284,11 @@
 
     [
         i1 := aString indexOfAny:'/?#' startingAt:i+1.
-        i1 == 0 ifTrue:[
-            pathSegments add:(aString copyFrom:i+1).
+        i1 == 0 ifTrue:[ |path|
+            path := aString copyFrom:i+1.
+            path size ~~ 0 ifTrue:[
+                pathSegments add:path.
+            ].
             ^ self.
         ] ifFalse:[
             separator := aString at:i1.
@@ -401,5 +434,5 @@
 !HierarchicalURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.1 2002-01-17 14:25:25 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.2 2003-06-24 14:10:39 tm Exp $'
 ! !
--- a/URI.st	Wed Jun 18 21:04:56 2003 +0200
+++ b/URI.st	Tue Jun 24 16:10:53 2003 +0200
@@ -51,6 +51,15 @@
 
 !URI class methodsFor:'accessing'!
 
+attributes
+
+    |dict|
+
+    dict := Dictionary new.
+    dict at:#MIME put:'text/plain'.
+    ^ dict
+!
+
 classForScheme:aString
     "find a class for a given scheme name aString"
 
@@ -195,6 +204,13 @@
 
 !URI methodsFor:'subclass responsibility'!
 
+pathExists
+
+    "returns true if path exists"
+
+    ^ self subclassResponsibility
+!
+
 readStreamDo:aBlock
 
     "evaluate a block with the read stream as first argument
@@ -203,10 +219,33 @@
      Attributes may be the mime type (key #MIME)"
 
     ^ self subclassResponsibility
+!
+
+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)"
+
+    ^ self subclassResponsibility
+!
+
+writeStreamDo:aBlock
+
+    "evaluate a block with the write stream as first argument
+     and a dictionary containing attributes as second argument.
+     The stream is closed after aBlock has been evaluated.
+     Attributes may be the mime type (key #MIME)"
+
+    ^ self subclassResponsibility
 ! !
 
 !URI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.3 2003-06-18 13:56:39 tm Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.4 2003-06-24 14:10:33 tm Exp $'
 ! !