DirectoryContents.st
author Claus Gittinger <cg@exept.de>
Thu, 08 Nov 2007 17:34:59 +0100
changeset 1913 4c2622e92a91
parent 1575 4c4042cd577f
child 1919 d52cda5ce0e7
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1997 by eXept Software AG
              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.
"



"{ Package: 'stx:libbasic2' }"

Object subclass:#DirectoryContents
	instanceVariableNames:'directory timeStamp contents'
	classVariableNames:'CachedDirectories LockSema ReadersList'
	poolDictionaries:''
	category:'System-Support'
!

Object subclass:#DirectoryContentsItem
	instanceVariableNames:'info fileName'
	classVariableNames:'CachedRemoteMountPoints CachedRemoteMountPointsTimeStamp'
	poolDictionaries:''
	privateIn:DirectoryContents
!

!DirectoryContents class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 by eXept Software AG
              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
"
    DirectoryContents provides a cached view onto a fileDirectory.


    Notice:
        This class is not available in other ST-systems;
        Applications using it may not be portable.

    [author:]
        Claus Atzkern

    [see also:]
        Filename
        FileStream DirectoryStream OperatingSystem
"

! !

!DirectoryContents class methodsFor:'initialization'!

initialize
    "setup lock-mechanism
    "
    LockSema    := RecursionLock new.
    ReadersList := Dictionary new.
! !

!DirectoryContents class methodsFor:'instance creation'!

new
    ^ self basicNew initialize
! !

!DirectoryContents class methodsFor:'accessing'!

directoryNamed:aDirectory
    "returns the DirectoryContents for a directory named 
     aDirectoryName, aString, nil or Filename
    "
    |directory contents max lockRead pathName addToList|

    (aDirectory notNil and:[(directory := aDirectory asFilename) exists]) ifFalse:[
        ^ nil
    ].
    directory := directory asAbsoluteFilename.
    contents := nil.

    LockSema critical:[
        CachedDirectories notNil ifTrue:[
            contents := self directoryAt:directory.

            contents isNil ifTrue:[
                max := self maxCachedDirectories.

                CachedDirectories size > max ifTrue:[
                    CachedDirectories := CachedDirectories select:[:aDir|
                        (aDir size > 32 and:[aDir isObsolete not])
                    ]
                ].

                CachedDirectories size > max ifTrue:[
                    CachedDirectories removeFirst
                ]
            ].
        ].
        contents isNil ifTrue:[
            ReadersList isNil ifTrue:[ReadersList := Dictionary new].
            pathName := directory pathName.
            lockRead := ReadersList at:pathName ifAbsentPut:[Semaphore forMutualExclusion].
        ]
    ].
    contents notNil ifTrue:[^ contents].
    addToList := false.

    lockRead critical:[
        [  "/ test whether another task got the semaphore and
           "/ has read the directory contents
           (contents := self directoryAt:directory) isNil ifTrue:[
                "/ read the directory contents
                contents  := self new directory:directory.
                "/ only cache if the mod'Time is valid.
                addToList := contents timeStamp notNil.
            ]
        ] ensure:[
            LockSema critical:[
                addToList ifTrue:[
                    CachedDirectories isNil ifTrue:[
                        CachedDirectories := OrderedCollection new
                    ].
                    CachedDirectories add:contents
                ].
                (lockRead isEmpty and:[ReadersList notNil]) ifTrue:[
                    ReadersList removeKey:pathName ifAbsent:nil
                ]
            ]
        ]
    ].    

    ^ contents
! !

!DirectoryContents class methodsFor:'cache flushing'!

flushCache
    "flush list of rememebred directory contents"

    LockSema critical:[ CachedDirectories := nil ].

    "
     self flushCache
    "

    "Created: / 11.2.2000 / 00:13:59 / cg"
!

flushCachedDirectoryFor:aDirectoryOrString
    "remove directory from cache
    "
    |index directory|

    (CachedDirectories notNil and:[aDirectoryOrString notNil]) ifTrue:[
        directory := aDirectoryOrString asFilename.

        (directory isSymbolicLink not
        and:[ directory isDirectory]) ifTrue:[
            LockSema critical:[
                CachedDirectories notNil ifTrue:[
                    directory := directory asAbsoluteFilename.
                    index := CachedDirectories findFirst:[:d | d directory = directory ].

                    index ~~ 0 ifTrue:[
                        CachedDirectories removeAtIndex:index.
                    ]
                ]
            ]
        ]
    ].
!

lowSpaceCleanup
    "flush list of remembered directory contents when low on memory"

    self flushCache

    "
     self lowSpaceCleanup
    "

    "Created: / 18.2.1998 / 18:17:05 / cg"
    "Modified: / 24.9.1998 / 17:51:15 / cg"
!

preSnapshot
    "flush list of rememebred directory contents' before saving an image"

    self flushCache.
! !

!DirectoryContents class methodsFor:'constants'!

maxCachedDirectories
    "returns number of maximum cached directories
    "
    ^ 20

    "Modified: / 25.2.1998 / 19:56:24 / cg"
! !

!DirectoryContents class methodsFor:'private'!

directoryAt:aFilename
    "checks whether directory already exists and is valid.
     If true the directory is returned otherwise nil
    "
    |index directory absoluteFilename|

    directory := nil.

    LockSema critical:[
        CachedDirectories notNil ifTrue:[
            absoluteFilename := aFilename asFilename asAbsoluteFilename.
            index := CachedDirectories findFirst:[:d| d directory = absoluteFilename ].

            index ~~ 0 ifTrue:[
                directory := CachedDirectories at:index.

                directory isObsolete ifTrue:[
                    CachedDirectories removeAtIndex:index.
                    directory := nil.
                ]
            ]
        ]
    ].
    ^ directory
! !

!DirectoryContents class methodsFor:'queries'!

directoryNamed:aDirectoryName detect:aTwoArgBlock
    "evaluate the block, [:filename :isDirectory] on the directory
     contents of a directory named aDirectoryName, until the block
     returns true. If nothing detected false is returned
    "
    |directory dir|

    directory := aDirectoryName asFilename.

    directory exists ifFalse:[
        ^ false
    ].

    (dir := self directoryAt:directory) notNil ifTrue:[
        dir contentsDo:[:aFile :isDir|
            (aTwoArgBlock value:aFile value:isDir) ifTrue:[^ true]
        ].
        ^ false
    ].

    [
        directory directoryContentsDo:[:fn |
            |file|

            file := directory construct:fn.
            (aTwoArgBlock value:file value:(file isDirectory)) ifTrue:[
                ^ true
            ]
        ].
    ] on:FileStream openErrorSignal do:[:ex|
          "cannot open directory"
          ^ false
    ].


"/    dir := DirectoryStream directoryNamed:(directory pathName).
"/
"/    dir isNil ifFalse:[
"/        [
"/            [dir atEnd] whileFalse:[
"/                (name := dir nextLine) notNil ifTrue:[
"/                    name := directory construct:name.
"/
"/                    (aTwoArgBlock value:name value:(name isDirectory)) ifTrue:[
"/                        ^ true
"/                    ]
"/                ]
"/            ].
"/        ] valueNowOrOnUnwindDo:[
"/            dir close.
"/        ]
"/    ].

    ^ false

    "Modified: / 24.9.1998 / 21:14:58 / cg"
! !

!DirectoryContents class methodsFor:'utilities'!

contentsItemForFileName:aFilenameOrString 
    | aFilename directory directoryContents|

    aFilename := aFilenameOrString asFilename.
    directory := aFilename directory.
    directoryContents := self directoryNamed:directory.
    directoryContents isNil ifTrue:[
        aFilename exists ifTrue:[
            ^ (DirectoryContentsItem new fileName:aFilename) info:aFilename info.
        ].
        ^ nil
    ].

    directoryContents itemsDo:[:fileItemThere |
        fileItemThere fileName = aFilename ifTrue:[
            fileItemThere updateInfo.
            ^ fileItemThere.
        ]
    ].
    ^ (DirectoryContentsItem new fileName:aFilename) info:aFilename info.

    "
     DirectoryContents contentsItemForFileName:'/etc/passwd'
     DirectoryContents contentsItemForFileName:'/'
    "
! !

!DirectoryContents methodsFor:'accessing'!

directory
    "returns the directoy name as Filename
    "
    ^ directory
!

modificationTime
    "get the last modification time of the directory
    "
    ^ directory modificationTime
!

timeStamp
    "get the last timeStamp (when the directory info was read) of the directory
    "
    ^ timeStamp
! !

!DirectoryContents methodsFor:'enumerating'!

contentsAndBaseNamesDo:aThreeArgBlock
    "evaluate the block on each file; the argument to the block is the
     filename, the baseName and true in case of a directory
     block arguments: [:fileName :aBaseName :isDirectory|
    "

    self itemsDo:[:eachItem |
        aThreeArgBlock 
            value:(eachItem fileName) 
            value:(eachItem baseName ) 
            value:(eachItem isDirectory)
    ].
!

contentsDo:aTwoArgBlock
    "evaluate the block on each file; the argument to the block is the
     filename and true in case of a directory
     block arguments: [:fileName :isDirectory|
    "

    self itemsDo:[:eachItem |
        aTwoArgBlock
            value:(eachItem fileName) 
            value:(eachItem isDirectory)
    ].
!

directoriesAndBasenamesDo:aTwoArgBlock
    "evaluate block on each directory; a Filename and Basename.
     The directories are sorted
    "

    self itemsDo:[:eachItem |
        eachItem isDirectory ifTrue:[
            aTwoArgBlock value:(eachItem fileName) value:(eachItem baseName)
        ]
    ]
!

directoriesDo:aOneArgBlock
    "evaluate block on each directory; a Filename. The directories are sorted
    "

    self itemsDo:[:eachItem |
        eachItem isDirectory ifTrue:[
            aOneArgBlock value:(eachItem fileName) 
        ]
    ].
!

filesAndBasenamesDo:aTwoArgBlock
    "evaluate block on each file; a Filename and a Basename.
     The files are sorted.
    "

    self itemsDo:[:eachItem |
        eachItem isDirectory ifFalse:[
            aTwoArgBlock value:(eachItem fileName) value:(eachItem baseName)
        ]
    ]
!

filesDo:aOneArgBlock
    "evaluate block on each file; a Filename. The files are sorted.
    "

    self itemsDo:[:eachItem |
        eachItem isDirectory ifFalse:[
            aOneArgBlock value:(eachItem fileName)
        ]
    ]
!

itemsDo:aBlock
    "evaluate the block on each contentsItem, which contains the fileName and type info"

    contents do:[:eachItem |
        aBlock value:eachItem.
    ].
! !

!DirectoryContents methodsFor:'instance creation'!

directory:aFilename
    "instance creation; setup attributes"

    |t dircontents|

    directory := aFilename asFilename.
    t := Timestamp now. "/ directory modificationTime.
    [
        dircontents := directory directoryContents.
        dircontents sort.
        contents  := dircontents collect:[:eachBasename | DirectoryContentsItem new fileName:(directory construct:eachBasename)].

"/        dircontents := directory directoryContentsAsFilenames.
"/        dircontents sort:[:a :b | a baseName < b baseName].
"/        contents  := dircontents 
"/                    collect:[:eachFilename | DirectoryContentsItem new fileName:eachFilename].
    ] on:FileStream openErrorSignal do:[:ex|
        contents := #().
    ].
    timeStamp := t.
! !

!DirectoryContents methodsFor:'printing'!

printOn:aStream
    aStream nextPutAll:'DirectoryContents of: '.
    directory printOn:aStream.
! !

!DirectoryContents methodsFor:'private'!

updateContents
    "ensure that the file-info os present for every item"

    contents do:[:eachItem |
        eachItem updateInfo.
    ].
! !

!DirectoryContents methodsFor:'queries'!

isObsolete
    "returns true if the directory contents represented by the receiver is obsolete
     (i.e. if the fileSystems directory has been changed in the meanwhile)
    "

    |mt|

    directory exists ifFalse:[^ true].
    timeStamp isNil ifTrue:[^ true].
    (mt := directory modificationTime) isNil ifTrue:[^ true].
    "/ ignores milliseconds in the comparison
    timeStamp < mt ifTrue:[^ true].
    timeStamp getSeconds = mt getSeconds ifTrue:[^ true].
    ^ false

    "Modified: / 23.8.2001 / 16:50:51 / cg"
!

size
    "get number of files including directories in the directory
    "
    ^ contents size
! !

!DirectoryContents methodsFor:'testing'!

isEmpty
    "retuirns true if directory is empty
    "
    ^ contents size == 0
!

notEmpty
    "returns true if directory is not empty
    "
    ^ contents size ~~ 0
! !

!DirectoryContents::DirectoryContentsItem methodsFor:'accessing'!

baseName
    ^ fileName baseName
!

fileName
    ^ fileName
!

fileName:something
    "set the value of the instance variable 'fileName' (automatically generated)"

    fileName := something.
!

info
    info isNil ifTrue:[
        self updateInfo.
    ].
    info isSymbol ifTrue:[^ nil]. "/ a remote directory
    ^ info
!

info:something
    "set the value of the instance variable 'type' (automatically generated)"

    info := something.
!

type
    info isNil ifTrue:[
        self updateInfo.
    ].
    info isSymbol ifTrue:[^ info].
    ^ info type
! !

!DirectoryContents::DirectoryContentsItem methodsFor:'misc'!

cachedRemoteMountPoints
    |mountPoints now|

    mountPoints := CachedRemoteMountPoints.

    (mountPoints isNil
    or:[ CachedRemoteMountPointsTimeStamp isNil
    or:[ now := Timestamp now.
         (now - CachedRemoteMountPointsTimeStamp) > 30 
    ]]) ifTrue:[
        CachedRemoteMountPointsTimeStamp := now.
        mountPoints := OperatingSystem mountPoints.
        mountPoints := mountPoints select:[:mp | mp isRemote].
        CachedRemoteMountPoints := mountPoints.
    ].

    ^ mountPoints.
!

updateInfo
    "ensure that the file-info is present"
    
    |mountPoints mountPoint nameString linkName|

    info isNil ifTrue:[
        nameString := fileName name.
        self assert:[fileName isAbsolute].
        mountPoints := self cachedRemoteMountPoints.
        info := fileName linkInfo.
        (info notNil and:[info isSymbolicLink]) ifTrue:[
            "have to check for both link and link target"
            linkName := info path.
            mountPoint := mountPoints 
                        detect:[:mInfo | |p|
                            p := mInfo mountPointPath.
                            ((linkName startsWith:p) and:[ linkName startsWith:(p , '/') ])
                        ]
                        ifNone:nil.
            info := fileName info.  "get the info of the link target"
        ] ifFalse:[
            "have to check for mountPoint only"
            mountPoint := mountPoints 
                        detect:[:mInfo | mInfo mountPointPath = nameString ]
                        ifNone:nil.
        ].
        (mountPoint notNil) ifTrue:[
            info := #remoteDirectory.
        ] ifFalse:[
            info isNil ifTrue:[
                "/ broken symbolic link
                info := #symbolicLink.
            ]
        ].
    ].
! !

!DirectoryContents::DirectoryContentsItem methodsFor:'printing'!

printOn:aStream
    aStream nextPutAll:'DirectoryContentsItem for: '.
    fileName printOn:aStream.
! !

!DirectoryContents::DirectoryContentsItem methodsFor:'queries'!

isDirectory
    |t|

    t := self type.
    ^ (t == #directory or:[t == #remoteDirectory])
!

isRemoteDirectory
    ^ info == #remoteDirectory
! !

!DirectoryContents class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/DirectoryContents.st,v 1.41 2005-10-19 08:11:58 stefan Exp $'
! !

DirectoryContents initialize!