124 - or a collection with streams on a directorie's files, but not recursive |
124 - or a collection with streams on a directorie's files, but not recursive |
125 |
125 |
126 The streams are closed after aBlock has been evaluated. |
126 The streams are closed after aBlock has been evaluated. |
127 Attributes may be the mime type (key #MIME)" |
127 Attributes may be the mime type (key #MIME)" |
128 |
128 |
129 self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:false |
129 self readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:nil |
130 ! |
130 ! |
131 |
131 |
132 readStreamsDo:aBlock skipFilenamesWithSuffix:aSuffix thenRemove:doRemoveSource |
132 readStreamsDo:aBlock renameBlock:renameBlock |
133 "evaluate the block with a Collection of streams as first argument |
133 "evaluate the block with a Collection of streams as first argument |
134 and a dictionary containing attributes as second argument, |
134 and a dictionary containing attributes as second argument, |
135 - a collection with a stream on a single file, |
135 - a collection with a stream on a single file, |
136 - or a collection with streams on a directorie's files, but not recursive |
136 - or a collection with streams on a directorie's files, but not recursive |
137 |
137 |
138 The streams are closed after aBlock has been evaluated. |
138 The streams are closed after aBlock has been evaluated. |
139 Attributes may be the mime type (key #MIME)" |
139 Attributes may be the mime type (key #MIME)" |
140 |
140 |
141 |attributes list requestDirectory path dirPath| |
141 self readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:renameBlock |
|
142 ! |
|
143 |
|
144 readStreamsDo:aBlock skipFilenamesWithSuffix:skipSuffix renameBlock:renameBlock |
|
145 "evaluate the block with a Collection of streams as first argument |
|
146 and a dictionary containing attributes as second argument, |
|
147 - a collection with a stream on a single file, |
|
148 - or a collection with streams on a directorie's files, but not recursive |
|
149 |
|
150 The streams are closed after aBlock has been evaluated. |
|
151 Attributes may be the mime type (key #MIME)" |
|
152 |
|
153 |attributes list requestDirectory path dirUri dirPath| |
142 |
154 |
143 requestDirectory := false. |
155 requestDirectory := false. |
144 path := self path. |
156 path := self path. |
145 "kludge" |
157 "kludge" |
146 (path startsWith:'/~') ifTrue:[ |
158 (path startsWith:'/~') ifTrue:[ |
147 path := path copyFrom:2. |
159 path := path copyFrom:2. |
148 ]. |
160 ]. |
|
161 |
149 attributes := self class attributes. |
162 attributes := self class attributes. |
150 list := OrderedCollection new. |
163 list := OrderedCollection new. |
151 |
164 |
152 self connectThenDo:[:ftp| |
165 self connectThenDo:[:ftp| |baseName| |
153 FTPClient fileErrorSignal handle:[:ex| |
166 "try to change directory to path. |
154 list add:path. |
167 If we get a file error, we know that the directory does not exist" |
155 attributes at:#requestDirectory put:false. |
168 baseName := self baseName. |
156 ] do:[ |
169 (baseName includesAny:'*?[]') ifTrue:[ |
157 dirPath := path. |
170 requestDirectory := true. |
|
171 dirUri := self directory. |
|
172 dirPath := dirUri path. |
158 ftp cd:dirPath. |
173 ftp cd:dirPath. |
159 requestDirectory := true. |
174 list addAll: |
160 attributes at:#requestDirectory put:true. |
175 (ftp nlist select:[:filenameString| filenameString matches:baseName]). |
161 list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]). |
176 ] ifFalse:[ |
162 ]. |
177 [ |
163 |
178 dirUri := self. |
164 requestDirectory ifFalse:[ |bName| |
179 dirPath := path. |
165 bName := self pathSegements last. |
180 ftp cd:dirPath. |
166 (bName startsWith:'*') ifTrue:[ |
|
167 list removeAll. |
|
168 requestDirectory := true. |
181 requestDirectory := true. |
169 attributes at:#requestDirectory put:true. |
182 list addAll:ftp nlist. |
170 dirPath := (path asFilename directory) pathName. |
183 ] on:FTPClient fileErrorSignal do:[:ex| |
171 ftp cd:dirPath. |
184 "no directory, fetch path istSelf" |
172 list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]). |
185 ]. |
173 ]. |
186 ]. |
174 (bName startsWith:'*.') ifTrue:[ |rest| |
187 requestDirectory ifFalse:[ |
175 rest := bName restAfter:$*. |
188 dirUri := self directory. |
176 (rest includesString:'*') ifTrue:[ |
189 dirPath := dirUri path. |
177 self error:'can''t resolve path:', self printString |
190 ftp cd:dirPath. |
|
191 list add:self baseName. |
|
192 ]. |
|
193 |
|
194 attributes at:#requestDirectory put:requestDirectory. |
|
195 |
|
196 "skip all files with skipSuffix aka 'file.old'" |
|
197 skipSuffix size == 0 ifFalse:[ |
|
198 list := list select:[:baseName| (baseName endsWith:skipSuffix) not] |
|
199 ]. |
|
200 |
|
201 list do:[:eachBaseName| |stream| |
|
202 "get a stream for the contents of the file" |
|
203 FTPClient fileErrorSignal handle:[:ex| |
|
204 "ignore errors -- skip subdirectories" |
|
205 ] do:[ |
|
206 stream := ftp getStreamFor:eachBaseName. |
|
207 attributes at:#fileSize put:(ftp sizeOf:eachBaseName). |
|
208 attributes at:#baseName put:eachBaseName. |
|
209 ]. |
|
210 |
|
211 stream notNil ifTrue:[ |srcUri srcPath| |
|
212 requestDirectory ifTrue:[ |
|
213 "accessing the contents of a directory" |
|
214 srcUri := dirUri construct:eachBaseName. |
|
215 ] ifFalse:[ |pathSegments| |
|
216 "accessing a single file" |
|
217 srcUri := self. |
178 ]. |
218 ]. |
179 list := list select:[:str| str endsWith:rest ] |
219 attributes at:#uriInfo put:srcUri. |
180 ]. |
220 |
181 ]. |
221 [ |
182 |
222 aBlock value:stream value:attributes |
183 aSuffix size ~~ 0 ifTrue:[ |
223 ] ensure:[stream close]. |
184 list := list select:[:str| (str endsWith:aSuffix) not ] |
224 |
185 ]. |
225 renameBlock notNil ifTrue:[ |renameFilenameString| |
186 |
226 renameFilenameString := renameBlock value:eachBaseName. |
187 list do:[:aPathName| |baseName stream| |
227 [ |
188 FTPClient fileErrorSignal handle:[:ex| |
228 ftp rename:eachBaseName to:renameFilenameString. |
189 "/ skip subdirectories and the summary of the list |
229 ] on:FTPClient fileErrorSignal do:[:ex| |
190 ] do:[ |
230 "rename failed, maybe file already exists" |
191 stream := ftp getStreamFor:aPathName. |
231 renameFilenameString := renameFilenameString, '.', |
192 attributes at:#fileSize put:(ftp sizeOf:aPathName). |
232 (AbsoluteTime now printStringFormat:'%(year)%(mon)%(day)%h%m%s'). |
193 requestDirectory |
233 ftp rename:eachBaseName to:renameFilenameString. |
194 ifTrue:[ baseName := aPathName ] |
234 ] |
195 ifFalse:[ baseName := self pathSegements last ]. |
|
196 attributes at:#baseName put:baseName |
|
197 ]. |
|
198 |
|
199 stream notNil ifTrue:[ |src srcPath| |
|
200 (self pathSegements includes:baseName) ifTrue:[ |
|
201 srcPath := (dirPath asFilename) pathName. |
|
202 attributes at:#uriInfo put:self. |
|
203 ] ifFalse:[ |pathSegements| |
|
204 src := self copy. |
|
205 pathSegements := (dirPath asFilename construct:baseName) components. |
|
206 pathSegements removeFirst. |
|
207 src pathSegements:pathSegements. |
|
208 srcPath := src path. |
|
209 attributes at:#uriInfo put:src. |
|
210 ]. |
235 ]. |
211 |
|
212 [ aBlock value:stream value:attributes ] |
|
213 ensure:[ stream close ]. |
|
214 doRemoveSource == true ifTrue:[ |
|
215 (srcPath startsWith:'/') ifFalse:[ srcPath := '/', srcPath ]. |
|
216 ftp delete:srcPath. |
|
217 ]. |
|
218 ]. |
236 ]. |
219 ]. |
237 ]. |
220 ]. |
238 ]. |
221 |
239 |
222 |
240 |
223 " |
241 " |
224 |pwd| |
242 |pwd| |
225 |
243 |
226 pwd := Dialog requestPassword:''. |
244 pwd := Dialog requestPassword:''. |
227 (URI fromString:('ftp://tm:%1@exept/home/tm/tmp' bindWith:pwd) ) |
245 (URI fromString:('ftp://tm:%1@exept/~/tmp' bindWith:pwd) ) |
228 readStreamsDo:[:stream :attributes | |
246 readStreamsDo:[:stream :attributes | |
229 Transcript showCR:(attributes at:#baseName). |
247 Transcript showCR:(attributes at:#baseName). |
230 Transcript showCR:(attributes at:#fileSize). |
248 Transcript showCR:(attributes at:#fileSize). |
231 Transcript showCR:(attributes at:#requestDirectory). |
249 Transcript showCR:(attributes at:#requestDirectory). |
232 Transcript showCR:(attributes at:#uriInfo). |
250 Transcript showCR:(attributes at:#uriInfo). |
233 ]. |
251 ]. |
234 " |
252 " |
235 ! |
253 ! |
236 |
254 |
237 readStreamsDo:aBlock thenRemove:doRemoveSource |
|
238 "evaluate the block with a Collection of streams as first argument |
|
239 and a dictionary containing attributes as second argument, |
|
240 - a collection with a stream on a single file, |
|
241 - or a collection with streams on a directorie's files, but not recursive |
|
242 |
|
243 The streams are closed after aBlock has been evaluated. |
|
244 Attributes may be the mime type (key #MIME)" |
|
245 |
|
246 self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:doRemoveSource |
|
247 ! |
|
248 |
|
249 writeStreamDo:aBlock |
255 writeStreamDo:aBlock |
250 "use FTPClient for now" |
256 "use FTPClient for now" |
251 |
257 |
252 self connectThenDo:[:ftp| |stream| |
258 self connectThenDo:[:ftp| |stream| |
253 [ |
259 [ |
254 ftp connectTo:self host |
|
255 port:self port |
|
256 user:(self user ? self defaultUser) |
|
257 password:(self password ? self defaultPassword). |
|
258 stream := ftp putStreamFor:self path. |
260 stream := ftp putStreamFor:self path. |
259 aBlock value:stream value:self class attributes. |
261 aBlock value:stream value:self class attributes. |
260 ] ensure:[ |
262 ] ensure:[ |
261 stream notNil ifTrue:[ |
263 stream notNil ifTrue:[ |
262 stream close. |
264 stream close. |