"======================================================================
|
|   File Method Definitions
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


Object subclass: #File
       instanceVariableNames: 'name stat'
       classVariableNames: 'Epoch'
       poolDictionaries: ''
       category: 'Streams-Files'
! 


CStruct newStruct: #CStatStruct declaration: #( 
	(stMode uShort) " protection "
	(stSize long)   " total size, in bytes "
	(stAtime long)	" time of last access "
	(stMtime long)	" time of last (contents) modification "
	(stCtime long)	" time of last (attribute) change "
).

File
	defineCFunc: 'stat'
	withSelectorArgs: 'statOn: fileName into: statStruct'
	returning: #int
	args: #(string cObject).

"opendir and closedir needed to test for directories"

File
	defineCFunc: 'opendir'
	withSelectorArgs: 'openDir: dirName'
	returning: #cObject
	args: #(string).

File
	defineCFunc: 'closedir'
	withSelectorArgs: 'closeDir: dirObject'
	returning: #int
	args: #(cObject).

File
	defineCFunc: 'fileIsReadable'
	withSelectorArgs: 'primIsReadable: name'
	returning: #boolean
	args: #(string).

File
	defineCFunc: 'fileIsWriteable'
	withSelectorArgs: 'primIsWriteable: name'
	returning: #boolean
	args: #(string).

File class
	defineCFunc: 'unlink'
	withSelectorArgs: 'primRemove: fileName'
	returning: #void
	args: #(string).

File class
	defineCFunc: 'rename'
	withSelectorArgs: 'primRename: oldFileName to: newFileName'
	returning: #void
	args: #(string string).

File class
	defineCFunc: 'strerror'
	withSelectorArgs: 'stringError: errno'
	returning: #string
	args: #(int).

File class
	defineCFunc: 'errno'
	withSelectorArgs: 'errno'
	returning: #long
	args: #()
!



!File class methodsFor: 'initialization'!

initialize
    "Initialize the receiver's class variables"
    Epoch := Date newDay: 2 month: #Jan year: 2000.
! !


!File class methodsFor: 'file name management'!

extensionFor: aString
    "Answer the extension of a file named `aString'"
    | index |
    aString isEmpty ifTrue: [ ^'' ].
    index := aString findLast: [ :each |
	each = Directory pathSeparator ifTrue: [ ^'' ]
	each = $.
    ].

    "Special case .foo and /bar/.foo"
    index = 1 ifTrue: [ ^'' ].
    (aString at: index - 1) = Directory pathSeparator ifTrue: [ ^'' ].
    ^aString copyFrom: index + 1 to: aString size.
!

stripExtensionFrom: aString
    "Remove the extension from the name of a file called `aString', and
     answer the result"
    | index |
    aString isEmpty ifTrue: [ ^'' ].
    index := aString findLast: [ :each |
	each = Directory pathSeparator ifTrue: [ ^aString ]
	each = $.
    ].

    "Special case .foo and /bar/.foo"
    index = 1 ifTrue: [ ^aString ].
    (aString at: index - 1) = Directory pathSeparator ifTrue: [ ^aString ].
    ^aString copyFrom: 1 to: index - 1
!

stripPathFrom: aString
    "Remove the path from the name of a file called `aString', and
     answer the file name plus extension."
    | index |
    aString isEmpty ifTrue: [ ^'' ].
    index := aString findLast: [ :each | each = Directory pathSeparator ].
    ^aString copyFrom: index + 1 to: aString size
!

pathFor: aString
    "Answer the path of the name of a file called `aString', and
     answer the result"
    | index |
    aString isEmpty ifTrue: [ ^'' ].
    index := aString findLast: [ :each | each = Directory pathSeparator ].
    index < 2 ifTrue: [ ^'' ].
    ^aString copyFrom: 1 to: index - 1.
!

fullNameFor: aString
    "Answer the full path to a file called `aString', resolving the `.' and
     `..' directory entries, and answer the result.  Answer nil if the file
     is invalid (such as '/usr/../..')"

    | path substrings |
    path := OrderedCollection new.
    (aString at: 1) = Directory pathSeparator ifFalse: [
	path addAll: (Directory working substrings: Directory pathSeparator).
    ].
    substrings := self substrings: Directory pathSeparator.
    substrings := ReadStream on: substrings.

    substrings do: [ :each |
	each = '.' ifFalse: [
	    each = '..' ifTrue: [
		path isEmpty ifTrue: [ ^nil ].
		path removeLast.
	    ].
	    path add: each.
	]
    ].

    ^path inject: '' into: [ :old :each |
	Directory append: each to: old
    ]
! !


!File class methodsFor: 'file operations'!

checkError
    "Return whether an error had been reported or not.
     If there had been one, raise an exception too"

    ^self checkError: self errno
!

checkError: errno
    "The error with the C code `errno' has been reported.
     If errno >= 1, raise an exception"

    | errors |
    errno < 1 ifTrue: [ ^false ].
    self error: (self stringError: errno).
    ^true
!

remove: fileName
    "Remove the file with the given path name"
    self primRemove: fileName.
    self checkError
!

rename: oldFileName to: newFileName
    "Rename the file with the given path name oldFileName to newFileName"
    self primRename: oldFileName to: newFileName.
    self checkError
! !


!File class methodsFor: 'instance creation'!

name: aName
    "Answer a new file with the given path. The path is not validated until
    some of the fields of the newly created objects are accessed"
    ^self basicNew init: aName
! !


!File class methodsFor: 'testing'!

exists: fileName
    "Answer whether a file with the given name exists"
    ^(File name: fileName) exists
!

isReadable: fileName
    "Answer whether a file with the given name exists and is readable"
    ^(File name: fileName) isReadable
!

isWriteable: fileName
    "Answer whether a file with the given name exists and is writeable"
    ^(File name: fileName) isWriteable
! !


!File class methodsFor: 'reading system defaults'!

image
    "Answer the full path to the image being used."
    ^ImageFileName
! !


!File methodsFor: 'accessing'!

name
    "Answer the name of the file identified by the receiver"
    ^name
!

size
    "Answer the size of the file identified by the receiver"
    ^self stat stSize value
!

lastAccessTime
    "Answer the last access time of the file identified by the receiver"
    ^self getDateAndTime: self stat stAtime value
!

lastChangeTime
    "Answer the last change time of the file identified by the receiver
    (the `last change time' has to do with permissions, ownership and the
    like). On some operating systems, this could actually be the
    file creation time."
    ^self getDateAndTime: self stat stCtime value
!

creationTime
    "Answer the creation time of the file identified by the receiver.
    On some operating systems, this could actually be the last change time
    (the `last change time' has to do with permissions, ownership and the
    like)."
    ^self getDateAndTime: self stat stCtime value
!

lastModifyTime
    "Answer the last modify time of the file identified by the receiver
    (the `last modify time' has to do with the actual file contents)."
    ^self getDateAndTime: self stat stMtime value
!

refresh
    "Refresh the statistics for the receiver"
    stat isNil ifTrue: [
	stat := CStatStruct new.
	stat addToBeFinalized
    ].
    self statOn: name into: stat.
    self class checkError
! !



!File methodsFor: 'testing'!

exists
    "Answer whether a file with the name contained in the receiver does exist."
    stat isNil ifTrue: [
	stat := CStatStruct new.
	stat addToBeFinalized.
    ].
    self statOn: name into: stat.
    ^self class errno == 0
!

isFile
    "Answer whether a file with the name contained in the receiver does exist
    and does not identify a directory."
    ^self exists and: [ self isDirectory not ]
!

isDirectory
    "Answer whether a file with the name contained in the receiver does exist
    and identifies a directory."
    | dir errno |
    self exists ifFalse: [ ^false ].
    dir := self openDir: name.
    errno := self class errno.
    (errno = 0) ifTrue: [
	self closeDir: dir.
	^true
    ].
    errno = 20 ifTrue: [ ^false ].
    self class checkError: errno
!

isReadable
    "Answer whether a file with the name contained in the receiver does exist
     and is readable"
    ^self exists
	and: [ (self primIsReadable: self name)
	or: [ self class checkError. false ]]!

isWriteable
    "Answer whether a file with the name contained in the receiver does exist
     and is writeable"
    ^self exists
	and: [ (self primIsWriteable: self name)
	or: [ self class checkError. false ]]!
! !


!File methodsFor: 'file name management'!

extension
    "Answer the extension of the receiver"
    ^File extensionFor: self name
!

stripExtension
    "Answer the path (if any) and file name of the receiver"
    ^File stripExtensionFrom: self name
!

stripPath
    "Answer the file name and extension (if any) of the receiver"
    ^File stripPathFrom: self name
!

path
    "Answer the path (if any) of the receiver"
    ^File pathFor: self name
!

fullName
    "Answer the full name of the receiver, resolving the `.' and
     `..' directory entries, and answer the result.  Answer nil if the
     name is invalid (such as '/usr/../../badname')"
    ^File fullNameFor: self name
! !


!File methodsFor: 'file operations'!

contents
    "Open a read-only FileStream on the receiver, read its contents,
    close the stream and answer the contents"
    | stream contents |
    stream := self readStream.
    contents := stream contents.
    stream close.
    ^contents
!

open: mode
    "Open the receiver in the given mode (as answered by FileStream's
    class constant methods)"
    ^FileStream open: self name mode: mode
!

readStream
    "Open a read-only FileStream on the receiver"
    ^FileStream open: self name mode: FileStream read
!

writeStream
    "Open a write-only FileStream on the receiver"
    ^FileStream open: self name mode: FileStream write
!

remove
    "Remove the file identified by the receiver"
    self class remove: name.
!

renameTo: newName
    "Remove the file identified by the receiver"
    self class rename: name to: newName.
    name := newName
! !


!File methodsFor: 'private'!

getDateAndTime: time
    "Private - Convert a time expressed in seconds from 1/1/2000 to
     an array of two Smalltalk Date and Time objects"

    ^Array
	with: (Epoch addDays: time // 86400 - 1)
	with: (Time fromSeconds: time \\ 86400)
!

stat
    "Private - Answer the receiver's statistics' C struct"
    stat isNil ifTrue: [ self refresh ].
    ^stat
!

init: aName
    "Private - Initialize the receiver's instance variables"
    name := aName
! !
    

File initialize!