--- a/FileURI.st Mon Jul 14 00:40:50 2003 +0200
+++ b/FileURI.st Mon Jul 14 00:50:08 2003 +0200
@@ -79,7 +79,7 @@
!FileURI methodsFor:'queries'!
-pathExists
+exists
^ self asFilename exists
! !
@@ -133,80 +133,88 @@
- a collection with a stream on a single file,
- or a collection with streams on a directorie's files, but not recursive"
- self readStreamsDo:aBlock thenRemove:false.
+ self readStreamsDo:aBlock renameBlock:nil.
!
-readStreamsDo:aBlock thenRemove:doRemoveSource
+readStreamsDo:aBlock renameBlock:renameBlock
"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"
+ - or a collection with streams on a directories files, but not recursive"
- |attributes fn files list dirPath|
+ |attributes fn files list baseName|
- fn := self path asFilename.
+ fn := self asFilename.
files := OrderedCollection new.
list := OrderedCollection new.
attributes := self class attributes.
fn isDirectory ifTrue:[
- dirPath := fn pathName.
attributes at:#requestDirectory put:true.
- (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
- files add:aFile
+ fn directoryContentsAsFilenamesDo:[:eachFilename|
+ eachFilename isDirectory ifFalse:[
+ files add:eachFilename
+ ].
].
] ifFalse:[
- attributes at:#requestDirectory put:false.
- files add:fn.
- ].
-
- fn isDirectory ifFalse:[ |bName|
- bName := fn baseName.
- (bName startsWith:'*') ifTrue:[
- files removeAll.
- fn := fn directory.
- dirPath := fn pathName.
+ baseName := fn baseName.
+ (baseName includesAny:'*?[]') ifTrue:[ |directoryName|
attributes at:#requestDirectory put:true.
- (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
- files add:aFile
+ directoryName := fn directory.
+ directoryName directoryContentsDo:[:eachFilenameString|
+ (baseName match:eachFilenameString) ifTrue:[ |filename|
+ filename := directoryName construct:eachFilenameString.
+ filename isDirectory ifFalse:[
+ files add:(directoryName construct:eachFilenameString).
+ ].
+ ].
].
- ].
- (bName startsWith:'*.') ifTrue:[ |rest|
- rest := bName restAfter:$*.
- (rest includesString:'*') ifTrue:[
- self error:'can''t resolve path:', self printString
- ].
- files := files select:[:aFile| aFile pathName endsWith:rest ]
+ ] ifFalse:[
+ attributes at:#requestDirectory put:false.
+ files add:fn.
].
].
- files do:[:aFile| |baseName stream|
+ files do:[:eachFilename| |baseName stream|
[
- baseName := aFile baseName.
- attributes at:#fileSize put:(aFile fileSize).
+ baseName := eachFilename baseName.
+ attributes at:#fileSize put:eachFilename fileSize.
attributes at:#baseName put:baseName.
- (self pathSegements includes:baseName) ifTrue:[
+ (self pathSegments includes:baseName) ifTrue:[
attributes at:#uriInfo put:self.
] ifFalse:[ |uri col|
uri := self copy.
- col := self pathSegements copy.
+ col := self pathSegments copy.
col removeLast.
col add:baseName.
- uri pathSegements:col.
+ uri pathSegments:col.
attributes at:#uriInfo put:uri.
].
- stream := aFile readStream.
+ stream := eachFilename readStream.
aBlock value:stream value:attributes.
] ensure:[
stream notNil ifTrue:[stream close]
].
- doRemoveSource == true ifTrue:[
- aFile remove
+
+ renameBlock notNil ifTrue:[ |renameFilenameString|
+ renameFilenameString := renameBlock value:eachFilename pathName.
+ renameFilenameString asFilename exists ifTrue:[
+ renameFilenameString := renameFilenameString, '.',
+ (AbsoluteTime now printStringFormat:'%(year)%(mon)%(day)%h%m%s').
+ ].
+ eachFilename moveTo:renameFilenameString.
].
].
"
- (URI fromString:'file:/home/tm/tmp')
+ (URI fromString:'file:~/test/out')
+ readStreamsDo:[:stream :attributes |
+ Transcript showCR:(attributes at:#baseName).
+ Transcript showCR:(attributes at:#fileSize).
+ Transcript showCR:(attributes at:#requestDirectory).
+ Transcript showCR:(attributes at:#uriInfo).
+ ].
+ (URI fromString:'file:~/test/out/*1')
readStreamsDo:[:stream :attributes |
Transcript showCR:(attributes at:#baseName).
Transcript showCR:(attributes at:#fileSize).
@@ -258,10 +266,12 @@
|stream fileName toFileName|
fileName := self asFilename.
+ toFileName := fileName.
doAtomic ifTrue:[
- toFileName := fileName directory construct:'.transferFile'.
- ] ifFalse:[
- toFileName := fileName.
+ fileName isDirectory ifFalse:[
+ toFileName := fileName directory.
+ ].
+ toFileName := toFileName construct:'.transferFile'.
].
[
Stream streamErrorSignal handle:[:ex|
@@ -274,10 +284,11 @@
stream := toFileName writeStream.
].
aBlock value:stream value:self class attributes.
+ stream close.
doAtomic ifTrue:[
toFileName moveTo:fileName.
]
- ] ensure:[
+ ] ifCurtailed:[
stream notNil ifTrue:[stream close]
].
@@ -293,5 +304,5 @@
!FileURI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.7 2003-07-11 12:46:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.8 2003-07-13 22:50:00 stefan Exp $'
! !
--- a/FtpURI.st Mon Jul 14 00:40:50 2003 +0200
+++ b/FtpURI.st Mon Jul 14 00:50:08 2003 +0200
@@ -36,12 +36,11 @@
!FtpURI methodsFor:'ftp requests'!
connectThenDo:aOneArgBlock
+ "setup a ftp connection and call aOneArgBlock with it"
|ftp|
ftp := FTPClient new.
-
-
[
ftp connectTo:self host
port:self port
@@ -55,8 +54,9 @@
]
!
-pathExists
- "establish a connection for try to get a readSteream"
+exists
+ "does the file represented by this uri exist?
+ establish a connection for try to get a readStream"
|exists|
@@ -98,7 +98,7 @@
path := self path.
attributes := self class attributes.
attributes at:#fileSize put:(ftp sizeOf:path).
- attributes at:#baseName put:self pathSegements last.
+ attributes at:#baseName put:self pathSegments last.
attributes at:#uriInfo put:self printString.
stream := ftp getStreamFor:path.
@@ -126,10 +126,22 @@
The streams are closed after aBlock has been evaluated.
Attributes may be the mime type (key #MIME)"
- self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:false
+ self readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:nil
!
-readStreamsDo:aBlock skipFilenamesWithSuffix:aSuffix thenRemove:doRemoveSource
+readStreamsDo:aBlock renameBlock:renameBlock
+ "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 readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:renameBlock
+!
+
+readStreamsDo:aBlock skipFilenamesWithSuffix:skipSuffix renameBlock:renameBlock
"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,
@@ -138,7 +150,7 @@
The streams are closed after aBlock has been evaluated.
Attributes may be the mime type (key #MIME)"
- |attributes list requestDirectory path dirPath|
+ |attributes list requestDirectory path dirUri dirPath|
requestDirectory := false.
path := self path.
@@ -146,74 +158,80 @@
(path startsWith:'/~') ifTrue:[
path := path copyFrom:2.
].
+
attributes := self class attributes.
list := OrderedCollection new.
- self connectThenDo:[:ftp|
- FTPClient fileErrorSignal handle:[:ex|
- list add:path.
- attributes at:#requestDirectory put:false.
- ] do:[
- dirPath := path.
+ self connectThenDo:[:ftp| |baseName|
+ "try to change directory to path.
+ If we get a file error, we know that the directory does not exist"
+ baseName := self baseName.
+ (baseName includesAny:'*?[]') ifTrue:[
+ requestDirectory := true.
+ dirUri := self directory.
+ dirPath := dirUri path.
ftp cd:dirPath.
- requestDirectory := true.
- attributes at:#requestDirectory put:true.
- list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
+ list addAll:
+ (ftp nlist select:[:filenameString| filenameString matches:baseName]).
+ ] ifFalse:[
+ [
+ dirUri := self.
+ dirPath := path.
+ ftp cd:dirPath.
+ requestDirectory := true.
+ list addAll:ftp nlist.
+ ] on:FTPClient fileErrorSignal do:[:ex|
+ "no directory, fetch path istSelf"
+ ].
].
-
- requestDirectory ifFalse:[ |bName|
- bName := self pathSegements last.
- (bName startsWith:'*') ifTrue:[
- list removeAll.
- requestDirectory := true.
- attributes at:#requestDirectory put:true.
- dirPath := (path asFilename directory) pathName.
- ftp cd:dirPath.
- list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
- ].
- (bName startsWith:'*.') ifTrue:[ |rest|
- rest := bName restAfter:$*.
- (rest includesString:'*') ifTrue:[
- self error:'can''t resolve path:', self printString
- ].
- list := list select:[:str| str endsWith:rest ]
- ].
+ requestDirectory ifFalse:[
+ dirUri := self directory.
+ dirPath := dirUri path.
+ ftp cd:dirPath.
+ list add:self baseName.
].
- aSuffix size ~~ 0 ifTrue:[
- list := list select:[:str| (str endsWith:aSuffix) not ]
+ attributes at:#requestDirectory put:requestDirectory.
+
+ "skip all files with skipSuffix aka 'file.old'"
+ skipSuffix size == 0 ifFalse:[
+ list := list select:[:baseName| (baseName endsWith:skipSuffix) not]
].
- list do:[:aPathName| |baseName stream|
+ list do:[:eachBaseName| |stream|
+ "get a stream for the contents of the file"
FTPClient fileErrorSignal handle:[:ex|
- "/ skip subdirectories and the summary of the list
+ "ignore errors -- skip subdirectories"
] 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 := ftp getStreamFor:eachBaseName.
+ attributes at:#fileSize put:(ftp sizeOf:eachBaseName).
+ attributes at:#baseName put:eachBaseName.
].
- stream notNil ifTrue:[ |src srcPath|
- (self pathSegements includes:baseName) ifTrue:[
- srcPath := (dirPath asFilename) pathName.
- attributes at:#uriInfo put:self.
- ] ifFalse:[ |pathSegements|
- src := self copy.
- pathSegements := (dirPath asFilename construct:baseName) components.
- pathSegements removeFirst.
- src pathSegements:pathSegements.
- srcPath := src path.
- attributes at:#uriInfo put:src.
+ stream notNil ifTrue:[ |srcUri srcPath|
+ requestDirectory ifTrue:[
+ "accessing the contents of a directory"
+ srcUri := dirUri construct:eachBaseName.
+ ] ifFalse:[ |pathSegments|
+ "accessing a single file"
+ srcUri := self.
].
+ attributes at:#uriInfo put:srcUri.
- [ aBlock value:stream value:attributes ]
- ensure:[ stream close ].
- doRemoveSource == true ifTrue:[
- (srcPath startsWith:'/') ifFalse:[ srcPath := '/', srcPath ].
- ftp delete:srcPath.
+ [
+ aBlock value:stream value:attributes
+ ] ensure:[stream close].
+
+ renameBlock notNil ifTrue:[ |renameFilenameString|
+ renameFilenameString := renameBlock value:eachBaseName.
+ [
+ ftp rename:eachBaseName to:renameFilenameString.
+ ] on:FTPClient fileErrorSignal do:[:ex|
+ "rename failed, maybe file already exists"
+ renameFilenameString := renameFilenameString, '.',
+ (AbsoluteTime now printStringFormat:'%(year)%(mon)%(day)%h%m%s').
+ ftp rename:eachBaseName to:renameFilenameString.
+ ]
].
].
].
@@ -224,7 +242,7 @@
|pwd|
pwd := Dialog requestPassword:''.
- (URI fromString:('ftp://tm:%1@exept/home/tm/tmp' bindWith:pwd) )
+ (URI fromString:('ftp://tm:%1@exept/~/tmp' bindWith:pwd) )
readStreamsDo:[:stream :attributes |
Transcript showCR:(attributes at:#baseName).
Transcript showCR:(attributes at:#fileSize).
@@ -234,27 +252,11 @@
"
!
-readStreamsDo:aBlock thenRemove:doRemoveSource
- "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 readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:doRemoveSource
-!
-
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:[
@@ -286,19 +288,23 @@
|path toPath directory|
path := self path.
+ "kludge"
+ (path startsWith:'/~') ifTrue:[
+ path := path copyFrom:2.
+ ].
+
doAtomic ifTrue:[
toPath := self directoryPath, '/.transferFile'.
+ "kludge"
+ (toPath startsWith:'/~') ifTrue:[
+ toPath := toPath copyFrom:2.
+ ].
] ifFalse:[
toPath := path.
].
self connectThenDo:[:ftp| |stream|
[
- ftp connectTo:self host
- port:self port
- user:(self user ? self defaultUser)
- password:(self password ? self defaultPassword).
-
[
stream := ftp putStreamFor:toPath.
] on:FTPClient filePutErrorSignal do:[:ex|
@@ -314,10 +320,11 @@
stream := ftp putStreamFor:toPath.
].
aBlock value:stream value:self class attributes.
+ stream close.
doAtomic ifTrue:[
ftp rename:toPath to:path
].
- ] ensure:[
+ ] ifCurtailed:[
stream notNil ifTrue:[
stream close.
].
@@ -336,5 +343,5 @@
!FtpURI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.8 2003-07-11 12:48:15 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.9 2003-07-13 22:49:52 stefan Exp $'
! !
--- a/HierarchicalURI.st Mon Jul 14 00:40:50 2003 +0200
+++ b/HierarchicalURI.st Mon Jul 14 00:50:08 2003 +0200
@@ -79,6 +79,10 @@
authority := something.
!
+baseName
+ ^ pathSegments last
+!
+
examples
"
@@ -113,14 +117,14 @@
^ isDirectory ? false
!
-pathSegements
- "return the value of the instance variable 'pathSegements' (automatically generated)"
+pathSegments
+ "return the value of the instance variable 'pathSegments' (automatically generated)"
^ pathSegments
!
-pathSegements:something
- "set the value of the instance variable 'pathSegements' (automatically generated)"
+pathSegments:something
+ "set the value of the instance variable 'pathSegments' (automatically generated)"
pathSegments := something.
!
@@ -361,7 +365,7 @@
aStream nextPut:$/.
].
pathSegments size > 1 ifTrue:[
- (pathSegments copyFrom:2) do:[:p|
+ (pathSegments copyTo:pathSegments size-1) do:[:p|
self class escape:p allow:'~;:@&=+",' on:aStream
] separatedBy:[
aStream nextPut:$/
@@ -459,7 +463,7 @@
(aString = '..'
and:[pathSegments size ~~ 0
- and:[pathSegments first ~= '..']]) ifTrue:[
+ and:[pathSegments last ~= '..']]) ifTrue:[
pathSegments removeLast.
] ifFalse:[
pathSegments add:aString
@@ -467,15 +471,35 @@
!
construct:aString
- "concatenate anUri to my path"
+ "concatenate aString to my path"
^ self copy
addComponent:aString;
yourself.
+!
+
+directory
+ "remove the last path component"
+
+ ^ self copy
+ removeLastComponent;
+ yourself.
+!
+
+removeLastComponent
+ "remove the last component"
+
+ pathSegments size ~~ 0 ifTrue:[
+ pathSegments last = '..' ifTrue:[
+ pathSegments add:'..'.
+ ] ifFalse:[
+ pathSegments removeLast.
+ ].
+ ].
! !
!HierarchicalURI class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.5 2003-07-11 12:47:04 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.6 2003-07-13 22:50:08 stefan Exp $'
! !