[Pkg] Rio: File-Base-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Thu Nov 13 02:19:15 UTC 2008
A new version of File-Base was added to project Rio:
http://www.squeaksource.com/Rio/File-Base-kph.1.mcz
==================== Summary ====================
Name: File-Base-kph.1
Author: kph
Time: 13 November 2008, 2:19:12 am
UUID: 9bc2621c-c6b8-4507-bd65-9f007b8f77b4
Ancestors:
First release of File version of Rio
==================== Snapshot ====================
SystemOrganization addCategory: #'File-Base'!
----- Method: InflateStream>>on: (in category '*file-base-override') -----
on: aCollectionOrStream
aCollectionOrStream isStream
ifTrue:[ aCollectionOrStream isBinary ifFalse: [ collection := String new ].
aCollectionOrStream binary.
sourceStream := aCollectionOrStream.
self getFirstBuffer]
ifFalse:[source := aCollectionOrStream].
^self on: source from: 1 to: source size.!
----- Method: InflateStream>>on:from:to: (in category '*file-base-override') -----
on: aCollection from: firstIndex to: lastIndex
bitBuf := bitPos := 0.
"The decompression buffer has a size of at 64k,
since we may have distances up to 32k back and
repetitions of at most 32k length forward"
collection := (collection ifNil: [ aCollection ]) species new: 1 << 16.
readLimit := 0. "Not yet initialized"
position := 0.
source := aCollection.
sourceLimit := lastIndex.
sourcePos := firstIndex-1.
state := StateNewBlock.!
----- Method: ZipWriteStream>>close (in category '*file-base-override') -----
close
self deflateBlock.
self flushBlock: true.
^encoder close.!
FileKernel subclass: #File
instanceVariableNames: 'recursive rename adaptor binary'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
!File commentStamp: 'test 11/6/2008 00:05' prior: 0!
Thinking out loud:
Rio is an experimental version of ruby's rio in smalltalk, so as to compare with other approaches such as Fileman. Rio is implemented on RioKernel, rather than as a utility layer on top of FileDirectory, the intention being to do away with FileDirectory!!
I am wondering whether a lot of what happens in FileDirectory is absolutely necessary. So Rather than cover every eventuality, such as handling encodings of path strings (which is broken in most vms anyway) lets just try it without and see how far we get. We use tests to encapsulate what does work, and tests will highlight were we need an advance in architecture.
For example for every basic example that I could think of '<example>' asVmPathString returns the same string as the original. Obviously it's not about basic examples.
So our use of a string-like class to store the path we are using should be agnostic to the implementation of string/encoding used. We can sort this out later if necessary in the interface to primitives.
In contrast to other approaches we define $/ as the standard delimieter for use within Squeak, translating for the underlying filesystem as needed. One reason for this being that Rio commonly uses $/ to assemble paths for readbility, and it doesnt really make sense to build $: delimited path with $/.
The #executive covers the interaction with the actual file system, and there is an executive for file systems with case insensitive filnames.
#rmdir does check for existence of the directory first (an improvement on legacy already!!)
#select: turns out to implement most of the guts of the fs Rio. It provides the basis for even the simpleset #stat and complex queries such as "files older than" via the stat record that is passed to the userBlock.
A beRecursive mode applies to all uses of #select:
By convention a mode change instanciates a fresh Rio instance. This treats existing instances as immutable. Mode changes are also intended to be temporary so that copying a new rio from this rio does not copy the recursive setting. (this may change).
A number of stats such as Rio>>#fileSize go via Rio>>#stat which searches for me in my parents directory!! This strikes me as a roundabout way of doing things. For multiple testing such as all the files newer than, #select: provides a much more efficient interface.
Stat results are cached, and the cache is shared by all Rios pointing to that file. The cache may be refreshed for all users via #restat, and may be invalidated via #statIsNoLongerValid Given that a cached stat contains the fileName and the parent directory rio, this can be used to get quicker cached answers to #parent and #name without splitting the ipath every time.
cwd is now available as a Class, enabling the readable form: Cwd / 'hello.txt' in code
Cool Null support for the following has been removed.
myFile := myFileRio ifFile reading.
newRio := myFileRio ifFile renameTo: 'newname'.
Rather than have #renameTo:overwriting: the following does the same job just as concisely.
oldRio renameTo: (newRio delete).
oldRio renameTo: (newRio forceNewFile). is equivalent also.
Pondering whether to have a quiet, error suppressing mode, but perhaps that is what error handlers are for.
Ruby Rio has the ability to tell the rio what the expected extension is, which it then takes into account when calculating the #basename then takes into account. So there is an #ext and an #extname, which gets kind of confusing. So if we simply define basename as the #fileName upto the last $., and the ext as the rest that should be enough.
Implementing #delete.
'\' asRio deleteTree may not be a good idea!! Do we need a guard. Ok, lets set it so that #delete wil do the job of deleteTree if the recursive flag is set.
usage: aRio all rmdir - makes sense
usage: aRio rmdir - makes sense if dir is empty.
Function of 'force'NewFileNamed: is now handled by
fileStream := aRio delete writer.
fileStream := aRio forceNewFile writer.
And the block case, instead of implementing three methods.
aRio readUsing: [ :str | ].
aRio appendUsing: [ :str | ].
myRio := aRio delete write use: [ :str | str, 'hello'; cr ].
we use #use: which unlike #in: ensures the stream is closed for us
aRio writer use: [ :str | ].
aRio writer use: [ :str | ].
FileStream #close to return the stream's rio (none of the existing senders of #close use the return value)
this allows continuing with the rio after the cascade, or using the result in assigment.
(myRio writer << 'a bit' << 'abit more') close isFile ifTrue: [ 'it s a file' ]
myRio := ('test' asRio writer << 'a bit' << 'a bit more') close.
myRio := 'test' asRio writer: [ :w | w,'hello';cr ].
myRio read contents.
Rio is split into Rio and RioKernel, the latter being the minimal useful implementation for the KernelImage.
Defined #reader: and #writer: to take a block.
instead of aRio reader use: [ :str | ], you can write aRio reader: [ :inStream | ... ].
instead of aRio writer use: [ :str | ], you can write aRio writer: [ :outStream | ... ].
#appender: is also available and is equivalent to writer: [ :out | out setToAppend. out ... ].
aStream copyTo: bStream has been implemented to be a reusable bit of code, since the same basic pattern seems to be used all over the place in slightly different forms. So now, Rio-#compress, is simply a Rio set to binary mode copied using the generic stream copy to a Rio set with a gzip adaptor.
I have moved Rio-compress to be implemented by the adaptor, this will allow different compression schemes to be supported. e.g. (Rio new: 'myFile.txt') gzip compress. Is handled by the GZip adaptor, there could be others.
So how to do copying multiple files to a directory or archive:
aDirectory copyTo: bDirectory. Could be done as aDirectory entries copyTo: bDirectory, but we havent got any methods on OrderedCollection to do that with, so it would have to be. bDirectory copyFrom: aDirectory all entries. That doesnt read correctly and it looks like you might be overwriting bDirectory. I think that "bDirectory addAll: aDirectory all entries" is fairly unambiguous. aFile copyTo: bDirectory makes sense but rather than overload #copyTo: with multiple behavours , lets keep it file to file only, and use bDirectory add: aFile as an equally unambigous version. To be useful when adding a tree of directory and files we need to know the base directory we are starting from, and all of the files as relative paths to that pase directory. The implementation of simpleRelativeTo: is brilliantly simple especially compared to the methods used in Archive-addTree: etc.
The result is a quite simple and versatile,
1. aDirectory add: aFile ,
2. aDirectory addAll: acollection
- e.g. aDirectory addAll: (myOutput all filesMatching: #('*.image' '*.changes') ).
3. aDirectory addTree: aDirectory (and all of its contents).
4. The generic version of addTree: which can be used with a hand crafted collection of files,
missing directories are created.
aDirectory addAll: aCollection fromBase: aDirectory
Moving the above Directory interface into an adaptor RioAdaptorDir, enabled this to be pluggable with other back ends, i.e. Archives which use the same interface. RioAdaptorArchive is a subclass of RioAdaptorDir, and it handles both Zip and Tar archive (tar not yet supported).
Implemented and tested Win32 implementation, modelling Dos file Volumes as separate executives.
Created a comprehensive platform independent test framework is needed to be able to verify all platform scenarious.
Lazy initialialization of executive or not? Changed to not, on the basis that it is easier to debug if exploring a rio if you can see what the executive actually is rather than a nil.
RioFtpFileSystem executive depends upon MCPasswordManager to look after passwords.
!
File subclass: #Directory
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
!Directory commentStamp: 'kph 4/12/2007 07:44' prior: 0!
Could mode mkdir and mkpath into this adaptor.!
Directory subclass: #Cwd
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
----- Method: Cwd class>>new: (in category 'public instanciation') -----
new: pathOrFile
^ Directory new: pathOrFile!
----- Method: Cwd>>newFrom: (in category 'as yet unclassified') -----
newFrom: pathOrFile
^ File executive: executive value: pathOrFile!
----- Method: Cwd>>printOn: (in category 'as yet unclassified') -----
printOn: str
str , '(', self class name, ' new)'
!
----- Method: Cwd>>split (in category 'as yet unclassified') -----
split
^ Array new!
----- Method: Directory>>/ (in category 'directory/container actions') -----
/ morePath
^ self newFrom: (self pathJoin: morePath)!
----- Method: Directory>>add: (in category 'directory/container actions') -----
add: aFile
self validateIsDirectory.
aFile validateIsFile.
^ aFile copyTo: self / aFile fileName
!
----- Method: Directory>>add:fromBase: (in category 'directory/container actions') -----
add: aFileOrDir fromBase: aBaseDirectory
"I am a directory, add the file or create directory using aBaseDirectory
as the base reference."
| newRio |
self validateIsDirectory.
newRio := self / (aFileOrDir linearRelativeTo: aBaseDirectory).
aFileOrDir isFile ifTrue: [
newRio parent ifAbsentDo: [ :newPath | newPath mkpath ].
^ aFileOrDir copyTo: newRio
].
aFileOrDir isDirectory ifTrue: [ ^ newRio mkpath ].
!
----- Method: Directory>>addAll: (in category 'directory/container actions') -----
addAll: aCollectionOfFiles
aCollectionOfFiles do: [ :each | self add: each ]!
----- Method: Directory>>addAll:fromBase: (in category 'directory/container actions') -----
addAll: aCollection fromBase: aDirectory
aCollection do: [ :each | self add: each fromBase: aDirectory ]!
----- Method: Directory>>addTree: (in category 'directory/container actions') -----
addTree: aDir
| base newAddition |
self validateIsContainer.
aDir validateIsDirectory.
newAddition := self add: aDir fromBase: (base := aDir parent).
self addAll: (aDir all entries) fromBase: base.
^ newAddition
!
----- Method: Directory>>commit (in category 'directory/container actions') -----
commit
!
----- Method: Directory>>commit: (in category 'directory/container actions') -----
commit: monadicBlock
monadicBlock value; self.
self commit.!
----- Method: Directory>>validateIsContainer (in category 'directory/container actions') -----
validateIsContainer
self validateIsDirectory
!
Directory subclass: #FileArchive
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
----- Method: FileArchive class>>on: (in category 'as yet unclassified') -----
on: aRio
^ self executive: (FileArchiveExecutive file: aRio) value: ''.!
----- Method: FileArchive>>add: (in category 'public') -----
add: aFile
self validateIsContainer.
aFile validateIsFile.
self archive addFile: aFile full asString as: aFile fileName.
!
----- Method: FileArchive>>add:fromBase: (in category 'public') -----
add: aFileOrDir fromBase: aBaseDirectory
"I am an archive, add the file or create directory using aBaseDirectory
as the base reference."
| localFileName |
self validateIsContainer.
localFileName := aFileOrDir linearRelativeTo: aBaseDirectory.
aFileOrDir isFile ifTrue: [
self archive addFile: aFileOrDir value as: localFileName value.
].
aFileOrDir isDirectory ifTrue: [
self archive addDirectory: aFileOrDir value as: localFileName value.
].
!
----- Method: FileArchive>>archive (in category 'accessing') -----
archive
^ executive archive!
----- Method: FileArchive>>comment: (in category 'public') -----
comment: aComment
self archive zipFileComment: aComment!
----- Method: FileArchive>>commit (in category 'public') -----
commit
"Catch attempts to overwrite existing zip file"
(self archive canWriteToFileNamed: self asString)
ifFalse: [ ^ self error: 'a member of this archive is using this file: ', self ].
self writer: [ :stream |
self archive writeTo: stream.
].!
----- Method: FileArchive>>file (in category 'public') -----
file
^ executive file !
----- Method: FileArchive>>setArchive: (in category 'accessing') -----
setArchive: anArchiveManager
executive setArchive: anArchiveManager.
!
----- Method: FileArchive>>setRio: (in category 'accessing') -----
setRio: aFile
super setRio: aFile.
aFile executive: (FileArchiveExecutive file: aFile copy).
aFile value: ''. "aFile executive root value."!
----- Method: FileArchive>>validExtensions (in category 'validation') -----
validExtensions
^ #('zip' 'mcz')!
----- Method: FileArchive>>validateIsContainer (in category 'validation') -----
validateIsContainer
(self validExtensions includes: self file ext) ifFalse: [ ^self error: 'wrong extension for a zip archive' ].
!
----- Method: FileArchive>>writeStream (in category 'public') -----
writeStream
^ self file writeStream!
----- Method: File class>>/ (in category 'as yet unclassified') -----
/ a
^ Directory new: a
!
----- Method: File class>>canInstanciate: (in category 'as yet unclassified') -----
canInstanciate: any
"we return false, because we do not support any specific protocol"
^ false!
----- Method: File class>>examples (in category 'documentation') -----
examples
"
(Rio new: '/usr/local') directories explore.
recursive mode can be used very naturally.
(Rio new: '/usr/local') all directories explore.
(Rio new: '/usr/local') all files explore.
(Rio new: '/usr/local') all select: [ :e | e modificationTime > ('1-1-05' asDate) ].
"!
----- Method: File class>>extensions (in category 'documentation') -----
extensions
"
StandardFileStream-#retryWithGC: execBlock until: testBlock forFileNamed: fullName
trivial change allows fullName to be passed in as a rio, since the rio handles the equivalent of String-sameAs:. However
rio's implementation of sameAs: can be adjusted according to the platform.
_
Object-#isRio for testing
_
String-#asRio for coercion
_
FileStream close now returns the file i.e. the Rio that opened it.
Stream in: [ :str | ] now includes an ensure close block,
and returns the return value of that close.
_
FileDirectory-#fullNameFor:
adding asString allows a Rio to be passed in to many FileDirectory functions.
"!
----- Method: File class>>instantiation (in category 'documentation') -----
instantiation
"
Rio has an instanciation scheme which provides many dimensions for specialisation, dividing
responsibilities logically among the components involved.
A path string can specify a specialised protocol which refers to a particular domain
e.g. ftp remote host. The domain executive may in turn choose which class to represent
the elements which it manages. The elements perform all primitive manipulations
via the domain executive.
Typical Instanciation Route:
<aPathString> asRio. - gives an instance of Rio, via Rio new: aPathOrARio
Rio #new: traverses its subclasses asking if any #canInstanciate: so as to allow
specific subclasses to handle protocols, or any other encoded-in-path-string specialisations.
As a fallback Rio handles the default case.
The elected class, is sent #new in order to create an empty instance, which will be populated #from: <aPathString>
The default behaviour of #new is to ask the #defaultExecutive, 'LocalFileSystemCurrent' to instanciate an instance that implements the appropriate behaviour for that domain via: #makeNewRioOfClass: <theClass>, the default be being <theClass>-#basicNew.
"!
----- Method: File class>>lookInUsualPlacesFor: (in category 'as yet unclassified') -----
lookInUsualPlacesFor: fileName
"Check the default directory, the imagePath, and the vmPath (and the vmPath's owner) for this file."
^({ File default.
(File thisImage parent).
(File new: SmalltalkImage current vmPath ).
(File new: SmalltalkImage current vmPath ) parent.
} collect: [ :dir | dir / fileName ]) detect: [ :file | file isFile ] ifNone: nil
"
self lookInUsualPlacesFor: 'SqueakV39.sources'
"
"
self lookInUsualPlacesForB: '391.2.changes'
"!
----- Method: File class>>mkTmpDir (in category 'as yet unclassified') -----
mkTmpDir
^ (self defaultExecutive getTempDirectory / DateAndTime now asString) mkdir!
----- Method: File class>>rioModesRenaming (in category 'documentation') -----
rioModesRenaming
"
!!Renaming Mode:
When in renaming mode changes to the Rio filename are reflected in the filesystem.
This allows rio to reuse all of its full featured filename accessors, for both renaming the Rio and also renaming files on disk.
As with all modes, there is a persistent and a temporary form.
persistent form: #setModeToRenaming, sets the current rio to renaming.
temporary form: #rename, yields a new rio in renaming mode.
"!
----- Method: File class>>rioStreams (in category 'documentation') -----
rioStreams
"
Using streams from a Rio
rio := Rio new: 'myFile.txt'.
contents := rio reader contents. - doesnt close the stream
rio stream close.
" !
----- Method: File class>>setToEnd (in category 'as yet unclassified') -----
setToEnd!
----- Method: File class>>temporaryDirectory (in category 'as yet unclassified') -----
temporaryDirectory
^ self defaultExecutive getTempDirectory !
----- Method: File class>>thisVm (in category 'as yet unclassified') -----
thisVm
^ self new: (self defaultExecutive primVmPath)!
----- Method: File class>>untrustedDirectory (in category 'as yet unclassified') -----
untrustedDirectory
^ self new: (SecurityManager default primUntrustedUserDirectory)
!
----- Method: File>>+ (in category 'public path') -----
+ ext
^ self newFrom: (self value, ext)!
----- Method: File>>, (in category 'public file') -----
, aString
"concat as a string"
^ self asString , aString
!
----- Method: File>>/ (in category 'public path') -----
/ morePath
^ self error: 'This is a file not a directory'!
----- Method: File>><= (in category 'public file') -----
<= aRioOrString
^ self asString <= aRioOrString asString!
----- Method: File>>all (in category 'public modes') -----
all
^ self copy beRecursive!
----- Method: File>>append: (in category 'public file') -----
append: aStreamAble
"aStreamable refers to implementers of << and hence putOn:
And so would write out an array of strings"
self writer: [ :out | out setToAppend << aStreamAble ]
!
----- Method: File>>appender: (in category 'public file') -----
appender: block
self writer setToAppend use: block
!
----- Method: File>>archive (in category 'public modes') -----
archive
^ self zip!
----- Method: File>>asDirectory (in category 'public modes') -----
asDirectory
^ Directory newFrom: self!
----- Method: File>>asTask (in category 'public modes') -----
asTask
^ (Smalltalk at: #SakeTask) file: self!
----- Method: File>>auto (in category 'public modes') -----
auto
self ext = 'gz' ifTrue: [ ^ self gzip ].
^ self copy!
----- Method: File>>base (in category 'accessing fileName') -----
base
^ self splitToBaseVersionAndExt: [ :b :v :e | b ]!
----- Method: File>>base: (in category 'accessing fileName') -----
base: newName
self base: newName version: nil ext: nil
!
----- Method: File>>basic (in category 'public modes') -----
basic
^ File newFrom: self!
----- Method: File>>basicWriter (in category 'public file') -----
basicWriter
self statIsNowInvalid.
^ super basicWriter
!
----- Method: File>>beBinary (in category 'public modes') -----
beBinary
binary := true!
----- Method: File>>beRecursive (in category 'public modes') -----
beRecursive
recursive := true!
----- Method: File>>beRenaming (in category 'public modes') -----
beRenaming
rename := true!
----- Method: File>>binary (in category 'public modes') -----
binary
^ self copy beBinary !
----- Method: File>>cTime (in category 'accessing stat') -----
cTime
^self stat cTime!
----- Method: File>>contents (in category 'public file') -----
contents
self reader: [ :str | ^ str upToEnd ].
^ nil!
----- Method: File>>contents: (in category 'public file') -----
contents: aStreamAble
"aStreamable refers to implementers of << and hence putOn:
And so would write out an array of strings"
self writer: [ :out | out << aStreamAble ].!
----- Method: File>>copyDescription (in category 'public file') -----
copyDescription
^ adaptor ifNil: [ 'Copying' ] ifNotNil: [ adaptor copyDescription ]
!
----- Method: File>>copyResultDescription (in category 'public file') -----
copyResultDescription
^ adaptor ifNil: [ '' ] ifNotNil: [ adaptor copyResultDescription ]
!
----- Method: File>>copyTo: (in category 'public file') -----
copyTo: aPathOrFile
| outFile size |
"we do a stat here, so that we have the fileSize".
size := self fileSize.
^ (outFile := aPathOrFile asFile isBinary: self isBinary) writer: [ :out |
self reader: [ :in |
in copyTo: out size: size withProgress:
(self copyDescription, ' ', self asString, ' ', outFile copyResultDescription)
].
].
!
----- Method: File>>creationTime (in category 'accessing stat') -----
creationTime
^self stat creationTime!
----- Method: File>>delete (in category 'public file') -----
delete
executive delete: self!
----- Method: File>>directories (in category 'enumeration') -----
directories
^ self select: [:e | e isDirectory ]!
----- Method: File>>ext (in category 'accessing fileName') -----
ext
^ self splitToBaseVersionAndExt: [ :b :v :e | e ]!
----- Method: File>>ext: (in category 'accessing fileName') -----
ext: newExt
self base: nil version: nil ext: newExt!
----- Method: File>>fileName: (in category 'accessing fileName') -----
fileName: newFileName
self renamingWith: [
super fileName: newFileName
].!
----- Method: File>>fileSize (in category 'accessing stat') -----
fileSize
^ executive fileSize: self!
----- Method: File>>files (in category 'enumeration') -----
files
^ self select: [:e | e isFile ]!
----- Method: File>>filesMatching: (in category 'enumeration') -----
filesMatching: aos
| matchStringsArray |
matchStringsArray := aos isString ifTrue: [ Array with: aos ] ifFalse: [ aos ].
^ self select: [:e |
e isFile and: [ matchStringsArray anySatisfy: [ :m | m match: e name] ] ]
!
----- Method: File>>forceNewFile (in category 'public file') -----
forceNewFile
self parent mkpath.
^ self delete!
----- Method: File>>from: (in category 'copying instanciation') -----
from: pathOrRio
(pathOrRio isEmpty and: [ self class name ~= #Cwd ]) ifTrue: [ value := ''].
(pathOrRio isKindOf: FileKernel) ifTrue: [
self setStat: pathOrRio getStat.
pathOrRio isBinary ifTrue: [ self beBinary ].
].
^ self value: pathOrRio!
----- Method: File>>full: (in category 'public path') -----
full: aPathOrFile
^ self withRenaming: [
value := executive importPath: (aPathOrFile asFile linearRelativeTo: executive DefaultDirectory) asString.
]
!
----- Method: File>>getStat (in category 'private') -----
getStat
^ stat!
----- Method: File>>gzip (in category 'public modes') -----
gzip
^ FileGzip newFrom: self!
----- Method: File>>ifAbsentDo: (in category 'testing') -----
ifAbsentDo: aBlock
^ self exists not ifTrue: [ aBlock value: self ] ifFalse: [ self ]!
----- Method: File>>ifDirectoryDo: (in category 'testing') -----
ifDirectoryDo: aBlock
^ self isDirectory ifTrue: [ aBlock value: self ] ifFalse: [ self ]!
----- Method: File>>ifFileDo: (in category 'testing') -----
ifFileDo: aBlock
^ self isFile ifTrue: [ aBlock value: self ] ifFalse: [ self ]!
----- Method: File>>initialize (in category 'copying instanciation') -----
initialize
value := ''.
recursive := false.!
----- Method: File>>isBinary (in category 'accessing') -----
isBinary
^ binary ifNil: [ false ]!
----- Method: File>>isBinary: (in category 'accessing') -----
isBinary: bool
binary := bool!
----- Method: File>>isRecursive (in category 'testing') -----
isRecursive
^ recursive!
----- Method: File>>isRenaming (in category 'testing') -----
isRenaming
^ rename == true!
----- Method: File>>linearRelativeTo: (in category 'public dir') -----
linearRelativeTo: aDirectoryOrFile
| tmp |
self = aDirectoryOrFile full ifTrue: [ ^ Directory new: '' ].
tmp := (self parent linearRelativeTo: aDirectoryOrFile) / self fileName.
^tmp
!
----- Method: File>>mTime (in category 'accessing stat') -----
mTime
^ self stat mTime!
----- Method: File>>mkdir (in category 'public dir') -----
mkdir
"to avoid failing if already present, use:
myFileRio ifAbsent mkdir"
executive mkdir: self!
----- Method: File>>mkpath (in category 'public dir') -----
mkpath
"this is like assureExistence"
executive mkpath: self!
----- Method: File>>modificationTime (in category 'accessing stat') -----
modificationTime
^ self stat modificationTime!
----- Method: File>>name (in category 'accessing fileName') -----
name
^ self fileName!
----- Method: File>>os (in category 'public modes') -----
os
^ RioOSProcess new: self!
----- Method: File>>parent (in category 'public path') -----
parent
^ stat ifNotNil: [ stat dir ] ifNil: [ super parent ]!
----- Method: File>>parent: (in category 'public path') -----
parent: aPathOrRio
^ self full: ((self newFrom: aPathOrRio) / self fileName)!
----- Method: File>>readForm (in category 'adaptor') -----
readForm
^ ImageReadWriter formFromFileNamed: self asString !
----- Method: File>>readStream (in category 'adaptor') -----
readStream
| reader |
reader := self basicReader ifNil: [ ^ nil ].
self isBinary ifTrue: [ reader binary ].
^ reader!
----- Method: File>>reader (in category 'public file') -----
reader
^ self readStream!
----- Method: File>>reader: (in category 'public file') -----
reader: block
self reader use: block!
----- Method: File>>recursively (in category 'public modes') -----
recursively
^ self copy beRecursive!
----- Method: File>>relativeTo: (in category 'public file') -----
relativeTo: aPathOrDirectory
| source dest relativePath |
dest := self full split.
source := aPathOrDirectory asDirectory full split.
[ (dest at:1 ifAbsent: true) = (source at:1 ifAbsent: false) ]
whileTrue: [ dest := dest copyWithoutFirst.
source := source copyWithoutFirst. ].
relativePath := String streamContents: [ :out | .
source size timesRepeat: [ out nextPutAll: '../' ].
dest withIndexDo: [ :each :n |
out nextPutAll: each.
n = dest size ifFalse: [ out nextPut: $/ ]
].
].
^ self newFrom: relativePath
!
----- Method: File>>rename (in category 'public modes') -----
rename
^ self copy beRenaming !
----- Method: File>>renameTo: (in category 'public file') -----
renameTo: rioable
^ executive rename: self to: rioable asFile!
----- Method: File>>renamingWith: (in category 'private') -----
renamingWith: aBlock
^ self isRenaming
ifTrue: [ self copy renameTo: aBlock value ]
ifFalse: [ aBlock value ]
!
----- Method: File>>restat (in category 'accessing') -----
restat
"when we restat, we populate the existing stat instance, because more than one rio may be sharing it"
| full |
full := self full.
full parent select: [ :e | e = full ifTrue: [ ^ stat copyFrom: e stat. ]. false. ].
^ stat := nil.
"
(Rio new: '') myEntry.
(Rio new: 'SqueakDebug.log') myEntry
"!
----- Method: File>>rmdir (in category 'public dir') -----
rmdir
"as a minor saftey precaution, the directory must be empty or we
must be explicitly set in recursive mode (rmdir resets recursive mode).
"
self isDirectory ifFalse: [ ^self ].
self isRecursive
ifTrue: [ recursive := false.
self entries do: [:d | d beRecursive delete ] ].
executive deleteDirectory: self
!
----- Method: File>>setExecutive:value: (in category 'copying instanciation') -----
setExecutive: e value: pathOrRio
super setExecutive: e value: pathOrRio.
recursive := false
!
----- Method: File>>setFileTypeToObject (in category 'mac file types') -----
setFileTypeToObject
"On the Macintosh, set the file type and creator of this file to be a Squeak object file. On other platforms, do nothing. Setting the file type allows Squeak object files to be sent as email attachments and launched by double-clicking. On other platforms, similar behavior is achieved by creating the file with the '.sqo' file name extension."
self setMacType: 'SOBJ' creator: 'FAST'.
!
----- Method: File>>setFileTypeToSqueak (in category 'mac file types') -----
setFileTypeToSqueak
self setMacType: 'STch' creator: 'FAST'.
!
----- Method: File>>setStat: (in category 'private') -----
setStat: s
stat := s!
----- Method: File>>split (in category 'public modes') -----
split
| parent |
self value isEmpty ifTrue: [ ^ Array new ].
self splitToPathAndName: [ :p :n |
parent := self newFrom: p.
(parent = self) ifTrue: [ ^ Array with: self value ].
^ parent split copyWith: n
]
!
----- Method: File>>statIsNowInvalid (in category 'accessing') -----
statIsNowInvalid
"All rios copyied from this one, share a stat instance if it exists.
Invalidating that instance means that this and all such derived rios,
will refresh their stat when needed."
stat ifNotNil: [ stat invalidate ].
!
----- Method: File>>tar (in category 'public modes') -----
tar
^ (RioArchive on: self) setArchive: TarArchive new; yourself!
----- Method: File>>touch (in category 'public file') -----
touch
executive touch: self!
----- Method: File>>version (in category 'accessing fileName') -----
version
^ self splitToBaseVersionAndExt: [ :b :v :e | v ]!
----- Method: File>>version: (in category 'accessing fileName') -----
version: newVersion
self base: nil version: newVersion ext: nil
!
----- Method: File>>writeStream (in category 'adaptor') -----
writeStream
| writer |
writer := self basicWriter ifNil: [ ^ nil ].
self isBinary ifTrue: [ writer binary ].
^ writer!
----- Method: File>>writer (in category 'public file') -----
writer
^ self writeStream!
----- Method: File>>writer: (in category 'public file') -----
writer: block
self writer use: block
!
----- Method: File>>zip (in category 'public modes') -----
zip
^ (FileArchive on: self) setArchive: ZipArchive new; yourself!
File subclass: #FileGzip
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
!FileGzip commentStamp: 'kph 3/16/2007 08:06' prior: 0!
In using gzip rio expects that if you write text to the file you should read text from the file.
The 3.9 implemementation of InflateStream blindly sets the readStream to binary. Although its output buffer is created using #species new: in an attempt to make the output in the correct form in practice this would always result in a ByteArray.
A small fix to InflateStream #on:, checks the #binary setting before is is 'blindly set' and initializes the output collection to be a String is it is not binary.
In #on:from:to: the collection is initialized to be a buffer being the same species as itself if set in #on:
!
----- Method: FileGzip class>>validExtensions (in category 'as yet unclassified') -----
validExtensions
^ #( 'gz' )!
----- Method: FileGzip>>basicReader (in category 'streams') -----
basicReader
self validateIsFile.
^ GZipReadStream on: (super basicReader).!
----- Method: FileGzip>>compress (in category 'streams') -----
compress
^ self binary basic copyTo: (self + '.gz') gzip.
!
----- Method: FileGzip>>copyDescription (in category 'streams') -----
copyDescription
^ 'Decompressing'!
----- Method: FileGzip>>copyResultDescription (in category 'streams') -----
copyResultDescription
^ 'Compressed with gzip'!
----- Method: FileGzip>>decompress (in category 'streams') -----
decompress
^ self copyTo: ((File new: self asString) ext: '')
!
----- Method: FileGzip>>readStream (in category 'streams') -----
readStream
| str |
self validateGzip.
str := super basicReader.
self isBinary ifTrue: [ str binary ].
^ self readerClass on: str.
!
----- Method: FileGzip>>readerClass (in category 'streams') -----
readerClass
^ GZipReadStream !
----- Method: FileGzip>>validExtensions (in category 'streams') -----
validExtensions
^ #( 'gz' )!
----- Method: FileGzip>>validateGzip (in category 'validation & errors') -----
validateGzip
(self validExtensions includes: self ext) ifFalse: [ ^self error: 'wrong extension for a gzip file' ].
!
----- Method: FileGzip>>writeStream (in category 'streams') -----
writeStream
| str |
self validateGzip.
str := self writerClass on: (super writeStream ifNil: [ ^ nil ]).
self setFileTypeToObject.
^ str!
----- Method: FileGzip>>writerClass (in category 'streams') -----
writerClass
^ GZipWriteStream !
----- Method: ZipEncoder>>close (in category '*file-base-override') -----
close
self flush.
^encodedStream close.!
----- Method: FTPClient>>getFileSize: (in category '*file-base') -----
getFileSize: fileName
self sendCommand: 'SIZE ' , fileName.
self checkResponse.
^ (self lastResponse readStream upTo: $ ; upToEnd) asNumber!
----- Method: Stream>>use: (in category '*file-base') -----
use: aBlock
"just like #in: except the stream will be closed"
| ret |
[ ret := aBlock value: self] ensure: [ self close].
^ ret
!
----- Method: UndefinedObject>>use: (in category '*file-base') -----
use: aBlock
"ifNil the block is entirely passed over"
^ self!
----- Method: GZipReadStream class>>saveContents: (in category '*file-base-override') -----
saveContents: fullFileName
"Save the contents of a gzipped file"
| zipped buffer unzipped newName |
newName := fullFileName copyUpToLast: FileDirectory extensionDelimiter.
unzipped := FileStream newFileNamed: newName.
unzipped binary.
zipped := GZipReadStream on: (FileStream readOnlyFileNamed: fullFileName) binary.
buffer := ByteArray new: 50000.
'Extracting ' , fullFileName
displayProgressAt: Sensor cursorPoint
from: 0
to: zipped sourceStream size
during:
[:bar |
[zipped atEnd]
whileFalse:
[bar value: zipped sourceStream position.
unzipped nextPutAll: (zipped nextInto: buffer)].
zipped close.
unzipped close].
^ newName!
FileLocalExecutive subclass: #FileArchiveExecutive
instanceVariableNames: 'file archive members'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
----- Method: FileArchiveExecutive class>>file: (in category 'as yet unclassified') -----
file: aRio
^ (self new) setFile: aRio; yourself!
----- Method: FileArchiveExecutive>>archive (in category 'as yet unclassified') -----
archive
^ archive!
----- Method: FileArchiveExecutive>>file (in category 'as yet unclassified') -----
file
^ file !
----- Method: FileArchiveExecutive>>fullFor: (in category 'as yet unclassified') -----
fullFor: aRio
^ aRio
!
----- Method: FileArchiveExecutive>>isDirectory: (in category 'as yet unclassified') -----
isDirectory: aRio
| dir |
dir := aRio value, '/'.
^ (archive members detect: [ :member | dir = member fileName ] ifNone: [ ^false ]) isDirectory!
----- Method: FileArchiveExecutive>>isFile: (in category 'as yet unclassified') -----
isFile: aRio
^ (self isDirectory: aRio) not!
----- Method: FileArchiveExecutive>>members (in category 'as yet unclassified') -----
members
^ members ifNil: [
file reader: [ :str | archive readFrom: str ].
members := archive members.
]!
----- Method: FileArchiveExecutive>>printId (in category 'as yet unclassified') -----
printId
^ self file asString!
----- Method: FileArchiveExecutive>>root (in category 'as yet unclassified') -----
root
^ self pathDelimiter
!
----- Method: FileArchiveExecutive>>setArchive: (in category 'as yet unclassified') -----
setArchive: anArchive
archive := anArchive !
----- Method: FileArchiveExecutive>>setFile: (in category 'as yet unclassified') -----
setFile: aRio
file := aRio!
----- Method: FileArchiveExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') -----
startAt: rioOrString recursively: beRecursive select: selectBlock into: results
"this unpleasent method repackages the flat archive as a hierarchical structure that
can be recursively traversed like a normal directory."
| membersBelow subDirs dir |
membersBelow := self members.
rioOrString isEmpty
ifTrue: [
dir := ''.
]
ifFalse: [
dir := rioOrString value.
dir last ~= $/ ifTrue: [ dir := dir , '/' ].
membersBelow := membersBelow select: [ :member |
(member fileName ~= dir) and: [member fileName beginsWith: dir]
].
].
subDirs := membersBelow select: [ :member |
| pathBelow entry |
pathBelow := member fileName allButFirst: dir size.
pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ].
(pathBelow includes: $/)
ifFalse: [
entry := member isDirectory
ifTrue: [ self class makeNew: self class dirClass from: member fileName ]
ifFalse: [ self class makeNew: self class fileClass from: member fileName ].
entry setStatFromDir: rioOrString andEntryArray:
(Array
with: pathBelow
with: "member lastModTime" 0
with: "member lastModTime" 0
with: member isDirectory).
(selectBlock value: entry) ifTrue: [ results add: entry ].
false
]
ifTrue: [ true ].
].
beRecursive ifTrue: [
subDirs do: [ :aDir |
self startAt: aDir fileName recursively: beRecursive select: selectBlock into: results
].
].
^ results!
FileArchiveExecutive subclass: #FileZipArchiveExecutive
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
FileExecutive subclass: #FileRemoteExecutive
instanceVariableNames: 'url client'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
FileRemoteExecutive subclass: #FileFtpExecutive
instanceVariableNames: 'home isKeepAlive rw ftpClient'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
----- Method: FileFtpExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') -----
canInstanciateFrom: aPathString
^ aPathString beginsWith: 'ftp:'!
----- Method: FileFtpExecutive>>FTPClient (in category 'as yet unclassified') -----
FTPClient
^ FTPClient"Debug"!
----- Method: FileFtpExecutive>>basicReader: (in category 'as yet unclassified') -----
basicReader: aRio
^ self ftpOpenForRead: aRio!
----- Method: FileFtpExecutive>>basicWriter: (in category 'as yet unclassified') -----
basicWriter: aRio
^ self ftpOpenForWrite: aRio!
----- Method: FileFtpExecutive>>closeAndDestroy: (in category 'wrap socket') -----
closeAndDestroy: timeout
client closeDataSocket.
client checkResponse.
rw = #write ifTrue: [ client checkResponse ].!
----- Method: FileFtpExecutive>>createDirectory: (in category 'Rio-Grande') -----
createDirectory: aRio
self ftpDo: [ :ftp |
ftp makeDirectory: home, aRio asVmPathName.
].
aRio statIsNowInvalid.!
----- Method: FileFtpExecutive>>dataAvailable (in category 'wrap socket') -----
dataAvailable
^ client dataSocket dataAvailable!
----- Method: FileFtpExecutive>>delete: (in category 'Rio-Grande') -----
delete: aRio
self ftpDo: [ :ftp | super delete: aRio ] !
----- Method: FileFtpExecutive>>deleteDirectory: (in category 'Rio-Grande') -----
deleteDirectory: aRio
self ftpDo: [ :ftp |
ftp deleteDirectory: home, aRio asVmPathName.
].
aRio statIsNowInvalid.!
----- Method: FileFtpExecutive>>deleteFile: (in category 'Rio-Grande') -----
deleteFile: aRio
self ftpDo: [ :ftp |
(self isFile: aRio) ifTrue: [ ftp deleteFileNamed: home , aRio asVmPathName ]
].
aRio statIsNowInvalid.!
----- Method: FileFtpExecutive>>fileSize: (in category 'Rio-Grande') -----
fileSize: aRio
^ self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] !
----- Method: FileFtpExecutive>>ftpClient (in category 'as yet unclassified') -----
ftpClient
client ifNotNil: [client isConnected ifTrue: [ ^ client ] ].
^ client := self ftpOpenClient!
----- Method: FileFtpExecutive>>ftpDo: (in category 'as yet unclassified') -----
ftpDo: aBlock
| tmp result |
tmp := isKeepAlive.
isKeepAlive := true.
[ result := aBlock value: self ftpClient. ]
ensure: [ (isKeepAlive := tmp) ifFalse: [ client ifNotNil: [ client quit ] ] ].
^ result!
----- Method: FileFtpExecutive>>ftpDo:ifError: (in category 'as yet unclassified') -----
ftpDo: aBlock ifError: errBlock
[ self ftpDo: aBlock.
] on: TelnetProtocolError do: errBlock !
----- Method: FileFtpExecutive>>ftpGetDirectory: (in category 'Rio-Grande') -----
ftpGetDirectory: dirString
"Return a stream with a listing of the current server directory. (Later -- Use a proxy server if one has been registered.)"
| listing str ftpEntries |
self ftpDo: [ :ftp |
ftp changeDirectoryTo: dirString.
listing := ftp getDirectory ].
str := ReadStream on: listing.
(str respondsTo: #contentsOfEntireFile) ifFalse: [^ #()].
ftpEntries := str contentsOfEntireFile findTokens: String crlf.
^ ftpEntries
collect:[:ftpEntry | self ftpParseEntry: ftpEntry ]
thenSelect: [:entry | entry notNil]!
----- Method: FileFtpExecutive>>ftpKeepAliveDuring: (in category 'as yet unclassified') -----
ftpKeepAliveDuring: aBlock
| tmp |
tmp := isKeepAlive.
isKeepAlive := true.
aBlock ensure: [ isKeepAlive := tmp ]
!
----- Method: FileFtpExecutive>>ftpOpenClient (in category 'as yet unclassified') -----
ftpOpenClient
| loginSuccessful what client |
client := self FTPClient openOnHostNamed: self host.
loginSuccessful := false.
[loginSuccessful]
whileFalse: [
[loginSuccessful := true.
client loginUser: self user password: self password]
on: LoginFailedException
do: [:ex |
what := UIManager default
chooseFrom: #('enter password' 'give up')
title: 'Would you like to try another password?'.
what = 1 ifFalse: [self error: 'Login failed.'. ^nil]
ifTrue: [ self password: nil ].
loginSuccessful := false]].
home := client pwd.
^client!
----- Method: FileFtpExecutive>>ftpOpenForRead: (in category 'as yet unclassified') -----
ftpOpenForRead: aRio
self ftpClient openPassiveDataConnection.
self ftpClient sendCommand: 'RETR ', home , aRio asVmPathName.
[client checkResponse]
on: TelnetProtocolError
do: [:ex |
client closeDataSocket.
ex pass].
"we will wrap a socket for writing"
rw := #read.
^ SocketStream on: self.!
----- Method: FileFtpExecutive>>ftpOpenForWrite: (in category 'as yet unclassified') -----
ftpOpenForWrite: aRio
self ftpClient openPassiveDataConnection.
self ftpClient sendCommand: 'STOR ', home , aRio asVmPathName.
"we will wrap a socket for writing"
rw := #write.
^ SocketStream on: self.!
----- Method: FileFtpExecutive>>ftpParseEntry: (in category 'as yet unclassified') -----
ftpParseEntry: ftpEntry
| permissions rs dateInSeconds thisYear thisMonth unkown user group size month day time filename |
thisYear := Date today year.
thisMonth := Date today monthIndex.
rs := ftpEntry readStream.
permissions := rs upToSeparator.
permissions size < 10 ifTrue: [ ^ nil ].
rs skipSeparators.
unkown := rs upToSeparator.
rs skipSeparators.
user := rs upToSeparator.
rs skipSeparators.
group := rs upToSeparator.
rs skipSeparators.
size := rs upToSeparator.
rs skipSeparators.
month := rs upToSeparator.
rs skipSeparators.
"Fix for case that group is blank (relies on month being 3 chars)"
(size size = 3 and: [ size asNumber = 0 ]) ifTrue: [
month := size.
size := group.
group := 'blank'.
].
day := rs upToSeparator.
rs skipSeparators.
time := rs upToSeparator.
rs skipSeparators.
filename := rs upToEnd.
dateInSeconds := self
secondsForDay: day
month: month
yearOrTime: time
thisMonth: thisMonth
thisYear: thisYear.
^Array with: filename "file name"
with: dateInSeconds "creation date"
with: dateInSeconds "modification time"
with: ( (permissions first) = $d or: [permissions first =$l]) "is-a-directory flag"
with: size asNumber "file size"
!
----- Method: FileFtpExecutive>>ftpParseEntryOld: (in category 'as yet unclassified') -----
ftpParseEntryOld: ftpEntry
| tokens longy dateInSeconds thisYear thisMonth |
thisYear := Date today year.
thisMonth := Date today monthIndex.
tokens := ftpEntry findTokens: ' '.
tokens size = 8 ifTrue:
[((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue:
["Fix for case that group is blank (relies on month being 3 chars)"
tokens _ tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]].
tokens size >= 9 ifFalse:[^nil].
((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue:
["Fix for case that group is blank (relies on month being 3 chars)"
tokens := tokens copyReplaceFrom: 4 to: 3 with: {'blank'}].
tokens size > 9 ifTrue:
[longy := tokens at: 9.
10 to: tokens size do: [:i | longy := longy , ' ' , (tokens at: i)].
tokens at: 9 put: longy].
dateInSeconds := self
secondsForDay: (tokens at: 7)
month: (tokens at: 6)
yearOrTime: (tokens at: 8)
thisMonth: thisMonth
thisYear: thisYear.
^Array with: (tokens last) "file name"
with: dateInSeconds "creation date"
with: dateInSeconds "modification time"
with: ( (tokens first first) = $d or: [tokens first first =$l]) "is-a-directory flag"
with: tokens fifth asNumber "file size"
!
----- Method: FileFtpExecutive>>in:select: (in category 'as yet unclassified') -----
in: aRio select: selectBlock
^ self ftpDo: [ :c | super in: aRio select: selectBlock ]!
----- Method: FileFtpExecutive>>initialize (in category 'as yet unclassified') -----
initialize
isKeepAlive := false.!
----- Method: FileFtpExecutive>>isConnected (in category 'wrap socket') -----
isConnected
^ (client dataSocket ifNil: [ ^ false ]) isConnected!
----- Method: FileFtpExecutive>>isDirectory: (in category 'Rio-Grande') -----
isDirectory: aRio
self ftpDo: [ :ftp | ftp changeDirectoryTo: home, aRio asVmPathName ] ifError: [ :ex | ^ false ].
^ true.!
----- Method: FileFtpExecutive>>isFile: (in category 'Rio-Grande') -----
isFile: aRio
self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] ifError: [ :ex | ^ false ].
^ true.!
----- Method: FileFtpExecutive>>isKeepAlive (in category 'as yet unclassified') -----
isKeepAlive
^ true!
----- Method: FileFtpExecutive>>isOtherEndClosed (in category 'wrap socket') -----
isOtherEndClosed
^ (client dataSocket ifNil: [ ^ true ]) isOtherEndClosed!
----- Method: FileFtpExecutive>>mkdir: (in category 'Rio-Grande') -----
mkdir: aRio
self ftpDo: [ :ftp | super mkdir: aRio ] !
----- Method: FileFtpExecutive>>mkpath: (in category 'Rio-Grande') -----
mkpath: aRio
self ftpDo: [ :ftp | super mkpath: aRio ] !
----- Method: FileFtpExecutive>>receiveAvailableDataInto:startingAt: (in category 'wrap socket') -----
receiveAvailableDataInto: inBuffer startingAt: n
^ client dataSocket receiveAvailableDataInto: inBuffer startingAt: n!
----- Method: FileFtpExecutive>>receiveDataSignallingTimeout:into:startingAt: (in category 'wrap socket') -----
receiveDataSignallingTimeout: timeout
into: inBuffer startingAt: inNextToWrite
^ client dataSocket receiveDataSignallingTimeout: timeout
into: inBuffer startingAt: inNextToWrite!
----- Method: FileFtpExecutive>>rename:to: (in category 'Rio-Grande') -----
rename: aRio to: bRio
self ftpDo: [ :ftp | ftp renameFileNamed: home, aRio asVmPathName to: home, bRio asVmPathName ]
ifError: [
aRio exists ifFalse:[ self error:'Attempt to rename a non-existent file or dir:' , aRio].
bRio exists ifTrue:[ self error: 'Failed to rename, ', bRio,' already exists.' ].
].
aRio statIsNowInvalid.
^ bRio
!
----- Method: FileFtpExecutive>>rioClass (in category 'as yet unclassified') -----
rioClass
^ File!
----- Method: FileFtpExecutive>>secondsForDay:month:yearOrTime:thisMonth:thisYear: (in category 'as yet unclassified') -----
secondsForDay: dayToken month: monthToken yearOrTime: ytToken
thisMonth: thisMonth thisYear: thisYear
| ftpDay ftpMonth pickAYear jDateToday trialJulianDate |
ftpDay := dayToken asNumber.
ftpMonth := Date indexOfMonth: monthToken.
(ytToken includes: $:) ifFalse: [
^(Date newDay: ftpDay month: ftpMonth year: ytToken asNumber) asSeconds
].
jDateToday := Date today dayOfYear.
trialJulianDate := (Date newDay: ftpDay month: ftpMonth year: thisYear) dayOfYear.
"Date has no year if within six months (do we need to check the day, too?)"
"Well it appear to be pickier than that... it isn't just 6 months or 6 months and the day of the month, put perhaps the julian date AND the time as well. I don't know what the precise standard is, but this seems to produce better results"
pickAYear := (jDateToday - trialJulianDate) > 182 ifTrue: [
thisYear + 1 "his clock could be ahead of ours??"
] ifFalse: [
pickAYear := (trialJulianDate - jDateToday) > 182 ifTrue: [
thisYear - 1
] ifFalse: [
thisYear
].
].
^(Date newDay: ftpDay month: ftpMonth year: pickAYear) asSeconds +
(Time readFrom: (ReadStream on: ytToken)) asSeconds
!
----- Method: FileFtpExecutive>>sendData:count: (in category 'wrap socket') -----
sendData: outBuffer count: n
client dataSocket sendData: outBuffer count: n!
----- Method: FileFtpExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') -----
startAt: rioOrString recursively: beRecursive select: selectBlock into: results
"Return a collection of rio's selected by passing
the directoryEntry array to the selectBlock.
This can be called with startAt: aString, but if so beRecursive must be false.
See primLookupEntryIn:index: for further details."
| entry isDir |
(self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray |
(entry := rioOrString / (entryArray at: 1))
setStatFromDir: rioOrString andEntryArray:entryArray.
isDir := entryArray at: 4.
isDir ifFalse: [ entry := entry asFile ].
(selectBlock value: entry) ifTrue: [ results add: entry ].
(beRecursive and: [ isDir ])
ifTrue: [
self
startAt: entry
recursively: beRecursive
select: selectBlock
into: results
].
].
^ results!
----- Method: FileFtpExecutive>>touch: (in category 'Rio-Grande') -----
touch: aRio
self ftpDo: [ :dtp |
ftp putFileStreamContents: (WriteStream with: String new) as: home , aRio asVmPathName
]!
----- Method: FileFtpExecutive>>user (in category 'as yet unclassified') -----
user
^ url username ifNil: [ 'ftp' ]
!
FileRemoteExecutive subclass: #FileHttpExecutive
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Base'!
!FileHttpExecutive commentStamp: 'kph 11/10/2008 05:36' prior: 0!
placeholder!
----- Method: FileHttpExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') -----
canInstanciateFrom: aPathString
^ aPathString beginsWith: 'http:'!
----- Method: FileHttpExecutive>>password: (in category 'as yet unclassified') -----
password: passwordString
| pwd |
self user = 'ftp' ifTrue: [ ^ self ].
passwordString isEmpty ifTrue:[pwd := nil] ifFalse:[pwd := passwordString].
self MCPasswordManager default passwordAt: url asString user: self user put: pwd.
!
----- Method: FileRemoteExecutive class>>executiveForUrl: (in category 'as yet unclassified') -----
executiveForUrl: aUrl
^ self basicNew setUrl: aUrl; initialize!
----- Method: FileRemoteExecutive class>>makeNew:from: (in category 'as yet unclassified') -----
makeNew: aClass from: aString
| exec path theUrl |
theUrl := aString asUrl.
path := String new writeStream.
theUrl path do: [ :pathElem |
path nextPut: $/.
path nextPutAll: pathElem ].
theUrl path: #().
exec := self executiveForUrl: theUrl.
^ aClass executive: exec value: path contents.!
----- Method: FileRemoteExecutive>>host (in category 'as yet unclassified') -----
host
^ url authority!
----- Method: FileRemoteExecutive>>password (in category 'as yet unclassified') -----
password
^ url password ifNil: [ (self MCPasswordManager default queryPasswordAt: url asString user: (self user ifNil:[^'squeak'])) ]
!
----- Method: FileRemoteExecutive>>rootString (in category 'as yet unclassified') -----
rootString
^ '/'!
----- Method: FileRemoteExecutive>>setUrl: (in category 'as yet unclassified') -----
setUrl: aUrl
url := aUrl.
!
----- Method: FileRemoteExecutive>>user (in category 'as yet unclassified') -----
user
^ url username ifNil: [ '' ]
!
----- Method: PositionableStream>>copyTo:size:withProgress: (in category '*file-base') -----
copyTo: out size: aSize withProgress: label
| buffer barPos read first |
self atEnd ifTrue: [ ^ self ].
first := self next.
buffer := (first isCharacter
ifTrue: [ String ]
ifFalse: [ out binary. ByteArray ]) new: 50000.
out nextPut: first.
label asString displayProgressAt: Sensor cursorPoint
from: (barPos := 0) to: (aSize)
during: [:bar |
[ self atEnd ] whileFalse: [
bar value: barPos.
out nextPutAll: (read := self nextInto: buffer).
barPos := barPos + read size ].
].!
----- Method: PositionableStream>>setToAppend (in category '*file-base') -----
setToAppend
^ self setToEnd!
----- Method: PositionableStream>>upToSeparator (in category '*file-base') -----
upToSeparator
"Answer a subcollection from the current access position to the
occurrence (if any, but not inclusive) of anObject in the receiver. If
anObject is not in the collection, answer the entire rest of the receiver."
| newStream element |
newStream := WriteStream on: (collection species new: 100).
[self atEnd or: [(element := self next) isSeparator]]
whileFalse: [newStream nextPut: element].
^newStream contents!
More information about the Packages
mailing list