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