"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

ExternalStream subclass:#FileStream
	instanceVariableNames:'pathName'
	classVariableNames:''
	poolDictionaries:''
	category:'Streams-External'
!

!FileStream primitiveDefinitions!
%{
#include <stdio.h>
#define _STDIO_H_INCLUDED_

#include <errno.h>
#define _ERRNO_H_INCLUDED_

#ifdef transputer
# include <iocntrl.h>
# ifndef fileno
   /* kludge: inmos forgot fileno */
#  define fileno(f)     ((f)->__file)
# endif
#else
# include <sys/types.h>
# include <sys/stat.h>
#endif

#ifdef hpux
# define fileno(f)      ((f->__fileH << 8) | (f->__fileL))
#endif

#ifndef SEEK_SET
# define SEEK_SET       0
#endif
#ifndef SEEK_CUR
# define SEEK_CUR       1
#endif
#ifndef SEEK_END
# define SEEK_END       2
#endif

/*
 * on some systems errno is a macro ... check for it here
 */
#ifndef errno
 extern errno;
#endif

%}
! !

!FileStream class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    This class provides access to the operating systems underlying file
    system (i.e. its an interface to the stdio library).

    Notice, that on some systems, the standard I/O library has performance
    problems when a file is opened for readwrite. 
    For best results, open files either readonly or writeonly.

    [author:]
        Claus Gittinger

    [see also:]
        Filename DirectoryStream PipeStream Socket
"
! !

!FileStream class methodsFor:'instance creation'!

appendingOldFileNamed:filename
    "return a FileStream for existing file named filename, aString.
     The file is opened for writeonly access."

    |newStream|
    newStream := self new pathName:filename.
    newStream openForAppending isNil ifTrue:[^nil].
"
    this is not a good idea; I might like to read the written stuff ...

    newStream readLimit:(newStream size).
"
    ^ newStream
!

appendingOldFileNamed:filename in:aDirectory
    "return a FileStream for existing file named filename, aString
     in aDirectory, a FileDirectory.
     The file is opened for writeonly access."

    |newStream|
    newStream := self new pathName:filename in:aDirectory.
    newStream openForAppending isNil ifTrue:[^nil].
"
    this is not a good idea; I might like to read the written stuff ...

    newStream readLimit:(newStream size).
"
    ^ newStream
!

fileNamed:filename
    "return a stream on file filename - if the file does not
     already exist, create it.
     The file is opened for read/write access."

    |stream|

    stream := self oldFileNamed:filename.
    stream isNil ifTrue:[
	stream := self newFileNamed:filename
    ].
    ^ stream
!

fileNamed:filename in:aDirectory
    "return a stream on file filename - if the file does not
     already exist, create it.
     The file is opened for read/write access."

    |stream|

    stream := self oldFileNamed:filename in:aDirectory.
    stream isNil ifTrue:[
	stream := self newFileNamed:filename in:aDirectory
    ].
    ^ stream
!

newFileForWritingNamed:filename
    "return a FileStream for new file named filename, aString.
     If the file exists, it is truncated, otherwise created.
     The file is opened for writeonly access."

    |newStream|
    newStream := self new pathName:filename.
    newStream createForWriting isNil ifTrue:[^nil].
    ^ newStream
!

newFileForWritingNamed:filename in:aDirectory
    "return a FileStream for new file named filename, aString
     in aDirectory, a FileDirectory.
     If the file exists, it is truncated, otherwise created.
     The file is opened for writeonly access."

    |newStream|
    newStream := self new pathName:filename in:aDirectory.
    newStream createForWriting isNil ifTrue:[^nil].
    ^ newStream
!

newFileNamed:filename
    "return a FileStream for new file named filename, aString.
     If the file exists, it is truncated, otherwise created.
     The file is opened for read/write access."

    |newStream|
    newStream := self new pathName:filename.
    newStream createForReadWrite isNil ifTrue:[^nil].
    ^ newStream
!

newFileNamed:filename in:aDirectory
    "return a FileStream for new file named filename, aString
     in aDirectory, a FileDirectory.
     If the file exists, it is truncated, otherwise created.
     The file is opened for read/write access."

    |newStream|
    newStream := self new pathName:filename in:aDirectory.
    newStream createForReadWrite isNil ifTrue:[^nil].
    ^ newStream
!

oldFileNamed:filename
    "return a FileStream for existing file named filename, aString.
     The file is opened for read/write access."

    |newStream|

    (OperatingSystem isReadable:filename) ifFalse:[^nil].
    newStream := self new pathName:filename.
    newStream readwrite.
    newStream openForReadWrite isNil ifTrue:[^nil].
"
    this is not a good idea; someone else might be appending ...

    newStream readLimit:(newStream size).
"
    ^ newStream
!

oldFileNamed:filename in:aDirectory
    "return a FileStream for existing file named filename, aString
     in aDirectory, a FileDirectory.
     The file is opened for read/write access."

    |newStream|
    newStream := self new pathName:filename in:aDirectory.
    newStream openForReadWrite isNil ifTrue:[^nil].
"
    this is not a good idea; someone else might be appending ...

    newStream readLimit:(newStream size).
"
    ^ newStream
!

readonlyFileNamed:filename
    "return a readonly FileStream for existing file named filename, aString"

    |newStream|

    (OperatingSystem isReadable:filename) ifFalse:[^nil].

    newStream := self new pathName:filename.
    newStream openForReading isNil ifTrue:[^nil].
"
    this is not a good idea; someone else might be appending ...

    newStream readLimit:(newStream size).
"
    ^ newStream
!

readonlyFileNamed:filename in:aDirectory
    "return a readonly FileStream for existing file named filename, aString
     in aDirectory, a FileDirectory"

    |newStream|
    newStream := self new pathName:filename in:aDirectory.
    newStream openForReading isNil ifTrue:[^nil].
"
    this is not a good idea; someone else might be appending ...

    newStream readLimit:(newStream size).
"
    ^ newStream
! !

!FileStream methodsFor:'accessing'!

directoryName
    "return the name of the directory I'm in"

    |path lastIndex index|

    path := pathName.
    lastIndex := 0.
    index := path indexOf:$/.
    [index ~~ 0] whileTrue:[
	lastIndex := index.
	index := path indexOf:$/ startingAt:(index + 1)
    ].
    (lastIndex == 0) ifTrue:[^ '.'].
    (lastIndex == 1) ifTrue:[^ '/'].
    ^ path copyTo:(lastIndex - 1)
!

name
    "return my name without leading direcory-path"

    |lastIndex index|

    lastIndex := 1.
    [true] whileTrue:[
	index := pathName indexOf:$/ startingAt:lastIndex.
	(index == 0) ifTrue:[
	    ^ pathName copyFrom:lastIndex
	].
	lastIndex := index + 1
    ]
!

pathName
    "return the pathname"

    ^ pathName
!

store:something
    "what really should this do"

    self nextPutAll:something storeString
! !

!FileStream methodsFor:'error handling'!

openError
    "report an error, that file open failed"

    "/
    "/ for now, do not raise any signal (see super>>openError).
    "/ Its not yet handled anywhere. Instead, senders of open
    "/ check for nil return value (which is a historic leftover)
    "/
    LastErrorNumber := lastErrorNumber.
    ^ nil.
! !

!FileStream methodsFor:'printing & storing'!

printOn:aStream
    aStream nextPutAll:'(a FileStream for:'.
    aStream nextPutAll:pathName.
    aStream nextPut:$)
!

storeOn:aStream
    aStream nextPutAll:'(FileStream oldFileNamed:'.
    aStream nextPutAll:pathName.
    (self position ~~ 1) ifTrue:[
	aStream nextPutAll:'; position:'.
	self position storeOn:aStream
    ].
    aStream nextPut:$)
! !

!FileStream methodsFor:'private'!

createForReadWrite
    "create/truncate the file for read/write.
     If the file existed, its truncated; otherwise its created."


    mode := #readwrite.
    ^ self openWithMode:'w+'
!

createForWriting
    "create/truncate the file for writeonly.
     If the file existed, its truncated; otherwise its created."

    mode := #writeonly.
    didWrite := true.
    ^ self openWithMode:'w'
!

open
    "open the file"

    pathName isNil ifTrue:[^nil].
    (mode == #readonly) ifTrue: [
	didWrite := false.
	^ self openWithMode:'r'
    ].
    (mode == #writeonly) ifTrue: [
	didWrite := true.
	^ self openWithMode:'w'
    ].
    ^ self openWithMode:'r+'
!

openForAppending
    "open the file for writeonly appending to the end.
     If the file does not exist its an error, return nil; 
     otherwise return the receiver."

    mode := #writeonly.
    didWrite := true.
    ^ self openWithMode:'a+'
!

openForReadWrite
    "open the file for read/write.
     If the file does not exist its an error, return nil; 
     otherwise return the receiver."

    mode := #readwrite.
    ^ self openWithMode:'r+'
!

openForReading
    "open the file for readonly.
     If the file does not exist its an error, return nil; 
     otherwise return the receiver."

    mode := #readonly.
    didWrite := false.
    ^ self openWithMode:'r'
!

openForWriting
    "open the file writeonly.
     If the file does not exist its an error, return nil; 
     otherwise return the receiver."

    mode := #writeonly.
    didWrite := true.
    ^ self openWithMode:'r+'   "unix-io does not allow this; open for update here"
!

openWithMode:openmode
    "open the file; openmode is the string defining the way to open"

    |retVal laspass|

    filePointer notNil ifTrue:[^ self errorOpen].
%{
    FILE *f;
    OBJ path, fp;
    int pass = 0;

retry:
    path = __INST(pathName);
    if (__isNonNilObject(path) && (__qClass(path)==String)) {
        __BEGIN_INTERRUPTABLE__
        do {
#ifdef LINUX
            /* LINUX returns a non-NULL f even when interrupted */
            errno = 0;
            f = (FILE *) fopen((char *) __stringVal(path), (char *) __stringVal(openmode));
            if (errno == EINTR)
                f = NULL;
#else

            f = (FILE *) fopen((char *) __stringVal(path), (char *) __stringVal(openmode));
#endif
        } while ((f == NULL) && (errno == EINTR));
        __END_INTERRUPTABLE__
        if (f == NULL) {
            /*
             * If no filedescriptors available, try to finalize
             * possibly collected fd's and try again.
             */

            if (pass == 0 && (errno == ENFILE || errno == EMFILE)) {
                pass = 1;
%}.
                ObjectMemory scavenge; finalize.
%{
                goto retry;
            }
            __INST(lastErrorNumber) = __MKSMALLINT(errno);
            __INST(position) = nil;
        } else {
            __INST(filePointer) = fp = __MKOBJ((int)f); __STORE(self, fp);
            __INST(position) = __MKSMALLINT(1);
            retVal = self;
        }
    }
%}.
    retVal notNil ifTrue:[
        buffered := true.       "default is buffered"
        Lobby register:self.
        ^ retVal
    ] ifFalse:[
        "
         the open failed for some reason ...
        "
        ^ self openError
    ].

!

pathName:filename
    "set the pathname"

    pathName := filename
!

pathName:filename in:aDirectory
    "set the pathname starting at aDirectory, a FileDirectory"

    ((filename at:1) == $/) ifTrue:[
	"filename may not start with a '/'"
	pathName := nil
    ] ifFalse:[
	pathName := aDirectory pathName.
	(pathName endsWith:'/') ifFalse:[
	    pathName := pathName , '/'
	].
	pathName := pathName , filename
    ]
!

reOpen
    "sent after snapin to reopen streams"

    |oldPos|

    filePointer notNil ifTrue:[
        "it was open, when snapped-out"
        filePointer := nil.
        Lobby unregister:self.
        oldPos := position.
        self open.
        filePointer isNil ifTrue:[
            "this happens, if after a restart, the file is no longer accessable ..."

            (self class name , ' [warning]: could not reOpen file: ', pathName) errorPrintCR.
        ] ifFalse:[
            self position:oldPos.
        ]
    ]

    "Modified: 10.1.1997 / 17:50:51 / cg"
! !

!FileStream methodsFor:'queries'!

position
    "return the read/write position in the file -
     notice, in smalltalk indices start at 1 so begin of file is 1"

%{  /* NOCONTEXT */

    FILE *f;
    long currentPosition;

    if (__INST(filePointer) != nil) {
	f = __FILEVal(__INST(filePointer));
	do {
	    if (__INST(buffered) == true) {
		currentPosition = (long) ftell(f);
	    } else {
		currentPosition = (long) lseek(fileno(f), 0L, SEEK_CUR);
	    }
	} while ((currentPosition < 0) && (errno == EINTR));
	if (currentPosition >= 0) {
	    /*
	     * notice: Smalltalk index starts at 1
	     */
	    RETURN ( __MKSMALLINT(currentPosition + 1) );
	}
	__INST(lastErrorNumber) = __MKSMALLINT(errno);
    }
%}.
    lastErrorNumber notNil ifTrue:[^ self ioError].
    filePointer isNil ifTrue:[^ self errorNotOpen].
    ^ self primitiveFailed
!

position:newPos
    "set the read/write position in the file"

%{  /* NOCONTEXT */

    FILE *f;
    int ret;
    OBJ fp;

    if ((fp = __INST(filePointer)) != nil) {
	if (__isSmallInteger(newPos)) {
	    f = __FILEVal(fp);
	    /*
	     * notice: Smalltalk index starts at 1
	     */
	    do {
		if (__INST(buffered) == true) {
		    ret = fseek(f, (long) (__intVal(newPos) - 1), SEEK_SET);
		} else {
		    ret = (long) lseek(fileno(f), (long)(__intVal(newPos) - 1), SEEK_SET);
		}
	    } while ((ret < 0) && (errno == EINTR));
	    if (ret >= 0) {
		__INST(position) = newPos;
		/*
		 * just to make certain ...
		 */
		__INST(hitEOF) = false;
		RETURN ( self );
	    }
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
	}
    }
%}.
    lastErrorNumber notNil ifTrue:[^ self ioError].
    filePointer isNil ifTrue:[^ self errorNotOpen].
    ^ self primitiveFailed
!

setToEnd
    "set the read/write position in the file to be at the end of the file"

%{
    FILE *f;
    int ret;

    if (__INST(filePointer) != nil) {
	f = __FILEVal(__INST(filePointer));
	__INST(position) = nil;
	do {
	    if (__INST(buffered) == true) {
		ret = fseek(f, 0L, SEEK_END);
	    } else {
		ret = (long)lseek(fileno(f), 0L, SEEK_END);
	    }
	} while ((ret < 0) && (errno == EINTR));
	if (ret >= 0) {
	    RETURN ( self );
	}
	__INST(lastErrorNumber) = __MKSMALLINT(errno);
    }
%}.
    lastErrorNumber notNil ifTrue:[^ self ioError].
    filePointer isNil ifTrue:[^ self errorNotOpen].
    ^ self primitiveFailed
!

size
    "return the size in bytes of the file"

%{  /* NOCONTEXT */

#ifdef transputer
    FILE *f;
    int size;

    if (__INST(filePointer) != nil) {
	f = __FILEVal(__INST(filePointer));
	if ((size = filesize(fileno(f))) >= 0) {
	    RETURN ( __MKSMALLINT(size) );
	}
    }
#else
    FILE *f;
    struct stat buf;
    int ret;
    int fd;

    if (__INST(filePointer) != nil) {
	f = __FILEVal(__INST(filePointer));
	fd = fileno(f);
	do {
	    ret = fstat(fd, &buf);
	} while ((ret < 0) && (errno == EINTR));
	if (ret >= 0) {
	    RETURN ( __MKSMALLINT(buf.st_size) );
	}
	__INST(lastErrorNumber) = __MKSMALLINT(errno);
    }
#endif
%}.

    "could add a fall-back here:

	oldPosition := self position.
	self setToEnd.
	sz := self position.
	self position:oldPosition.
	^ sz
    "
    lastErrorNumber notNil ifTrue:[^ self ioError].
    filePointer isNil ifTrue:[^ self errorNotOpen].
    ^ self primitiveFailed
! !

!FileStream methodsFor:'testing'!

isFileStream
    "return true, if the receiver is some kind of fileStream.
     redefined from Object"

    ^ true
! !

!FileStream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.35 1997-01-10 18:00:57 cg Exp $'
! !