Files.ns

Newspeak3
'NSFiles'
class Files usingPlatform: platform = (
(* This code was derived by converting the Strongtalk File classes to Newspeak, which is why the Sun Microsystems copyright and BSD license below applies.

Copyright (c) 1995-2006 Sun Microsystems, Inc. ALL RIGHTS RESERVED.
Copyright 2008-2009 Gilad Bracha and other contributors.
Copyright 2010 Ryan Macnak and other contributors.

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

* Redistributions of source code must retain the above copyright notice,
 this  list of conditions and the following disclaimer.

* Redistribution in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation and/o other materials provided with the distribution.

Neither the name of Sun Microsystems or the names of contributors may
be used to endorse or promote products derived from this software without
specific prior written permission.

>>
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.>> *)
|
(* Imports *)
(* Standard stuff *)
private IdentitySet = platform collections IdentitySet.
private List = platform collections List.

(* Alien stuff *)
private Alien = platform aliens Alien.

(* Streams *)
private ExternalOutputStream = platform streams ExternalOutputStream.
private ExternalReadStream = platform streams ExternalReadStream.
private ExternalReadWriteStream = platform streams ExternalReadWriteStream.
private CharacterReadConverter = platform streams CharacterReadConverter.
private CharacterInputOutputConverter = platform streams CharacterInputOutputConverter.

(* mixins *)
private ExternalFilePattern = ExternalObject mixinApply: FilePattern.
private ExternalStreamableFilePattern = ExternalStreamableObject mixinApply: ExternalFilePattern.

(* module variables *)
OpenDescriptors ::= IdentitySet(* [ExternalDescriptor] *) new.

public platformSpecificPathClass
public platformSpecificPatternClass
|#TODO yourself) (
class ExternalDescriptor = Object (
(* ExternalDescriptors represent 'handles' to transient operating system objects such as open file descriptors, semaphores, etc.
This class keeps track of the state of such descriptors, and attempts to 'reopen' them if possible after image restarts.

Instances must be closed using finalization if they are garbage collected while open.  This
can be handled automatically by sending the message #register to an instance.  This may not
be appropriate in all cases, since sometimes the finalization should be handled by a higher-level
object so that buffer flushing or other operations can be performed before closing.

These objects are not generally handled directly by programmers- they are generally wrapped in a higher-level abstraction such as a stream.

Subclass
	%responsibility flushIfFail:
	Subclasses for which flushing has meaning must reimplement flushIfFail:
*)
|
public externalObject <EOBJ> (* is nil if closed *)
handle <ExternalProxy>
|) (
public close = (
	self severExternalConnections.
	externalObject:: nil.
)
isClosed ^ <Boolean> = (
	^externalObject isNil
)
openIfFail: err <[:ExternalError]> = (
	(* Subclasses should implement to open a handle, restore its state, and store it using #handle: *)

	self subclassResponsibility
)
postCopy = (
	super postCopy.
	self reopen.
)
register = (
	OpenDescriptors include: self
)
reopen = (
	(* Sent on image startup to restablish any open descriptors. Can't be used to reopen a closed connection *)

	self isClosed
		ifFalse: [ self openIfFail: [ ^self ] ]
)
severExternalConnections = (
	(* Subclasses should implement to release any external resources.  Called either when an image
	  exits, or when the file is closed *)

	self subclassResponsibility
)
unregister = (
	OpenDescriptors removeEvery: self
)
) : (
reopenAll = (
	(* Should be sent when the image starts up to reopen any external descriptors *)

	OpenDescriptors do: [:d <ExternalDescriptor> |
		d reopen	].
)
restartAll = (
	(* Should be sent when the image starts up to reopen any external descriptors *)

	OpenDescriptors do: [:d <ExternalDescriptor> |
		d restart	].
)
severAllExternalConnections = (
	(* Should be sent before the image saves to clean up external resource connections *)

	OpenDescriptors do: [:d <ExternalDescriptor> |
		d severExternalConnections	].
)
)
class ExternalObject = (
(* A dummy class *)
) (
) : (
)
class ExternalStreamDescriptor = ExternalDescriptor (
(* The abstract superclass for external descriptors that are streams, such as open file descriptors.
*)
|
mode <Symbol>
public buffer <ExternalProxy>
public bufferSize <Integer>
|) (
public flushIfFail: err <[:ExternalError]> = (
	self subclassResponsibility
)
getBufferSize ^ <Integer> = (
	self subclassResponsibility
)
openIfFail: err <[:ExternalError]> = (
	self handle: (self externalObject openInternalFor: self mode
		ifFail: [:e <Symbol> |
			^err value: e 	]).
	self bufferSize: self getBufferSize.

#BOGUS yourself. (* review this *)
	(* self buffer malloc: self bufferSize. *)
	self buffer: (Alien newC: bufferSize).
)
postCopy = (
	buffer:: ExternalProxy new.
	super postCopy.
)
readAt: pos <Integer> ifFail: errf <[:ExternalError]> ^ <Integer> = (
	(* read as many bytes as possible into the buffer (up to its size), and return the number
	of bytes that were actually read.  The semantics at end of file are to return 0 with no error. *)
	self subclassResponsibility
)
severExternalConnections = (
	self buffer free.
)
write: nBytes <Integer> at: pos <Integer> ifFail: errf <[:ExternalError]> = (
	(* write nBytes from the buffer *)
	self subclassResponsibility
)
) : (
for: obj <EOBJ> mode: m <Symbol> ^ <Instance> = (
	(* Create a new instance, but don't open yet *)

	^self new externalObject: obj; mode: m
)
)
class ExternalStreamableObject = ExternalObject (
(* A dummy class *)
) (
) : (
)
public class FileDescriptor = ExternalStreamDescriptor (
(* A file descriptor is a positionable stream descriptor.
%todo: factor out a superclass for positionable-ness if needed
%bug: reopening on image startup will probably cause file truncation for write files, since we
	don''t currently distinguish between the original open, which should truncate, and
	reopens, which should not.  When we fix, be sure to set knowAtEnd on first open of
	a write file, and be sure not to on reopens.

*)
|
position_0 <Integer> ::= 0.
(* This must be cached here so that we can seek to the right spot when
			  the descriptor is reopened after an image restart.  Note that because
			  of external stream buffering, this position will probably not be the same
			  as the stream position. *)
knowAtEnd <Boolean> ::= false.
	  (* True if we know we are at the end, and can optimize reads *)
|) (
openIfFail: errf <[:ExternalError]> = (
	super openIfFail:
	[:err <ExternalError> |
	  errf value: err.
		^self ].
	(* Restore the file position *)
	self setExternalPosition: self position.
	(* When opening a write only file, the file is created/truncated, so we
	know we are at the end *)
	self knowAtEnd: self mode = #write
)
position ^ <Integer> = (
	^position_0
)
position: p <Integer> = (
	p = self position
	ifFalse: [ self knowAtEnd: false ]
	ifTrue: [ ^self ].
	self setPosition: p.
	self isClosed
	ifFalse: [ self setExternalPosition: p ]
)
setExternalPosition: p <Integer> = (
	(* moves the external file pointer.  Assume: file is open and position ivar already moved *)

	self subclassResponsibility
)
setPosition: p <Integer> = (
	position_0:: p.
)
size ^ <Integer> = (
	self subclassResponsibility
)
) : (
)
public class FilePath = ExternalStreamableFilePattern (
(* FilePaths are FilePatterns without wildcard characters, which means
they match individual files, not sets of files.
*)
) (
public , extension <FilePattern> ^ <EXTENDED>
	(* {where EXTENDED is returnType of #extendPath: message of arg 1} *)
= (
	(* This guarantee is safe because of the inference clause *)
	^(* guaranteed <EXTENDED> ( *) extension extendPath: self (* ) *)
)
charInputStream ^ <CharInputStream> = (
	^super charInputStream

	(* Override to use a ReadConverter, which is faster for things like upTo: *)
	(* ^CharacterReadConverter on: self readStream *)
)
charInputStreamDo: blk <[:CharInputStream | X def]>
ifFail: fail <[Y def]>
^ <X | Y> = (
	(* %kludge: this is a quick hack that catches only some kinds of
		problems *)
	^self exists
		ifFalse: [ fail value ]
		ifTrue: [ super charInputStreamDo: blk ]
)
charOutputStream ^ <CharOutputStream> = (
	^CharacterInputOutputConverter on: self writeStream
)
public containingDirectory ^ <FilePath> = (
	(* use when coerce: works with mixins *)
(*	^FilePath coerce: super containingDirectory *)
	^(* guaranteed <FilePath> ( *) super containingDirectory (* ) *)
)
public copyAs: newPath <FilePath> = (
	self copyAs: newPath
		ifFail: [:err <Symbol> |
						self error: err	]
)
public copyAs: newPath <FilePath> ifFail: fail <[:ExternalError]> = (
	self subclassResponsibility
)
public copyNamed: name <Str> ^ <FilePath> = (
	(* create a copy in the same directory with the specified name. The
		new path is returned. *)

	^self copyNamed: name ifFail: [:err <Symbol> | self error: err ]
)
public copyNamed: name <Str> ifFail: fail <[:ExternalError]> ^ <FilePath> = (
	(* create a copy in the same directory with the specified name. The
		new path is returned. *)

	| newPath <FilePath> |
	newPath:: self containingDirectory, (FilePath for: name).
	self copyAs: newPath
		ifFail: [:err <Symbol> |
						self error: err	].
	^newPath
)
public createDirectoryIfFail: fail <[:Symbol]> = (
	(* Create the directory with the given name, if it does not exist.
		If the directory can not be created and did not previously exist,
		the fail block is evaluated with an error symbol *)

	self subclassResponsibility
)
public deletePathIfFail: blk <[:Symbol]> = (
	(* This is how the #delete operation is implemented.  API level users should
		use #delete instead *)

	self subclassResponsibility
)
public elements ^ <SeqCltn[FilePath]> = (
	(* A file path's elements must also be filepaths *)
	^(* guaranteed <SeqCltn[FilePath]> *) super elements
)
public entries ^ <List[FilePath]> = (
	^(self, (FilePattern for: '*')) paths
)
public exists ^ <Boolean> = (
	self unimplemented
)
public extendPath: path <FilePath> ^ <FilePath> = (
	^FilePath for: (self patternExtending: path)
)
fileDescriptorClass ^ <FileDescriptor class> = (
	self subclassResponsibility
)
public inputStream ^ <InputStream[Integer]> = (
	(* We are using this for now since read streams are faster at things like upTo: than input streams *)
	^self readStream
)
public isDirectory ^ <Boolean> = (
	self subclassResponsibility
)
public isPath ^ <Boolean> = (
	^true
)
public isReadOnly ^ <Boolean> = (
	self unimplemented
)
public isWriteable ^ <Boolean> = (
	^self isReadOnly not
)
public lastModified = (
	self subclassResponsibility
)
public moveAs: newPath <FilePath> = (
	self moveAs: newPath
		ifFail: [:err <Symbol> |
						self error: err	]
)
public moveAs: newPath <FilePath> ifFail: fail <[:ExternalError]> = (
	(* Move the file to the specified new path, which includes the new name of the
		file as well.  Among the possible failures are: #(AlreadyExists SharingViolation). *)

	self subclassResponsibility
)
public name ^ <Str> = (
	^self pattern
)
public open: mode <Symbol> ifFail: err <[:ExternalError | X def]> ^ <FileDescriptor | X> = (
	(* Modes: #read, #write, #readWrite *)

	^(self fileDescriptorClass for: self mode: mode)
		openIfFail: [:e <ExternalError> |
			^err value: e ]
)
public openInternalFor: mode <Symbol> ifFail: err <[:ExternalError | X def]> ^ <ExternalProxy | X> = (
	#ACCESSBOGUS.
	self subclassResponsibility
)
public outputStream ^ <OutputStream[Integer]> = (
	^ExternalOutputStream onDescriptor: (self open: #write ifFail: [:err <ExternalError> | self error: err ])
)
pathsDo: blk <[:FilePath]> = (
	self exists
		ifTrue: [ blk value: self ]
)
public pattern: p <Str> = (
	super pattern: p.
	self assert: [ (platformSpecificPatternClass patternHasWildcards: p) not ] message: 'shouldnothavewildcards'.
)
public readStream ^ <ExternalReadStream> = (
	^ExternalReadStream onDescriptor:
		(self open: #read ifFail: [:err <ExternalError> | self error: err ])
)
public readWriteStream ^ <ExternalReadWriteStream> = (
	^ExternalReadWriteStream onDescriptor: (self open: #readWrite ifFail: [:err <ExternalError> | self error: err ])
)
public rename: name <Str> ^ <FilePath> = (
	(* rename in the same directory.  The new path is returned. *)

	^self rename: name ifFail: [:err <Symbol> | self error: err ]
)
public rename: name <Str> ifFail: fail <[:ExternalError]> ^ <FilePath> = (
	(* rename in the same directory.   The new path is returned. *)

	| newPath <FilePath> |
	newPath:: self containingDirectory, (FilePath for: name).
	self moveAs: newPath
		ifFail: [:err <Symbol> |
						self error: err	].
	^newPath
)
public simpleName ^ <String> = (
	^elements last name
)
public size = (
	self subclassResponsibility
)
public type ^ <Str> = (
	(* The file type (on most platforms this is the part after the "." at the end) *)

	self subclassResponsibility
)
public writeStream ^ <ExternalReadWriteStream> = (
	^ExternalReadWriteStream onDescriptor: (self open: #write ifFail: [:err <ExternalError> | self error: err ])
)
) : (
public currentDirectory ^ <FilePath> = (
	^platformSpecificPathClass currentDirectory
)
public for: nm <String> ^ <FilePath> = (
	^platformSpecificPathClass new pattern: nm
)
)
public class FilePattern = Object (
(* FilePatterns represent a pattern that matches some set of
files, and are used (along with the subclass FilePath, which
represents individual files without wildcards) to represent
all file paths in the system.  For example, (FilePattern for: '*')
is the pattern for all files in the current directory.

The interface for FilePatterns is designed to be
file-system independent, as well as typesafe. This mostly involves
an interface that allows you to avoid use of file system dependent
characters like "/" or "\".  This is done by using operators to
combine FilePatterns for subpaths, as well as utility creation methods,
so that you never have to use separators directly.

For example,  a relative FilePattern that matches '*.bar' files in a
subdirectory 'foo' can be constructed with
	fp :: FilePattern forElements: #('foo' '*.bar')
To turn this into an absolute path, you can use the general
FilePattern concatenation operator ',':
	FilePath currentDirectory, fp

FilePatterns can be iterated over to examine all matching FilePaths,
and have stream operations used to open the files, and other
methods for deleting, renaming, etc.

Tags: %User

*)
| pattern_0 <String> |) (
public , extension <FilePattern> ^ <EXTENDED>
	(* {where EXTENDED is returnType of #extendPattern: message of arg 1} *) = (
	(* This is how patterns are concatenated.  If both the receiver and the argument
		are FilePaths, the return type is FilePath, otherwise it is a FilePattern. *)

	(* This guarantee is safe because of the inference clause *)
	^(* guaranteed <EXTENDED> ( *) extension extendPattern: self (* ) *)
)
public / string = (
	^self , (FilePattern for: string)
)
public baseName ^ <FilePattern> = (
	^self elements last
)
public containingDirectory ^ <FilePattern> = (
	| e <SeqCltn[FilePattern]> |
	e:: self elements.
	self assert: [ e size > 1 ] message: ''.
	^FilePattern forAll: (e copyFrom: 1 to: e size - 1)
)
copyToDir: dirPath <FilePath> ifFail: fail <[:ExternalError]> = (
	self subclassResponsibility
)
public delete = (
	(* This deletes all files and directories that match the specified pattern, with a dynamic failure if
		unsuccessful. *)

	self deleteIfFail: [:err <Symbol> | self error: err ]
)
public deleteIfFail: blk <[:Symbol]> = (
	(* This deletes all files and directories that match the specified pattern.
		This should be used with extreme caution.  Directories that are
		not empty are not deleted.  If any matching files or directories cannot
		be deleted, blk is evaluated with an error symbol *)

	self pathsDo:
		[:p <FilePath> |
			p deletePathIfFail:
				[:err <Symbol> |
					blk value: err.
					^self		 ] ]
)
elements ^ <SeqCltn[FilePattern]> = (
	(* Return a collection of the elements that you would get from elementsDo: *)

	| els <OrdCltn[FilePattern]> |
	els:: List(* [FilePattern] *) new.
	self elementsDo:
		[:el <FilePattern> |
			els addLast: el. ].
	^els
)
elementsDo: blk <[:FilePattern]> = (
	(* Evaluate blk with each path element, from the highest to the lowest.
		For example, on a unix system, a pattern named '/usr/*.txt' would
		be evaluated with patterns for '/', 'usr', and '*.txt'.  On Win32 platforms,
		'C:\windows\*.dll' would be: 'C:\', 'windows', and '*.dll' *)

	self subclassResponsibility
)
public extendPath: path <FilePath> ^ <FilePattern> = (
	^FilePattern for: (self patternExtending: path)
)
public extendPattern: pat <FilePattern> ^ <FilePattern> = (
	^FilePattern for: (self patternExtending: pat)
)
extensions ^ <FilePattern> = (
	(* return a pattern that matches all of the possible existing paths that
		are one element longer than the receiver.  For a directory filepath,
		for example, this pattern would match all of the files in the directory *)

	self subclassResponsibility
)
public isAbsolute ^ <Boolean> = (
	self subclassResponsibility
)
public isPath ^ <Boolean> = (
	(* Returns true if the receive is a FilePath (i.e. contains no wildcards) *)

	^false
)
public isRelative ^ <Boolean> = (
	^self isAbsolute not
)
isSyntaxValid ^ <Boolean> = (
	(* Make sure the pattern is syntactically valid.
		Wildcards should not be required *)

	self subclassResponsibility
)
moveToDir: dirPath <FilePath> ifFail: fail <[:ExternalError]> = (
	self subclassResponsibility
)
public paths ^ <List[FilePath]> = (
	(* Return a collection of the elements that you would get from pathsDo: *)

	| els <List[FilePath]> |
	els:: List(* [FilePath] *) new.
	self pathsDo:
		[:el <FilePath> |
			els addLast: el. ].
	^els
)
public pathsDo: blk <[:FilePath]> = (
	(* Evaluate blk for each existing path that matches the receiver's pattern.

		Note: Implicit files for the current directory and/or the
		containing directory (e.g. '.' and '..') are not listed. *)

	self subclassResponsibility
)
public pattern ^ <String> = (
	^pattern_0
)
public pattern: p <String> = (
	pattern_0:: p
)
public patternExtending: pat <FilePattern> ^ <Str> = (
	self subclassResponsibility
)
public printOn: strm <CharOutputStream> = (
	super printOn: strm.
	strm nextPut: "("; print: self pattern; nextPut: ")".
)
recursiveDelete = (
	(* This is a very dangerous method that deletes the files and
	  directories matching the pattern, and is invoked recursively
	  on any subfiles or subdirectories.  Be very careful calling this,
	  as it will destroy arbitrarily large directory trees without confirmation!
	  This halts immediately if any error is encountered. *)

	self recursiveDeleteIfFail: [:err <Symbol> | self error: err ]
)
recursiveDeleteIfFail: failBlk <[:Symbol]> = (
	(* This is a very dangerous method that deletes the files and
	  directories matching the pattern, and is invoked recursively
	  on any subfiles or subdirectories.  Be very careful calling this,
	  as it will destroy arbitrarily large directory trees without confirmation!
	  failBlk is invoked for each file or directory that cannot be deleted *)

	self pathsDo:
		[:p <FilePath> |
			p isDirectory
				ifTrue: [ p extensions pathsDo:
								[:sub <FilePath> |
									sub recursiveDeleteIfFail:
												[:err <Symbol> |
														failBlk value: err ].		].	].
			p deleteIfFail: [:err <Symbol> |
										failBlk value: err ].		]
)
) : (
public for: pat <Str> ^ <FilePattern> = (
	^(platformSpecificPatternClass patternHasWildcards: pat)
		ifTrue: [platformSpecificPatternClass new pattern: pat ]
		ifFalse: [ FilePath for: pat ]
)
public forAll: patternElements <SeqCltn[FilePattern]> ^ <FilePattern> = (
	| p <FilePattern> |
	patternElements do:
		[:el <FilePattern> |
			p isNil
				ifTrue: [ p:: el ]
				ifFalse: [ p:: p, el ]
		].
	^p
)
public forElements: els <SeqCltn[Str]> ^ <FilePattern> = (
	^self forAll: (els collect:
						[:s <Str> |
							FilePattern for: s ])
)
public multipleMatchWildcardCharacter = (
	^platformSpecificPatternClass multipleMatchWildcardCharacter
)
public patternHasWildcards: pat <Str> ^ <Boolean> = (
	self subclassResponsibility
)
public singleMatchWildcardCharacter = (
	^platformSpecificPatternClass singleMatchWildcardCharacter
)
)
) : (
)