2 File traitsWindow _map delegates at: File traitsWindow _map delegates size - 2 put: ExternalResource traits.
3 File addSlotsFrom: ExternalResource.
4 File traits ReadWrite ::= Oddball clone.
5 File traits Read ::= Oddball clone.
6 File traits Write ::= Oddball clone.
7 File traits CreateWrite ::= Oddball clone.
8 File addSlot: #mode valued: File ReadWrite.
9 File traits ByLocation ::= Dictionary new.
10 "Maps locators to File objects, leading to a weak normalization.
11 TODO: This currently only maps open File objects, which can lead to conflicts. Weak references could fix this."
14 "Get the file size in bytes."
16 f isOpen ifTrue: [f sizeOf: f handle]
17 ifFalse: [f fileInfo ifNotNilDo: #fileSize `er]
20 f@(File traits) position
21 "Answer the handle cursor position."
22 [f positionOf: f handle].
24 f@(File traits) position: index
25 "Set the handle cursor position."
26 [f reposition: f handle to: index].
28 f@(File traits) isAtEnd
29 "Whether the file handle cursor is at the end of the file. True also if closed."
30 [f isOpen ifTrue: [f atEndOf: f handle] ifFalse: [True]].
32 f@(File traits) restoringPositionDo: block
34 origPos ::= f position.
35 [block applyWith: f] ensure: [f position := origPos]
38 f@(File traits) at: index
39 [f restoringPositionDo: [| :f | f position := index. f reader next]].
41 f@(File traits) at: index put: byte
42 [f restoringPositionDo: [| :f | f position := index. f writer nextPut: byte]].
44 f@(File traits) register
45 "Adds the File to the registration dictionary."
46 [f ByLocation at: f locator ifAbsentPut: [f]].
48 f@(File traits) unregister
49 "Removes the File from the registration dictionary."
51 f ByLocation at: f locator ifPresent:
52 [| :reg | reg == f ifTrue: [f ByLocation removeKey: f locator]]
55 f@(File traits) named: filename &mode
56 "Accesses or creates the File object associated with the specified Locator.
57 Notably, a File created this way needs to be #unregister`ed manually if it
58 is never enabled or disabled before being garbage-collected."
60 locator ::= filename as: f Locator.
61 f ByLocation at: locator ifAbsentPut: [f newNamed: locator &mode: mode]
64 f@(File traits) newNamed: filename &mode
65 "Forces the creation of a new instance of a File for the given Locator. If none
66 is registered, this File gets registered, otherwise it does not interfere with
69 mode `defaultsTo: f mode.
70 locator ::= filename as: f Locator.
71 f ByLocation at: locator ifPresent: [| :file | ].
72 f cloneSettingSlots: #{#handle. #locator. #mode} to: {Nil. locator. mode}
75 s@(String traits) file
80 f@(File traits) enable
81 "Open the file in its associated mode."
83 filename ::= f locator as: String.
86 {f Read -> [f handleForInput: filename].
87 f Write -> [f handleForOutput: filename].
88 f ReadWrite -> [f handleFor: filename].
89 f CreateWrite -> [f handleForNew: filename]}
90 otherwise: [error: 'No mode specified.'])
91 ifNil: [f connectionFailure]
92 ifNotNil: [f register].
96 file@(File traits) disable
97 "Invokes the File close primitive, and also removes it from the registration
98 dictionary, to minimize the potential for leaks."
99 [file close: file handle. file unregister].
101 f@(File traits) sessionDo: block &mode
102 "Extends the basic sessionDo: with a way to temporarily set the mode."
106 ifNotNil: [oldMode ::= f mode. f mode := mode. resend. f mode := oldMode]
109 f@(File traits) touch
110 "Opens the file, creating it if necessary, and updating access time."
113 [f mode := f CreateWrite.
114 f sessionDo: [| :_ | ]]
115 ensure: [f mode := oldmode]
118 f@(File traits) create
119 "Create a File via #touch if it does not exist."
120 [f exists ifFalse: [f touch]. f].
122 f@(File traits) delete
123 "Deletes the file, ensuring that it is closed first."
126 (f deleteFileNamed: (f locator as: String))
127 ifFalse: [error: 'Unable to delete this file.'].
130 f@(File traits) renameTo: newName
133 (f renameFileNamed: (f locator as: String) to: (newName as: String))
134 ifTrue: [f locator := newName as: f locator]
135 ifFalse: [error: 'Unable to rename this file.']
138 f1@(File traits) with: f2@(File traits) sessionDo: block &mode1 &mode2 &mode
139 "Same as sessionDo, but works with two files.
140 If &mode is defined then this mode will be used for both files."
142 mode ifNotNil: [ mode1 := mode. mode2 := mode ].
147 block applyWith: file1 with: file2
152 f@(File traits) withOpenNamed: filename do: block &mode
153 "Calls sessionDo: on a File made for the given filename and mode."
155 (f newNamed: filename) sessionDo: block &mode: mode
158 f@(File traits) exists
159 "Answer whether the file as specified by its locator already exists.
160 If it's already open, it exists; otherwise try to open it and then close it
161 if the result is successful. Then answer whether it worked."
166 f@(File traits) checkExists
167 "Raise a NotFound condition if the file as specified by its locator does not
169 If it's already open, it exists; otherwise try to open it and then close it
170 if the result is successful."
174 [[[f mode := f Read. f open] on: f ConnectionFailed do: [| :c | f notFound]]
175 ensure: [f isOpen ifTrue: [f close]. f mode := oldMode]]
178 file1@(File traits) hasSameContentsAs: file2@(File traits)
179 "Check for the exact same contents, using a quick file size check first to
182 file1 size = file2 size
183 /\ [[file1 reader with: file2 reader do:
184 [| :char1 :char2 | char1 = char2 ifFalse: [^ False]]]
185 on: Stream Exhaustion do: [| :c | ^ False]. True]
188 file1@(File traits) copyContentsTo: file2@(File traits)
190 file1 reader >> file2 writer.
194 file@(File traits) copyContentsTo: s@(Sequence traits)
195 "TODO: rename this method to something more appropriate to what it does."
197 result ::= s new &capacity: file size.
198 file sessionDo: [| :f | f reader next: file size putInto: result].
202 File traits define: #NotFound &parents: {ExternalResource ConnectionFailed}.
204 f@(File traits) connectionFailure
207 f@(File traits) notFound
208 [(f NotFound cloneSettingSlots: #{#resource} to: {f}) signal].
210 f@(File traits) noneExistsFor: filename
211 [(f NotFound cloneSettingSlots: #{#resource} to: {f newNamed: filename}) signal].
213 e@(File NotFound traits) describeOn: out
215 out ; 'A file does not exist for the pathname: '
216 ; e resource locator printString.
219 File NotFound traits define: #CreateFile &parents: {Restart}.
221 r@(File NotFound CreateFile traits) describeOn: out
222 [out ; 'Create a file with the given name.\n'].
224 r@(File NotFound CreateFile traits) defaultHandler
226 r condition resource `cache locator ensureExists.
227 r condition resource create.
230 File NotFound traits define: #SpecifyAnotherLocation &parents: {Restart} &slots: {#newLocator}.
232 r@(File NotFound SpecifyAnotherLocation traits) describeOn: out
233 [out ; 'Select a new pathname and retry opening the file\n'].
235 r@(File NotFound SpecifyAnotherLocation traits) queryFrom: d
237 d console ; 'Specify a new pathname to try to open: '.
238 r newLocator: (r condition resource Locator readFrom: d parser next).
239 "TODO: Avoid the parser since a Slate literal string is inconvenient."
242 r@(File NotFound SpecifyAnotherLocation traits) defaultHandler
244 oldLocator ::= r condition resource `cache locator.
245 r condition resource locator := r newLocator.
246 [r condition resource open]
247 on: File NotFound do:
248 [| :c | c exit. "r condition resource locator := oldLocator."
252 File traits define: #Locator &parents: {ExternalResource Locator}
254 #path -> ExtensibleArray new.
255 "The Sequence of path accessors (directory names) to reach the file's area."
257 "The name of a file(-group)."
259 "Corresponds to the filetype or suffix used in many filesystems."
261 "Corresponds to the version of a file, with optional support."
263 "The storage system or logical host of the file."
265 "The logical or physical device hosting the file. (optional)"
268 File locator := File Locator.
270 l@(File Locator traits) type
271 "So a Locator knows it's for a File and not a Directory."
274 s@(String traits) as: l@(File Locator traits)
277 l@(File Locator traits) copy
279 l cloneSettingSlots: #{#path. #name. #fileType. #version}
280 to: {l path copy. l name copy. l fileType copy. l version copy}
283 l@(File Locator traits) / name@(String traits)
285 l copy `>> [path := l path copyWith: name. ]
288 l@(File Locator traits) / names@(Sequence traits)
290 l copy `>> [path := l path ; names. ]
293 f1@(File Locator traits) = f2@(File Locator traits)
294 [f1 name = f2 name /\ [f1 path = f2 path] /\ [f1 fileType = f2 fileType]
295 /\ [f1 version = f2 version]].
297 l@(File Locator traits) new &capacity: n
299 l cloneSettingSlots: #{#path. #name. #fileType. #version}
300 to: {l path new &capacity: n. Nil. Nil. Nil}
303 l@(File Locator traits) baseName
304 "Performs the same function as POSIX basename(), answering the last element
305 of the path or the filename itself if not empty/Nil."
307 l name isNotNil /\ [l name isEmpty not]
308 ifTrue: [l name] ifFalse: [l path last]
311 l@(File Locator traits) openFile &mode
313 (File newNamed: l &mode: mode) open
316 l@(File Locator traits) sessionDo: block &mode
317 "Calls the block with the File object as input, opening and closing it
318 transparently in an error-tolerant way. The return value of the block is
319 answered if it completes without error."
320 "NOTE: This cannot protect the case where the handle is created but an error
321 occurs before it can be assigned to the #file slot."
323 [file ::= l openFile &mode: mode.
324 block applyWith: file]
326 [file ifNotNil: [file close]]
329 l1@(File Locator traits) with: l2@(File Locator traits) sessionDo: block &mode1 &mode2 &mode
330 "Same as sessionDo, but works with two files.
331 If &mode is defined then this mode will be used for both files."
333 mode ifNotNil: [mode1 := mode. mode2 := mode].
338 block apply*, file1, file2] &mode: mode2] &mode: mode1
341 File Locator traits define: #hostSeparator -> $:.
342 File Locator traits define: #pathSeparator -> $/.
344 File traits define: #AbsoluteLocator &parents: {File Locator}.
346 s@(String traits) as: l@(File AbsoluteLocator traits)
347 "Parses the String representation of a path into an actual File Locator object;
348 this will assume the current platform's naming scheme."
350 endHostPart ::= s indexOf: l hostSeparator ifAbsent: [-1].
353 host := s copyFrom: 0 to: endHostPart.
354 path := (s sliceFrom: endHostPart + 1) splitWith: l pathSeparator.
355 (s last = l pathSeparator) ifFalse: [newL path removeLast].
356 name := s last = l pathSeparator
358 ifFalse: [s copyFrom:
359 (s lastIndexOf: l pathSeparator ifAbsent: [-1]) + 1
363 l@(File Locator traits) as: _@(File Locator traits) [l].
365 File Locator traits define: #parentString -> '..'.
366 File Locator traits define: #hereString -> '.'.
367 File Locator traits define: #homeString -> '~'.
368 File Locator traits define: #dot -> $. .
370 File traits define: #RelativeLocator &parents: {File Locator} &slots: {#basePath -> File Locator}.
371 "A path taken relative to an existing one, which may be another RelativeLocator
372 but ultimately must be based on an AbsoluteLocator."
374 "The basis of the path. The other slots are treated as overrides of any
375 information in that path, except the #path which is appended to the path of
378 f1@(File RelativeLocator traits) = f2@(File RelativeLocator traits)
379 [f1 name = f2 name /\ [f1 basePath = f2 basePath] /\ [f1 path = f2 path]
380 /\ [f1 fileType = f2 fileType] /\ [f1 version = f2 version]].
382 s@(String traits) as: l@(File RelativeLocator traits) &base
384 base `defaultsTo: Directory Current.
385 resend `>> [basePath := base. ]
388 l@(File RelativeLocator traits) newFrom: base
389 [l cloneSettingSlots: #{#basePath} to: {base}].
391 l@(File Locator traits) readFrom: src &pathSeparator
393 src := src reader. "Should be a PositionableStream."
394 pathSeparator `defaultsTo: l pathSeparator.
395 firstPart ::= src upToAnyOf: ':\\/'.
396 src retract. "Position just before the first one found."
397 src isAtEnd not /\ [src peek = l hostSeparator]
400 firstPart size = 1 /\ [firstPart first isLetter]
401 "Windows-style path detection, detects a drive letter:"
402 ifTrue: [(l readFrom: src upToEnd &pathSeparator: $\\)
403 `>> [device := firstPart. ]]
404 "It's a hostname. Read the rest from scratch."
405 ifFalse: [(l readFrom: src upToEnd) `>> [host := firstPart. ]]]
406 ifFalse: "Now detect initial relativity of location or a hostname."
407 [(({l hereString. l parentString. l homeString} includes:
409 ifTrue: [l type RelativeLocator newFrom: (firstPart caseOf:
410 {l hereString -> [Directory Current].
411 l parentString -> [Directory Current parent].
412 l homeString -> [Directory Home]})]
415 "Nothing before \ or / - means it is absolute."
416 ifTrue: [l type AbsoluteLocator clone]
417 "Implicitly relative to the current directory."
419 l type RelativeLocator newFrom: Directory Current]])
420 "Now read the sequence of Path elements into it."
421 `>> [readPathElementsFrom: src &pathSeparator: pathSeparator. ]]
424 l@(File Locator traits) readPathElementsFrom: s &pathSeparator
426 pathSeparator `defaultsTo: l pathSeparator.
427 pathElements ::= s upToEnd splitWith: pathSeparator.
428 l path := pathElements allButLast.
429 pathElements isEmpty ifFalse: [l readFilenameFrom: pathElements last].
432 l@(File Locator traits) readFilenameFrom: s
434 l name := s copyUpToLast: l dot.
435 (s lastIndexOf: l dot) ifNotNil: [l fileType := s copyAfterLast: l dot].
438 l@(File Locator traits) isRoot
439 "Whether this describes the Root path or an entry within it."
440 [l path isEmpty \/ [l path size = 1 /\ [l path first isEmpty]]].
442 l@(File RelativeLocator traits) isRoot
443 "Relative locators can never be root."
444 [resend /\ [l basePath isRoot]].
446 l@(File Locator traits) reduce
447 "Eliminate uses of . and .. in the path Sequence."
449 "First, remove all . entries."
450 [(curIndex := l path indexOf: l hereString) isNotNil] whileTrue:
451 [l path removeAt: curIndex].
452 "Now, remove all non-initial .. entries and those that precede them."
453 "Find the first non-.. entry."
454 (curIndex := l path indexOfFirstSatisfying: #(~= l parentString) `er)
456 [[(curIndex := l path indexOf: l parentString startingAt: curIndex)
458 whileTrue: [l path removeAt: curIndex. l path removeAt: curIndex - 1]].
462 l@(File RelativeLocator traits) reduce
463 "Go one step further than the generic Locator reduce by manually re-adjusting
464 the basePath by climbing up the number of parents as there are initial ..
465 entries in the path."
468 (l path indexOfFirstSatisfying: #(~= l parentString) `er)
469 ifNotNilDo: [| :numParents |
470 numParents isPositive
471 ifTrue: [l basePath := l basePath locator copy. l basePath path removeLast: numParents].
472 l path removeFirst: numParents].
476 l@(File Locator traits) writeDeviceOrHostOn: s
479 ifNil: [l host ifNotNil: [s ; l host. s nextPut: l hostSeparator]]
480 ifNotNil: [s ; l device. s nextPut: l hostSeparator].
483 l@(File Locator traits) writeNameVersionTypeOn: s
485 l name ifNotNil: [s ; l name].
486 l version ifNotNil: [s ; l hereString ; l version printString].
487 l fileType ifNotNil: [s ; l hereString ; l fileType].
490 l@(File Locator traits) as: s@(String traits) &pathSeparator &relativeTo: basePath
492 l device ifNotNil: [pathSeparator := $\\].
493 pathSeparator `defaultsTo: l pathSeparator.
495 l writeDeviceOrHostOn: s.
496 l path do: [| :each | s ; each. s nextPut: pathSeparator].
497 l writeNameVersionTypeOn: s] writingAs: s
500 l@(File RelativeLocator traits) as: s@(String traits) &pathSeparator &relativeTo: basePath
502 l device ifNotNil: [pathSeparator := $\\].
503 pathSeparator `defaultsTo: l pathSeparator.
504 basePath `defaultsTo: Directory current.
506 l writeDeviceOrHostOn: s.
507 l basePath ifNotNilDo:
508 [| :base | base locator ifNotNilDo:
509 [| :locator | locator = Directory current locator ifFalse:
510 [s ; (locator as: String &pathSeparator: pathSeparator &relativeTo: basePath)]]].
511 l path do: [| :each | s ; each. s nextPut: pathSeparator].
512 l writeNameVersionTypeOn: s] writingAs: s
515 l@(File AbsoluteLocator traits) as: s@(String traits) &pathSeparator &relativeTo: basePath
517 l device ifNotNil: [pathSeparator := $\\].
518 pathSeparator `defaultsTo: l pathSeparator.
519 basePath `defaultsTo: Directory root.
521 l writeDeviceOrHostOn: s.
522 s nextPut: pathSeparator.
524 [l path do: [| :each | s ; each. s nextPut: pathSeparator]].
525 l writeNameVersionTypeOn: s] writingAs: s
528 l@(File Locator traits) printOn: s &relativeTo: basePath
529 "Print out (each/path/element)/name.version.fileType."
531 s ; 'p\'' ; (l as: String &relativeTo: basePath) escaped ; '\''
534 l@(File Locator traits) newChildNamed: name
535 [l copy `>> [path addLast: name. ]].
537 "File traits define: #Stream
538 &parents: {ExternalResource ReadWriteStream. PositionableStream}.
539 File Stream removeSlot: #position."
541 "fix: this is a hack (i.e. problem with parent linearization) to make sure we know that
542 ExternalResource Stream is a more significant trait than PositionableStream but we need
543 both in the chain. The #on: function needs to resolve first to ExternalResource Stream."
545 File traits define: #Stream &parents: {ExternalResource ReadWriteStream. ExternalResource ReadStream. ExternalResource WriteStream. ExternalResource Stream. PositionableStream}.
546 File Stream removeSlot: #position.
547 File traits define: #ReadStream &parents: {File Stream}.
548 File traits define: #WriteStream &parents: {File Stream}.
549 File traits define: #ReadWriteStream &parents: {File Stream}.
551 File traits define: #ASCIIStream &parents: {File Stream}.
552 File traits define: #ASCIIReadStream &parents: {File ReadStream}.
553 File traits define: #ASCIIWriteStream &parents: {File WriteStream}.
554 File traits define: #ASCIIReadWriteStream &parents: {File ReadWriteStream}.
555 fs@(File ASCIIStream traits) elementType [ASCIIString Character].
556 fs@(File ASCIIStream traits) collectionType [ASCIIString].
557 fs@(File ASCIIReadStream traits) elementType [ASCIIString Character].
558 fs@(File ASCIIReadStream traits) collectionType [ASCIIString].
559 fs@(File ASCIIWriteStream traits) elementType [ASCIIString Character].
560 fs@(File ASCIIWriteStream traits) collectionType [ASCIIString].
561 fs@(File ASCIIReadWriteStream traits) elementType [ASCIIString Character].
562 fs@(File ASCIIReadWriteStream traits) collectionType [ASCIIString].
565 fs@(File Stream traits) on: target@(String traits)
566 "Open a File ReadWriteStream on the String path."
568 fs on: (File newNamed: target &mode: File ReadWrite) open
571 fs@(File ReadStream traits) on: target@(String traits)
572 "Open a File ReadStream on the String path."
574 fs on: (File newNamed: target &mode: File Read) open
577 fs@(File WriteStream traits) on: target@(String traits)
578 "Open a File WriteStream on the String path."
580 fs on: (File newNamed: target &mode: File Write) open
583 fs@(File ReadWriteStream traits) on: target@(String traits)
584 "Open a File ReadWriteStream on the String path."
586 fs on: (File newNamed: target &mode: File ReadWrite) open
589 fs@(File Stream traits) elementType
592 fs@(File Stream traits) collectionType
597 fs@(File Stream traits) position
598 [fs resource position].
600 fs@(File Stream traits) position: index
601 [fs resource position := index].
603 fs@(File Stream traits) isAtEnd
604 [fs resource isAtEnd].
606 fs@(File Stream traits) peekForwardBy: offset
607 "Saves the original position and moves forward by the given offset and then
608 restores before answering the element found."
610 ((origPos ::= fs position) + offset between: 0 and: fs resource size)
611 ifFalse: [error: 'Beyond the end of the file.'].
612 fs position := origPos + offset - 1.
614 fs position := origPos.
618 fs@(File Stream traits) contents
619 "Get everything from the file at once, preserving the current position in the
624 s ::= fs next: fs resource size.
629 f@(File traits) contents
631 f sessionDo: [| :in size result |
633 result := String newSize: size.
634 (in read: size into: result).
639 fs@(File Stream traits) file
642 File traits define: #Info &parents: {Cloneable} &slots: {#data -> Array new}.
644 l@(File Info traits) newNamed: locator
646 (File informationForFileNamed: (locator as: String))
647 ifNotNilDo: [| :data | l clone `>> [data := data. ]]
650 l@(File Locator traits) exists
655 l@(File Locator traits) fileInfo
657 File Info newNamed: l
660 f@(File traits) fileInfo
662 f Info newNamed: f locator
665 i@(File Info traits) fileSize
670 i@(File Info traits) accessTimestamp
675 i@(File Info traits) modificationTimestamp
680 i@(File Info traits) creationTimestamp
685 "We express the bitmask checks in octal to verify against stat.h"
687 i@(File Info traits) typeBits
689 i data last bitAnd: 8r0170000
692 i@(File Info traits) isFile
694 i typeBits = 8r100000
697 i@(File Info traits) isDirectory
699 i typeBits = 8r040000
702 i@(File Info traits) isLink
704 i typeBits = 8r120000
707 i@(File Info traits) isFIFO
709 i typeBits = 8r010000
712 i@(File Info traits) isCharacterDevice
714 i typeBits = 8r020000
717 i@(File Info traits) isBlockDevice
719 i typeBits = 8r060000
722 i@(File Info traits) isSocket
724 i typeBits = 8r140000
727 i@(File Info traits) accessBits
729 i data last bitAnd: 8r777