FileDirectory.st
changeset 1 a27a279701f8
child 2 6526dde5f3ac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/FileDirectory.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,553 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Collection subclass:#FileDirectory
+       instanceVariableNames:'pathName lazy'
+       classVariableNames:'pathOfCurrentDirectory'
+       poolDictionaries:''
+       category:'Collections-Files'
+!
+
+FileDirectory comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+             All Rights Reserved
+
+FileDirectories represent directories in the underlying host system.
+They provide various methods to create/delete and query for files and/or
+directories.
+
+%W% %E%
+
+written winter 89 by claus
+'!
+
+!FileDirectory class methodsFor:'instance creation'!
+
+rootDirectory
+    "create and return a new FileDirectory for the root directory"
+
+    ^ (self basicNew) pathName:'/'
+!
+
+currentDirectory
+    "create and return a new FileDirectory for the current directory"
+
+    ^ (self basicNew) pathName:'.'
+!
+
+directoryNamed:name
+    "create and return a new FileDirectory for the directory
+     with given pathname"
+
+    ^ (self basicNew) pathName:name
+!
+
+directoryNamed:name in:aFileDirectory
+    "create and return a new FileDirectory for the directory with given name
+     in another FileDirectory"
+
+    |baseName|
+
+    ((name at:1) == $/) ifTrue:[
+        ^ self directoryNamed:name
+    ].
+    (aFileDirectory isKindOf:FileDirectory) ifTrue:[
+        baseName := aFileDirectory pathName
+    ] ifFalse:[
+        baseName := aFileDirectory
+    ].
+"
+    (name = '..') ifTrue:[
+        ^ (self basicNew) pathName:(OperatingSystem directoryNameOf:baseName)
+    ].
+"
+    (name = '.') ifTrue:[^ aFileDirectory].
+
+    (baseName = '/') ifFalse:[
+        (baseName endsWith:'/') ifFalse:[
+            baseName := baseName , '/'
+        ]
+    ].
+    ^ (self basicNew) pathName:(baseName , name)
+! !
+
+!FileDirectory methodsFor:'accessing'!
+
+baseName
+    "return my baseName
+     - thats the directory name without leading parent-dirs"
+
+    lazy ifTrue:[self getFullPathName].
+    ^ OperatingSystem baseNameOf:pathName
+!
+
+directoryName
+    "return my directoryName
+     - thats the directory name where I'm in"
+
+    lazy ifTrue:[self getFullPathName].
+    ^ OperatingSystem directoryNameOf:pathName
+!
+
+pathName
+    "return my full pathname"
+
+    lazy ifTrue:[self getFullPathName].
+    ^ pathName
+!
+
+pathName:dirName
+    "set my pathname; return nil if not a valid path; self otherwise"
+
+    pathName := dirName.
+    (dirName startsWith:'/') ifFalse:[
+        lazy := true
+    ] ifTrue:[
+        (dirName includes:$.) ifTrue:[
+            lazy := true
+        ]
+    ].
+    ^ self
+"
+    (OperatingSystem isDirectory:pathName) ifFalse:[^ nil]
+"
+!
+
+contents 
+    "return a collection with all files and subdirectories in the receiver"
+
+    |coll|
+
+    coll := OrderedCollection new.
+    self do:[:name |
+        coll add:name
+    ].
+    (coll size ~~ 0) ifTrue:[
+        coll sort
+    ].
+    ^ coll
+!
+
+directories
+    "return a collection with all subdirectories in the receiver directory"
+
+    |coll|
+
+    coll := OrderedCollection new.
+    self directoriesDo:[:name |
+        coll add:name
+    ].
+    (coll size ~~ 0) ifTrue:[
+        coll sort
+    ].
+    ^ coll
+!
+
+files
+    "return a collection with all plain files in the receiver directory"
+
+    |coll|
+
+    coll := OrderedCollection new.
+    self filesDo:[:name |
+        coll add:name
+    ].
+    ^ coll sort
+! !
+
+!FileDirectory methodsFor:'private'!
+
+getFullPathName
+    "make my pathname be a full pathname - i.e. starting at root"
+
+    |aStream command shortPathName fullPathName|
+
+    (pathName = '/') ifTrue:[
+        lazy := false.
+        ^ self
+    ].
+
+    "since currentDirectory is used very often, cache its path here"
+
+    (pathName = '.') ifTrue:[
+        pathOfCurrentDirectory notNil ifTrue:[
+            pathName := pathOfCurrentDirectory.
+            lazy := false.
+            ^ self
+        ]
+    ].
+
+    shortPathName := pathName.
+
+    "sys5.4 and sunos have a convenient function for this ..."
+%{
+#if defined(SYSV4) || defined(sunos)
+#   include <stdlib.h>
+#   include <sys/param.h>
+
+    char nameBuffer[MAXPATHLEN + 1];
+
+    if (realpath(_stringVal(_INST(pathName)), nameBuffer)) {
+	fullPathName = _MKSTRING(nameBuffer COMMA_CON);
+    }
+#endif
+%}
+.
+    fullPathName notNil ifTrue:[
+	pathName := fullPathName.
+	lazy := false
+    ] ifFalse:[
+        "since there might be symbolic links and other stuff involved,
+         better trust pwd than removing '..' by ourself
+         - although this is very slow"
+
+        command := 'cd ' , pathName , '; pwd'.
+        aStream := PipeStream readingFrom:command.
+        aStream isNil ifFalse:[
+            (aStream atEnd) ifFalse:[
+                fullPathName := aStream nextLine
+            ].
+            aStream close.
+            fullPathName notNil ifTrue:[
+                pathName := fullPathName.
+                lazy := false
+            ]
+        ] ifTrue:[
+            self error:('PipeStream for <' , command , '> failed').
+            "by clearing lazy, we avoid triggering the error again"
+            lazy := false
+        ]
+    ].
+
+    "if it was the current dir, keep name for next query"
+    (shortPathName = '.') ifTrue:[
+        pathOfCurrentDirectory := fullPathName
+    ]
+! !
+
+!FileDirectory methodsFor:'basic'!
+
+createDirectory:newName
+    "create a new filedirectory as a subdirectory of myself;
+     return true if successful"
+
+    |realName|
+
+    (newName = '.') ifFalse:[
+        (newName = '..') ifFalse:[
+            ((newName at:1) == $/) ifTrue:[
+                realName := newName copyFrom:2
+            ] ifFalse:[
+                realName := newName
+            ].
+            (realName startsWith:'/') ifTrue:[
+                ^ OperatingSystem createDirectory:realName
+            ] ifFalse:[
+                ^ OperatingSystem createDirectory:(pathName , '/' , realName)
+            ]
+        ]
+    ].
+    ^ false
+!
+
+removeFile:fileName
+    "remove the file 'fileName' from myself; return true if successful"
+
+    (fileName startsWith:'/') ifTrue:[
+        ^ OperatingSystem removeFile:fileName
+    ].
+    ^ OperatingSystem removeFile:(pathName , '/' , fileName)
+!
+
+removeDirectory:dirName
+    "remove the directory 'dirName' from myself; return true if successful"
+
+    (dirName startsWith:'/') ifTrue:[
+        ^ OperatingSystem removeDirectory:dirName
+    ].
+    ^ OperatingSystem removeDirectory:(pathName , '/' , dirName)
+!
+    
+remove:aFileOrDirectoryName
+    "remove the file or directory from myself; return true if successful"
+
+    |path|
+
+    (aFileOrDirectoryName startsWith:'/') ifTrue:[
+        path := aFileOrDirectoryName
+    ] ifFalse:[
+        path := (pathName , '/' , aFileOrDirectoryName)
+    ].
+    (OperatingSystem isDirectory:path) ifTrue:[
+        ^ OperatingSystem removeDirectory:path
+    ].
+    ^ OperatingSystem removeFile:path
+!
+
+link:oldFileName to:newFileName
+    "link oldFileName to newFileName in myself, return true if successful"
+
+    |path1 path2|
+
+    (oldFileName startsWith:'/') ifTrue:[
+        path1 := oldFileName
+    ] ifFalse:[
+        path1 := (pathName , '/' , oldFileName)
+    ].
+    (newFileName startsWith:'/') ifTrue:[
+        path2 := newFileName
+    ] ifFalse:[
+        path2 := (pathName , '/' , newFileName)
+    ].
+    ^ OperatingSystem link:path1 to:path2
+!
+
+renameFile:oldFileName newName:newFileName
+    "rename the file; return true if successful"
+
+    |path1 path2|
+
+    (oldFileName startsWith:'/') ifTrue:[
+        path1 := oldFileName
+    ] ifFalse:[
+        path1 := (pathName , '/' , oldFileName)
+    ].
+    (newFileName startsWith:'/') ifTrue:[
+        path2 := newFileName
+    ] ifFalse:[
+        path2 := (pathName , '/' , newFileName)
+    ].
+    ^ OperatingSystem rename:path1 to:path2
+! !
+
+!FileDirectory methodsFor:'queries'!
+
+id
+    "return the directories file-id (inode number)"
+
+    ^ OperatingSystem idOf:pathName
+!
+
+exists
+    "return true if this directory exists"
+
+    ^ OperatingSystem isDirectory:pathName
+    "(FileDirectory directoryNamed:'fooBar') exists"
+!
+
+infoOf:name
+    "return an array filled with file info for the file 'aFileName';
+     return nil if such a file does not exist"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem infoOf:name
+    ].
+    ^ OperatingSystem infoOf:(pathName , '/' , name)
+!
+
+timeOfLastChange:name
+    "return the timeStamp of a file in myself"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem timeOfLastChange:name
+    ].
+    ^ OperatingSystem timeOfLastChange:(pathName , '/' , name)
+!
+
+timeOfLastChange
+    "return the timeStamp of myself"
+
+    ^ OperatingSystem timeOfLastChange:pathName
+!
+
+accessModeOf:aFileName
+    "return the access-mode bits (rwxrwxrwx) of a file in myself"
+
+    (aFileName startsWith:'/') ifTrue:[
+        ^ OperatingSystem accessModeOf:aFileName
+    ].
+    ^ OperatingSystem accessModeOf:(pathName , '/' , aFileName)
+!
+
+changeAccessModeOf:aFileName to:modeBits
+    "set the access-mode bits (rwxrwxrwx) of a file in myself"
+
+    (aFileName startsWith:'/') ifTrue:[
+        ^ OperatingSystem changeAccessModeOf:aFileName
+                                          to:modeBits
+    ].
+    ^ OperatingSystem changeAccessModeOf:(pathName , '/' , aFileName)
+                                      to:modeBits
+!
+
+typeOf:aFileName
+    "return the symbolic type of a file in myself"
+
+    (aFileName startsWith:'/') ifTrue:[
+        ^ OperatingSystem typeOf:aFileName
+    ].
+    ^ OperatingSystem typeOf:(pathName , '/' , aFileName)
+!
+
+isDirectory:name
+    "return true, if the given name is that of a directory in myself"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem isDirectory:name
+    ].
+    ^ OperatingSystem isDirectory:(pathName , '/' , name)
+!
+
+isReadable:name
+    "return true, if the given file is readable"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem isReadable:name
+    ].
+    ^ OperatingSystem isReadable:(pathName , '/' , name)
+!
+
+isWritable:name
+    "return true, if the given file is readable"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem isWritable:name
+    ].
+    ^ OperatingSystem isWritable:(pathName , '/' , name)
+!
+
+isExecutable:name
+    "return true, if the given file is executable"
+
+    (name startsWith:'/') ifTrue:[
+        ^ OperatingSystem isExecutable:name
+    ].
+    ^ OperatingSystem isExecutable:(pathName , '/' , name)
+! !
+
+!FileDirectory methodsFor:'printing & storing'!
+
+printString
+    lazy ifTrue:[self getFullPathName].
+    ^ '(a FileDirectory pathName:' , pathName, ')'
+!
+
+storeOn:aStream
+    lazy ifTrue:[self getFullPathName].
+    aStream nextPutAll:'(FileDirectory directoryNamed:'.
+    aStream nextPutAll:pathName.
+    aStream nextPut:$)
+! !
+
+!FileDirectory methodsFor:'more instance creation'!
+
+directoryNamed:aName
+    ^ self class directoryNamed:aName in:self pathName
+! !
+
+!FileDirectory methodsFor:'enumerating'!
+
+where:testBlock do:aBlock
+    "evaluate the argument, aBlock for every object in the directory
+     for which testBlock evaluates to true."
+
+    |aStream name|
+
+    aStream := DirectoryStream directoryNamed:pathName.
+    aStream isNil ifTrue:[^ nil].
+    [aStream atEnd] whileFalse:[
+        name := aStream nextLine.
+        name notNil ifTrue:[
+            (testBlock value:name) ifTrue:[
+                aBlock value:name
+            ]
+        ]
+    ].
+    aStream close
+!
+
+do:aBlock
+    "evaluate the argument, aBlock for every name in the directory"
+
+    self where:[:name | true] do:aBlock
+!
+
+namesDo:aBlock
+    "evaluate the argument, aBlock for every name in the directory.
+     for ST-80 compatibility"
+
+    self do:aBlock
+!
+
+filesDo:aBlock
+    "evaluate the argument, aBlock for every plain file name in the directory"
+
+    self where:[:name | (self isDirectory:name) not] do:aBlock
+!
+
+directoriesDo:aBlock
+    "evaluate the argument, aBlock for every subdirectory name in the directory"
+
+    self where:[:name | (self isDirectory:name) ifTrue:[
+                            ((name ~= '.') and:[name ~= '..'])
+                        ] ifFalse:[
+                            false
+                        ]
+               ] do:aBlock
+!
+
+allFilesDo:aBlock
+    "evaluate the argument, aBlock for every file name in the directory and in all
+     subdirectories"
+
+    |aStream command line|
+
+    lazy ifTrue:[self getFullPathName].
+    command := 'cd ' , pathName , '; find . -print'.
+    aStream := PipeStream readingFrom:command.
+    aStream isNil ifTrue:[^ nil].
+    [aStream atEnd] whileFalse:[
+        line := aStream nextLine.
+        line notNil ifTrue:[
+            (line = '.') ifFalse:[
+                "cut off initial ./"
+                line := line copyFrom:3 to:(line size)
+            ].
+            aBlock value:line
+        ]
+    ].
+    aStream close
+!
+
+allDirectoriesDo:aBlock
+    "evaluate the argument, aBlock for every directory name
+     in the directory and in all subdirectories"
+
+    |aStream command line|
+
+    lazy ifTrue:[self getFullPathName].
+    command := 'cd ' , pathName , '; find . -type d -print'.
+    aStream := PipeStream readingFrom:command.
+    aStream isNil ifTrue:[^ nil].
+    [aStream atEnd] whileFalse:[
+        line := aStream nextLine.
+        line notNil ifTrue:[
+            (line = '.') ifFalse:[
+                "cut off initial ./"
+                line := line copyFrom:3 to:(line size)
+            ].
+            aBlock value:line
+        ]
+    ].
+    aStream close
+! !