[Pkg] Rio: File-Kernel-kph.5.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Tue Nov 25 15:35:12 UTC 2008


A new version of File-Kernel was added to project Rio:
http://www.squeaksource.com/Rio/File-Kernel-kph.5.mcz

==================== Summary ====================

Name: File-Kernel-kph.5
Author: kph
Time: 25 November 2008, 3:35:10 pm
UUID: 43c4e71e-a6f0-4dd5-83d4-9d073ae77ed4
Ancestors: File-Kernel-kph.4

moved FileExecutive back in (silly mistake at 5am)

=============== Diff against File-Kernel-kph.4 ===============

Item was added:
+ ----- Method: FileExecutive>>basicReader: (in category 'as yet unclassified') -----
+ basicReader: aFile
+ 
+ 	^ self class fileStreamClass new open: aFile forWrite: false!

Item was added:
+ ----- Method: FileExecutive>>toDirLocal:addAllLocal:relativeTo: (in category 'local/remote file copy') -----
+ toDirLocal: aDir addAllLocal: someFD relativeTo: aBaseDir
+ 
+ 	| map |
+ 
+ 	map := self toDir: aDir mkpathAll: someFD relativeTo: aBaseDir.
+ 
+ 	map do: [ :each | self copyLocalFile: each first toLocalFile: each second ].
+ 	
+ 	^ map!

Item was added:
+ ----- Method: FileExecutive>>touch: (in category 'as yet unclassified') -----
+ touch: aRio
+ 
+ 	aRio writer close!

Item was added:
+ ----- Method: FileExecutive>>root (in category 'as yet unclassified') -----
+ root
+ 
+ 	^ self class makeNew: self class dirClass from: self rootString!

Item was added:
+ ----- Method: FileExecutive>>pathDelimiter (in category 'as yet unclassified') -----
+ pathDelimiter
+  
+ 	^ '/'
+ !

Item was added:
+ ----- Method: FileExecutive>>mkpath: (in category 'as yet unclassified') -----
+ mkpath: aRio
+ 
+ 	aRio isDirectory ifTrue: [ ^self ].
+ 	aRio parent mkpath.
+ 	self createDirectory: aRio.  !

Item was added:
+ ----- Method: FileExecutive>>isRoot: (in category 'testing') -----
+ isRoot: aRioOrString
+ 
+ 	^ aRioOrString value = self rootString!

Item was added:
+ ----- Method: FileExecutive>>isDirectory: (in category 'as yet unclassified') -----
+ isDirectory: aRio 
+ 
+ 	^ aRio stat ifNil: [ false ] ifNotNil: [ aRio stat isDirectory ]
+ !

Item was added:
+ ----- Method: FileExecutive class>>newDirectoryFrom: (in category 'as yet unclassified') -----
+ newDirectoryFrom: aString
+ 
+ 	^ (self instanciatorFrom: aString) makeNew: self dirClass from: aString
+     !

Item was added:
+ ----- Method: FileExecutive>>toDir:mkpathAll:relativeTo: (in category 'local/remote file copy') -----
+ toDir: aDir mkpathAll: someFD relativeTo: aBaseDir
+ 
+ 	"take the list of files and ensure that the directories exist, return sourceFile -> destFile map"
+ 
+ 	^ someFD 
+ 		collect: [ :aFileOrDir | Array with: aFileOrDir with: (self dir: aDir mkpath: aFileOrDir relativeTo: aBaseDir) ]
+ 		thenSelect: [ :ea | ea first isFile ].
+ 	
+ 	 !

Item was added:
+ ----- Method: FileExecutive>>fileSize: (in category 'testing') -----
+ fileSize: aRio
+ 
+ 	^ aRio stat fileSize!

Item was added:
+ ----- Method: FileExecutive class>>pathDelimiter (in category 'as yet unclassified') -----
+ pathDelimiter
+  
+ 	^ '/'
+ !

Item was added:
+ ----- Method: FileExecutive>>delete: (in category 'as yet unclassified') -----
+ delete: aFileOrDir
+ 
+ 	aFileOrDir isDirectory ifTrue: [ ^ aFileOrDir rmdir ].
+ 	self deleteFile: aFileOrDir.!

Item was added:
+ ----- Method: FileExecutive class>>instanciatorFrom: (in category 'as yet unclassified') -----
+ instanciatorFrom: aString
+ 
+ 	| executiveClass |
+ 	
+ 	FileExecutive allSubclassesDo: [ :c | (c canInstanciateFrom: aString) ifTrue: [ executiveClass := c ]].
+ 	
+ 	^ executiveClass ifNil: [ self default ]!

Item was added:
+ ----- Method: FileExecutive>>dirClass (in category 'as yet unclassified') -----
+ dirClass
+ 
+ 	^ Smalltalk at: #Directory ifAbsent: [ FileKernel ]!

Item was added:
+ ----- Method: FileExecutive class>>fileStreamClass (in category 'as yet unclassified') -----
+ fileStreamClass
+ 
+ 	^ FileStream concreteStream!

Item was added:
+ ----- Method: FileExecutive>>toDir:addAllLocal:relativeTo: (in category 'local/remote file copy') -----
+ toDir: aDir addAllLocal: someFD relativeTo: aBaseDir
+ 
+ 	^ self toDirLocal: aDir addAllLocal: someFD relativeTo: aBaseDir.!

Item was added:
+ ----- Method: FileExecutive>>makeNewRioFromString: (in category 'as yet unclassified') -----
+ makeNewRioFromString: aString
+ 
+ 	^ self fileClass executive: self value: aString !

Item was added:
+ ----- Method: FileExecutive>>mkdir: (in category 'as yet unclassified') -----
+ mkdir: aRio
+ 
+ 	aRio isDirectory ifTrue: [ ^ self error: 'directory already exists' ].
+ 	self createDirectory: aRio  !

Item was added:
+ ----- Method: FileExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') -----
+ canInstanciateFrom: aPathString
+ 
+ 	"we return false, because we do not support any specific protocol"
+ 
+ 	^ false!

Item was added:
+ ----- Method: FileExecutive>>fileClass (in category 'as yet unclassified') -----
+ fileClass
+ 
+ 	^ Smalltalk at: #File ifAbsent: [ FileKernel ]!

Item was added:
+ ----- Method: FileExecutive>>toDir:addAllRemote:relativeTo: (in category 'local/remote file copy') -----
+ toDir: aDir addAllRemote: someFD relativeTo: aBaseDir
+ 
+ 	^ someFD first executive toDirLocal: aDir addAllRemote: someFD relativeTo: aBaseDir.!

Item was added:
+ ----- Method: FileExecutive class>>dirClass (in category 'as yet unclassified') -----
+ dirClass
+ 
+ 	^ Smalltalk at: #Directory ifAbsent: [ FileKernel ]!

Item was added:
+ ----- Method: FileExecutive>>basicWriter: (in category 'as yet unclassified') -----
+ basicWriter: aRio
+ 
+ 	^ self class fileStreamClass new open: aRio forWrite: true 
+ 	!

Item was added:
+ Object subclass: #FileExecutive
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'File-Kernel'!

Item was added:
+ ----- Method: FileExecutive>>pathDelimiterChar (in category 'as yet unclassified') -----
+ pathDelimiterChar
+  
+ 	^ $/
+ !

Item was added:
+ ----- Method: FileExecutive>>MCPasswordManager (in category 'case-sensitivity') -----
+ MCPasswordManager
+ 
+ 	^ MCPasswordManager!

Item was added:
+ ----- Method: FileExecutive class>>default (in category 'as yet unclassified') -----
+ default
+ 
+ 	^ FileLocalExecutive            !

Item was added:
+ ----- Method: FileExecutive class>>fileClass (in category 'as yet unclassified') -----
+ fileClass
+ 
+ 	^ Smalltalk at: #File ifAbsent: [ FileKernel ]!

Item was added:
+ ----- Method: FileExecutive>>importValue: (in category 'executive actions') -----
+ importValue: path
+  
+ 	path isEmpty ifTrue: [  ^ '' ].
+ 	
+ 	(self isRoot: path) ifTrue: [ ^ self rootString ].
+ 	
+  	(path last = self pathDelimiter first) ifTrue: [ ^ path allButLast ].
+ 	
+ 	^path!

Item was added:
+ ----- Method: FileExecutive>>isFile: (in category 'as yet unclassified') -----
+ isFile: aFileOrDirectory 
+ 
+ 	^ (aFileOrDirectory stat ifNil: [ ^ false ]) isFile
+ !

Item was added:
+ ----- Method: FileExecutive>>isFull: (in category 'as yet unclassified') -----
+ isFull: aFileOrDirectory
+ 
+ 	^ aFileOrDirectory value beginsWith: self rootString!

Item was added:
+ ----- Method: FileExecutive>>rootString (in category 'as yet unclassified') -----
+ rootString
+ 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: FileExecutive>>dir:mkpath:relativeTo: (in category 'as yet unclassified') -----
+ dir: aDir mkpath: aFileOrDir relativeTo: aBaseDirectory
+ 	
+ 	| newFD |
+ 	
+ 	newFD := aBaseDirectory ifNil: [ aFileOrDir ]
+ 				    		 	 ifNotNil: [ aDir / (aFileOrDir linearRelativeTo: aBaseDirectory) ].
+ 
+  	aFileOrDir isDirectory ifTrue: [ newFD mkpath ]. 
+ 	aFileOrDir isFile ifTrue: [ newFD parent mkpath ].
+ 	
+ 	^ newFD
+ 	
+  !

Item was added:
+ ----- Method: FileExecutive>>hashFor: (in category 'equality') -----
+ hashFor: aRio
+ 	
+ 	^ aRio value hash!

Item was added:
+ ----- Method: FileExecutive>>is:sameAs: (in category 'equality') -----
+ is: aRio sameAs: bRio
+ 
+ 	^ aRio value = bRio value!

Item was added:
+ ----- Method: FileExecutive>>in:select: (in category 'as yet unclassified') -----
+ in: aDir select: selectBlock
+ 
+ 	^ self 
+ 		startAt: aDir
+ 		recursively: aDir isRecursive 
+ 		select: selectBlock 
+ 		into: (OrderedCollection new: 50)
+ !

Item was added:
+ ----- Method: FileExecutive>>arePathsCaseSensitive (in category 'case-sensitivity') -----
+ arePathsCaseSensitive
+ 
+ 	^ (self is: $a sameAs: $A) not
+ 	
+ !

Item was added:
+ ----- Method: FileExecutive>>addAll:relativeTo:toDir: (in category 'local/remote file copy') -----
+ addAll: someFD relativeTo: aBaseDir toDir: aDir
+ 	
+ 	^ aDir executive toDir: aDir addAllLocal: someFD relativeTo: aBaseDir.!

Item was added:
+ ----- Method: FileExecutive class>>newFileFrom: (in category 'as yet unclassified') -----
+ newFileFrom: aString
+ 
+ 	^ (self instanciatorFrom: aString) makeNew: self fileClass from: aString
+     !

Item was added:
+ ----- Method: FileExecutive class>>OSProcessOrNil (in category 'as yet unclassified') -----
+ OSProcessOrNil
+ 
+ 	"extra check is needed because OSProcess on windows does not support waitForCommand (yet)"
+ 	
+ 	| osp |
+ 	
+ 	osp := Smalltalk at: #OSProcess ifAbsent: [ ^ nil ].
+ 	
+ 	^ (osp thisOSProcess respondsTo: #waitForCommand:) ifTrue: [ osp ] ifFalse: [ nil ]
+ 	!

Item was added:
+ ----- Method: FileExecutive>>fullFor: (in category 'as yet unclassified') -----
+ fullFor: aFileOrDirectory
+ 
+ 	"the absolute path of this rio, or if relative 
+ 	combine with #defaultDirectory to obtain the full path"
+ 	
+ 	aFileOrDirectory value isEmpty ifTrue: [ ^ self defaultDirectory ].
+ 	
+ 	(self isFull: aFileOrDirectory) ifTrue: [ ^ aFileOrDirectory ].
+ 
+ 	^ aFileOrDirectory newFrom: (self defaultDirectory value, self pathDelimiter, aFileOrDirectory value)!



More information about the Packages mailing list