--- a/FileURI.st Thu Jul 10 16:33:01 2003 +0200
+++ b/FileURI.st Fri Jul 11 14:48:15 2003 +0200
@@ -32,8 +32,18 @@
^ authority notNil ifTrue:[
Filename remoteHost:authority rootComponents:pathSegments.
] ifFalse:[
- Filename rootComponents:pathSegments
+ "kludge"
+ (pathSegments first startsWith:$~) ifTrue:[
+ pathSegments first asFilename construct:(Filename rootComponents:(pathSegments copyFrom:2)).
+ ] ifFalse:[
+ Filename rootComponents:pathSegments.
+ ].
].
+
+ "
+ (URI fromString:'file:~/bla') asFilename
+ (URI fromString:'file:~root/bla') asFilename
+ "
! !
!FileURI methodsFor:'initialize'!
@@ -82,6 +92,9 @@
"
'file:/etc/group' asURI readStream contents
+ 'file:/~/.profile' asURI readStream contents
+ (URI fromString:'file:~/.profile') asFilename
+ (URI fromString:'file:~/.profile') readStream upToEnd
"
!
@@ -228,25 +241,42 @@
!
writeStreamDo:aBlock create:doCreate
+
+ ^ self writeStreamDo:aBlock create:doCreate atomic:false.
+!
+
+writeStreamDo:aBlock create:doCreate atomic:doAtomic
"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)"
+ Attributes may be the mime type (key #MIME)
+
+ 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"
- |stream fileName|
+ |stream fileName toFileName|
- fileName := self path asFilename.
+ fileName := self asFilename.
+ doAtomic ifTrue:[
+ toFileName := fileName directory construct:'.transferFile'.
+ ] ifFalse:[
+ toFileName := fileName.
+ ].
[
Stream streamErrorSignal handle:[:ex|
doCreate ifFalse:[
ex reject
].
- (fileName directory) recursiveMakeDirectory.
- stream := fileName writeStream.
+ fileName directory recursiveMakeDirectory.
+ stream := toFileName writeStream.
] do:[
- stream := fileName writeStream.
+ stream := toFileName writeStream.
].
- aBlock value:stream value:self class attributes
+ aBlock value:stream value:self class attributes.
+ doAtomic ifTrue:[
+ toFileName moveTo:fileName.
+ ]
] ensure:[
stream notNil ifTrue:[stream close]
].
@@ -263,5 +293,5 @@
!FileURI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.6 2003-07-10 14:32:51 tm Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.7 2003-07-11 12:46:51 stefan Exp $'
! !
--- 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 $'
! !
--- a/HierarchicalURI.st Thu Jul 10 16:33:01 2003 +0200
+++ b/HierarchicalURI.st Fri Jul 11 14:48:15 2003 +0200
@@ -271,7 +271,7 @@
|i i1 separator|
(aString startsWith:'//') ifTrue:[
- i := aString indexOfAny:'~/?#' startingAt:3.
+ i := aString indexOfAny:'/?#' startingAt:3.
i == 0 ifTrue:[
authority := aString copyFrom:3.
^ self.
@@ -288,15 +288,6 @@
]
].
- isAbsolute ifFalse:[
- i ~~ 0 ifTrue:[
- (aString at:i) == $~ ifTrue:[
- pathSegments add:'~'.
- i := i + 1
- ].
- ].
- ].
-
[
i1 := aString indexOfAny:'/?#' startingAt:i+1.
i1 == 0 ifTrue:[ |path|
@@ -314,14 +305,11 @@
pathSegments add:(aString copyFrom:i+1 to:i1-1).
isAbsolute ifTrue:[
pathSegments size == 1 ifTrue:[
- pathSegments first = '~' ifTrue:[
+ (pathSegments first startsWith:$~) ifTrue:[
isAbsolute := false
].
].
].
- (pathSegments size == 1 and:[pathSegments first = '~']) ifTrue:[
-
- ].
i := i1.
].
] doWhile:[separator == $/].
@@ -361,6 +349,29 @@
!HierarchicalURI methodsFor:'printing & storing'!
+directoryPath
+ "answer the directory path part of the URI"
+
+ |aStream|
+
+ aStream := WriteStream on:''.
+
+ pathSegments size ~~ 0 ifTrue: [
+ self isAbsolute ifTrue:[
+ aStream nextPut:$/.
+ ].
+ pathSegments size > 1 ifTrue:[
+ (pathSegments copyFrom:2) do:[:p|
+ self class escape:p allow:'~;:@&=+",' on:aStream
+ ] separatedBy:[
+ aStream nextPut:$/
+ ].
+ ].
+ ].
+
+ ^ aStream contents
+!
+
path
"answer the path part of the URI"
@@ -369,11 +380,11 @@
aStream := WriteStream on:''.
pathSegments size ~~ 0 ifTrue: [
- isAbsolute ifTrue:[
+ self isAbsolute ifTrue:[
aStream nextPut:$/.
].
pathSegments do:[:p|
- self class escape:p allow:';:@&=+",' on:aStream
+ self class escape:p allow:'~;:@&=+",' on:aStream
] separatedBy:[
aStream nextPut:$/
].
@@ -403,18 +414,18 @@
authority notNil ifTrue: [
aStream nextPutAll:'//'.
doEscape ifTrue:[
- self class escape:authority allow:'$,;:@&=+' on:aStream
+ self class escape:authority allow:'~$,;:@&=+' on:aStream
] ifFalse:[
aStream nextPutAll:authority
]
].
pathSegments size ~~ 0 ifTrue: [
- isAbsolute ifTrue:[
+ self isAbsolute ifTrue:[
aStream nextPut:$/.
].
pathSegments do:[:p|
doEscape ifTrue:[
- self class escape:p allow:';:@&=+",' on:aStream
+ self class escape:p allow:'~;:@&=+",' on:aStream
] ifFalse:[
aStream nextPutAll:p
]
@@ -466,5 +477,5 @@
!HierarchicalURI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.4 2003-07-10 14:33:01 tm Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.5 2003-07-11 12:47:04 stefan Exp $'
! !
--- a/URI.st Thu Jul 10 16:33:01 2003 +0200
+++ b/URI.st Fri Jul 11 14:48:15 2003 +0200
@@ -28,6 +28,8 @@
"
self fromString:''
+ self fromString:'file:~'
+ self fromString:'ftp://exept.exept.de/~stefan/bla'
"
!
@@ -251,5 +253,5 @@
!URI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.5 2003-07-09 12:40:33 tm Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.6 2003-07-11 12:47:46 stefan Exp $'
! !