--- 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 $'
! !