[squeak-dev] The Inbox: Compression-xw.63.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:08 UTC 2022
A new version of Compression was added to project The Inbox: http://source.squeak.org/inbox/Compression-xw.63.mcz ==================== Summary ==================== Name: Compression-xw.63 Author: xw Time: 5 May 2022, 9:37:13.986596 pm UUID: 039074bd-e85c-124a-ba1a-f865a6237d32 Ancestors: Compression-tpr.62 Add `CompressedSourceStream>>#skip:`, to override implementation of `PositionableStream>>#skip:`, which is not compatible with usage of instance variable `position` in `CompressedSourceStream` Related to https://github.com/squeak-smalltalk/squeak-object-memory/issues/17 =============== Diff against Compression-tpr.62 =============== Item was removed: - SystemOrganization addCategory: #'Compression-Archives'! - SystemOrganization addCategory: #'Compression-Streams'! Item was removed: - Object subclass: #Archive - instanceVariableNames: 'members' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !Archive commentStamp: '<historical>' prior: 0! - This is the abstract superclass for file archives. Archives can be read from or written to files, and contain members that represent files and directories.! Item was removed: - ----- Method: Archive>>addDirectory: (in category 'archive operations') ----- - addDirectory: aFileName - ^self addDirectory: aFileName as: aFileName - ! Item was removed: - ----- Method: Archive>>addDirectory:as: (in category 'archive operations') ----- - addDirectory: aFileName as: anotherFileName - | newMember | - newMember := self memberClass newFromDirectory: aFileName. - self addMember: newMember. - newMember localFileName: anotherFileName. - ^newMember! Item was removed: - ----- Method: Archive>>addFile: (in category 'archive operations') ----- - addFile: aFileName - ^self addFile: aFileName as: aFileName! Item was removed: - ----- Method: Archive>>addFile:as: (in category 'archive operations') ----- - addFile: aFileName as: anotherFileName - | newMember | - newMember := self memberClass newFromFile: aFileName. - self addMember: newMember. - newMember localFileName: anotherFileName. - ^newMember! Item was removed: - ----- Method: Archive>>addMember: (in category 'archive operations') ----- - addMember: aMember - ^members addLast: aMember! Item was removed: - ----- Method: Archive>>addString:as: (in category 'archive operations') ----- - addString: aString as: aFileName - | newMember | - newMember := self memberClass newFromString: aString named: aFileName. - self addMember: newMember. - newMember localFileName: aFileName. - ^newMember! Item was removed: - ----- Method: Archive>>addTree:match: (in category 'archive operations') ----- - addTree: aFileNameOrDirectory match: aBlock - | nameSize | - nameSize := aFileNameOrDirectory isString - ifTrue: [aFileNameOrDirectory size] - ifFalse: [aFileNameOrDirectory pathName size]. - ^ self - addTree: aFileNameOrDirectory - removingFirstCharacters: nameSize + 1 - match: aBlock! Item was removed: - ----- Method: Archive>>addTree:removingFirstCharacters: (in category 'archive operations') ----- - addTree: aFileNameOrDirectory removingFirstCharacters: n - ^ self - addTree: aFileNameOrDirectory - removingFirstCharacters: n - match: [:e | true]! Item was removed: - ----- Method: Archive>>addTree:removingFirstCharacters:match: (in category 'archive operations') ----- - addTree: aFileNameOrDirectory removingFirstCharacters: n match: aBlock - | dir fullPath relativePath | - dir := (aFileNameOrDirectory isString) - ifTrue: [ FileDirectory on: aFileNameOrDirectory ] - ifFalse: [ aFileNameOrDirectory ]. - fullPath := dir pathName, dir slash. - relativePath := fullPath copyFrom: n + 1 to: fullPath size. - (dir entries select: aBlock) - do: [ :ea | | fullName newMember | - fullName := fullPath, ea name. - newMember := ea isDirectory - ifTrue: [ self memberClass newFromDirectory: fullName ] - ifFalse: [ self memberClass newFromFile: fullName ]. - newMember localFileName: relativePath, ea name. - self addMember: newMember. - ea isDirectory ifTrue: [ self addTree: fullName removingFirstCharacters: n match: aBlock]. - ]. - ! Item was removed: - ----- Method: Archive>>canWriteToFileNamed: (in category 'archive operations') ----- - canWriteToFileNamed: aFileName - "Catch attempts to overwrite existing zip file" - ^members noneSatisfy: [ :ea | ea usesFileNamed: aFileName ]. - ! Item was removed: - ----- Method: Archive>>contentsOf: (in category 'archive operations') ----- - contentsOf: aMemberOrName - | member | - member := self member: aMemberOrName. - member ifNil: [ ^nil ]. - ^member contents! Item was removed: - ----- Method: Archive>>extractMember: (in category 'archive operations') ----- - extractMember: aMemberOrName - | member | - member := self member: aMemberOrName. - member ifNil: [ ^nil ]. - member extractToFileNamed: member localFileName inDirectory: FileDirectory default.! Item was removed: - ----- Method: Archive>>extractMember:toFileNamed: (in category 'archive operations') ----- - extractMember: aMemberOrName toFileNamed: aFileName - | member | - member := self member: aMemberOrName. - member ifNil: [ ^nil ]. - member extractToFileNamed: aFileName! Item was removed: - ----- Method: Archive>>extractMemberWithoutPath: (in category 'archive operations') ----- - extractMemberWithoutPath: aMemberOrName - self extractMemberWithoutPath: aMemberOrName inDirectory: FileDirectory default.! Item was removed: - ----- Method: Archive>>extractMemberWithoutPath:inDirectory: (in category 'archive operations') ----- - extractMemberWithoutPath: aMemberOrName inDirectory: dir - | member | - member := self member: aMemberOrName. - member ifNil: [ ^nil ]. - member extractToFileNamed: (FileDirectory localNameFor: member localFileName) inDirectory: dir! Item was removed: - ----- Method: Archive>>initialize (in category 'initialization') ----- - initialize - members := OrderedCollection new.! Item was removed: - ----- Method: Archive>>member: (in category 'private') ----- - member: aMemberOrName - ^(members includes: aMemberOrName) - ifTrue: [ aMemberOrName ] - ifFalse: [ self memberNamed: aMemberOrName ].! Item was removed: - ----- Method: Archive>>memberClass (in category 'private') ----- - memberClass - self subclassResponsibility! Item was removed: - ----- Method: Archive>>memberNamed: (in category 'archive operations') ----- - memberNamed: aString - "Return the first member whose zip name or local file name matches aString, or nil" - ^members detect: [ :ea | ea fileName = aString or: [ ea localFileName = aString ]] ifNone: [ ]! Item was removed: - ----- Method: Archive>>memberNames (in category 'archive operations') ----- - memberNames - ^members collect: [ :ea | ea fileName ]! Item was removed: - ----- Method: Archive>>members (in category 'archive operations') ----- - members - ^members! Item was removed: - ----- Method: Archive>>membersMatching: (in category 'archive operations') ----- - membersMatching: aString - ^members select: [ :ea | (aString match: ea fileName) or: [ aString match: ea localFileName ] ]! Item was removed: - ----- Method: Archive>>numberOfMembers (in category 'archive operations') ----- - numberOfMembers - ^members size! Item was removed: - ----- Method: Archive>>removeMember: (in category 'archive operations') ----- - removeMember: aMemberOrName - | member | - member := self member: aMemberOrName. - member ifNotNil: [ members remove: member ]. - ^member! Item was removed: - ----- Method: Archive>>replaceMember:with: (in category 'archive operations') ----- - replaceMember: aMemberOrName with: newMember - | member | - member := self member: aMemberOrName. - member ifNotNil: [ members replaceAll: member with: newMember ]. - ^member! Item was removed: - ----- Method: Archive>>setContentsOf:to: (in category 'archive operations') ----- - setContentsOf: aMemberOrName to: aString - | newMember oldMember | - oldMember := self member: aMemberOrName. - newMember := (self memberClass newFromString: aString named: oldMember fileName) - copyFrom: oldMember. - self replaceMember: oldMember with: newMember.! Item was removed: - ----- Method: Archive>>writeTo: (in category 'archive operations') ----- - writeTo: aStream - self subclassResponsibility! Item was removed: - ----- Method: Archive>>writeToFileNamed: (in category 'archive operations') ----- - writeToFileNamed: aFileName - | stream | - "Catch attempts to overwrite existing zip file" - (self canWriteToFileNamed: aFileName) - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. - stream := StandardFileStream forceNewFileNamed: aFileName. - self writeTo: stream. - stream close.! Item was removed: - Object subclass: #ArchiveMember - instanceVariableNames: 'fileName isCorrupt' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !ArchiveMember commentStamp: '<historical>' prior: 0! - This is the abstract superclass for archive members, which are files or directories stored in archives.! Item was removed: - ----- Method: ArchiveMember class>>newDirectoryNamed: (in category 'as yet unclassified') ----- - newDirectoryNamed: aString - self subclassResponsibility! Item was removed: - ----- Method: ArchiveMember class>>newFromFile: (in category 'as yet unclassified') ----- - newFromFile: aFileName - self subclassResponsibility! Item was removed: - ----- Method: ArchiveMember class>>newFromString: (in category 'as yet unclassified') ----- - newFromString: aString - self subclassResponsibility! Item was removed: - ----- Method: ArchiveMember>>close (in category 'initialization') ----- - close - ! Item was removed: - ----- Method: ArchiveMember>>fileName (in category 'accessing') ----- - fileName - ^fileName! Item was removed: - ----- Method: ArchiveMember>>fileName: (in category 'accessing') ----- - fileName: aName - fileName := aName! Item was removed: - ----- Method: ArchiveMember>>initialize (in category 'initialization') ----- - initialize - fileName := ''. - isCorrupt := false.! Item was removed: - ----- Method: ArchiveMember>>isCorrupt (in category 'accessing') ----- - isCorrupt - ^isCorrupt ifNil: [ isCorrupt := false ]! Item was removed: - ----- Method: ArchiveMember>>isCorrupt: (in category 'accessing') ----- - isCorrupt: aBoolean - "Mark this member as being corrupt." - isCorrupt := aBoolean! Item was removed: - ----- Method: ArchiveMember>>localFileName: (in category 'accessing') ----- - localFileName: aString - "Set my internal filename. - Returns the (possibly new) filename. - aString will be translated from local FS format into Unix format." - - ^fileName := aString copyReplaceAll: FileDirectory slash with: '/'.! Item was removed: - ----- Method: ArchiveMember>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut: $(; - nextPutAll: self fileName; - nextPut: $)! Item was removed: - ----- Method: ArchiveMember>>usesFileNamed: (in category 'testing') ----- - usesFileNamed: aFileName - "Do I require aFileName? That is, do I care if it's clobbered?" - ^false! Item was removed: - ----- Method: ByteArray>>unzipped (in category '*Compression-Streams') ----- - unzipped - | magic1 magic2 | - magic1 := self at: 1. - magic2 := self at: 2. - (magic1 = 16r1F and:[magic2 = 16r8B]) ifFalse:[^self]. - ^(GZipReadStream on: self) upToEnd! Item was removed: - ----- Method: ByteArray>>zipped (in category '*Compression-Streams') ----- - zipped - | stream gzstream | - stream := (ByteArray new: self size // 5) writeStream. - gzstream := GZipWriteStream on: stream. - gzstream nextPutAll: self. - gzstream close. - ^stream contents! Item was removed: - Error subclass: #CRCError - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! Item was removed: - ----- Method: CRCError>>isResumable (in category 'as yet unclassified') ----- - isResumable - ^true! Item was removed: - ----- Method: CompiledMethodTrailer>>decodeEmbeddedSourceZip (in category '*Compression-Streams') ----- - decodeEmbeddedSourceZip - - "data is string with method's source code, compressed using zip compression" - self decodeZip.! Item was removed: - ----- Method: CompiledMethodTrailer>>decodeTempsNamesZip (in category '*Compression-Streams') ----- - decodeTempsNamesZip - - "data is string with method's temporary names, compressed using zip compression" - self decodeZip.! Item was removed: - ----- Method: CompiledMethodTrailer>>decodeZip (in category '*Compression-Streams') ----- - decodeZip - - "data := <trailer> unzip utf8ToSqueak" - | len bytes | - len := self decodeLengthField. - bytes := ByteArray new: len. - 1 to: len do: [ :i | - bytes at: i put: (method at: method size - size + i) ]. - - data := (ZipReadStream on: bytes) contents asString convertFromEncoding: 'utf8'! Item was removed: - ----- Method: CompiledMethodTrailer>>encodeEmbeddedSourceZip (in category '*Compression-Streams') ----- - encodeEmbeddedSourceZip - - "data is string with method's source code, encode it using Zip compression method" - self encodeUsingZip - ! Item was removed: - ----- Method: CompiledMethodTrailer>>encodeTempsNamesZip (in category '*Compression-Streams') ----- - encodeTempsNamesZip - - "data is string with method's temporary names, encode it using zip compression" - self encodeUsingZip - - "data is string with method's source code, encoded using qCompress method" - - - ! Item was removed: - ----- Method: CompiledMethodTrailer>>encodeUsingZip (in category '*Compression-Streams') ----- - encodeUsingZip - - "data is string, encode it using gzip compression" - | utf8str stream length encodedLength | - - self assert: (data isString). - utf8str := data convertToEncoding: 'utf8'. - - stream := ((ZipWriteStream on: (ByteArray new: utf8str size)) - nextPutAll: utf8str asByteArray; - close; - encodedStream). - - length := stream position. - encodedLength := self encodeLengthField: length. - - stream nextPutAll: encodedLength. - "trailing byte" - stream nextPut: (self kindAsByte + encodedLength size - 1). - - encodedData := stream contents - ! Item was removed: - ReadWriteStream subclass: #CompressedSourceStream - instanceVariableNames: 'segmentFile segmentSize nSegments segmentTable segmentIndex dirty endOfFile' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! - - !CompressedSourceStream commentStamp: 'nice 3/24/2010 07:36' prior: 0! - I implement a file format that compresses segment by segment to allow incremental writing and browsing. Note that the file can only be written at the end. - - Structure: - segmentFile The actual compressed file. - segmentSize This is the quantum of compression. The virtual file is sliced up - into segments of this size. - nSegments The maximum number of segments to which this file can be grown. - endOfFile The user's endOfFile pointer. - segmentTable When a file is open, this table holds the physical file positions - of the compressed segments. - segmentIndex Index of the most recently accessed segment. - - Inherited from ReadWriteStream... - collection The segment buffer, uncompressed - position This is the position *local* to the current segment buffer - readLimit ReadLimit for the current buffer - writeLimit WriteLimit for the current buffer - - Great care must be exercised to distinguish between the position relative to the segment buffer and the full file position (and, or course, the segment file position ;-). - - The implementation defaults to a buffer size of 20k, and a max file size of 34MB (conveniently chosen to be greater than the current 33MB limit of source code pointers). The format of the file is as follows: - segmentSize 4 bytes - nSegments 4 bytes - endOfFile 4 bytes - segmentTable 4 bytes * (nSegments+1) - beginning of first compressed segment - - It is possible to override the default allocation by sending the message #segmentSize:nSegments: immediately after opening a new file for writing, as follows: - - bigFile := (CompressedSourceStream on: (FileStream newFileNamed: 'biggy.stc')) - segmentSize: 50000 maxSize: 200000000 - - The difference between segment table entries reveals the size of each compressed segment. When a file is being written, it may lack the final segment, but any flush, position:, or close will force a dirty segment to be written.! Item was removed: - ----- Method: CompressedSourceStream class>>on: (in category 'as yet unclassified') ----- - on: aFile - ^ self basicNew openOn: aFile! Item was removed: - ----- Method: CompressedSourceStream>>atEnd (in category 'access') ----- - atEnd - - position >= readLimit ifFalse: [^ false]. "more in segment" - ^ self position >= endOfFile "more in file"! Item was removed: - ----- Method: CompressedSourceStream>>binary (in category 'open/close') ----- - binary - self error: 'Compressed source files are ascii to the user (though binary underneath)'! Item was removed: - ----- Method: CompressedSourceStream>>close (in category 'open/close') ----- - close - self flush. - segmentFile close! Item was removed: - ----- Method: CompressedSourceStream>>contentsOfEntireFile (in category 'access') ----- - contentsOfEntireFile - ^ self uncompressedBytes: [ :bar | "bar ignored"] - ! Item was removed: - ----- Method: CompressedSourceStream>>fileID (in category 'private') ----- - fileID "Only needed for OSProcess stuff" - ^ segmentFile fileID - ! Item was removed: - ----- Method: CompressedSourceStream>>firstSegmentLoc (in category 'private') ----- - firstSegmentLoc - "First segment follows 3 header words and segment table" - ^ (3 + nSegments+1) * 4! Item was removed: - ----- Method: CompressedSourceStream>>flush (in category 'access') ----- - flush - dirty ifTrue: - ["Write buffer, compressed, to file, and also write the segment offset and eof" - self writeSegment].! Item was removed: - ----- Method: CompressedSourceStream>>into:chunkSize:notifying: (in category 'private') ----- - into: byteStream chunkSize: chunkSize notifying: progress - "Decompress sources into a byte stream, notifying a progress dialog. - Reading from the compressed sources is recursive, so reading in chunks - can be more efficient, and is also convenient for updating a progress bar." - - self position: 0. - [self position < self size] - whileTrue: [ - progress value: self position / self size. - byteStream nextPutAll: (self next: chunkSize)] - ! Item was removed: - ----- Method: CompressedSourceStream>>next (in category 'access') ----- - next - <primitive: 65> - position >= readLimit - ifTrue: [^ (self next: 1) at: 1] - ifFalse: [^ collection at: (position := position + 1)]! Item was removed: - ----- Method: CompressedSourceStream>>next: (in category 'access') ----- - next: n - | str | - n <= (readLimit - position) ifTrue: - ["All characters are available in buffer" - str := collection copyFrom: position + 1 to: position + n. - position := position + n. - ^ str]. - - "Read limit could be segment boundary or real end of file" - (readLimit + self segmentOffset) = endOfFile ifTrue: - ["Real end of file -- just return what's available" - ^ self next: readLimit - position]. - - "Read rest of segment. Then (after positioning) read what remains" - str := self next: readLimit - position. - self position: self position. - ^ str , (self next: n - str size) - ! Item was removed: - ----- Method: CompressedSourceStream>>nextChunk (in category 'access') ----- - nextChunk - self flag: #workAround. "all accessors should decode utf8" - ^super nextChunk utf8ToSqueak! Item was removed: - ----- Method: CompressedSourceStream>>nextPut: (in category 'access') ----- - nextPut: char - "Slow, but we don't often write, and then not a lot" - self nextPutAll: char asString. - ^ char! Item was removed: - ----- Method: CompressedSourceStream>>nextPutAll: (in category 'access') ----- - nextPutAll: str - | n nInSeg | - n := str size. - n <= (writeLimit - position) ifTrue: - ["All characters fit in buffer" - collection replaceFrom: position + 1 to: position + n with: str. - dirty := true. - position := position + n. - readLimit := readLimit max: position. - endOfFile := endOfFile max: self position. - ^ str]. - - "Write what fits in segment. Then (after positioning) write what remains" - nInSeg := writeLimit - position. - nInSeg = 0 - ifTrue: [self position: self position. - self nextPutAll: str] - ifFalse: [self nextPutAll: (str first: nInSeg). - self position: self position. - self nextPutAll: (str allButFirst: nInSeg)]. - ^str - - ! Item was removed: - ----- Method: CompressedSourceStream>>openOn: (in category 'open/close') ----- - openOn: aFile - "Open the receiver." - segmentFile := aFile. - segmentFile binary. - segmentFile size > 0 - ifTrue: - [self readHeaderInfo. "If file exists, then read the parameters"] - ifFalse: - [self segmentSize: 20000 maxSize: 34000000. "Otherwise write default values"]! Item was removed: - ----- Method: CompressedSourceStream>>openReadOnly (in category 'open/close') ----- - openReadOnly - - segmentFile openReadOnly! Item was removed: - ----- Method: CompressedSourceStream>>position (in category 'access') ----- - position - - ^ position + self segmentOffset! Item was removed: - ----- Method: CompressedSourceStream>>position: (in category 'access') ----- - position: newPosition - | compressedBuffer newSegmentIndex | - newPosition > endOfFile ifTrue: - [self error: 'Attempt to position beyond the end of file']. - newSegmentIndex := (newPosition // segmentSize) + 1. - newSegmentIndex ~= segmentIndex ifTrue: - [self flush. - segmentIndex := newSegmentIndex. - newSegmentIndex > nSegments ifTrue: - [self error: 'file size limit exceeded']. - segmentFile position: (segmentTable at: segmentIndex). - (segmentTable at: segmentIndex+1) = 0 - ifTrue: - [newPosition ~= endOfFile ifTrue: - [self error: 'Internal logic error']. - collection size = segmentSize ifFalse: - [self error: 'Internal logic error']. - "just leave garbage beyond end of file"] - ifFalse: - [compressedBuffer := segmentFile next: ((segmentTable at: segmentIndex+1) - (segmentTable at: segmentIndex)). - collection := (GZipReadStream on: compressedBuffer) upToEnd asString]. - readLimit := collection size min: endOfFile - self segmentOffset]. - position := newPosition \\ segmentSize. - ! Item was removed: - ----- Method: CompressedSourceStream>>readHeaderInfo (in category 'open/close') ----- - readHeaderInfo - | valid a b | - segmentFile position: 0. - segmentSize := segmentFile nextNumber: 4. - nSegments := segmentFile nextNumber: 4. - endOfFile := segmentFile nextNumber: 4. - segmentFile size < (nSegments+1 + 3 * 4) ifTrue: "Check for reasonable segment info" - [self error: 'This file is not in valid compressed source format']. - segmentTable := (1 to: nSegments+1) collect: [:x | segmentFile nextNumber: 4]. - segmentTable first ~= self firstSegmentLoc ifTrue: - [self error: 'This file is not in valid compressed source format']. - valid := true. - 1 to: nSegments do: "Check that segment offsets are ascending" - [:i | a := segmentTable at: i. b := segmentTable at: i+1. - (a = 0 and: [b ~= 0]) ifTrue: [valid := false]. - (a ~= 0 and: [b ~= 0]) ifTrue: [b <= a ifTrue: [valid := false]]]. - valid ifFalse: - [self error: 'This file is not in valid compressed source format']. - dirty := false. - self position: 0.! Item was removed: - ----- Method: CompressedSourceStream>>readOnlyCopy (in category 'open/close') ----- - readOnlyCopy - - ^ self class on: segmentFile readOnlyCopy! Item was removed: - ----- Method: CompressedSourceStream>>segmentOffset (in category 'private') ----- - segmentOffset - - ^ segmentIndex - 1 * segmentSize! Item was removed: - ----- Method: CompressedSourceStream>>segmentSize:maxSize: (in category 'private') ----- - segmentSize: segSize maxSize: maxSize - "Note that this method can be called after the initial open, provided that no - writing has yet taken place. This is how to override the default segmentation." - self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write']. - segmentFile position: 0. - segmentFile nextNumber: 4 put: (segmentSize := segSize). - segmentFile nextNumber: 4 put: (nSegments := maxSize // segSize + 2). - segmentFile nextNumber: 4 put: (endOfFile := 0). - segmentTable := Array new: nSegments+1 withAll: 0. - segmentTable at: 1 put: self firstSegmentLoc. "Loc of first segment, always." - segmentTable do: [:i | segmentFile nextNumber: 4 put: i]. - segmentIndex := 1. - collection := String new: segmentSize. - writeLimit := segmentSize. - readLimit := 0. - position := 0. - endOfFile := 0. - self writeSegment. - ! Item was removed: - ----- Method: CompressedSourceStream>>size (in category 'access') ----- - size - ^ endOfFile ifNil: [0]! Item was removed: - ----- Method: CompressedSourceStream>>test (in category 'open/close') ----- - test - "FileDirectory default deleteFileNamed: 'test.stc'. - (CompressedSourceStream on: (FileStream newFileNamed: 'test.stc')) fileOutChanges" - - "FileDirectory default deleteFileNamed: 'test2.stc'. - ((CompressedSourceStream on: (FileStream newFileNamed: 'test2.stc')) - segmentSize: 100 nSegments: 1000) fileOutChanges" - - "FileDirectory default deleteFileNamed: 'test3.st'. - (FileStream newFileNamed: 'test3.st') fileOutChanges" - - "(CompressedSourceStream on: (FileStream oldFileNamed: 'test.stc')) contentsOfEntireFile" - ! Item was removed: - ----- Method: CompressedSourceStream>>uncompressedBytes: (in category 'access') ----- - uncompressedBytes: progress - - "ProgressInitiationException - display: 'reading compressed sources from a compressed .stc file' - during: [:bar | (SourceFiles at: 1) uncompressedBytes: bar]" - - ^ ByteString streamContents: [ :strm | - self readOnlyCopy reset into: strm chunkSize: 50000 notifying: progress]. - - ! Item was removed: - ----- Method: CompressedSourceStream>>writeSegment (in category 'private') ----- - writeSegment - "The current segment must be the last in the file." - | compressedSegment | - segmentFile position: (segmentTable at: segmentIndex). - compressedSegment := ByteArray streamContents: - [:strm | (GZipWriteStream on: strm) nextPutAll: collection asByteArray; close]. - segmentFile nextPutAll: compressedSegment. - segmentTable at: segmentIndex + 1 put: segmentFile position. - - segmentFile position: 2 * 4. - segmentFile nextNumber: 4 put: endOfFile. - segmentFile position: (segmentIndex + 3) * 4. - segmentFile nextNumber: 4 put: (segmentTable at: segmentIndex + 1). - dirty := false! Item was removed: - CompressedSourceStream subclass: #CompressedSources - instanceVariableNames: '' - classVariableNames: 'CachedSources' - poolDictionaries: '' - category: 'Compression-Streams'! - - !CompressedSources commentStamp: 'dtl 1/16/2022 17:39' prior: 0! - A CompressedSources is a CompressedSourceStream that holds its sources in the image rather than in an external file. - ! Item was removed: - ----- Method: CompressedSources class>>cachedSources (in category 'accessing') ----- - cachedSources - ^CachedSources! Item was removed: - ----- Method: CompressedSources class>>fromSourceFileArray (in category 'instance creation') ----- - fromSourceFileArray - "Answer a new instance created from the existing SourceFiles" - - "CompressedSources fromSourceFileArray" - - | f sourcesName | - f := SourceFiles first readOnlyCopy. - sourcesName := f localName. - (sourcesName endsWith: 'sources') - ifTrue: [^self fromSourcesFile: f]. - ^f asCompressedSources. - ! Item was removed: - ----- Method: CompressedSources class>>fromSourcesFile: (in category 'private') ----- - fromSourcesFile: f - - | cf | - f binary. "binary to preserve utf8 encoding" - cf := (CompressedSources on: (ReadWriteStream with: ByteArray new)) - segmentSize: 65536 maxSize: f size. - - "Copy the sources" - 'Compressing Sources File...' - displayProgressAt: Sensor cursorPoint - from: 0 to: f size - during: - [:bar | f position: 0. - [f atEnd] whileFalse: - [cf nextPutAll: (f next: 65536). - bar value: f position]]. - ^cf. - ! Item was removed: - ----- Method: CompressedSources class>>internalizeSources (in category 'accessing') ----- - internalizeSources - - <preference: 'Cache sources file' - category: 'Files' - description: 'If true, a compressed sources file will be kept in the image to avoid file system access' - type: #Boolean> - ^CachedSources notNil - ! Item was removed: - ----- Method: CompressedSources class>>internalizeSources: (in category 'accessing') ----- - internalizeSources: internalize - internalize - ifNotNil: [| msg | - msg := 'No external ' translated , Smalltalk sourceFileVersionString , ' sources file found' translated. - internalize - ifTrue: [CachedSources := self fromSourceFileArray position: 0] - ifFalse: [Smalltalk locateSourcesEntry - ifNil: [((self confirm: msg , ', save a local copy?' translated) - and: [self saveSourcesToLocalFile]) - ifFalse: [^ msg , ' (preference not changed)' translated]]. - CachedSources := nil]. - Smalltalk closeSourceFiles; openSourceFiles]! Item was removed: - ----- Method: CompressedSources class>>saveSourcesToLocalFile (in category 'accessing') ----- - saveSourcesToLocalFile - "Save the compressed sources to a .sources file in the default directory. Answer true for success" - - | sourcesName fs | - sourcesName := Smalltalk sourceFileVersionString , '.sources'. - (FileDirectory default fileExists: sourcesName) - ifTrue: [self error: sourcesName , ' already exists in the default directory'. - ^ false]. - [[| sourceData | - fs := FileStream newFileNamed: sourcesName. - fs binary. - sourceData := ProgressInitiationException - display: 'converting compressed sources' - during: [:bar | CachedSources uncompressedBytes: bar]. - fs nextPutAll: sourceData] - ensure: [fs close]] - on: Error - do: [:e | - self notify: 'failed writing ' , sourcesName. - ^ false]. - ^ true! Item was removed: - ----- Method: CompressedSources>>asCompressedSources (in category 'converting') ----- - asCompressedSources - ^self! Item was removed: - ----- Method: CompressedSources>>readOnlyCopy (in category 'file open/close') ----- - readOnlyCopy - "Not required for source file management, just answer a copy" - ^self copy! Item was removed: - ----- Method: CompressedSources>>reopen (in category 'file open/close') ----- - reopen - self position: 0. - ! Item was removed: - WriteStream subclass: #DeflateStream - instanceVariableNames: 'hashHead hashTail hashValue blockPosition blockStart' - classVariableNames: '' - poolDictionaries: 'ZipConstants' - category: 'Compression-Streams'! Item was removed: - ----- Method: DeflateStream>>compare:with:min: (in category 'deflating') ----- - compare: here with: matchPos min: minLength - "Compare the two strings and return the length of matching characters. - minLength is a lower bound for match lengths that will be accepted. - Note: here and matchPos are zero based." - | length | - "First test if we can actually get longer than minLength" - (collection at: here+minLength+1) = (collection at: matchPos+minLength+1) - ifFalse:[^0]. - (collection at: here+minLength) = (collection at: matchPos+minLength) - ifFalse:[^0]. - "Then test if we have an initial match at all" - (collection at: here+1) = (collection at: matchPos+1) - ifFalse:[^0]. - (collection at: here+2) = (collection at: matchPos+2) - ifFalse:[^1]. - "Finally do the real comparison" - length := 3. - [length <= MaxMatch and:[ - (collection at: here+length) = (collection at: matchPos+length)]] - whileTrue:[length := length + 1]. - ^length - 1! Item was removed: - ----- Method: DeflateStream>>deflateBlock (in category 'deflating') ----- - deflateBlock - "Deflate the current contents of the stream" - | flushNeeded lastIndex | - (blockStart == nil) ifTrue:[ - "One time initialization for the first block" - 1 to: MinMatch-1 do:[:i| self updateHashAt: i]. - blockStart := 0]. - - [blockPosition < position] whileTrue:[ - (position + MaxMatch + 1 > writeLimit) - ifTrue:[lastIndex := writeLimit - MaxMatch - 1] - ifFalse:[lastIndex := position]. - flushNeeded := self deflateBlock: lastIndex-1 - chainLength: self hashChainLength - goodMatch: self goodMatchLength. - flushNeeded ifTrue:[ - self flushBlock. - blockStart := blockPosition]. - "Make room for more data" - self moveContentsToFront]. - ! Item was removed: - ----- Method: DeflateStream>>deflateBlock:chainLength:goodMatch: (in category 'deflating') ----- - deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch - "Continue deflating the receiver's collection from blockPosition to lastIndex. - Note that lastIndex must be at least MaxMatch away from the end of collection" - | here matchResult flushNeeded hereMatch hereLength newMatch newLength hasMatch | - blockPosition > lastIndex ifTrue:[^false]. "Nothing to deflate" - hasMatch := false. - here := blockPosition. - [here <= lastIndex] whileTrue:[ - hasMatch ifFalse:[ - "Find the first match" - matchResult := self findMatch: here - lastLength: MinMatch-1 - lastMatch: here - chainLength: chainLength - goodMatch: goodMatch. - self insertStringAt: here. "update hash table" - hereMatch := matchResult bitAnd: 16rFFFF. - hereLength := matchResult bitShift: -16]. - - "Look ahead if there is a better match at the next position" - matchResult := self findMatch: here+1 - lastLength: hereLength - lastMatch: hereMatch - chainLength: chainLength - goodMatch: goodMatch. - newMatch := matchResult bitAnd: 16rFFFF. - newLength := matchResult bitShift: -16. - - "Now check if the next match is better than the current one. - If not, output the current match (provided that the current match - is at least MinMatch long)" - (hereLength >= newLength and:[hereLength >= MinMatch]) ifTrue:[ - self assert:[self validateMatchAt: here - from: hereMatch to: hereMatch + hereLength - 1]. - "Encode the current match" - flushNeeded := self - encodeMatch: hereLength - distance: here - hereMatch. - "Insert all strings up to the end of the current match. - Note: The first string has already been inserted." - 1 to: hereLength-1 do:[:i| self insertStringAt: (here := here + 1)]. - hasMatch := false. - here := here + 1. - ] ifFalse:[ - "Either the next match is better than the current one or we didn't - have a good match after all (e.g., current match length < MinMatch). - Output a single literal." - flushNeeded := self encodeLiteral: (collection byteAt: (here + 1)). - here := here + 1. - (here <= lastIndex and:[flushNeeded not]) ifTrue:[ - "Cache the results for the next round" - self insertStringAt: here. - hasMatch := true. - hereMatch := newMatch. - hereLength := newLength]. - ]. - flushNeeded ifTrue:[blockPosition := here. ^true]. - ]. - blockPosition := here. - ^false! Item was removed: - ----- Method: DeflateStream>>encodeLiteral: (in category 'encoding') ----- - encodeLiteral: literal - "Encode the given literal. - Return true if the current block needs to be flushed." - ^false! Item was removed: - ----- Method: DeflateStream>>encodeMatch:distance: (in category 'encoding') ----- - encodeMatch: matchLength distance: matchDistance - "Encode a match of the given length and distance. - Return true if the current block should be flushed." - ^false! Item was removed: - ----- Method: DeflateStream>>findMatch:lastLength:lastMatch:chainLength:goodMatch: (in category 'deflating') ----- - findMatch: here lastLength: lastLength lastMatch: lastMatch chainLength: maxChainLength goodMatch: goodMatch - "Find the longest match for the string starting at here. - If there is no match longer than lastLength return lastMatch/lastLength. - Traverse at most maxChainLength entries in the hash table. - Stop if a match of at least goodMatch size has been found." - | matchResult matchPos distance chainLength limit bestLength length | - "Compute the default match result" - matchResult := (lastLength bitShift: 16) bitOr: lastMatch. - - "There is no way to find a better match than MaxMatch" - lastLength >= MaxMatch ifTrue:[^matchResult]. - - "Start position for searches" - matchPos := hashHead at: (self updateHashAt: here + MinMatch) + 1. - - "Compute the distance to the (possible) match" - distance := here - matchPos. - - "Note: It is required that 0 < distance < MaxDistance" - (distance > 0 and:[distance < MaxDistance]) ifFalse:[^matchResult]. - - chainLength := maxChainLength. "Max. nr of match chain to search" - here > MaxDistance "Limit for matches that are too old" - ifTrue:[limit := here - MaxDistance] - ifFalse:[limit := 0]. - - "Best match length so far (current match must be larger to take effect)" - bestLength := lastLength. - - ["Compare the current string with the string at match position" - length := self compare: here with: matchPos min: bestLength. - "Truncate accidental matches beyound stream position" - (here + length > position) ifTrue:[length := position - here]. - "Ignore very small matches if they are too far away" - (length = MinMatch and:[(here - matchPos) > (MaxDistance // 4)]) - ifTrue:[length := MinMatch - 1]. - length > bestLength ifTrue:["We have a new (better) match than before" - "Compute the new match result" - matchResult := (length bitShift: 16) bitOr: matchPos. - bestLength := length. - "There is no way to find a better match than MaxMatch" - bestLength >= MaxMatch ifTrue:[^matchResult]. - "But we may have a good, fast match" - bestLength > goodMatch ifTrue:[^matchResult]. - ]. - (chainLength := chainLength - 1) > 0] whileTrue:[ - "Compare with previous entry in hash chain" - matchPos := hashTail at: (matchPos bitAnd: WindowMask) + 1. - matchPos <= limit ifTrue:[^matchResult]. "Match position is too old" - ]. - ^matchResult! Item was removed: - ----- Method: DeflateStream>>flush (in category 'initialize-release') ----- - flush - "Force compression" - self deflateBlock.! Item was removed: - ----- Method: DeflateStream>>flushBlock (in category 'deflating') ----- - flushBlock - "Flush a deflated block"! Item was removed: - ----- Method: DeflateStream>>goodMatchLength (in category 'accessing') ----- - goodMatchLength - "Return the length that is considered to be a 'good' match. - Higher values will result in better compression but take more time." - ^MaxMatch "Best compression"! Item was removed: - ----- Method: DeflateStream>>hashChainLength (in category 'accessing') ----- - hashChainLength - "Return the max. number of hash chains to traverse. - Higher values will result in better compression but take more time." - ^4096 "Best compression"! Item was removed: - ----- Method: DeflateStream>>initialize (in category 'initialize-release') ----- - initialize - blockStart := nil. - blockPosition := 0. - hashValue := 0. - self initializeHashTables.! Item was removed: - ----- Method: DeflateStream>>initializeHashTables (in category 'initialize-release') ----- - initializeHashTables - hashHead := WordArray new: 1 << HashBits. - hashTail := WordArray new: WindowSize. - ! Item was removed: - ----- Method: DeflateStream>>insertStringAt: (in category 'deflating') ----- - insertStringAt: here - "Insert the string at the given start position into the hash table. - Note: The hash value is updated starting at MinMatch-1 since - all strings before have already been inserted into the hash table - (and the hash value is updated as well)." - | prevEntry | - hashValue := self updateHashAt: (here + MinMatch). - prevEntry := hashHead at: hashValue+1. - hashHead at: hashValue+1 put: here. - hashTail at: (here bitAnd: WindowMask)+1 put: prevEntry.! Item was removed: - ----- Method: DeflateStream>>moveContentsToFront (in category 'private') ----- - moveContentsToFront - "Move the contents of the receiver to the front" - | delta | - delta := (blockPosition - WindowSize). - delta <= 0 ifTrue:[^self]. - "Move collection" - collection - replaceFrom: 1 - to: collection size - delta - with: collection - startingAt: delta+1. - position := position - delta. - "Move hash table entries" - blockPosition := blockPosition - delta. - blockStart := blockStart - delta. - self updateHashTable: hashHead delta: delta. - self updateHashTable: hashTail delta: delta.! Item was removed: - ----- Method: DeflateStream>>next:putAll:startingAt: (in category 'accessing') ----- - next: bytesCount putAll: aCollection startingAt: startIndex - - | start count max | - bytesCount > 0 ifFalse: [ ^aCollection ]. - aCollection species = collection species - ifFalse: - [startIndex to: startIndex + bytesCount - 1 do: [:i | self nextPut: (aCollection at: i)]. - ^aCollection]. - start := startIndex. - count := bytesCount. - [count = 0] whileFalse:[ - position = writeLimit ifTrue:[self deflateBlock]. - max := writeLimit - position. - max > count ifTrue:[max := count]. - collection replaceFrom: position+1 - to: position+max - with: aCollection - startingAt: start. - start := start + max. - count := count - max. - position := position + max]. - ^aCollection! Item was removed: - ----- Method: DeflateStream>>nextPutAll: (in category 'accessing') ----- - nextPutAll: aCollection - ^self next: aCollection size putAll: aCollection startingAt: 1! Item was removed: - ----- Method: DeflateStream>>on: (in category 'initialize-release') ----- - on: aCollection - self initialize. - super on: (aCollection species new: WindowSize * 2).! Item was removed: - ----- Method: DeflateStream>>on:from:to: (in category 'initialize-release') ----- - on: aCollection from: firstIndex to: lastIndex - "Not for DeflateStreams please" - ^self shouldNotImplement! Item was removed: - ----- Method: DeflateStream>>pastEndPut: (in category 'accessing') ----- - pastEndPut: anObject - self deflateBlock. - ^self nextPut: anObject! Item was removed: - ----- Method: DeflateStream>>updateHash: (in category 'deflating') ----- - updateHash: nextValue - "Update the running hash value based on the next input byte. - Return the new updated hash value." - ^((hashValue bitShift: HashShift) bitXor: nextValue) bitAnd: HashMask.! Item was removed: - ----- Method: DeflateStream>>updateHashAt: (in category 'deflating') ----- - updateHashAt: here - "Update the hash value at position here (one based)" - ^self updateHash: (collection byteAt: here)! Item was removed: - ----- Method: DeflateStream>>updateHashTable:delta: (in category 'private') ----- - updateHashTable: table delta: delta - | pos | - <primitive: 'primitiveDeflateUpdateHashTable' module: 'ZipPlugin'> - 1 to: table size do:[:i| - "Discard entries that are out of range" - (pos := table at: i) >= delta - ifTrue:[table at: i put: pos - delta] - ifFalse:[table at: i put: 0]].! Item was removed: - ----- Method: DeflateStream>>validateMatchAt:from:to: (in category 'deflating') ----- - validateMatchAt: pos from: startPos to: endPos - | here | - here := pos. - startPos+1 to: endPos+1 do:[:i| - (collection at: i) = (collection at: (here := here + 1)) - ifFalse:[^self error:'Not a match']]. - ^true! Item was removed: - InflateStream subclass: #FastInflateStream - instanceVariableNames: '' - classVariableNames: 'DistanceMap FixedDistTable FixedLitTable LiteralLengthMap' - poolDictionaries: '' - category: 'Compression-Streams'! - - !FastInflateStream commentStamp: '<historical>' prior: 0! - This class adds the following optimizations to the basic Inflate decompression: - - a) Bit reversed access - If we want to fetch the bits efficiently then we have them in the wrong bit order (e.g., when we should fetch 2r100 we would get 2r001). But since the huffman tree lookup determines the efficiency of the decompression, reversing the bits before traversal is expensive. Therefore the entries in each table are stored in REVERSE BIT ORDER. This is achieved by a reverse increment of the current table index in the huffman table construction phase (see method increment:bits:). According to my measures this speeds up the implementation by about 30-40%. - - b) Inplace storage of code meanings and extra bits - Rather than looking up the meaning for each code during decompression of blocks we store the appropriate values directly in the huffman tables, using a pre-defined mapping. Even though this does not make a big difference in speed, it cleans up the code and allows easier translation into primitive code (which is clearly one goal of this implementation). - - c) Precomputed huffman tables for fixed blocks - So we don't have to compute the huffman tables from scratch. The precomputed tables are not in our superclass to avoid double storage (and my superclass is more intended for documentation anyways).! Item was removed: - ----- Method: FastInflateStream class>>initialize (in category 'class initialization') ----- - initialize - "FastInflateStream initialize" - | low high | - - "Init literal/length map" - low := #(3 4 5 6 7 8 9 10 11 13 15 17 19 23 27 31 35 43 51 59 67 83 99 115 131 163 195 227 258 ). - high := #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0 0). - LiteralLengthMap := WordArray new: 256 + 32. - 1 to: 257 do:[:i| LiteralLengthMap at: i put: i-1]. - 1 to: 29 do:[:i| LiteralLengthMap at: 257+i put: (low at:i) + ( (high at: i) + 1 << 16)]. - - "Init distance map" - high := #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13). - low := #(1 2 3 4 5 7 9 13 17 25 33 49 65 97 129 193 257 385 513 769 - 1025 1537 2049 3073 4097 6145 8193 12289 16385 24577). - DistanceMap := WordArray new: 32. - 1 to: 30 do:[:i| DistanceMap at: i put: (low at: i) + ( (high at: i) << 16)]. - - "Init fixed block huffman tables" - FixedLitTable := self basicNew - huffmanTableFrom: FixedLitCodes - mappedBy: LiteralLengthMap. - FixedDistTable := self basicNew - huffmanTableFrom: FixedDistCodes - mappedBy: DistanceMap.! Item was removed: - ----- Method: FastInflateStream>>decompressBlock:with: (in category 'inflating') ----- - decompressBlock: llTable with: dTable - "Process the compressed data in the block. - llTable is the huffman table for literal/length codes - and dTable is the huffman table for distance codes." - | value extra length distance oldPos oldBits oldBitPos | - <primitive: 'primitiveInflateDecompressBlock' module: 'ZipPlugin'> - [readLimit < collection size and:[sourcePos <= sourceLimit]] whileTrue:[ - "Back up stuff if we're running out of space" - oldBits := bitBuf. - oldBitPos := bitPos. - oldPos := sourcePos. - value := self decodeValueFrom: llTable. - value < 256 ifTrue:[ "A literal" - collection byteAt: (readLimit := readLimit + 1) put: value. - ] ifFalse:["length/distance or end of block" - value = 256 ifTrue:["End of block" - state := state bitAnd: StateNoMoreData. - ^self]. - "Compute the actual length value (including possible extra bits)" - extra := (value bitShift: -16) - 1. - length := value bitAnd: 16rFFFF. - extra > 0 ifTrue:[length := length + (self nextBits: extra)]. - "Compute the distance value" - value := self decodeValueFrom: dTable. - extra := (value bitShift: -16). - distance := value bitAnd: 16rFFFF. - extra > 0 ifTrue:[distance := distance + (self nextBits: extra)]. - (readLimit + length >= collection size) ifTrue:[ - bitBuf := oldBits. - bitPos := oldBitPos. - sourcePos := oldPos. - ^self]. - collection - replaceFrom: readLimit+1 - to: readLimit + length - with: collection - startingAt: readLimit - distance + 1. - readLimit := readLimit + length. - ]. - ].! Item was removed: - ----- Method: FastInflateStream>>distanceMap (in category 'huffman trees') ----- - distanceMap - ^DistanceMap! Item was removed: - ----- Method: FastInflateStream>>increment:bits: (in category 'huffman trees') ----- - increment: value bits: nBits - "Increment value in reverse bit order, e.g. - for a 3 bit value count as follows: - 000 / 100 / 010 / 110 - 001 / 101 / 011 / 111 - See the class comment why we need this." - | result bit | - result := value. - "Test the lowest bit first" - bit := 1 << (nBits - 1). - "If the currently tested bit is set then we need to - turn this bit off and test the next bit right to it" - [(result bitAnd: bit) = 0] whileFalse:[ - "Turn off current bit" - result := result bitXor: bit. - "And continue testing the next bit" - bit := bit bitShift: -1]. - "Turn on the right-most bit that we haven't touched in the loop above" - ^result bitXor: bit! Item was removed: - ----- Method: FastInflateStream>>literalLengthMap (in category 'huffman trees') ----- - literalLengthMap - ^LiteralLengthMap! Item was removed: - ----- Method: FastInflateStream>>nextSingleBits: (in category 'bit access') ----- - nextSingleBits: n - "Fetch the bits all at once" - ^self nextBits: n.! Item was removed: - ----- Method: FastInflateStream>>processFixedBlock (in category 'inflating') ----- - processFixedBlock - litTable := FixedLitTable. - distTable := FixedDistTable. - state := state bitOr: BlockProceedBit. - self proceedFixedBlock.! Item was removed: - ----- Method: FileStream>>viewGZipContents (in category '*Compression-Streams') ----- - viewGZipContents - "View the contents of a gzipped file" - - | stringContents | - self binary. - stringContents := self contentsOfEntireFile. - stringContents := (GZipReadStream on: stringContents) upToEnd. - ^ stringContents asString withSqueakLineEndings.! Item was removed: - SharedPool subclass: #GZipConstants - instanceVariableNames: '' - classVariableNames: 'GZipAsciiFlag GZipCommentFlag GZipContinueFlag GZipDeflated GZipEncryptFlag GZipExtraField GZipMagic GZipNameFlag GZipReservedFlags' - poolDictionaries: '' - category: 'Compression-Streams'! Item was removed: - ----- Method: GZipConstants class>>gzipMagic (in category 'pool initialization') ----- - gzipMagic - ^GZipMagic! Item was removed: - ----- Method: GZipConstants class>>initialize (in category 'pool initialization') ----- - initialize - "GZipConstants initialize" - GZipMagic := 16r8B1F. "GZIP magic number" - GZipDeflated := 8. "Compression method" - - GZipAsciiFlag := 16r01. "Contents is ASCII" - GZipContinueFlag := 16r02. "Part of a multi-part archive" - GZipExtraField := 16r04. "Archive has extra fields" - GZipNameFlag := 16r08. "Archive has original file name" - GZipCommentFlag := 16r10. "Archive has comment" - GZipEncryptFlag := 16r20. "Archive is encrypted" - GZipReservedFlags := 16rC0. "Reserved" ! Item was removed: - FastInflateStream subclass: #GZipReadStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: 'GZipConstants' - category: 'Compression-Streams'! Item was removed: - ----- Method: GZipReadStream class>>fileIn: (in category 'fileIn/Out') ----- - fileIn: fullFileName - "FileIn the contents of a gzipped file" - | zipped unzipped | - zipped := self on: (FileStream readOnlyFileNamed: fullFileName). - unzipped := MultiByteBinaryOrTextStream with: (zipped contents asString). - unzipped reset. - unzipped fileIn. - ! Item was removed: - ----- Method: GZipReadStream class>>fileIntoNewChangeSet: (in category 'fileIn/Out') ----- - fileIntoNewChangeSet: fullFileName - "FileIn the contents of a gzipped file" - | zipped unzipped cs | - cs := Smalltalk at: #ChangesOrganizer ifAbsent: [ ^self ]. - zipped := self on: (FileStream readOnlyFileNamed: fullFileName). - unzipped := MultiByteBinaryOrTextStream with: zipped contents asString. - unzipped reset. - cs newChangesFromStream: unzipped named: (FileDirectory localNameFor: fullFileName) - ! Item was removed: - ----- Method: GZipReadStream class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - | services | - (suffix = 'gz') | (suffix = '*') - ifFalse: [^ #()]. - services := OrderedCollection new. - (suffix = '*') | (fullName asLowercase endsWith: '.cs.gz') | (fullName asLowercase endsWith: '.mcs.gz') - ifTrue: [services add: self serviceFileIn. - (Smalltalk includesKey: #ChangSet) - ifTrue: [services add: self serviceFileIntoNewChangeSet]]. - services addAll: self services. - ^ services! Item was removed: - ----- Method: GZipReadStream class>>saveContents: (in category 'fileIn/Out') ----- - 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). - buffer := ByteArray new: 50000. - 'Extracting ' , fullFileName - displayProgressFrom: 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! Item was removed: - ----- Method: GZipReadStream class>>serviceDecompressToFile (in category 'fileIn/Out') ----- - serviceDecompressToFile - - ^ FileModifyingSimpleServiceEntry - provider: self - label: 'decompress to file' translatedNoop - selector: #saveContents: - description: 'decompress to file' translatedNoop! Item was removed: - ----- Method: GZipReadStream class>>serviceFileIn (in category 'fileIn/Out') ----- - serviceFileIn - "Answer a service for filing in an entire file" - - ^ SimpleServiceEntry - provider: self - label: 'fileIn entire file' translatedNoop - selector: #fileIn: - description: 'file in the entire decompressed contents of the file, which is expected to contain Smalltalk code in fileout ("chunk") format' translatedNoop - buttonLabel: 'filein' translatedNoop - - ! Item was removed: - ----- Method: GZipReadStream class>>serviceFileIntoNewChangeSet (in category 'fileIn/Out') ----- - serviceFileIntoNewChangeSet - "Answer a service for filing in an entire file" - ^ SimpleServiceEntry - provider: self - label: 'install into new change set' translatedNoop - selector: #fileIntoNewChangeSet: - description: 'install the decompressed contents of the file as a body of code in the image: create a new change set and file-in the selected file into it' translatedNoop - buttonLabel: 'install' translatedNoop! Item was removed: - ----- Method: GZipReadStream class>>services (in category 'fileIn/Out') ----- - services - - ^ Array - with: self serviceViewDecompress - with: self serviceDecompressToFile - ! Item was removed: - ----- Method: GZipReadStream class>>uncompressedFileName: (in category 'fileIn/Out') ----- - uncompressedFileName: fullName - ^((fullName endsWith: '.gz') and: [self confirm: ('{1} - appears to be a compressed file. - Do you want to uncompress it?' translated format:{fullName})]) - ifFalse: [fullName] - ifTrue:[self saveContents: fullName]! Item was removed: - ----- Method: GZipReadStream class>>unload (in category 'class initialization') ----- - unload - - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: GZipReadStream>>on:from:to: (in category 'initialize') ----- - on: aCollection from: firstIndex to: lastIndex - "Check the header of the GZIP stream." - | method magic flags length | - super on: aCollection from: firstIndex to: lastIndex. - crc := 16rFFFFFFFF. - magic := self nextBits: 16. - (magic = GZipMagic) - ifFalse:[^self error:'Not a GZipped stream']. - method := self nextBits: 8. - (method = GZipDeflated) - ifFalse:[^self error:'Bad compression method']. - flags := self nextBits: 8. - (flags anyMask: GZipEncryptFlag) - ifTrue:[^self error:'Cannot decompress encrypted stream']. - (flags anyMask: GZipReservedFlags) - ifTrue:[^self error:'Cannot decompress stream with unknown flags']. - "Ignore stamp, extra flags, OS type" - self nextBits: 16; nextBits: 16. "stamp" - self nextBits: 8. "extra flags" - self nextBits: 8. "OS type" - (flags anyMask: GZipContinueFlag) "Number of multi-part archive - ignored" - ifTrue:[self nextBits: 16]. - (flags anyMask: GZipExtraField) "Extra fields - ignored" - ifTrue:[ length := self nextBits: 16. - 1 to: length do:[:i| self nextBits: 8]]. - (flags anyMask: GZipNameFlag) "Original file name - ignored" - ifTrue:[[(self nextBits: 8) = 0] whileFalse]. - (flags anyMask: GZipCommentFlag) "Comment - ignored" - ifTrue:[[(self nextBits: 8) = 0] whileFalse]. - ! Item was removed: - ----- Method: GZipReadStream>>updateCrc:from:to:in: (in category 'crc') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - "Answer an updated CRC for the range of bytes in aCollection" - ^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection.! Item was removed: - ----- Method: GZipReadStream>>verifyCrc (in category 'crc') ----- - verifyCrc - | stored | - stored := 0. - 0 to: 24 by: 8 do: [ :i | - sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ]. - stored := stored + (self nextByte bitShift: i) ]. - stored := stored bitXor: 16rFFFFFFFF. - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. - ^stored! Item was removed: - Object subclass: #GZipSurrogateStream - instanceVariableNames: 'gZipStream zippedFileStream bufferStream positionThusFar' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! - - !GZipSurrogateStream commentStamp: 'nice 3/24/2010 07:36' prior: 0! - A pseudo stream that allows SmartRefStream to write directly to a gzipped file. There are some peculiarities of the project exporting process that require: - - 1. We ignore #close since the file is closed and may be reopened to continue writing. We implement #reallyClose for when we know that all writing is over. - - 2. We use a BitBlt to write WordArrayForSegment objects. Bit of a hack, but there it is. - - | fileStream wa | - - wa := WordArrayForSegment new: 30000. - 1 to: wa size do: [ :i | wa at: i put: i]. - fileStream := GZipSurrogateStream newFileNamed: 'xxx3.gz' inDirectory: FileDirectory default. - fileStream nextPutAll: 'this is a test'. - fileStream nextPutAll: wa. - fileStream reallyClose. - ! Item was removed: - ----- Method: GZipSurrogateStream class>>newFileNamed:inDirectory: (in category 'as yet unclassified') ----- - newFileNamed: fName inDirectory: aDirectory - - ^self new newFileNamed: fName inDirectory: aDirectory! Item was removed: - ----- Method: GZipSurrogateStream>>ascii (in category 'accessing') ----- - ascii - - self bufferStream ascii! Item was removed: - ----- Method: GZipSurrogateStream>>binary (in category 'accessing') ----- - binary - - self bufferStream binary! Item was removed: - ----- Method: GZipSurrogateStream>>bufferStream (in category 'private') ----- - bufferStream - - ^bufferStream ifNil: [bufferStream := RWBinaryOrTextStream on: (ByteArray new: 5000)]. - ! Item was removed: - ----- Method: GZipSurrogateStream>>close (in category 'open/close') ----- - close - - "we don't want to until user is really done" - - - ! Item was removed: - ----- Method: GZipSurrogateStream>>closed (in category 'open/close') ----- - closed - - ^false! Item was removed: - ----- Method: GZipSurrogateStream>>command: (in category 'writing') ----- - command: aString - "Overridden by HtmlFileStream to append commands directly without translation. 4/5/96 tk" - "We ignore any HTML commands. Do nothing"! Item was removed: - ----- Method: GZipSurrogateStream>>cr (in category 'writing') ----- - cr - - self bufferStream cr! Item was removed: - ----- Method: GZipSurrogateStream>>fileOutClass:andObject: (in category 'writing') ----- - fileOutClass: extraClass andObject: theObject - "Write a file that has both the source code for the named class and an object as bits. Any instance-specific object will get its class written automatically." - - | class srefStream | - - self timeStamp. - - extraClass ifNotNil: [ - class := extraClass. "A specific class the user wants written" - class sharedPools size > 0 ifTrue: [ - class shouldFileOutPools ifTrue: [class fileOutSharedPoolsOn: self] - ]. - class fileOutOn: self moveSource: false toFile: 0 - ]. - - "Append the object's raw data" - srefStream := SmartRefStream on: self. - srefStream nextPut: theObject. "and all subobjects" - srefStream close. "also closes me - well it thinks it does, anyway" - ! Item was removed: - ----- Method: GZipSurrogateStream>>flushBuffer (in category 'private') ----- - flushBuffer - - | data | - bufferStream ifNil: [^self]. - data := bufferStream contents asByteArray. - gZipStream nextPutAll: data. - positionThusFar := positionThusFar + data size. - bufferStream := nil. - ! Item was removed: - ----- Method: GZipSurrogateStream>>header (in category 'writing') ----- - header - - "ignore"! Item was removed: - ----- Method: GZipSurrogateStream>>newFileNamed:inDirectory: (in category 'private') ----- - newFileNamed: fName inDirectory: aDirectory - - positionThusFar := 0. - zippedFileStream := aDirectory newFileNamed: fName. - zippedFileStream binary; setFileTypeToObject. - "Type and Creator not to be text, so can be enclosed in an email" - gZipStream := GZipWriteStream on: zippedFileStream. - ! Item was removed: - ----- Method: GZipSurrogateStream>>next (in category 'reading') ----- - next - - ^self bufferStream next! Item was removed: - ----- Method: GZipSurrogateStream>>nextChunkPut: (in category 'writing') ----- - nextChunkPut: aString - - self bufferStream nextChunkPut: aString! Item was removed: - ----- Method: GZipSurrogateStream>>nextInt32Put: (in category 'writing') ----- - nextInt32Put: int32 - - ^self bufferStream nextInt32Put: int32 - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextNumber:put: (in category 'writing') ----- - nextNumber: n put: v - - ^self bufferStream nextNumber: n put: v - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextPut: (in category 'writing') ----- - nextPut: aByte - - ^self bufferStream nextPut: aByte - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextPutAll: (in category 'writing') ----- - nextPutAll: aString - - ^aString writeOnGZIPByteStream: self - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextPutAllBytes: (in category 'writing') ----- - nextPutAllBytes: aString - - ^self bufferStream nextPutAll: aString - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextPutAllWordArray: (in category 'writing') ----- - nextPutAllWordArray: aWordArray - - | ba hackwa hackba blt rowsAtATime sourceOrigin rowsRemaining | - - self flag: #bob. "do we need to be concerned by bytesPerElement??" - ba := nil. - rowsAtATime := 2000. "or 8000 bytes" - hackwa := Form new hackBits: aWordArray. - sourceOrigin := 0 at 0. - [(rowsRemaining := hackwa height - sourceOrigin y) > 0] whileTrue: [ - rowsAtATime := rowsAtATime min: rowsRemaining. - (ba isNil or: [ba size ~= (rowsAtATime * 4)]) ifTrue: [ - ba := ByteArray new: rowsAtATime * 4. - hackba := Form new hackBits: ba. - blt := (BitBlt toForm: hackba) sourceForm: hackwa. - ]. - blt - combinationRule: Form over; - sourceOrigin: sourceOrigin; - destX: 0 destY: 0 width: 4 height: rowsAtATime; - copyBits. - self bufferStream nextPutAll: ba. - self flushBuffer. - sourceOrigin := sourceOrigin x @ (sourceOrigin y + rowsAtATime). - ]. - ! Item was removed: - ----- Method: GZipSurrogateStream>>nextStringPut: (in category 'writing') ----- - nextStringPut: s - "Append the string, s, to the receiver. Only used by DataStream. Max size of 64*256*256*256." - - | length | - (length := s size) < 192 - ifTrue: [self nextPut: length] - ifFalse: - [self nextPut: (length digitAt: 4)+192. - self nextPut: (length digitAt: 3). - self nextPut: (length digitAt: 2). - self nextPut: (length digitAt: 1)]. - self nextPutAll: s. - ^s! Item was removed: - ----- Method: GZipSurrogateStream>>nextWordsPutAll: (in category 'writing') ----- - nextWordsPutAll: aCollection - "Write the argument a word-like object in big endian format on the receiver. - May be used to write other than plain word-like objects (such as ColorArray)." - ^self nextPutAllWordArray: aCollection! Item was removed: - ----- Method: GZipSurrogateStream>>originalContents (in category 'reading') ----- - originalContents - - ^'' "used only to determine if we are byte-structured"! Item was removed: - ----- Method: GZipSurrogateStream>>padToEndWith: (in category 'writing') ----- - padToEndWith: aChar - "We don't have pages, so we are at the end, and don't need to pad."! Item was removed: - ----- Method: GZipSurrogateStream>>position (in category 'positionning') ----- - position - - ^self bufferStream position + positionThusFar! Item was removed: - ----- Method: GZipSurrogateStream>>reallyClose (in category 'open/close') ----- - reallyClose - - self flushBuffer. - gZipStream close. - ! Item was removed: - ----- Method: GZipSurrogateStream>>reopen (in category 'open/close') ----- - reopen - - "ignore"! Item was removed: - ----- Method: GZipSurrogateStream>>setFileTypeToObject (in category 'properties-setting') ----- - setFileTypeToObject - - "ignore"! Item was removed: - ----- Method: GZipSurrogateStream>>setToEnd (in category 'positionning') ----- - setToEnd - - "ignore"! Item was removed: - ----- Method: GZipSurrogateStream>>skip: (in category 'positionning') ----- - skip: aNumber - - ^self bufferStream skip: aNumber - ! Item was removed: - ----- Method: GZipSurrogateStream>>timeStamp (in category 'writing') ----- - timeStamp - "Append the current time to the receiver as a String." - self bufferStream nextChunkPut: "double string quotes and !!s" - (String streamContents: [:s | Smalltalk timeStamp: s]) printString. - self bufferStream cr! Item was removed: - ----- Method: GZipSurrogateStream>>trailer (in category 'writing') ----- - trailer - - "ignore"! Item was removed: - ZipWriteStream subclass: #GZipWriteStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: 'GZipConstants' - category: 'Compression-Streams'! Item was removed: - ----- Method: GZipWriteStream class>>compressFile: (in category 'file list services') ----- - compressFile: fileName - "Create a compressed file from the file of the given name" - - (FileStream readOnlyFileNamed: fileName) compressFile! Item was removed: - ----- Method: GZipWriteStream class>>fileReaderServicesForFile:suffix: (in category 'file list services') ----- - fileReaderServicesForFile: fullName suffix: suffix - "Don't offer to compress already-compressed files - sjc 3-May 2003-added jpeg extension" - - ^({ 'gz' . 'sar' . 'zip' . 'gif' . 'jpg' . 'jpeg'. 'pr'. 'png'} includes: suffix) - ifTrue: [ #() ] - ifFalse: [ self services ] - ! Item was removed: - ----- Method: GZipWriteStream class>>initialize (in category 'class initialization') ----- - initialize - FileServices registerFileReader: self! Item was removed: - ----- Method: GZipWriteStream class>>serviceCompressFile (in category 'file list services') ----- - serviceCompressFile - - ^ FileModifyingSimpleServiceEntry - provider: self - label: 'compress file' translatedNoop - selector: #compressFile: - description: 'compress file using gzip compression, making a new file' translatedNoop! Item was removed: - ----- Method: GZipWriteStream class>>services (in category 'file list services') ----- - services - ^ { self serviceCompressFile }! Item was removed: - ----- Method: GZipWriteStream class>>unload (in category 'class initialization') ----- - unload - FileServices unregisterFileReader: self! Item was removed: - ----- Method: GZipWriteStream>>writeFooter (in category 'initialize-release') ----- - writeFooter - "Write some footer information for the crc" - super writeFooter. - 0 to: 3 do:[:i| encoder nextBytePut: (crc >> (i*8) bitAnd: 255)]. - 0 to: 3 do:[:i| encoder nextBytePut: (bytesWritten >> (i*8) bitAnd: 255)].! Item was removed: - ----- Method: GZipWriteStream>>writeHeader (in category 'initialize-release') ----- - writeHeader - "Write the GZip header" - encoder nextBits: 16 put: GZipMagic. - encoder nextBits: 8 put: GZipDeflated. - encoder nextBits: 8 put: 0. "No flags" - encoder nextBits: 32 put: 0. "no time stamp" - encoder nextBits: 8 put: 0. "No extra flags" - encoder nextBits: 8 put: 0. "No OS type" - ! Item was removed: - ReadStream subclass: #InflateStream - instanceVariableNames: 'state bitBuf bitPos source sourcePos sourceLimit litTable distTable sourceStream crc' - classVariableNames: 'BlockProceedBit BlockTypes FixedDistCodes FixedLitCodes MaxBits StateNewBlock StateNoMoreData' - poolDictionaries: '' - category: 'Compression-Streams'! - - !InflateStream commentStamp: 'nice 3/24/2010 07:37' prior: 0! - This class implements the Inflate decompression algorithm as defined by RFC1951 and used in PKZip, GZip and ZLib (and many, many more). It is a variant of the LZ77 compression algorithm described in - - [LZ77] Ziv J., Lempel A., "A Universal Algorithm for Sequential Data Compression", IEEE Transactions on Information Theory", Vol. 23, No. 3, pp. 337-343. - - [RFC1951] Deutsch. P, "DEFLATE Compressed Data Format Specification version 1.3" - - For more information see the above mentioned RFC 1951 which can for instance be found at - - http://www.leo.org/pub/comp/doc/standards/rfc/index.html - - Huffman Tree Implementation Notes: - =========================================== - The huffman tree used for decoding literal, distance and length codes in the inflate algorithm has been encoded in a single Array. The tree is made up of subsequent tables storing all entries at the current bit depth. Each entry in the table (e.g., a 32bit Integer value) is either a leaf or a non-leaf node. Leaf nodes store the immediate value in its low 16 bits whereas non-leaf nodes store the offset of the subtable in its low 16bits. The high 8 bits of non-leaf nodes contain the number of additional bits needed for the sub table (the high 8 bits of leaf-nodes are always zero). The first entry in each table is always a non-leaf node indicating how many bits we need to fetch initially. We can thus travel down the tree as follows (written in sort-of-pseudocode the actual implementation can be seen in InflateStream>>decodeValueFrom:): - - table := initialTable. - bitsNeeded := high 8 bits of (table at: 1). "Determine initial bits" - table := initialTable + (low 16 bits of (table at: 1)). "Determine start of first real table" - [bits := fetch next bitsNeeded bits. "Grab the bits" - value := table at: bits. "Lookup the value" - value has high 8 bit set] whileTrue:[ "Check if it's leaf" - table := initialTable + (low 16 bits of value). "No - compute new sub table start" - bitsNeeded := high 8 bit of value]. "Compute additional number of bits needed" - ^value - ! Item was removed: - ----- Method: InflateStream class>>initialize (in category 'class initialization') ----- - initialize - "InflateStream initialize" - MaxBits := 16. - StateNewBlock := 0. - StateNoMoreData := 1. - BlockProceedBit := 8. - BlockTypes := #( processStoredBlock "New block in stored format" - processFixedBlock "New block with fixed huffman tables" - processDynamicBlock "New block with dynamic huffman tables" - errorBadBlock "Bad block format" - proceedStoredBlock "Continue block in stored format" - proceedFixedBlock "Continue block in fixed format" - proceedDynamicBlock "Continue block in dynamic format" - errorBadBlock "Bad block format"). - "Initialize fixed block values" - FixedLitCodes := ((1 to: 144) collect:[:i| 8]), - ((145 to: 256) collect:[:i| 9]), - ((257 to: 280) collect:[:i| 7]), - ((281 to: 288) collect:[:i| 8]). - FixedDistCodes := ((1 to: 32) collect:[:i| 5]).! Item was removed: - ----- Method: InflateStream>>atEnd (in category 'testing') ----- - atEnd - "Note: It is possible that we have a few bits left, - representing just the EOB marker. To check for - this we must force decompression of the next - block if at end of data." - super atEnd ifFalse:[^false]. "Primitive test" - (position >= readLimit and:[state = StateNoMoreData]) ifTrue:[^true]. - "Force decompression, by calling #next. Since #moveContentsToFront - will never move data to the beginning of the buffer it is safe to - skip back the read position afterwards" - self next == nil ifTrue:[^true]. - position := position - 1. - ^false! Item was removed: - ----- Method: InflateStream>>bitPosition (in category 'bit access') ----- - bitPosition - "Return the current bit position of the source" - sourceStream == nil - ifTrue:[^sourcePos * 8 + bitPos] - ifFalse:[^sourceStream position + sourcePos * 8 + bitPos]! Item was removed: - ----- Method: InflateStream>>close (in category 'accessing') ----- - close - sourceStream ifNotNil:[sourceStream close].! Item was removed: - ----- Method: InflateStream>>computeHuffmanValues:counts:from:to: (in category 'huffman trees') ----- - computeHuffmanValues: aCollection counts: counts from: minBits to: maxBits - "Assign numerical values to all codes. - Note: The values are stored according to the bit length" - | offsets values baseOffset codeLength | - offsets := Array new: maxBits. - offsets atAllPut: 0. - baseOffset := 1. - minBits to: maxBits do:[:bits| - offsets at: bits put: baseOffset. - baseOffset := baseOffset + (counts at: bits+1)]. - values := WordArray new: aCollection size. - 1 to: aCollection size do:[:i| - codeLength := aCollection at: i. - codeLength > 0 ifTrue:[ - baseOffset := offsets at: codeLength. - values at: baseOffset put: i-1. - offsets at: codeLength put: baseOffset + 1]]. - ^values! Item was removed: - ----- Method: InflateStream>>contents (in category 'accessing') ----- - contents - - ^ self upToEnd! Item was removed: - ----- Method: InflateStream>>crcError: (in category 'crc') ----- - crcError: aString - ^CRCError signal: aString! Item was removed: - ----- Method: InflateStream>>createHuffmanTables:counts:from:to: (in category 'huffman trees') ----- - createHuffmanTables: values counts: counts from: minBits to: maxBits - "Create the actual tables" - | table tableStart tableSize tableEnd - valueIndex tableStack numValues deltaBits maxEntries - lastTable lastTableStart tableIndex lastTableIndex | - - table := WordArray new: ((4 bitShift: minBits) max: 16). - - "Create the first entry - this is a dummy. - It gives us information about how many bits to fetch initially." - table at: 1 put: (minBits bitShift: 24) + 2. "First actual table starts at index 2" - - "Create the first table from scratch." - tableStart := 2. "See above" - tableSize := 1 bitShift: minBits. - tableEnd := tableStart + tableSize. - "Store the terminal symbols" - valueIndex := (counts at: minBits+1). - tableIndex := 0. - 1 to: valueIndex do:[:i| - table at: tableStart + tableIndex put: (values at: i). - tableIndex := self increment: tableIndex bits: minBits]. - "Fill up remaining entries with invalid entries" - tableStack := OrderedCollection new: 10. "Should be more than enough" - tableStack addLast: - (Array - with: minBits "Number of bits (e.g., depth) for this table" - with: tableStart "Start of table" - with: tableIndex "Next index in table" - with: minBits "Number of delta bits encoded in table" - with: tableSize - valueIndex "Entries remaining in table"). - "Go to next value index" - valueIndex := valueIndex + 1. - "Walk over remaining bit lengths and create new subtables" - minBits+1 to: maxBits do:[:bits| - numValues := counts at: bits+1. - [numValues > 0] whileTrue:["Create a new subtable" - lastTable := tableStack last. - lastTableStart := lastTable at: 2. - lastTableIndex := lastTable at: 3. - deltaBits := bits - (lastTable at: 1). - "Make up a table of deltaBits size" - tableSize := 1 bitShift: deltaBits. - tableStart := tableEnd. - tableEnd := tableEnd + tableSize. - [tableEnd > table size ] - whileTrue:[table := self growHuffmanTable: table]. - "Connect to last table" - self assert:[(table at: lastTableStart + lastTableIndex) = 0]."Entry must be unused" - table at: lastTableStart + lastTableIndex put: (deltaBits bitShift: 24) + tableStart. - lastTable at: 3 put: (self increment: lastTableIndex bits: (lastTable at: 4)). - lastTable at: 5 put: (lastTable at: 5) - 1. - self assert:[(lastTable at: 5) >= 0]. "Don't exceed tableSize" - "Store terminal values" - maxEntries := numValues min: tableSize. - tableIndex := 0. - 1 to: maxEntries do:[:i| - table at: tableStart + tableIndex put: (values at: valueIndex). - valueIndex := valueIndex + 1. - numValues := numValues - 1. - tableIndex := self increment: tableIndex bits: deltaBits]. - "Check if we have filled up the current table completely" - maxEntries = tableSize ifTrue:[ - "Table has been filled. Back up to the last table with space left." - [tableStack isEmpty not and:[(tableStack last at: 5) = 0]] - whileTrue:[tableStack removeLast]. - ] ifFalse:[ - "Table not yet filled. Put it back on the stack." - tableStack addLast: - (Array - with: bits "Nr. of bits in this table" - with: tableStart "Start of table" - with: tableIndex "Index in table" - with: deltaBits "delta bits of table" - with: tableSize - maxEntries "Unused entries in table"). - ]. - ]. - ]. - ^table copyFrom: 1 to: tableEnd-1! Item was removed: - ----- Method: InflateStream>>decodeDynamicTable:from: (in category 'huffman trees') ----- - decodeDynamicTable: nItems from: aHuffmanTable - "Decode the code length of the literal/length and distance table - in a block compressed with dynamic huffman trees" - | values index value repCount theValue | - values := Array new: nItems. - index := 1. - theValue := 0. - [index <= nItems] whileTrue:[ - value := self decodeValueFrom: aHuffmanTable. - value < 16 ifTrue:[ - "Immediate values" - theValue := value. - values at: index put: value. - index := index+1. - ] ifFalse:[ - "Repeated values" - value = 16 ifTrue:[ - "Repeat last value" - repCount := (self nextBits: 2) + 3. - ] ifFalse:[ - "Repeat zero value" - theValue := 0. - value = 17 - ifTrue:[repCount := (self nextBits: 3) + 3] - ifFalse:[value = 18 - ifTrue:[repCount := (self nextBits: 7) + 11] - ifFalse:[^self error:'Invalid bits tree value']]]. - 0 to: repCount-1 do:[:i| values at: index+i put: theValue]. - index := index + repCount]. - ]. - ^values! Item was removed: - ----- Method: InflateStream>>decodeValueFrom: (in category 'inflating') ----- - decodeValueFrom: table - "Decode the next value in the receiver using the given huffman table." - | bits bitsNeeded tableIndex value | - bitsNeeded := (table at: 1) bitShift: -24. "Initial bits needed" - tableIndex := 2. "First real table" - [bits := self nextSingleBits: bitsNeeded. "Get bits" - value := table at: (tableIndex + bits). "Lookup entry in table" - (value bitAnd: 16r3F000000) = 0] "Check if it is a non-leaf node" - whileFalse:["Fetch sub table" - tableIndex := value bitAnd: 16rFFFF. "Table offset in low 16 bit" - bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit" - bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']]. - ^value! Item was removed: - ----- Method: InflateStream>>decompressAll (in category 'private') ----- - decompressAll - "Profile the decompression speed" - [self atEnd] whileFalse:[ - position := readLimit. - self next "Provokes decompression" - ].! Item was removed: - ----- Method: InflateStream>>decompressBlock:with: (in category 'inflating') ----- - decompressBlock: llTable with: dTable - "Process the compressed data in the block. - llTable is the huffman table for literal/length codes - and dTable is the huffman table for distance codes." - | value extra length distance oldPos oldBits oldBitPos | - [readLimit < collection size and:[sourcePos <= sourceLimit]] whileTrue:[ - "Back up stuff if we're running out of space" - oldBits := bitBuf. - oldBitPos := bitPos. - oldPos := sourcePos. - value := self decodeValueFrom: llTable. - value < 256 ifTrue:[ "A literal" - collection byteAt: (readLimit := readLimit + 1) put: value. - ] ifFalse:["length/distance or end of block" - value = 256 ifTrue:["End of block" - state := state bitAnd: StateNoMoreData. - ^self]. - "Compute the actual length value (including possible extra bits)" - extra := #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0) at: value - 256. - length := #(3 4 5 6 7 8 9 10 11 13 15 17 19 23 27 31 35 43 51 59 67 83 99 115 131 163 195 227 258) at: value - 256. - extra > 0 ifTrue:[length := length + (self nextBits: extra)]. - "Compute the distance value" - value := self decodeValueFrom: dTable. - extra := #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13) at: value+1. - distance := #(1 2 3 4 5 7 9 13 17 25 33 49 65 97 129 193 257 385 513 769 - 1025 1537 2049 3073 4097 6145 8193 12289 16385 24577) at: value+1. - extra > 0 ifTrue:[distance := distance + (self nextBits: extra)]. - (readLimit + length >= collection size) ifTrue:[ - bitBuf := oldBits. - bitPos := oldBitPos. - sourcePos := oldPos. - ^self]. - collection - replaceFrom: readLimit+1 - to: readLimit + length - with: collection - startingAt: readLimit - distance + 1. - readLimit := readLimit + length. - ]. - ].! Item was removed: - ----- Method: InflateStream>>distanceMap (in category 'huffman trees') ----- - distanceMap - "This is used by the fast decompressor" - ^nil! Item was removed: - ----- Method: InflateStream>>getFirstBuffer (in category 'private') ----- - getFirstBuffer - "Get the first source buffer after initialization has been done" - sourceStream == nil ifTrue:[^self]. - source := sourceStream next: 1 << 16. "This is more than enough..." - sourceLimit := source size.! Item was removed: - ----- Method: InflateStream>>getNextBlock (in category 'private') ----- - getNextBlock - ^self nextBits: 3! Item was removed: - ----- Method: InflateStream>>growHuffmanTable: (in category 'huffman trees') ----- - growHuffmanTable: table - | newTable | - newTable := table species new: table size * 2. - newTable replaceFrom: 1 to: table size with: table startingAt: 1. - ^newTable! Item was removed: - ----- Method: InflateStream>>huffmanTableFrom:mappedBy: (in category 'huffman trees') ----- - huffmanTableFrom: aCollection mappedBy: valueMap - "Create a new huffman table from the given code lengths. - Map the actual values by valueMap if it is given. - See the class comment for a documentation of the huffman - tables used in this decompressor." - | counts values table minBits maxBits | - minBits := MaxBits + 1. - maxBits := 0. - "Count the occurences of each code length and compute minBits and maxBits" - counts := Array new: MaxBits+1. - counts atAllPut: 0. - aCollection do:[:length| - length > 0 ifTrue:[ - length < minBits ifTrue:[minBits := length]. - length > maxBits ifTrue:[maxBits := length]. - counts at: length+1 put: (counts at: length+1)+1]]. - maxBits = 0 ifTrue:[^nil]. "Empty huffman table" - - "Assign numerical values to all codes." - values := self computeHuffmanValues: aCollection counts: counts from: minBits to: maxBits. - - "Map the values if requested" - self mapValues: values by: valueMap. - - "Create the actual tables" - table := self createHuffmanTables: values counts: counts from: minBits to: maxBits. - - ^table! Item was removed: - ----- Method: InflateStream>>increment:bits: (in category 'huffman trees') ----- - increment: value bits: nBits - "Increment a value of nBits length. - The fast decompressor will do this differently" - ^value+1! Item was removed: - ----- Method: InflateStream>>literalLengthMap (in category 'huffman trees') ----- - literalLengthMap - "This is used by the fast decompressor" - ^nil! Item was removed: - ----- Method: InflateStream>>mapValues:by: (in category 'huffman trees') ----- - mapValues: values by: valueMap - | oldValue | - valueMap ifNil:[^values]. - 1 to: values size do:[:i| - oldValue := values at: i. - "Note: there may be nil values if not all values are used" - oldValue isNil - ifTrue:[^values] - ifFalse:[values at: i put: (valueMap at: oldValue+1)]]. - ! Item was removed: - ----- Method: InflateStream>>moveContentsToFront (in category 'private') ----- - moveContentsToFront - "Move the decoded contents of the receiver to the front so that we have enough space for decoding more data." - | delta | - readLimit > 32768 ifTrue:[ - delta := readLimit - 32767. - collection - replaceFrom: 1 - to: collection size - delta + 1 - with: collection - startingAt: delta. - position := position - delta + 1. - readLimit := readLimit - delta + 1].! Item was removed: - ----- Method: InflateStream>>moveSourceToFront (in category 'private') ----- - moveSourceToFront - "Move the encoded contents of the receiver to the front so that we have enough space for decoding more data." - (sourceStream == nil or:[sourceStream atEnd]) ifTrue:[^self]. - sourcePos > 10000 ifTrue:[ - source - replaceFrom: 1 - to: source size - sourcePos - with: source - startingAt: sourcePos + 1. - source := sourceStream - next: sourcePos - into: source - startingAt: source size - sourcePos + 1. - sourcePos := 0. - sourceLimit := source size].! Item was removed: - ----- Method: InflateStream>>next (in category 'accessing') ----- - next - "Answer the next decompressed object in the Stream represented by the - receiver." - - <primitive: 65> - position >= readLimit - ifTrue: [^self pastEndRead] - ifFalse: [^collection at: (position := position + 1)]! Item was removed: - ----- Method: InflateStream>>next: (in category 'accessing') ----- - next: anInteger - "Answer the next anInteger elements of my collection. overriden for simplicity" - | newArray | - - "try to do it the fast way" - position + anInteger < readLimit ifTrue: [ - newArray := collection copyFrom: position + 1 to: position + anInteger. - position := position + anInteger. - ^newArray - ]. - - "oh, well..." - newArray := collection species new: anInteger. - 1 to: anInteger do: [:index | newArray at: index put: (self next ifNil: [ ^newArray copyFrom: 1 to: index - 1]) ]. - ^newArray! Item was removed: - ----- Method: InflateStream>>next:into:startingAt: (in category 'accessing') ----- - next: n into: buffer startingAt: startIndex - "Read n objects into the given collection. - Return aCollection or a partial copy if less than - n elements have been read." - | c numRead count | - n = 0 ifTrue: [ ^buffer ]. - numRead := 0. - ["Force decompression if necessary" - (c := self next) == nil - ifTrue:[^buffer copyFrom: 1 to: startIndex+numRead-1]. - "Store the first value which provoked decompression" - buffer at: startIndex + numRead put: c. - numRead := numRead + 1. - "After collection has been filled copy as many objects as possible" - count := (readLimit - position) min: (n - numRead). - buffer - replaceFrom: startIndex + numRead - to: startIndex + numRead + count - 1 - with: collection - startingAt: position+1. - position := position + count. - numRead := numRead + count. - numRead = n] whileFalse. - ^buffer! Item was removed: - ----- Method: InflateStream>>nextBits: (in category 'bit access') ----- - nextBits: n - | bits | - [bitPos < n] whileTrue:[ - bitBuf := bitBuf + (self nextByte bitShift: bitPos). - bitPos := bitPos + 8]. - bits := bitBuf bitAnd: (1 bitShift: n)-1. - bitBuf := bitBuf bitShift: 0 - n. - bitPos := bitPos - n. - ^bits! Item was removed: - ----- Method: InflateStream>>nextByte (in category 'bit access') ----- - nextByte - ^source byteAt: (sourcePos := sourcePos + 1)! Item was removed: - ----- Method: InflateStream>>nextSingleBits: (in category 'bit access') ----- - nextSingleBits: n - | out | - out := 0. - 1 to: n do:[:i| out := (out bitShift: 1) + (self nextBits: 1)]. - ^out! Item was removed: - ----- Method: InflateStream>>on: (in category 'initialize') ----- - on: aCollectionOrStream - aCollectionOrStream isStream - ifTrue:[ aCollectionOrStream binary. - sourceStream := aCollectionOrStream. - self getFirstBuffer] - ifFalse:[source := aCollectionOrStream]. - ^self on: source from: 1 to: source size.! Item was removed: - ----- Method: InflateStream>>on:from:to: (in category 'initialize') ----- - 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 := aCollection species new: 1 << 16. - readLimit := 0. "Not yet initialized" - position := 0. - source := aCollection. - sourceLimit := lastIndex. - sourcePos := firstIndex-1. - state := StateNewBlock.! Item was removed: - ----- Method: InflateStream>>pastEndRead (in category 'private') ----- - pastEndRead - "A client has attempted to read beyond the read limit. - Check in what state we currently are and perform - the appropriate action" - | blockType bp oldLimit | - state = StateNoMoreData ifTrue:[^nil]. "Get out early if possible" - "Check if we can move decoded data to front" - self moveContentsToFront. - "Check if we can fetch more source data" - self moveSourceToFront. - state = StateNewBlock ifTrue:[state := self getNextBlock]. - blockType := state bitShift: -1. - bp := self bitPosition. - oldLimit := readLimit. - self perform: (BlockTypes at: blockType+1). - "Note: if bit position hasn't advanced then nothing has been decoded." - bp = self bitPosition - ifTrue:[^self primitiveFailed]. - "Update crc for the decoded contents" - readLimit > oldLimit - ifTrue:[crc := self updateCrc: crc from: oldLimit+1 to: readLimit in: collection]. - state = StateNoMoreData ifTrue:[self verifyCrc]. - ^self next! Item was removed: - ----- Method: InflateStream>>proceedDynamicBlock (in category 'inflating') ----- - proceedDynamicBlock - self decompressBlock: litTable with: distTable! Item was removed: - ----- Method: InflateStream>>proceedFixedBlock (in category 'inflating') ----- - proceedFixedBlock - self decompressBlock: litTable with: distTable! Item was removed: - ----- Method: InflateStream>>proceedStoredBlock (in category 'inflating') ----- - proceedStoredBlock - "Proceed decompressing a stored (e.g., uncompressed) block" - | length decoded | - "Literal table must be nil for a stored block" - litTable == nil ifFalse:[^self error:'Bad state']. - length := distTable. - [length > 0 and:[readLimit < collection size and:[sourcePos < sourceLimit]]] - whileTrue:[ - collection at: (readLimit := readLimit + 1) put: - (source at: (sourcePos := sourcePos + 1)). - length := length - 1]. - length = 0 ifTrue:[state := state bitAnd: StateNoMoreData]. - decoded := length - distTable. - distTable := length. - ^decoded! Item was removed: - ----- Method: InflateStream>>processDynamicBlock (in category 'inflating') ----- - processDynamicBlock - | nLit nDist nLen codeLength lengthTable bits | - nLit := (self nextBits: 5) + 257. - nDist := (self nextBits: 5) + 1. - nLen := (self nextBits: 4) + 4. - codeLength := Array new: 19. - codeLength atAllPut: 0. - 1 to: nLen do:[:i| - bits := #(16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15) at: i. - codeLength at: bits+1 put: (self nextBits: 3). - ]. - lengthTable := self huffmanTableFrom: codeLength mappedBy: nil. - "RFC 1951: In other words, all code lengths form a single sequence..." - codeLength := self decodeDynamicTable: nLit+nDist from: lengthTable. - litTable := self - huffmanTableFrom: (codeLength copyFrom: 1 to: nLit) - mappedBy: self literalLengthMap. - distTable := self - huffmanTableFrom: (codeLength copyFrom: nLit+1 to: codeLength size) - mappedBy: self distanceMap. - state := state bitOr: BlockProceedBit. - self proceedDynamicBlock.! Item was removed: - ----- Method: InflateStream>>processFixedBlock (in category 'inflating') ----- - processFixedBlock - litTable := self - huffmanTableFrom: FixedLitCodes - mappedBy: self literalLengthMap. - distTable := self - huffmanTableFrom: FixedDistCodes - mappedBy: self distanceMap. - state := state bitOr: BlockProceedBit. - self proceedFixedBlock.! Item was removed: - ----- Method: InflateStream>>processStoredBlock (in category 'inflating') ----- - processStoredBlock - | chkSum length | - "Skip to byte boundary" - self nextBits: (bitPos bitAnd: 7). - length := self nextBits: 16. - chkSum := self nextBits: 16. - (chkSum bitXor: 16rFFFF) = length - ifFalse:[^self error:'Bad block length']. - litTable := nil. - distTable := length. - state := state bitOr: BlockProceedBit. - ^self proceedStoredBlock! Item was removed: - ----- Method: InflateStream>>readInto:startingAt:count: (in category 'accessing') ----- - readInto: buffer startingAt: startIndex count: n - "Read n objects into the given collection. - Return number of elements that have been read." - | c numRead count | - n = 0 ifTrue: [ ^n ]. - numRead := 0. - ["Force decompression if necessary" - (c := self next) == nil - ifTrue: [^numRead]. - "Store the first value which provoked decompression" - buffer at: startIndex + numRead put: c. - numRead := numRead + 1. - "After collection has been filled copy as many objects as possible" - count := (readLimit - position) min: (n - numRead). - buffer - replaceFrom: startIndex + numRead - to: startIndex + numRead + count - 1 - with: collection - startingAt: position+1. - position := position + count. - numRead := numRead + count. - numRead = n] whileFalse. - ^n! Item was removed: - ----- Method: InflateStream>>reset (in category 'initialize') ----- - reset - "Position zero - nothing decoded yet" - position := readLimit := 0. - sourcePos := 0. - bitBuf := bitPos := 0. - state := 0.! Item was removed: - ----- Method: InflateStream>>size (in category 'accessing') ----- - size - "This is a compressed stream - we don't know the size beforehand" - ^self shouldNotImplement! Item was removed: - ----- Method: InflateStream>>sourceLimit (in category 'accessing') ----- - sourceLimit - ^sourceLimit! Item was removed: - ----- Method: InflateStream>>sourcePosition (in category 'accessing') ----- - sourcePosition - ^sourcePos! Item was removed: - ----- Method: InflateStream>>sourceStream (in category 'accessing') ----- - sourceStream - ^sourceStream! Item was removed: - ----- Method: InflateStream>>upTo: (in category 'accessing') ----- - upTo: anObject - "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) = anObject]] - whileFalse: [newStream nextPut: element]. - ^newStream contents! Item was removed: - ----- Method: InflateStream>>upToAnyOf:do: (in category 'accessing') ----- - upToAnyOf: subcollection do: aBlock - "re-implement super super again... - This is a strong indicator that ReadStream SHOULD be abstract" - - ^self collectionSpecies new: 1000 streamContents: [ :stream | - | ch | - [ self atEnd or: [ (subcollection includes: (ch := self next)) and: [aBlock value: ch. true] ] ] - whileFalse: [ stream nextPut: ch ] ]! Item was removed: - ----- Method: InflateStream>>upToEnd (in category 'accessing') ----- - upToEnd - "Answer a subcollection from the current access position through the last element of the receiver." - - | newStream buffer | - buffer := collection species new: 1000. - newStream := WriteStream on: (collection species new: 100). - [self atEnd] whileFalse: [newStream nextPutAll: (self nextInto: buffer)]. - ^ newStream contents! Item was removed: - ----- Method: InflateStream>>updateCrc:from:to:in: (in category 'crc') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - "Answer an updated CRC for the range of bytes in aCollection. - Subclasses can implement the appropriate means for the check sum they wish to use." - ^oldCrc! Item was removed: - ----- Method: InflateStream>>verifyCrc (in category 'crc') ----- - verifyCrc - "Verify the crc checksum in the input"! Item was removed: - ----- Method: PositionableStream>>asZLibReadStream (in category '*Compression-Archives') ----- - asZLibReadStream - ^ZLibReadStream on: collection from: position+1 to: readLimit! Item was removed: - ----- Method: ReadWriteStream>>asUnZippedStream (in category '*Compression-Streams') ----- - asUnZippedStream - | isGZip outputStream first strm archive which | - "Decompress this file if needed, and return a stream. No file is written. File extension may be .gz or anything else. Also works on archives (.zip, .gZip)." - - strm := self binary. - strm isZipArchive ifTrue: [ - archive := ZipArchive new readFrom: strm. - which := archive members detect: [:any | any fileName asLowercase endsWith: '.ttf'] - ifNone: [nil]. - which ifNil: [archive close. - ^ self error: 'Can''t find .ttf file in archive']. - strm := which contentStream. - archive close]. - - first := strm next. - isGZip := (strm next * 256 + first) = (GZipConstants gzipMagic). - strm skip: -2. - isGZip - ifTrue: [outputStream := (MultiByteBinaryOrTextStream with: - (GZipReadStream on: strm) upToEnd) reset. - strm close] - ifFalse: [outputStream := strm]. - ^ outputStream! Item was removed: - ----- Method: ReadWriteStream>>isZipArchive (in category '*Compression-Archives') ----- - isZipArchive - "Determine if this appears to be a valid Zip archive" - | sig | - self binary. - sig := self next: 4. - self position: self position - 4. "rewind" - ^ZipArchive validSignatures includes: sig! Item was removed: - ----- Method: StandardFileStream>>compressFile (in category '*Compression-Streams') ----- - compressFile - "Write a new file that has the data in me compressed in GZip format." - | zipped buffer | - - self readOnly; binary. - zipped := self directory newFileNamed: (self name, FileDirectory dot, 'gz'). - zipped binary; setFileTypeToObject. - "Type and Creator not to be text, so can be enclosed in an email" - zipped := GZipWriteStream on: zipped. - buffer := ByteArray new: 50000. - 'Compressing ', self fullName - displayProgressFrom: 0 to: self size - during: [:bar | - [self atEnd] whileFalse: [ - bar value: self position. - zipped nextPutAll: (self nextInto: buffer)]. - zipped close. - self close]. - ^zipped! Item was removed: - ----- Method: String>>unzipped (in category '*Compression-Streams') ----- - unzipped - ^self isByteString - ifTrue: [self asByteArray unzipped asString] - ifFalse: [self asByteArray unzipped asWideString]! Item was removed: - ----- Method: String>>zipped (in category '*Compression-Streams') ----- - zipped - "This sounds questionnable for WideString but works - even if zipped size is not a multiple of 4" - | zipped | - zipped := self asByteArray zipped. - self isByteString ifTrue: [^zipped asString]. - zipped size \\ 4 = 0 ifTrue: [^zipped asWideString]. - ^(zipped , (ByteArray new: 4 - (zipped size \\ 4))) asWideString! Item was removed: - Archive subclass: #TarArchive - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !TarArchive commentStamp: '<historical>' prior: 0! - This is a kind of archive that uses the TAR format (popular in Unix). It is here as a placeholder.! Item was removed: - ----- Method: TarArchive>>memberClass (in category 'private') ----- - memberClass - ^TarArchiveMember! Item was removed: - ArchiveMember subclass: #TarArchiveMember - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! Item was removed: - FastInflateStream subclass: #ZLibReadStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! Item was removed: - ----- Method: ZLibReadStream>>on:from:to: (in category 'initialize') ----- - on: aCollection from: firstIndex to: lastIndex - "Check the header of the ZLib stream." - | method byte | - super on: aCollection from: firstIndex to: lastIndex. - crc := 1. - method := self nextBits: 8. - (method bitAnd: 15) = 8 ifFalse:[^self error:'Unknown compression method']. - (method bitShift: -4) + 8 > 15 ifTrue:[^self error:'Invalid window size']. - byte := self nextBits: 8. - (method bitShift: 8) + byte \\ 31 = 0 ifFalse:[^self error:'Incorrect header']. - (byte anyMask: 32) ifTrue:[^self error:'Need preset dictionary']. - ! Item was removed: - ----- Method: ZLibReadStream>>updateCrc:from:to:in: (in category 'crc') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - "Answer an updated CRC for the range of bytes in aCollection" - ^ZLibWriteStream updateAdler32: oldCrc from: start to: stop in: aCollection.! Item was removed: - ----- Method: ZLibReadStream>>verifyCrc (in category 'crc') ----- - verifyCrc - | stored | - stored := 0. - 24 to: 0 by: -8 do: [ :i | - sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ]. - stored := stored + (self nextByte bitShift: i) ]. - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. - ^stored! Item was removed: - ZipWriteStream subclass: #ZLibWriteStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! Item was removed: - ----- Method: ZLibWriteStream class>>updateAdler32:from:to:in: (in category 'crc') ----- - updateAdler32: adler from: start to: stop in: aCollection - "Update crc using the Adler32 checksum technique from RFC1950" - " - unsigned long s1 = adler & 0xffff; - unsigned long s2 = (adler >> 16) & 0xffff; - int n; - - for (n = 0; n < len; n++) { - s1 = (s1 + buf[n]) % BASE; - s2 = (s2 + s1) % BASE; - } - return (s2 << 16) + s1; - " - | s1 s2 | - <primitive: 'primitiveUpdateAdler32' module: 'ZipPlugin'> - s1 := adler bitAnd: 16rFFFF. - s2 := (adler bitShift: -16) bitAnd: 16rFFFF. - start to: stop do: [ :n | | b | - b := aCollection byteAt: n. - s1 := (s1 + b) \\ 65521. - s2 := (s2 + s1) \\ 65521. ]. - ^(s2 bitShift: 16) + s1! Item was removed: - ----- Method: ZLibWriteStream>>on: (in category 'initialize-release') ----- - on: aCollectionOrStream - super on: aCollectionOrStream. - crc := 1.! Item was removed: - ----- Method: ZLibWriteStream>>updateCrc:from:to:in: (in category 'initialize-release') ----- - updateCrc: adler from: start to: stop in: aCollection - "Update crc using the Adler32 checksum technique from RFC1950" - ^self class updateAdler32: adler from: start to: stop in: aCollection! Item was removed: - ----- Method: ZLibWriteStream>>writeFooter (in category 'initialize-release') ----- - writeFooter - "Store the Adler32 checksum as the last 4 bytes." - 3 to: 0 by: -1 do:[:i| encoder nextBytePut: (crc >> (i*8) bitAnd: 255)].! Item was removed: - ----- Method: ZLibWriteStream>>writeHeader (in category 'initialize-release') ----- - writeHeader - "Write header information" - encoder nextBits: 8 put: 120. "deflate method with 15bit window size" - encoder nextBits: 8 put: 94. "checksum; no preset; fast (flevel=1) compression"! Item was removed: - Archive subclass: #ZipArchive - instanceVariableNames: 'centralDirectorySize centralDirectoryOffsetWRTStartingDiskNumber zipFileComment writeCentralDirectoryOffset writeEOCDOffset' - classVariableNames: '' - poolDictionaries: 'ZipFileConstants' - category: 'Compression-Archives'! - - !ZipArchive commentStamp: '<historical>' prior: 0! - A ZipArchive represents an archive that is read and/or written using the PKZIP file format. - - ZipArchive instances know how to read and write such archives; their members are subinstances of ZipArchiveMember.! Item was removed: - ----- Method: ZipArchive class>>compressionDeflated (in category 'constants') ----- - compressionDeflated - ^CompressionDeflated! Item was removed: - ----- Method: ZipArchive class>>compressionLevelDefault (in category 'constants') ----- - compressionLevelDefault - ^CompressionLevelDefault! Item was removed: - ----- Method: ZipArchive class>>compressionLevelNone (in category 'constants') ----- - compressionLevelNone - ^CompressionLevelNone ! Item was removed: - ----- Method: ZipArchive class>>compressionStored (in category 'constants') ----- - compressionStored - ^CompressionStored! Item was removed: - ----- Method: ZipArchive class>>findEndOfCentralDirectoryFrom: (in category 'constants') ----- - findEndOfCentralDirectoryFrom: stream - "Seek in the given stream to the end, then read backwards until we find the - signature of the central directory record. Leave the file positioned right - before the signature. - - Answers the file position of the EOCD, or 0 if not found." - - | data fileLength seekOffset pos maxOffset | - stream setToEnd. - fileLength := stream position. - "If the file length is less than 18 for the EOCD length plus 4 for the signature, we have a problem" - fileLength < 22 ifTrue: [^ self error: 'file is too short: ', stream name]. - - seekOffset := 0. - pos := 0. - data := ByteArray new: 4100. - maxOffset := 40960 min: fileLength. "limit search range to 40K" - - [ - seekOffset := (seekOffset + 4096) min: fileLength. - stream position: fileLength - seekOffset. - data := stream next: (4100 min: seekOffset) into: data startingAt: 1. - pos := self lastIndexOfPKSignature: EndOfCentralDirectorySignature in: data. - pos = 0 and: [seekOffset < maxOffset] - ] whileTrue. - - ^ pos > 0 - ifTrue: [ | newPos | stream position: (newPos := (stream position + pos - seekOffset - 1)). newPos] - ifFalse: [0]! Item was removed: - ----- Method: ZipArchive class>>isZipArchive: (in category 'file format') ----- - isZipArchive: aStreamOrFileName - "Answer whether the given filename represents a valid zip file." - - | stream eocdPosition | - stream := aStreamOrFileName isStream - ifTrue: [aStreamOrFileName] - ifFalse: [StandardFileStream oldFileNamed: aStreamOrFileName]. - stream ifNil: [^ false]. - "nil happens sometimes somehow" - stream size < 22 ifTrue: [^ false]. - stream binary. - eocdPosition := self findEndOfCentralDirectoryFrom: stream. - stream ~= aStreamOrFileName ifTrue: [stream close]. - ^ eocdPosition > 0! Item was removed: - ----- Method: ZipArchive class>>lastIndexOfPKSignature:in: (in category 'constants') ----- - lastIndexOfPKSignature: aSignature in: data - "Answer the last index in data where aSignature (4 bytes long) occurs, or 0 if not found" - | a b c d | - a := aSignature first. - b := aSignature second. - c := aSignature third. - d := aSignature fourth. - (data size - 3) to: 1 by: -1 do: [ :i | - (((data at: i) = a) - and: [ ((data at: i + 1) = b) - and: [ ((data at: i + 2) = c) - and: [ ((data at: i + 3) = d) ]]]) - ifTrue: [ ^i ] - ]. - ^0! Item was removed: - ----- Method: ZipArchive class>>validSignatures (in category 'constants') ----- - validSignatures - "Return the valid signatures for a zip file" - ^Array - with: LocalFileHeaderSignature - with: CentralDirectoryFileHeaderSignature - with: EndOfCentralDirectorySignature! Item was removed: - ----- Method: ZipArchive>>addDeflateString:as: (in category 'archive operations') ----- - addDeflateString: aString as: aFileName - "Add a verbatim string under the given file name" - | mbr | - mbr := self addString: aString as: aFileName. - mbr desiredCompressionMethod: CompressionDeflated. - ^mbr! Item was removed: - ----- Method: ZipArchive>>close (in category 'initialization') ----- - close - self members do:[:m| m close].! Item was removed: - ----- Method: ZipArchive>>extractAllTo: (in category 'archive operations') ----- - extractAllTo: aDirectory - "Extract all elements to the given directory" - self extractAllTo: aDirectory informing: nil.! Item was removed: - ----- Method: ZipArchive>>extractAllTo:informing: (in category 'archive operations') ----- - extractAllTo: aDirectory informing: bar - "Extract all elements to the given directory, notifying the user of progress" - ^self extractAllTo: aDirectory informing: bar overwrite: false! Item was removed: - ----- Method: ZipArchive>>extractAllTo:informing:overwrite: (in category 'archive operations') ----- - extractAllTo: aDirectory informing: bar overwrite: allOverwrite - "Extract all elements to the given directory" - | overwriteAll | - overwriteAll := allOverwrite. - self members do:[:entry| | dir | - entry isDirectory ifTrue:[ - bar ifNotNil:[bar value: 'Creating ', entry fileName]. - dir := (entry fileName findTokens:'/') - inject: aDirectory into:[:base :part| base directoryNamed: part]. - dir assureExistence. - ]. - ]. - self members do:[:entry| | response | - entry isDirectory ifFalse:[ - bar ifNotNil:[bar value: 'Extracting ', entry fileName]. - response := entry extractInDirectory: aDirectory overwrite: overwriteAll. - response == #retryWithOverwrite ifTrue:[ - overwriteAll := true. - response := entry extractInDirectory: aDirectory overwrite: overwriteAll. - ]. - response == #abort ifTrue:[^self]. - response == #failed ifTrue:[ - (self confirm: 'Failed to extract ', entry fileName, '. Proceed?') ifFalse:[^self]. - ]. - ]. - ]. - ! Item was removed: - ----- Method: ZipArchive>>hasMemberSuchThat: (in category 'accessing') ----- - hasMemberSuchThat: aBlock - "Answer whether we have a member satisfying the given condition" - ^self members anySatisfy: aBlock! Item was removed: - ----- Method: ZipArchive>>initialize (in category 'initialization') ----- - initialize - super initialize. - writeEOCDOffset := writeCentralDirectoryOffset := 0. - zipFileComment := ''. - ! Item was removed: - ----- Method: ZipArchive>>memberClass (in category 'private') ----- - memberClass - ^ZipArchiveMember! Item was removed: - ----- Method: ZipArchive>>prependedDataSize (in category 'accessing') ----- - prependedDataSize - "Answer the size of whatever data exists before my first member. - Assumes that I was read from a file or stream (i.e. the first member is a ZipFileMember)" - ^members isEmpty - ifFalse: [ members first localHeaderRelativeOffset ] - ifTrue: [ centralDirectoryOffsetWRTStartingDiskNumber ]! Item was removed: - ----- Method: ZipArchive>>readEndOfCentralDirectoryFrom: (in category 'private') ----- - readEndOfCentralDirectoryFrom: aStream - "Read EOCD, starting from position before signature." - | signature zipFileCommentLength | - signature := self readSignatureFrom: aStream. - signature = EndOfCentralDirectorySignature ifFalse: [ ^self error: 'bad signature at ', aStream position printString ]. - - aStream nextLittleEndianNumber: 2. "# of this disk" - aStream nextLittleEndianNumber: 2. "# of disk with central dir start" - aStream nextLittleEndianNumber: 2. "# of entries in central dir on this disk" - aStream nextLittleEndianNumber: 2. "total # of entries in central dir" - centralDirectorySize := aStream nextLittleEndianNumber: 4. "size of central directory" - centralDirectoryOffsetWRTStartingDiskNumber := aStream nextLittleEndianNumber: 4. "offset of start of central directory" - zipFileCommentLength := aStream nextLittleEndianNumber: 2. "zip file comment" - zipFileComment := aStream next: zipFileCommentLength. - ! Item was removed: - ----- Method: ZipArchive>>readFrom: (in category 'reading') ----- - readFrom: aStreamOrFileName - | stream name eocdPosition | - stream := aStreamOrFileName isStream - ifTrue: [name := aStreamOrFileName name. aStreamOrFileName] - ifFalse: [StandardFileStream readOnlyFileNamed: (name := aStreamOrFileName)]. - stream binary. - eocdPosition := self class findEndOfCentralDirectoryFrom: stream. - eocdPosition <= 0 ifTrue: [self error: self class name, ' cannot find EOCD position in ', aStreamOrFileName name]. - self readEndOfCentralDirectoryFrom: stream. - stream position: eocdPosition - centralDirectorySize. - self readMembersFrom: stream named: name! Item was removed: - ----- Method: ZipArchive>>readMembersFrom:named: (in category 'private') ----- - readMembersFrom: stream named: fileName - [ - | newMember signature | - newMember := self memberClass newFromZipFile: stream named: fileName. - signature := self readSignatureFrom: stream. - signature = EndOfCentralDirectorySignature ifTrue: [ ^self ]. - signature = CentralDirectoryFileHeaderSignature - ifFalse: [ self error: 'bad CD signature at ', (stream position - 4) printStringHex ]. - newMember readFrom: stream. - newMember looksLikeDirectory ifTrue: [ newMember := newMember asDirectory ]. - self addMember: newMember. - ] repeat.! Item was removed: - ----- Method: ZipArchive>>readSignatureFrom: (in category 'private') ----- - readSignatureFrom: stream - "Returns next signature from given stream, leaves stream positioned afterwards." - - | signatureData | - signatureData := ByteArray new: 4. - stream next: 4 into: signatureData. - ({ CentralDirectoryFileHeaderSignature . LocalFileHeaderSignature . EndOfCentralDirectorySignature } - includes: signatureData) - ifFalse: [ ^self error: 'bad signature ', signatureData asString asHex, ' at position ', (stream position - 4) asString ]. - ^signatureData - ! Item was removed: - ----- Method: ZipArchive>>writeCentralDirectoryTo: (in category 'private') ----- - writeCentralDirectoryTo: aStream - | offset | - offset := writeCentralDirectoryOffset. - members do: [ :member | - member writeCentralDirectoryFileHeaderTo: aStream. - offset := offset + member centralDirectoryHeaderSize. - ]. - writeEOCDOffset := offset. - self writeEndOfCentralDirectoryTo: aStream. - - ! Item was removed: - ----- Method: ZipArchive>>writeEndOfCentralDirectoryTo: (in category 'private') ----- - writeEndOfCentralDirectoryTo: aStream - - aStream nextPutAll: EndOfCentralDirectorySignature. - aStream nextLittleEndianNumber: 2 put: 0. "diskNumber" - aStream nextLittleEndianNumber: 2 put: 0. "diskNumberWithStartOfCentralDirectory" - aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectoriesOnThisDisk" - aStream nextLittleEndianNumber: 2 put: members size. "numberOfCentralDirectories" - aStream nextLittleEndianNumber: 4 put: writeEOCDOffset - writeCentralDirectoryOffset. "size of central dir" - aStream nextLittleEndianNumber: 4 put: writeCentralDirectoryOffset. "offset of central dir" - aStream nextLittleEndianNumber: 2 put: zipFileComment size. "zip file comment" - zipFileComment isEmpty ifFalse: [ aStream nextPutAll: zipFileComment ]. - - ! Item was removed: - ----- Method: ZipArchive>>writeTo: (in category 'writing') ----- - writeTo: stream - stream binary. - members do: [ : member | - [ member writeTo: stream. - member endRead ] ensure: [ member close ] ]. - writeCentralDirectoryOffset := stream position. - self writeCentralDirectoryTo: stream! Item was removed: - ----- Method: ZipArchive>>writeTo:prepending: (in category 'writing') ----- - writeTo: stream prepending: aString - stream binary. - stream nextPutAll: aString. - members do: [ :member | - member writeTo: stream. - member endRead. - ]. - writeCentralDirectoryOffset := stream position. - self writeCentralDirectoryTo: stream. - ! Item was removed: - ----- Method: ZipArchive>>writeTo:prependingFileNamed: (in category 'writing') ----- - writeTo: stream prependingFileNamed: aFileName - | prepended buffer | - stream binary. - prepended := StandardFileStream readOnlyFileNamed: aFileName. - prepended binary. - buffer := ByteArray new: (prepended size min: 32768). - [ prepended atEnd ] whileFalse: [ | bytesRead | - bytesRead := prepended readInto: buffer startingAt: 1 count: buffer size. - stream next: bytesRead putAll: buffer startingAt: 1 - ]. - members do: [ :member | - member writeTo: stream. - member endRead. - ]. - writeCentralDirectoryOffset := stream position. - self writeCentralDirectoryTo: stream. - ! Item was removed: - ----- Method: ZipArchive>>writeToFileNamed:prepending: (in category 'writing') ----- - writeToFileNamed: aFileName prepending: aString - | stream | - "Catch attempts to overwrite existing zip file" - (self canWriteToFileNamed: aFileName) - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. - stream := StandardFileStream forceNewFileNamed: aFileName. - self writeTo: stream prepending: aString. - stream close.! Item was removed: - ----- Method: ZipArchive>>writeToFileNamed:prependingFileNamed: (in category 'writing') ----- - writeToFileNamed: aFileName prependingFileNamed: anotherFileName - | stream | - "Catch attempts to overwrite existing zip file" - (self canWriteToFileNamed: aFileName) - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. - stream := StandardFileStream forceNewFileNamed: aFileName. - self writeTo: stream prependingFileNamed: anotherFileName. - stream close.! Item was removed: - ----- Method: ZipArchive>>zipFileComment (in category 'accessing') ----- - zipFileComment - ^zipFileComment asString! Item was removed: - ----- Method: ZipArchive>>zipFileComment: (in category 'accessing') ----- - zipFileComment: aString - zipFileComment := aString! Item was removed: - ArchiveMember subclass: #ZipArchiveMember - instanceVariableNames: 'lastModFileDateTime fileAttributeFormat versionMadeBy versionNeededToExtract bitFlag compressionMethod desiredCompressionMethod desiredCompressionLevel internalFileAttributes externalFileAttributes cdExtraField localExtraField fileComment crc32 compressedSize uncompressedSize writeLocalHeaderRelativeOffset readDataRemaining' - classVariableNames: '' - poolDictionaries: 'ZipFileConstants' - category: 'Compression-Archives'! - - !ZipArchiveMember commentStamp: '<historical>' prior: 0! - Subinstances of me are members in a ZipArchive. - They represent different data sources: - * ZipDirectoryMember -- a directory to be added to a zip file - * ZipFileMember -- a file or directory that is already in a zip file - * ZipNewFilemember -- a file that is to be added to a zip file - * ZipStringMember -- a string that is to be added to a zip file - - They can write their data to another stream either copying, compressing, - or decompressing as desired.! Item was removed: - ----- Method: ZipArchiveMember class>>newFromDirectory: (in category 'instance creation') ----- - newFromDirectory: aFileName - ^ZipDirectoryMember newNamed: aFileName! Item was removed: - ----- Method: ZipArchiveMember class>>newFromFile: (in category 'instance creation') ----- - newFromFile: aFileName - ^ZipNewFileMember newNamed: aFileName! Item was removed: - ----- Method: ZipArchiveMember class>>newFromString:named: (in category 'instance creation') ----- - newFromString: aString named: aFileName - ^ZipStringMember newFrom: aString named: aFileName! Item was removed: - ----- Method: ZipArchiveMember class>>newFromZipFile:named: (in category 'instance creation') ----- - newFromZipFile: stream named: fileName - ^ZipFileMember newFrom: stream named: fileName! Item was removed: - ----- Method: ZipArchiveMember>>asDirectory (in category 'private') ----- - asDirectory - ^ZipDirectoryMember new copyFrom: self! Item was removed: - ----- Method: ZipArchiveMember>>centralDirectoryHeaderSize (in category 'accessing') ----- - centralDirectoryHeaderSize - - | systemFileName systemFileComment systemCdExtraField | - systemFileName := fileName asVmPathName. - systemFileComment := fileComment convertToSystemString. - systemCdExtraField := cdExtraField. - ^ 46 + systemFileName size + systemCdExtraField size + systemFileComment size - ! Item was removed: - ----- Method: ZipArchiveMember>>clearExtraFields (in category 'accessing') ----- - clearExtraFields - cdExtraField := ''. - localExtraField := ''.! Item was removed: - ----- Method: ZipArchiveMember>>compressDataTo: (in category 'private-writing') ----- - compressDataTo: aStream - "Copy my deflated data to the given stream." - | encoder startPos endPos | - - encoder := ZipWriteStream on: aStream. - startPos := aStream position. - - [ readDataRemaining > 0 ] whileTrue: [ | data | - data := self readRawChunk: (4096 min: readDataRemaining). - encoder nextPutAll: data asByteArray. - readDataRemaining := readDataRemaining - data size. - ]. - encoder finish. "not close!!" - endPos := aStream position. - compressedSize := endPos - startPos. - crc32 := encoder crc. - ! Item was removed: - ----- Method: ZipArchiveMember>>compressedSize (in category 'accessing') ----- - compressedSize - "Return the compressed size for this member. - This will not be set for members that were constructed from strings - or external files until after the member has been written." - ^compressedSize! Item was removed: - ----- Method: ZipArchiveMember>>compressionMethod (in category 'accessing') ----- - compressionMethod - "Returns my compression method. This is the method that is - currently being used to compress my data. - - This will be CompressionStored for added string or file members, - or CompressionStored or CompressionDeflated (others are possible but not handled)" - - ^compressionMethod! Item was removed: - ----- Method: ZipArchiveMember>>contentStream (in category 'accessing') ----- - contentStream - "Answer my contents as a text stream. - Default is no conversion, since we don't know what the bytes mean." - - ^self contentStreamFromEncoding: 'latin1' - ! Item was removed: - ----- Method: ZipArchiveMember>>contentStreamFromEncoding: (in category 'accessing') ----- - contentStreamFromEncoding: encodingName - "Answer my contents as a text stream. - Interpret the raw bytes with given encodingName" - - | s | - s := MultiByteBinaryOrTextStream on: (String new: self uncompressedSize). - s converter: (TextConverter newForEncoding: encodingName). - self extractTo: s. - s reset. - ^ s - ! Item was removed: - ----- Method: ZipArchiveMember>>contents (in category 'reading') ----- - contents - "Answer my contents as a string - assuming a Latin1 encoding." - | s | - s := (ByteArray new: self uncompressedSize) writeStream. - self extractTo: s. - ^s contents asString! Item was removed: - ----- Method: ZipArchiveMember>>contentsFrom:to: (in category 'reading') ----- - contentsFrom: start to: finish - "Answer part of my contents as a string - assuming a Latin1 encoding.." - | s | - s := (ByteArray new: finish - start + 1) writeStream. - self extractTo: s from: start to: finish. - ^s contents asString! Item was removed: - ----- Method: ZipArchiveMember>>copyDataTo: (in category 'private-writing') ----- - copyDataTo: aStream - - compressionMethod = CompressionStored ifTrue: [ ^self copyDataWithCRCTo: aStream ]. - - self copyRawDataTo: aStream.! Item was removed: - ----- Method: ZipArchiveMember>>copyDataWithCRCTo: (in category 'private-writing') ----- - copyDataWithCRCTo: aStream - "Copy my data to aStream. Also set the CRC-32. - Only used when compressionMethod = desiredCompressionMethod = CompressionStored" - - uncompressedSize := compressedSize := readDataRemaining. - - crc32 := 16rFFFFFFFF. - - [ readDataRemaining > 0 ] whileTrue: [ | data | - data := self readRawChunk: (4096 min: readDataRemaining). - aStream nextPutAll: data. - crc32 := ZipWriteStream updateCrc: crc32 from: 1 to: data size in: data. - readDataRemaining := readDataRemaining - data size. - ]. - - crc32 := crc32 bitXor: 16rFFFFFFFF. - ! Item was removed: - ----- Method: ZipArchiveMember>>copyRawDataTo: (in category 'private-writing') ----- - copyRawDataTo: aStream - - [ readDataRemaining > 0 ] whileTrue: [ | data | - data := self readRawChunk: (4096 min: readDataRemaining). - aStream nextPutAll: data. - readDataRemaining := readDataRemaining - data size. - ]. - ! Item was removed: - ----- Method: ZipArchiveMember>>copyRawDataTo:from:to: (in category 'private-writing') ----- - copyRawDataTo: aStream from: start to: finish - - readDataRemaining := readDataRemaining min: finish - start + 1. - - self readRawChunk: start - 1. - - [ readDataRemaining > 0 ] whileTrue: [ | data | - data := self readRawChunk: (32768 min: readDataRemaining). - aStream nextPutAll: data. - readDataRemaining := readDataRemaining - data size. - ]. - ! Item was removed: - ----- Method: ZipArchiveMember>>crc32 (in category 'accessing') ----- - crc32 - ^crc32! Item was removed: - ----- Method: ZipArchiveMember>>crc32String (in category 'accessing') ----- - crc32String - | hexString | - hexString := crc32 storeStringHex. - ^('00000000' copyFrom: 1 to: 11 - (hexString size)) , (hexString copyFrom: 4 to: hexString size)! Item was removed: - ----- Method: ZipArchiveMember>>desiredCompressionLevel (in category 'accessing') ----- - desiredCompressionLevel - ^desiredCompressionLevel! Item was removed: - ----- Method: ZipArchiveMember>>desiredCompressionLevel: (in category 'accessing') ----- - desiredCompressionLevel: aNumber - "Set my desiredCompressionLevel - This is the method that will be used to write. - Returns prior desiredCompressionLevel. - - Valid arguments are 0 (CompressionLevelNone) through 9, - including 6 (CompressionLevelDefault). - - 0 (CompressionLevelNone) will change the desiredCompressionMethod - to CompressionStored. All other arguments will change the - desiredCompressionMethod to CompressionDeflated." - - | old | - old := desiredCompressionLevel. - desiredCompressionLevel := aNumber. - desiredCompressionMethod := (aNumber > 0) - ifTrue: [ CompressionDeflated ] - ifFalse: [ CompressionStored ]. - ^old! Item was removed: - ----- Method: ZipArchiveMember>>desiredCompressionMethod (in category 'accessing') ----- - desiredCompressionMethod - "Get my desiredCompressionMethod. - This is the method that will be used to write" - - ^desiredCompressionMethod! Item was removed: - ----- Method: ZipArchiveMember>>desiredCompressionMethod: (in category 'accessing') ----- - desiredCompressionMethod: aNumber - "Set my desiredCompressionMethod - This is the method that will be used to write. - Answers prior desiredCompressionMethod. - - Only CompressionDeflated or CompressionStored are valid arguments. - - Changing to CompressionStored will change my desiredCompressionLevel - to CompressionLevelNone; changing to CompressionDeflated will change my - desiredCompressionLevel to CompressionLevelDefault." - - | old | - old := desiredCompressionMethod. - desiredCompressionMethod := aNumber. - desiredCompressionLevel := (aNumber = CompressionDeflated) - ifTrue: [ CompressionLevelDefault ] - ifFalse: [ CompressionLevelNone ]. - compressionMethod = CompressionStored ifTrue: [ compressedSize := uncompressedSize ]. - ^old.! Item was removed: - ----- Method: ZipArchiveMember>>dosToSqueakTime: (in category 'private') ----- - dosToSqueakTime: dt - "DOS years start at 1980, so add 1980." - | year mon mday hour min sec date time | - - year := (( dt bitShift: -25 ) bitAnd: 16r7F ). - mon := (( dt bitShift: -21 ) bitAnd: 16r0F ). - mday := (( dt bitShift: -16 ) bitAnd: 16r1F ). - date := Date newDay: mday month: mon year: year+1980. - - hour := (( dt bitShift: -11 ) bitAnd: 16r1F ). - min := (( dt bitShift: -5 ) bitAnd: 16r3F ). - sec := (( dt bitShift: 1 ) bitAnd: 16r3E ). - time := ((( hour * 60 ) + min ) * 60 ) + sec. - - ^date asSeconds + time - - ! Item was removed: - ----- Method: ZipArchiveMember>>endRead (in category 'private') ----- - endRead - readDataRemaining := 0.! Item was removed: - ----- Method: ZipArchiveMember>>extractInDirectory: (in category 'extraction') ----- - extractInDirectory: dir - self extractToFileNamed: self localFileName inDirectory: dir - ! Item was removed: - ----- Method: ZipArchiveMember>>extractInDirectory:overwrite: (in category 'extraction') ----- - extractInDirectory: aDirectory overwrite: overwriteAll - "Extract this entry into the given directory. Answer #okay, #failed, #abort, or #retryWithOverwrite." - | path fileDir file index localName | - path := fileName findTokens:'/'. - localName := path last. - fileDir := path allButLast - inject: aDirectory - into: - [:base :part| - base directoryNamed: part]. - fileDir assureExistence. - file := [fileDir newFileNamed: localName] - on: FileExistsException - do: - [:ex| - ex return: nil]. - file ifNil: - [overwriteAll ifFalse: - [[index := Project uiManager - chooseOptionFrom: "<-- needs simpler dialogue with a proper cancle button" - {'Yes, overwrite'. - 'No, don''t overwrite'. - 'Overwrite ALL files'. - 'Cancel operation'} - lines: #(2) - title: fileName, ' already exists. Overwrite?'. - index == nil] whileTrue. - index = 4 ifTrue:[^#abort]. - index = 3 ifTrue:[^#retryWithOverwrite]. - index = 2 ifTrue:[^#okay]. - ]. - file := [fileDir forceNewFileNamed: localName] - on: Error - do: - [:ex| ex return]. - file ifNil:[^#failed]. - ]. - self extractTo: file. - file close. - ^#okay! Item was removed: - ----- Method: ZipArchiveMember>>extractTo: (in category 'extraction') ----- - extractTo: aStream - | oldCompression | - self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ]. - aStream binary. - oldCompression := self desiredCompressionMethod: CompressionStored. - self rewindData. - self writeDataTo: aStream. - self desiredCompressionMethod: oldCompression. - self endRead.! Item was removed: - ----- Method: ZipArchiveMember>>extractTo:from:to: (in category 'extraction') ----- - extractTo: aStream from: start to: finish - | oldCompression | - self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ]. - aStream binary. - oldCompression := self desiredCompressionMethod: CompressionStored. - self rewindData. - self writeDataTo: aStream from: start to: finish. - self desiredCompressionMethod: oldCompression. - self endRead.! Item was removed: - ----- Method: ZipArchiveMember>>extractToFileNamed: (in category 'extraction') ----- - extractToFileNamed: aFileName - self extractToFileNamed: aFileName inDirectory: FileDirectory default.! Item was removed: - ----- Method: ZipArchiveMember>>extractToFileNamed:inDirectory: (in category 'accessing') ----- - extractToFileNamed: aLocalFileName inDirectory: dir - | stream fullName fullDir | - self isEncrypted ifTrue: [ ^self error: 'encryption unsupported' ]. - fullName := dir fullNameFor: aLocalFileName. - fullDir := FileDirectory forFileName: fullName. - fullDir assureExistence. - self isDirectory ifFalse: [ - stream := fullDir forceNewFileNamed: (FileDirectory localNameFor: fullName). - self extractTo: stream. - stream close. - ] ifTrue: [ fullDir assureExistence ] - ! Item was removed: - ----- Method: ZipArchiveMember>>fileComment (in category 'accessing') ----- - fileComment - ^fileComment! Item was removed: - ----- Method: ZipArchiveMember>>fileComment: (in category 'accessing') ----- - fileComment: aString - fileComment := aString! Item was removed: - ----- Method: ZipArchiveMember>>hasDataDescriptor (in category 'testing') ----- - hasDataDescriptor - ^ (bitFlag bitAnd: 8) ~= 0 "GPBF:=HAS:=DATA:=DESCRIPTOR:=MASK"! Item was removed: - ----- Method: ZipArchiveMember>>initialize (in category 'initialization') ----- - initialize - super initialize. - lastModFileDateTime := 0. - fileAttributeFormat := FaUnix. - versionMadeBy := 20. - versionNeededToExtract := 20. - bitFlag := 0. - compressionMethod := CompressionStored. - desiredCompressionMethod := CompressionDeflated. - desiredCompressionLevel := CompressionLevelDefault. - internalFileAttributes := 0. - externalFileAttributes := 0. - fileName := ''. - cdExtraField := ''. - localExtraField := ''. - fileComment := ''. - crc32 := 0. - compressedSize := 0. - uncompressedSize := 0. - self unixFileAttributes: DefaultFilePermissions.! Item was removed: - ----- Method: ZipArchiveMember>>isDirectory (in category 'testing') ----- - isDirectory - ^false! Item was removed: - ----- Method: ZipArchiveMember>>isEncrypted (in category 'testing') ----- - isEncrypted - "Return true if this member is encrypted (this is unsupported)" - ^ (bitFlag bitAnd: 1) ~= 0! Item was removed: - ----- Method: ZipArchiveMember>>isTextFile (in category 'testing') ----- - isTextFile - "Returns true if I am a text file. - Note that this module does not currently do anything with this flag - upon extraction or storage. - That is, bytes are stored in native format whether or not they came - from a text file." - ^ (internalFileAttributes bitAnd: 1) ~= 0 - ! Item was removed: - ----- Method: ZipArchiveMember>>isTextFile: (in category 'testing') ----- - isTextFile: aBoolean - "Set whether I am a text file. - Note that this module does not currently do anything with this flag - upon extraction or storage. - That is, bytes are stored in native format whether or not they came - from a text file." - internalFileAttributes := aBoolean - ifTrue: [ internalFileAttributes bitOr: 1 ] - ifFalse: [ internalFileAttributes bitAnd: 1 bitInvert ] - ! Item was removed: - ----- Method: ZipArchiveMember>>lastModTime (in category 'accessing') ----- - lastModTime - "Return my last modification date/time stamp, - converted to Squeak seconds" - - ^self dosToSqueakTime: lastModFileDateTime! Item was removed: - ----- Method: ZipArchiveMember>>localFileName (in category 'accessing') ----- - localFileName - "Answer my fileName in terms of the local directory naming convention" - | localName | - localName := fileName copyReplaceAll: '/' with: FileDirectory slash. - ^(fileName first = $/) - ifTrue: [ FileDirectory default class makeAbsolute: localName ] - ifFalse: [ FileDirectory default class makeRelative: localName ]! Item was removed: - ----- Method: ZipArchiveMember>>looksLikeDirectory (in category 'testing') ----- - looksLikeDirectory - ^false! Item was removed: - ----- Method: ZipArchiveMember>>mapPermissionsFromUnix: (in category 'private') ----- - mapPermissionsFromUnix: unixPerms - ^ unixPerms bitShift: 16.! Item was removed: - ----- Method: ZipArchiveMember>>mapPermissionsToUnix: (in category 'private') ----- - mapPermissionsToUnix: dosPerms - ^ dosPerms bitShift: -16.! Item was removed: - ----- Method: ZipArchiveMember>>openStreamWhile: (in category 'private-writing') ----- - openStreamWhile: aBlock - ^ aBlock value! Item was removed: - ----- Method: ZipArchiveMember>>readRawChunk: (in category 'private') ----- - readRawChunk: n - self subclassResponsibility! Item was removed: - ----- Method: ZipArchiveMember>>refreshLocalFileHeaderTo: (in category 'private-writing') ----- - refreshLocalFileHeaderTo: aStream - "Re-writes my local header to the given stream. - To be called after writing the data stream. - Assumes that fileName and localExtraField sizes didn't change since last written." - - | here systemFileName | - here := aStream position. - systemFileName := fileName asVmPathName. - aStream position: writeLocalHeaderRelativeOffset. - - aStream nextPutAll: LocalFileHeaderSignature. - aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. - aStream nextLittleEndianNumber: 2 put: bitFlag. - aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. - aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. - aStream nextLittleEndianNumber: 4 put: crc32. - aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored - ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). - aStream nextLittleEndianNumber: 4 put: uncompressedSize. - aStream nextLittleEndianNumber: 2 put: systemFileName size. - aStream nextLittleEndianNumber: 2 put: localExtraField size. - - aStream position: here. - ! Item was removed: - ----- Method: ZipArchiveMember>>rewindData (in category 'private') ----- - rewindData - readDataRemaining := (desiredCompressionMethod = CompressionDeflated - and: [ compressionMethod = CompressionDeflated ]) - ifTrue: [ compressedSize ] - ifFalse: [ uncompressedSize ]. - ! Item was removed: - ----- Method: ZipArchiveMember>>setLastModFileDateTimeFrom: (in category 'accessing') ----- - setLastModFileDateTimeFrom: aSmalltalkTime - - lastModFileDateTime := self squeakToDosTime: aSmalltalkTime! Item was removed: - ----- Method: ZipArchiveMember>>splitFileName (in category 'accessing') ----- - splitFileName - "Answer my name split on slash boundaries. A directory will have a trailing empty string." - ^ fileName findTokens: '/'.! Item was removed: - ----- Method: ZipArchiveMember>>squeakToDosTime: (in category 'private') ----- - squeakToDosTime: secs - | dosTime dateTime | - - dateTime := Time dateAndTimeFromSeconds: secs. - dosTime := (dateTime second seconds) bitShift: -1. - dosTime := dosTime + ((dateTime second minutes) bitShift: 5). - dosTime := dosTime + ((dateTime second hours) bitShift: 11). - dosTime := dosTime + ((dateTime first dayOfMonth) bitShift: 16). - dosTime := dosTime + ((dateTime first monthIndex) bitShift: 21). - dosTime := dosTime + (((dateTime first year) - 1980) bitShift: 25). - ^dosTime - ! Item was removed: - ----- Method: ZipArchiveMember>>uncompressedSize (in category 'accessing') ----- - uncompressedSize - "Return the uncompressed size for this member." - ^uncompressedSize! Item was removed: - ----- Method: ZipArchiveMember>>unixFileAttributes (in category 'accessing') ----- - unixFileAttributes - ^self mapPermissionsToUnix: externalFileAttributes.! Item was removed: - ----- Method: ZipArchiveMember>>unixFileAttributes: (in category 'accessing') ----- - unixFileAttributes: perms - | oldPerms newPerms | - oldPerms := self mapPermissionsToUnix: externalFileAttributes. - newPerms := self isDirectory - ifTrue: [ (perms bitAnd: FileAttrib bitInvert) bitOr: DirectoryAttrib ] - ifFalse: [ (perms bitAnd: DirectoryAttrib bitInvert) bitOr: FileAttrib ]. - externalFileAttributes := self mapPermissionsFromUnix: newPerms. - ^oldPerms.! Item was removed: - ----- Method: ZipArchiveMember>>writeCentralDirectoryFileHeaderTo: (in category 'private-writing') ----- - writeCentralDirectoryFileHeaderTo: aStream - "C2 v3 V4 v5 V2" - - | systemFileName systemFileComment systemCdExtraField | - systemFileName := fileName asVmPathName. - systemFileComment := fileComment convertToSystemString. - systemCdExtraField := cdExtraField. - aStream nextPutAll: CentralDirectoryFileHeaderSignature. - aStream nextLittleEndianNumber: 1 put: versionMadeBy. - aStream nextLittleEndianNumber: 1 put: fileAttributeFormat. - - aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. - aStream nextLittleEndianNumber: 2 put: bitFlag. - aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. - - aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. - - "These next 3 should have been updated during the write of the data" - aStream nextLittleEndianNumber: 4 put: crc32. - aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored - ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). - aStream nextLittleEndianNumber: 4 put: uncompressedSize. - - aStream nextLittleEndianNumber: 2 put: systemFileName size. - aStream nextLittleEndianNumber: 2 put: systemCdExtraField size. - aStream nextLittleEndianNumber: 2 put: systemFileComment size. - aStream nextLittleEndianNumber: 2 put: 0. "diskNumberStart" - aStream nextLittleEndianNumber: 2 put: internalFileAttributes. - - aStream nextLittleEndianNumber: 4 put: externalFileAttributes. - aStream nextLittleEndianNumber: 4 put: writeLocalHeaderRelativeOffset. - - aStream nextPutAll: systemFileName asByteArray. - aStream nextPutAll: systemCdExtraField asByteArray. - aStream nextPutAll: systemFileComment asByteArray.! Item was removed: - ----- Method: ZipArchiveMember>>writeDataDescriptorTo: (in category 'private-writing') ----- - writeDataDescriptorTo: aStream - "This writes a data descriptor to the given stream. - Assumes that crc32, writeOffset, and uncompressedSize are - set correctly (they should be after a write). - Further, the local file header should have the - GPBF:=HAS:=DATA:=DESCRIPTOR:=MASK (8) bit set." - - aStream nextLittleEndianNumber: 4 put: crc32. - aStream nextLittleEndianNumber: 4 put: compressedSize. - aStream nextLittleEndianNumber: 4 put: uncompressedSize.! Item was removed: - ----- Method: ZipArchiveMember>>writeDataTo: (in category 'private-writing') ----- - writeDataTo: aStream - "Copy my (possibly inflated or deflated) data to the given stream. - This might do compression, decompression, or straight copying, depending - on the values of compressionMethod and desiredCompressionMethod" - - "Note: Do not shortcut this method if uncompressedSize = 0. Even in this case - data may be produced by the compressor (i.e., '' zipped size > 0) and must - be stored in the file or else other utilities will treat the zip file as corrupt." - - (compressionMethod = CompressionStored and: [ desiredCompressionMethod = CompressionDeflated ]) - ifTrue: [ ^self compressDataTo: aStream ]. - - (compressionMethod = CompressionDeflated and: [ desiredCompressionMethod = CompressionStored ]) - ifTrue: [ ^self uncompressDataTo: aStream ]. - - self copyDataTo: aStream.! Item was removed: - ----- Method: ZipArchiveMember>>writeDataTo:from:to: (in category 'private-writing') ----- - writeDataTo: aStream from: start to: finish - "Copy my (possibly inflated or deflated) data to the given stream. - But only the specified byte range. - This might do decompression, or straight copying, depending - on the values of compressionMethod and desiredCompressionMethod" - - uncompressedSize = 0 ifTrue: [ ^self ]. "nothing to do because no data" - start > finish ifTrue: [ ^self ]. - start > uncompressedSize ifTrue: [ ^self ]. - - (compressionMethod = CompressionStored and: [ desiredCompressionMethod = CompressionDeflated ]) - ifTrue: [ ^self error: 'only supports uncompression or copying right now' ]. - - (compressionMethod = CompressionDeflated and: [ desiredCompressionMethod = CompressionStored ]) - ifTrue: [ ^self uncompressDataTo: aStream from: start to: finish ]. - - self copyRawDataTo: aStream from: start to: finish.! Item was removed: - ----- Method: ZipArchiveMember>>writeLocalFileHeaderTo: (in category 'private-writing') ----- - writeLocalFileHeaderTo: aStream - "Write my local header to a file handle. - Stores the offset to the start of the header in my - writeLocalHeaderRelativeOffset member." - - | systemFileName | - systemFileName := fileName asVmPathName. - aStream nextPutAll: LocalFileHeaderSignature. - aStream nextLittleEndianNumber: 2 put: versionNeededToExtract. - aStream nextLittleEndianNumber: 2 put: bitFlag. - aStream nextLittleEndianNumber: 2 put: desiredCompressionMethod. - - aStream nextLittleEndianNumber: 4 put: lastModFileDateTime. - aStream nextLittleEndianNumber: 4 put: crc32. - aStream nextLittleEndianNumber: 4 put: (desiredCompressionMethod = CompressionStored - ifTrue: [ uncompressedSize ] ifFalse: [ compressedSize ]). - aStream nextLittleEndianNumber: 4 put: uncompressedSize. - - aStream nextLittleEndianNumber: 2 put: systemFileName size. - aStream nextLittleEndianNumber: 2 put: localExtraField size. - - aStream nextPutAll: systemFileName asByteArray. - aStream nextPutAll: localExtraField asByteArray. - ! Item was removed: - ----- Method: ZipArchiveMember>>writeTo: (in category 'writing') ----- - writeTo: aStream - self openStreamWhile: - [ self rewindData. - writeLocalHeaderRelativeOffset := aStream position. - self - writeLocalFileHeaderTo: aStream ; - writeDataTo: aStream ; - refreshLocalFileHeaderTo: aStream ]! Item was removed: - SharedPool subclass: #ZipConstants - instanceVariableNames: '' - classVariableNames: 'BaseDistance BaseLength BitLengthOrder DistanceCodes DynamicBlock EndBlock ExtraBitLengthBits ExtraDistanceBits ExtraLengthBits FixedBlock FixedDistanceTree FixedLiteralTree HashBits HashMask HashShift MatchLengthCodes MaxBitLengthBits MaxBitLengthCodes MaxBits MaxDistCodes MaxDistance MaxLengthCodes MaxLiteralCodes MaxMatch MinMatch NumLiterals Repeat11To138 Repeat3To10 Repeat3To6 StoredBlock WindowMask WindowSize' - poolDictionaries: '' - category: 'Compression-Streams'! Item was removed: - ----- Method: ZipConstants class>>initialize (in category 'pool initialization') ----- - initialize - "ZipConstants initialize" - self initializeDeflateConstants. - self initializeWriteStreamConstants.! Item was removed: - ----- Method: ZipConstants class>>initializeDeflateConstants (in category 'pool initialization') ----- - initializeDeflateConstants - - WindowSize := 16r8000. - WindowMask := WindowSize - 1. - MaxDistance := WindowSize. - - MinMatch := 3. - MaxMatch := 258. - - HashBits := 15. - HashMask := (1 << HashBits) - 1. - HashShift := (HashBits + MinMatch - 1) // MinMatch. - ! Item was removed: - ----- Method: ZipConstants class>>initializeDistanceCodes (in category 'pool initialization') ----- - initializeDistanceCodes - | dist | - BaseDistance := WordArray new: MaxDistCodes. - DistanceCodes := WordArray new: 512. - dist := 0. - 1 to: 16 do:[:code| - BaseDistance at: code put: dist. - 1 to: (1 bitShift: (ExtraDistanceBits at: code)) do:[:n| - dist := dist + 1. - DistanceCodes at: dist put: code-1]]. - dist = 256 ifFalse:[self error:'Whoops?!!']. - dist := dist >> 7. - 17 to: MaxDistCodes do:[:code| - BaseDistance at: code put: dist << 7. - 1 to: (1 bitShift: (ExtraDistanceBits at: code)-7) do:[:n| - dist := dist + 1. - DistanceCodes at: 256 + dist put: code-1]]. - ! Item was removed: - ----- Method: ZipConstants class>>initializeExtraBits (in category 'pool initialization') ----- - initializeExtraBits - ExtraLengthBits := - WordArray withAll: #(0 0 0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 0). - ExtraDistanceBits := - WordArray withAll: #(0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 12 13 13). - ExtraBitLengthBits := - WordArray withAll: #(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 3 7). - BitLengthOrder := - WordArray withAll: #(16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15). - ! Item was removed: - ----- Method: ZipConstants class>>initializeFixedTrees (in category 'pool initialization') ----- - initializeFixedTrees - "ZipWriteStream initializeFixedTrees" - | counts nodes | - FixedLiteralTree := ZipEncoderTree new. - FixedLiteralTree maxCode: 287. - counts := WordArray new: MaxBits+1. - counts at: 7+1 put: 24. - counts at: 8+1 put: 144+8. - counts at: 9+1 put: 112. - nodes := Array new: 288. - 1 to: 288 do:[:i| nodes at: i put: (ZipEncoderNode value: i-1 frequency: 0 height: 0)]. - 0 to: 143 do:[:i| (nodes at: i+1) setBitLengthTo: 8]. - 144 to: 255 do:[:i| (nodes at: i+1) setBitLengthTo: 9]. - 256 to: 279 do:[:i| (nodes at: i+1) setBitLengthTo: 7]. - 280 to: 287 do:[:i| (nodes at: i+1) setBitLengthTo: 8]. - FixedLiteralTree buildCodes: nodes counts: counts maxDepth: MaxBits. - FixedLiteralTree setValuesFrom: nodes. - - FixedDistanceTree := ZipEncoderTree new. - FixedDistanceTree maxCode: MaxDistCodes. - FixedDistanceTree - bitLengths: ((WordArray new: MaxDistCodes+1) atAllPut: 5) - codes: ((0 to: MaxDistCodes) collect:[:i| FixedDistanceTree reverseBits: i length: 5]).! Item was removed: - ----- Method: ZipConstants class>>initializeLengthCodes (in category 'pool initialization') ----- - initializeLengthCodes - | length | - BaseLength := WordArray new: MaxLengthCodes. - MatchLengthCodes := WordArray new: MaxMatch - MinMatch + 1. - length := 0. - 1 to: MaxLengthCodes - 1 do:[:code| - BaseLength at: code put: length. - 1 to: (1 bitShift: (ExtraLengthBits at: code)) do:[:n| - length := length + 1. - MatchLengthCodes at: length put: NumLiterals + code]]. - ! Item was removed: - ----- Method: ZipConstants class>>initializeWriteStreamConstants (in category 'pool initialization') ----- - initializeWriteStreamConstants - - MaxBits := 15. - MaxBitLengthBits := 7. - EndBlock := 256. - - StoredBlock := 0. - FixedBlock := 1. - DynamicBlock := 2. - - NumLiterals := 256. - MaxLengthCodes := 29. - MaxDistCodes := 30. - MaxBitLengthCodes := 19. - MaxLiteralCodes := NumLiterals + MaxLengthCodes + 1. "+ End of Block" - - Repeat3To6 := 16. "Repeat previous bit length 3-6 times (2 bits repeat count)" - Repeat3To10 := 17. "Repeat previous bit length 3-10 times (3 bits repeat count)" - Repeat11To138 := 18. "Repeat previous bit length 11-138 times (7 bits repeat count)" - - self initializeExtraBits. - self initializeLengthCodes. - self initializeDistanceCodes. - self initializeFixedTrees. - ! Item was removed: - ZipFileMember subclass: #ZipDirectoryMember - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !ZipDirectoryMember commentStamp: '<historical>' prior: 0! - ZipFileMember instances represent directories inside ZipArchives. - They don't do much other than hold names and permissions (and extra fields). - - You can add files in subdirectories to a ZipArchive without using any ZipDirectoryMembers.! Item was removed: - ----- Method: ZipDirectoryMember class>>newNamed: (in category 'as yet unclassified') ----- - newNamed: aFileName - ^(self new) localFileName: aFileName; yourself! Item was removed: - ----- Method: ZipDirectoryMember>>asDirectory (in category 'private') ----- - asDirectory - ^self! Item was removed: - ----- Method: ZipDirectoryMember>>desiredCompressionMethod: (in category 'accessing') ----- - desiredCompressionMethod: aNumber! Item was removed: - ----- Method: ZipDirectoryMember>>initialize (in category 'initialization') ----- - initialize - super initialize. - super desiredCompressionMethod: CompressionStored.! Item was removed: - ----- Method: ZipDirectoryMember>>isDirectory (in category 'testing') ----- - isDirectory - ^true! Item was removed: - ----- Method: ZipDirectoryMember>>localFileName: (in category 'accessing') ----- - localFileName: aString - | dir entry parent fsPath | - super localFileName: aString. - fileName last = $/ ifFalse: [ fileName := fileName, '/' ]. - parent := FileDirectory default. - aString last = parent pathNameDelimiter - ifTrue: [fsPath := parent fullNameFor: aString] - ifFalse: [fsPath := parent fullNameFor: aString, parent slash]. - (parent directoryExists: fsPath) ifTrue: [ - dir := FileDirectory on: fsPath. - entry := dir directoryEntry. - self setLastModFileDateTimeFrom: entry modificationTime - ] - ! Item was removed: - ----- Method: ZipDirectoryMember>>rewindData (in category 'private') ----- - rewindData! Item was removed: - ----- Method: ZipDirectoryMember>>usesFileNamed: (in category 'testing') ----- - usesFileNamed: aName - ^false! Item was removed: - ----- Method: ZipDirectoryMember>>writeDataTo: (in category 'private') ----- - writeDataTo: aStream - "Write nothing. Directories have no contents to write."! Item was removed: - WriteStream subclass: #ZipEncoder - instanceVariableNames: 'bitBuffer bitPosition encodedStream' - classVariableNames: '' - poolDictionaries: 'ZipConstants' - category: 'Compression-Streams'! Item was removed: - ----- Method: ZipEncoder>>bitPosition (in category 'accessing') ----- - bitPosition - ^encodedStream position + position * 8 + bitPosition.! Item was removed: - ----- Method: ZipEncoder>>close (in category 'initialize-release') ----- - close - self flush. - encodedStream close.! Item was removed: - ----- Method: ZipEncoder>>commit (in category 'initialize-release') ----- - commit - encodedStream next: position putAll: collection. - position := readLimit := 0.! Item was removed: - ----- Method: ZipEncoder>>encodedStream (in category 'accessing') ----- - encodedStream - ^encodedStream! Item was removed: - ----- Method: ZipEncoder>>flush (in category 'initialize-release') ----- - flush - self flushBits. - self commit.! Item was removed: - ----- Method: ZipEncoder>>flushBits (in category 'initialize-release') ----- - flushBits - "Flush currently unsent bits" - [bitPosition > 0] whileTrue:[ - self nextBytePut: (bitBuffer bitAnd: 255). - bitBuffer := bitBuffer bitShift: -8. - bitPosition := bitPosition - 8]. - bitPosition := 0.! Item was removed: - ----- Method: ZipEncoder>>nextBits:put: (in category 'accessing') ----- - nextBits: nBits put: value - "Store a value of nBits" - "self assert:[value >= 0 and:[(1 bitShift: nBits) > value]]." - bitBuffer := bitBuffer bitOr: (value bitShift: bitPosition). - bitPosition := bitPosition + nBits. - [bitPosition >= 8] whileTrue:[ - self nextBytePut: (bitBuffer bitAnd: 255). - bitBuffer := bitBuffer bitShift: -8. - bitPosition := bitPosition - 8].! Item was removed: - ----- Method: ZipEncoder>>nextBytePut: (in category 'accessing') ----- - nextBytePut: anObject - "Primitive. Insert the argument at the next position in the Stream - represented by the receiver. Fail if the collection of this stream is not an - Array or a String. Fail if the stream is positioned at its end, or if the - position is out of bounds in the collection. Fail if the argument is not - of the right type for the collection. Optional. See Object documentation - whatIsAPrimitive." - - <primitive: 66> - position >= writeLimit - ifTrue: [^ self pastEndPut: anObject] - ifFalse: - [position := position + 1. - ^collection byteAt: position put: anObject]! Item was removed: - ----- Method: ZipEncoder>>on: (in category 'initialize-release') ----- - on: aCollectionOrStream - aCollectionOrStream isStream - ifTrue:[encodedStream := aCollectionOrStream] - ifFalse:[ encodedStream := WriteStream on: aCollectionOrStream]. - encodedStream isBinary - ifTrue:[super on: (ByteArray new: 4096)] - ifFalse:[super on: (String new: 4096)]. - bitPosition := bitBuffer := 0.! Item was removed: - ----- Method: ZipEncoder>>pastEndPut: (in category 'private') ----- - pastEndPut: anObject - "Flush the current buffer and store the new object at the beginning" - self commit. - ^self nextBytePut: anObject asInteger! Item was removed: - ----- Method: ZipEncoder>>privateSendBlock:with:with:with: (in category 'private') ----- - privateSendBlock: literalStream with: distanceStream with: litTree with: distTree - "Send the current block using the encodings from the given literal/length and distance tree" - | lit dist code extra sum | - <primitive: 'primitiveZipSendBlock' module: 'ZipPlugin'> - sum := 0. - [lit := literalStream next. - dist := distanceStream next. - lit == nil] whileFalse:[ - dist = 0 ifTrue:["lit is a literal" - sum := sum + 1. - self nextBits: (litTree bitLengthAt: lit) - put: (litTree codeAt: lit). - ] ifFalse:["lit is match length" - sum := sum + lit + MinMatch. - code := (MatchLengthCodes at: lit + 1). - self nextBits: (litTree bitLengthAt: code) - put: (litTree codeAt: code). - extra := ExtraLengthBits at: code-NumLiterals. - extra = 0 ifFalse:[ - lit := lit - (BaseLength at: code-NumLiterals). - self nextBits: extra put: lit. - ]. - dist := dist - 1. - dist < 256 - ifTrue:[code := DistanceCodes at: dist + 1] - ifFalse:[code := DistanceCodes at: 257 + (dist bitShift: -7)]. - "self assert:[code < MaxDistCodes]." - self nextBits: (distTree bitLengthAt: code) - put: (distTree codeAt: code). - extra := ExtraDistanceBits at: code+1. - extra = 0 ifFalse:[ - dist := dist - (BaseDistance at: code+1). - self nextBits: extra put: dist. - ]. - ]. - ]. - ^sum! Item was removed: - ----- Method: ZipEncoder>>sendBlock:with:with:with: (in category 'block encoding') ----- - sendBlock: literalStream with: distanceStream with: litTree with: distTree - "Send the current block using the encodings from the given literal/length and distance tree" - | result | - result := 0. - [literalStream atEnd] whileFalse:[ - result := result + (self privateSendBlock: literalStream - with: distanceStream with: litTree with: distTree). - self commit. - ]. - self nextBits: (litTree bitLengthAt: EndBlock) put: (litTree codeAt: EndBlock). - ^result! Item was removed: - Object subclass: #ZipEncoderNode - instanceVariableNames: 'value frequency height bitLength code parent left right' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! - - !ZipEncoderNode commentStamp: '<historical>' prior: 0! - ZipEncoderNode represents a node in a huffman tree for encoding ZipStreams. - - Instance variables: - value <Integer> - Encoded value - frequency <Integer> - Number of occurences of the encoded value - height <Integer> - Height of the node in the tree - bitLength <Integer> - bit length of the code - code <Integer> - Assigned code for this node - parent <ZipEncoderNode> - Parent of this node - left <ZipEncoderNode> - First child of this node - right <ZipEncoderNode> - Second child of this node - ! Item was removed: - ----- Method: ZipEncoderNode class>>value:frequency:height: (in category 'instance creation') ----- - value: v frequency: f height: h - ^self new setValue: v frequency: f height: h! Item was removed: - ----- Method: ZipEncoderNode>>bitLength (in category 'accessing') ----- - bitLength - ^bitLength ifNil:[0]! Item was removed: - ----- Method: ZipEncoderNode>>code (in category 'accessing') ----- - code - ^code ifNil:[0]! Item was removed: - ----- Method: ZipEncoderNode>>code: (in category 'accessing') ----- - code: aCode - self assert:[aCode >= 0 and:[(1 bitShift: bitLength) > aCode]]. - code := aCode.! Item was removed: - ----- Method: ZipEncoderNode>>computeHeight (in category 'private') ----- - computeHeight - ^self isLeaf - ifTrue:[height := 0] - ifFalse:[height := (left computeHeight max: right computeHeight) + 1].! Item was removed: - ----- Method: ZipEncoderNode>>encodeBitLength:from: (in category 'encoding') ----- - encodeBitLength: blCounts from: aTree - | index | - "Note: If bitLength is not nil then the tree must be broken" - bitLength ifNotNil: [self error:'Huffman tree is broken']. - parent - ifNil: [bitLength := 0] - ifNotNil: [bitLength := parent bitLength + 1]. - self isLeaf ifTrue:[ - index := bitLength + 1. - blCounts at: index put: (blCounts at: index) + 1. - ] ifFalse:[ - left encodeBitLength: blCounts from: aTree. - right encodeBitLength: blCounts from: aTree. - ].! Item was removed: - ----- Method: ZipEncoderNode>>frequency (in category 'accessing') ----- - frequency - ^frequency! Item was removed: - ----- Method: ZipEncoderNode>>frequency: (in category 'accessing') ----- - frequency: aNumber - frequency := aNumber! Item was removed: - ----- Method: ZipEncoderNode>>height (in category 'accessing') ----- - height - ^height! Item was removed: - ----- Method: ZipEncoderNode>>isLeaf (in category 'testing') ----- - isLeaf - ^left == nil! Item was removed: - ----- Method: ZipEncoderNode>>leafNodes (in category 'private') ----- - leafNodes - self isLeaf - ifTrue:[^Array with: self] - ifFalse:[^left leafNodes, right leafNodes]! Item was removed: - ----- Method: ZipEncoderNode>>left (in category 'accessing') ----- - left - ^left! Item was removed: - ----- Method: ZipEncoderNode>>left: (in category 'accessing') ----- - left: aNode - aNode parent: self. - left := aNode.! Item was removed: - ----- Method: ZipEncoderNode>>parent (in category 'accessing') ----- - parent - ^parent! Item was removed: - ----- Method: ZipEncoderNode>>parent: (in category 'accessing') ----- - parent: aNode - parent := aNode! Item was removed: - ----- Method: ZipEncoderNode>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPut:$(; - nextPutAll:'value = '; print: value; - nextPutAll:', freq = '; print: frequency; - nextPutAll:', bitLength = '; print: bitLength; - nextPutAll:', code = '; print: code; - nextPutAll:', height = '; print: height; - nextPut:$).! Item was removed: - ----- Method: ZipEncoderNode>>right (in category 'accessing') ----- - right - ^right! Item was removed: - ----- Method: ZipEncoderNode>>right: (in category 'accessing') ----- - right: aNode - aNode parent: self. - right := aNode.! Item was removed: - ----- Method: ZipEncoderNode>>rotateToHeight: (in category 'encoding') ----- - rotateToHeight: maxHeight - "Rotate the tree to achieve maxHeight depth" - | newParent | - height < 4 ifTrue:[^self]. - self left: (left rotateToHeight: maxHeight-1). - self right: (right rotateToHeight: maxHeight-1). - height := (left height max: right height) + 1. - height <= maxHeight ifTrue:[^self]. - (left height - right height) abs <= 2 ifTrue:[^self]. - left height < right height ifTrue:[ - right right height >= right left height ifTrue:[ - newParent := right. - self right: newParent left. - newParent left: self. - ] ifFalse:[ - newParent := right left. - right left: newParent right. - newParent right: right. - self right: newParent left. - newParent left: self. - ]. - ] ifFalse:[ - left left height >= left right height ifTrue:[ - newParent := left. - self left: newParent right. - newParent right: self. - ] ifFalse:[ - newParent := left right. - left right: newParent left. - newParent left: left. - self left: newParent right. - newParent right: self. - ]. - ]. - parent computeHeight. - ^parent! Item was removed: - ----- Method: ZipEncoderNode>>setBitLengthTo: (in category 'private') ----- - setBitLengthTo: bl - bitLength := bl! Item was removed: - ----- Method: ZipEncoderNode>>setValue:frequency:height: (in category 'private') ----- - setValue: v frequency: f height: h - value := v. - frequency := f. - height := h.! Item was removed: - ----- Method: ZipEncoderNode>>value (in category 'accessing') ----- - value - ^value! Item was removed: - Object subclass: #ZipEncoderTree - instanceVariableNames: 'bitLengths codes maxCode' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! - - !ZipEncoderTree commentStamp: '<historical>' prior: 0! - ZipEncoderTree represents a huffman tree for encoding ZipStreams. - - Instance variables: - bitLengths <WordArray> - Bit lengths of each generated code - codes <WordArray> - Codes for each value - maxCode <Integer> - Maximum value with non-zero frequency! Item was removed: - ----- Method: ZipEncoderTree class>>buildTreeFrom:maxDepth: (in category 'instance creation') ----- - buildTreeFrom: frequencies maxDepth: depth - ^self new buildTreeFrom: frequencies maxDepth: depth! Item was removed: - ----- Method: ZipEncoderTree>>bitLengthAt: (in category 'accessing') ----- - bitLengthAt: index - ^bitLengths at: index+1! Item was removed: - ----- Method: ZipEncoderTree>>bitLengths (in category 'accessing') ----- - bitLengths - "Return an array of all bitLength values for valid codes" - ^bitLengths! Item was removed: - ----- Method: ZipEncoderTree>>bitLengths:codes: (in category 'private') ----- - bitLengths: blArray codes: codeArray - bitLengths := blArray as: WordArray. - codes := codeArray as: WordArray. - self assert:[(self bitLengthAt: maxCode) > 0].! Item was removed: - ----- Method: ZipEncoderTree>>buildCodes:counts:maxDepth: (in category 'encoding') ----- - buildCodes: nodeList counts: blCounts maxDepth: depth - "Build the codes for all nodes" - | nextCode code node length | - nextCode := WordArray new: depth+1. - code := 0. - 1 to: depth do:[:bits| - code := (code + (blCounts at: bits)) << 1. - nextCode at: bits+1 put: code]. - self assert:[(code + (blCounts at: depth+1) - 1) = (1 << depth - 1)]. - 0 to: maxCode do:[:n| - node := nodeList at: n+1. - length := node bitLength. - length = 0 ifFalse:[ - code := nextCode at: length+1. - node code: (self reverseBits: code length: length). - nextCode at: length+1 put: code+1. - ]. - ].! Item was removed: - ----- Method: ZipEncoderTree>>buildHierarchyFrom: (in category 'encoding') ----- - buildHierarchyFrom: aHeap - "Build the node hierarchy based on the leafs in aHeap" - | left right parent | - [aHeap size > 1] whileTrue:[ - left := aHeap removeFirst. - right := aHeap removeFirst. - parent := ZipEncoderNode value: -1 - frequency: (left frequency + right frequency) - height: (left height max: right height) + 1. - left parent: parent. - right parent: parent. - parent left: left. - parent right: right. - aHeap add: parent]. - ^aHeap removeFirst - ! Item was removed: - ----- Method: ZipEncoderTree>>buildTree:maxDepth: (in category 'encoding') ----- - buildTree: nodeList maxDepth: depth - "Build either the literal or the distance tree" - | heap rootNode blCounts | - heap := Heap new: nodeList size // 3. - heap sortBlock: self nodeSortBlock. - "Find all nodes with non-zero frequency and add to heap" - maxCode := 0. - nodeList do:[:dNode| - dNode frequency = 0 ifFalse:[ - maxCode := dNode value. - heap add: dNode]]. - "The pkzip format requires that at least one distance code exists, - and that at least one bit should be sent even if there is only one - possible code. So to avoid special checks later on we force at least - two codes of non zero frequency." - heap size = 0 ifTrue:[ - self assert:[maxCode = 0]. - heap add: nodeList first. - heap add: nodeList second. - maxCode := 1]. - heap size = 1 ifTrue:[ - nodeList first frequency = 0 - ifTrue:[heap add: nodeList first] - ifFalse:[heap add: nodeList second]. - maxCode := maxCode max: 1]. - rootNode := self buildHierarchyFrom: heap. - rootNode height > depth ifTrue:[ - rootNode := rootNode rotateToHeight: depth. - rootNode height > depth ifTrue:[self error:'Cannot encode tree']]. - blCounts := WordArray new: depth+1. - rootNode encodeBitLength: blCounts from: self. - self buildCodes: nodeList counts: blCounts maxDepth: depth. - self setValuesFrom: nodeList.! Item was removed: - ----- Method: ZipEncoderTree>>buildTreeFrom:maxDepth: (in category 'encoding') ----- - buildTreeFrom: frequencies maxDepth: depth - "Build the receiver from the given frequency values" - | nodeList | - nodeList := Array new: frequencies size. - 1 to: frequencies size do:[:i| - nodeList at: i put: (ZipEncoderNode value: i-1 frequency: (frequencies at: i) height: 0) - ]. - self buildTree: nodeList maxDepth: depth.! Item was removed: - ----- Method: ZipEncoderTree>>codeAt: (in category 'accessing') ----- - codeAt: index - ^codes at: index+1! Item was removed: - ----- Method: ZipEncoderTree>>codes (in category 'accessing') ----- - codes - "Return an array of all valid codes" - ^codes! Item was removed: - ----- Method: ZipEncoderTree>>maxCode (in category 'accessing') ----- - maxCode - ^maxCode! Item was removed: - ----- Method: ZipEncoderTree>>maxCode: (in category 'accessing') ----- - maxCode: aNumber - maxCode := aNumber.! Item was removed: - ----- Method: ZipEncoderTree>>nodeSortBlock (in category 'encoding') ----- - nodeSortBlock - ^[:n1 :n2| - n1 frequency = n2 frequency - ifTrue:[n1 height <= n2 height] - ifFalse:[n1 frequency <= n2 frequency]].! Item was removed: - ----- Method: ZipEncoderTree>>reverseBits:length: (in category 'private') ----- - reverseBits: code length: length - "Bit reverse the given code" - | result bit bits | - result := 0. - bits := code. - 1 to: length do:[:i| - bit := bits bitAnd: 1. - result := result << 1 bitOr: bit. - bits := bits >> 1]. - ^result! Item was removed: - ----- Method: ZipEncoderTree>>setValuesFrom: (in category 'private') ----- - setValuesFrom: nodeList - self bitLengths: (nodeList - collect: [:n | n bitLength] - from: 1 - to: maxCode + 1) - codes: (nodeList - collect: [:n | n code] - from: 1 - to: maxCode + 1)! Item was removed: - SharedPool subclass: #ZipFileConstants - instanceVariableNames: '' - classVariableNames: 'CentralDirectoryFileHeaderSignature CompressionDeflated CompressionLevelDefault CompressionLevelNone CompressionStored DataDescriptorLength DefaultDirectoryPermissions DefaultFilePermissions DeflatingCompressionFast DeflatingCompressionMaximum DeflatingCompressionNormal DeflatingCompressionSuperFast DirectoryAttrib EndOfCentralDirectorySignature FaMsdos FaUnix FileAttrib IfaBinaryFile IfaTextFile LocalFileHeaderSignature' - poolDictionaries: '' - category: 'Compression-Archives'! Item was removed: - ----- Method: ZipFileConstants class>>initialize (in category 'pool initialization') ----- - initialize - "ZipFileConstants initialize" - FaMsdos := 0. - FaUnix := 3. - DeflatingCompressionNormal := 0. - DeflatingCompressionMaximum := 2. - DeflatingCompressionFast := 4. - DeflatingCompressionSuperFast := 6. - CompressionStored := 0. - CompressionDeflated := 8. - CompressionLevelNone := 0. - CompressionLevelDefault := 6. - IfaTextFile := 1. - IfaBinaryFile := 0. - DataDescriptorLength := 12. - - "Unix permission bits" - DefaultDirectoryPermissions := 8r040755. - DefaultFilePermissions := 8r0100666. - DirectoryAttrib := 8r040000. - FileAttrib := 8r0100000. - - CentralDirectoryFileHeaderSignature := #[ 16r50 16r4B 16r01 16r02 ]. - LocalFileHeaderSignature := #[ 16r50 16r4B 16r03 16r04 ]. - EndOfCentralDirectorySignature := #[ 16r50 16r4B 16r05 16r06 ].! Item was removed: - ZipArchiveMember subclass: #ZipFileMember - instanceVariableNames: 'externalFileName stream localHeaderRelativeOffset dataOffset' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !ZipFileMember commentStamp: '<historical>' prior: 0! - ZipNewFileMember instances are used to represent files that have been read from a ZipArchive. - Their data stays in the file on disk, so the original Zip file cannot be directly overwritten.! Item was removed: - ----- Method: ZipFileMember class>>newFrom:named: (in category 'as yet unclassified') ----- - newFrom: stream named: fileName - ^(self new) stream: stream externalFileName: fileName! Item was removed: - ----- Method: ZipFileMember>>asDirectory (in category 'private') ----- - asDirectory - ^ZipDirectoryMember new copyFrom: self! Item was removed: - ----- Method: ZipFileMember>>canonicalizeFileName (in category 'private-reading') ----- - canonicalizeFileName - "For security reasons, make all paths relative and remove any ../ portions" - - [fileName beginsWith: '/'] whileTrue: [fileName := fileName allButFirst]. - fileName := fileName copyReplaceAll: '../' with: ''! Item was removed: - ----- Method: ZipFileMember>>close (in category 'initialization') ----- - close - stream ifNotNil:[stream close].! Item was removed: - ----- Method: ZipFileMember>>copyDataTo: (in category 'private-writing') ----- - copyDataTo: aStream - - self copyRawDataTo: aStream.! Item was removed: - ----- Method: ZipFileMember>>initialize (in category 'initialization') ----- - initialize - super initialize. - crc32 := 0. - localHeaderRelativeOffset := 0. - dataOffset := 0.! Item was removed: - ----- Method: ZipFileMember>>localHeaderRelativeOffset (in category 'private-writing') ----- - localHeaderRelativeOffset - ^localHeaderRelativeOffset! Item was removed: - ----- Method: ZipFileMember>>looksLikeDirectory (in category 'testing') ----- - looksLikeDirectory - ^fileName last = $/ - and: [ uncompressedSize = 0 ]! Item was removed: - ----- Method: ZipFileMember>>readCentralDirectoryFileHeaderFrom: (in category 'private-reading') ----- - readCentralDirectoryFileHeaderFrom: aStream - "Assumes aStream positioned after signature" - - | fileNameLength extraFieldLength fileCommentLength | - - versionMadeBy := aStream nextLittleEndianNumber: 1. - fileAttributeFormat := aStream nextLittleEndianNumber: 1. - - versionNeededToExtract := aStream nextLittleEndianNumber: 2. - bitFlag := aStream nextLittleEndianNumber: 2. - compressionMethod := aStream nextLittleEndianNumber: 2. - - lastModFileDateTime := aStream nextLittleEndianNumber: 4. - crc32 := aStream nextLittleEndianNumber: 4. - compressedSize := aStream nextLittleEndianNumber: 4. - uncompressedSize := aStream nextLittleEndianNumber: 4. - - fileNameLength := aStream nextLittleEndianNumber: 2. - extraFieldLength := aStream nextLittleEndianNumber: 2. - fileCommentLength := aStream nextLittleEndianNumber: 2. - aStream nextLittleEndianNumber: 2. "disk number start" - internalFileAttributes := aStream nextLittleEndianNumber: 2. - - externalFileAttributes := aStream nextLittleEndianNumber: 4. - localHeaderRelativeOffset := aStream nextLittleEndianNumber: 4. - - fileName := (aStream next: fileNameLength) asString asSqueakPathName. - cdExtraField := (aStream next: extraFieldLength) asByteArray asString. - fileComment := (aStream next: fileCommentLength) asString convertFromSystemString. - - self desiredCompressionMethod: compressionMethod! Item was removed: - ----- Method: ZipFileMember>>readFrom: (in category 'private-reading') ----- - readFrom: aStream - "assumes aStream positioned after CD header; leaves stream positioned after my CD entry" - - self readCentralDirectoryFileHeaderFrom: aStream. - self readLocalDirectoryFileHeaderFrom: aStream. - self endRead. - self canonicalizeFileName. - ! Item was removed: - ----- Method: ZipFileMember>>readLocalDirectoryFileHeaderFrom: (in category 'private-reading') ----- - readLocalDirectoryFileHeaderFrom: aStream - "Positions stream as necessary. Will return stream to its original position" - - | fileNameLength extraFieldLength xcrc32 xcompressedSize xuncompressedSize sig oldPos | - - oldPos := aStream position. - - aStream position: localHeaderRelativeOffset. - - sig := aStream next: 4. - sig = LocalFileHeaderSignature asByteArray - ifFalse: [ aStream position: oldPos. - ^self error: 'bad LH signature at ', localHeaderRelativeOffset printStringHex ]. - - versionNeededToExtract := aStream nextLittleEndianNumber: 2. - bitFlag := aStream nextLittleEndianNumber: 2. - compressionMethod := aStream nextLittleEndianNumber: 2. - - lastModFileDateTime := aStream nextLittleEndianNumber: 4. - xcrc32 := aStream nextLittleEndianNumber: 4. - xcompressedSize := aStream nextLittleEndianNumber: 4. - xuncompressedSize := aStream nextLittleEndianNumber: 4. - - fileNameLength := aStream nextLittleEndianNumber: 2. - extraFieldLength := aStream nextLittleEndianNumber: 2. - - fileName := (aStream next: fileNameLength) asString asSqueakPathName. - localExtraField := (aStream next: extraFieldLength) asByteArray. - - dataOffset := aStream position. - - "Don't trash these fields if we already got them from the central directory" - self hasDataDescriptor ifFalse: [ - crc32 := xcrc32. - compressedSize := xcompressedSize. - uncompressedSize := xuncompressedSize. - ]. - - aStream position: oldPos.! Item was removed: - ----- Method: ZipFileMember>>readRawChunk: (in category 'private-reading') ----- - readRawChunk: n - ^stream ensureOpen next: n! Item was removed: - ----- Method: ZipFileMember>>rewindData (in category 'private-reading') ----- - rewindData - super rewindData. - stream isNil ifTrue: [ self error: 'stream missing' ]. - stream ensureOpen. - stream position: localHeaderRelativeOffset + 4. - self skipLocalDirectoryFileHeaderFrom: stream! Item was removed: - ----- Method: ZipFileMember>>skipLocalDirectoryFileHeaderFrom: (in category 'private-reading') ----- - skipLocalDirectoryFileHeaderFrom: aStream - "Assumes that stream is positioned after signature." - - | extraFieldLength fileNameLength | - aStream next: 22. - fileNameLength := aStream nextLittleEndianNumber: 2. - extraFieldLength := aStream nextLittleEndianNumber: 2. - aStream next: fileNameLength. - aStream next: extraFieldLength. - dataOffset := aStream position. - ! Item was removed: - ----- Method: ZipFileMember>>stream:externalFileName: (in category 'initialization') ----- - stream: aStream externalFileName: aFileName - stream := aStream. - externalFileName := aFileName.! Item was removed: - ----- Method: ZipFileMember>>uncompressDataTo: (in category 'private-writing') ----- - uncompressDataTo: aStream - - | decoder buffer crcErrorMessage | - decoder := ZipReadStream on: stream ensureOpen. - decoder expectedCrc: self crc32. - buffer := ByteArray new: (32768 min: readDataRemaining). - crcErrorMessage := nil. - - [[ readDataRemaining > 0 ] whileTrue: [ - | chunkSize | - chunkSize := 32768 min: readDataRemaining. - buffer := decoder next: chunkSize into: buffer startingAt: 1. - aStream next: chunkSize putAll: buffer startingAt: 1. - readDataRemaining := readDataRemaining - chunkSize. - ]] on: CRCError do: [ :ex | crcErrorMessage := ex messageText. ex proceed ]. - - crcErrorMessage ifNotNil: [ self isCorrupt: true. CRCError signal: crcErrorMessage ] - - ! Item was removed: - ----- Method: ZipFileMember>>uncompressDataTo:from:to: (in category 'private-writing') ----- - uncompressDataTo: aStream from: start to: finish - - | decoder buffer chunkSize | - decoder := FastInflateStream on: stream ensureOpen. - readDataRemaining := readDataRemaining min: finish - start + 1. - buffer := ByteArray new: (32768 min: readDataRemaining). - decoder next: start - 1. - - [ readDataRemaining > 0 ] whileTrue: [ - chunkSize := 32768 min: readDataRemaining. - buffer := decoder next: chunkSize into: buffer startingAt: 1. - aStream next: chunkSize putAll: buffer startingAt: 1. - readDataRemaining := readDataRemaining - chunkSize. - ]. - ! Item was removed: - ----- Method: ZipFileMember>>usesFileNamed: (in category 'testing') ----- - usesFileNamed: aFileName - "Do I require aFileName? That is, do I care if it's clobbered?" - ^(FileDirectory default fullNameFor: externalFileName) = (FileDirectory default fullNameFor: aFileName)! Item was removed: - ZipArchiveMember subclass: #ZipNewFileMember - instanceVariableNames: 'externalFileName stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !ZipNewFileMember commentStamp: '<historical>' prior: 0! - ZipNewFileMember instances are used to represent files that are going to be written to a ZipArchive. - Their data comes from external file streams.! Item was removed: - ----- Method: ZipNewFileMember class>>newNamed: (in category 'instance creation') ----- - newNamed: aFileName - ^(self new) from: aFileName! Item was removed: - ----- Method: ZipNewFileMember>>close (in category 'initialization') ----- - close - stream ifNotNil:[stream close].! Item was removed: - ----- Method: ZipNewFileMember>>from: (in category 'initialization') ----- - from: aFileName - | entry | - compressionMethod := CompressionStored. - "Now get the size, attributes, and timestamps, and see if the file exists" - stream := (StandardFileStream readOnlyFileNamed: aFileName) close. - self localFileName: (externalFileName := stream name). - entry := stream directoryEntry. - compressedSize := uncompressedSize := entry fileSize. - desiredCompressionMethod := compressedSize > 0 ifTrue: [ CompressionDeflated ] ifFalse: [ CompressionStored ]. - self setLastModFileDateTimeFrom: entry modificationTime - ! Item was removed: - ----- Method: ZipNewFileMember>>initialize (in category 'initialization') ----- - initialize - super initialize. - externalFileName := ''.! Item was removed: - ----- Method: ZipNewFileMember>>openStreamWhile: (in category 'private-writing') ----- - openStreamWhile: aBlock - stream open. - ^ aBlock ensure: [ stream close ]! Item was removed: - ----- Method: ZipNewFileMember>>readRawChunk: (in category 'private') ----- - readRawChunk: n - ^stream next: n! Item was removed: - ----- Method: ZipNewFileMember>>rewindData (in category 'private-writing') ----- - rewindData - super rewindData. - readDataRemaining := stream ensureOpen size. - stream position: 0.! Item was removed: - ----- Method: ZipNewFileMember>>usesFileNamed: (in category 'testing') ----- - usesFileNamed: aFileName - "Do I require aFileName? That is, do I care if it's clobbered?" - ^(FileDirectory default fullNameFor: externalFileName) = (FileDirectory default fullNameFor: aFileName)! Item was removed: - FastInflateStream subclass: #ZipReadStream - instanceVariableNames: 'expectedCrc' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Streams'! - - !ZipReadStream commentStamp: 'nk 3/7/2004 18:54' prior: 0! - ZipReadStream is intended for uncompressing the compressed contents of Zip archive members. - - Since Zip archive members keep their expected CRC value separately in Zip headers, this class does not attempt to read the CRC from its input stream. - - Instead, if you want the CRC verification to work you have to call #expectedCrc: with the expected CRC-32 value from the Zip member header.! Item was removed: - ----- Method: ZipReadStream>>expectedCrc: (in category 'crc') ----- - expectedCrc: aNumberOrNil - "If expectedCrc is set, it will be compared against the calculated CRC32 in verifyCrc. - This number should be the number read from the Zip header (which is the bitwise complement of my crc if all is working correctly)" - expectedCrc := aNumberOrNil! Item was removed: - ----- Method: ZipReadStream>>on:from:to: (in category 'initialize') ----- - on: aCollection from: firstIndex to: lastIndex - super on: aCollection from: firstIndex to: lastIndex. - crc := 16rFFFFFFFF. - expectedCrc := nil.! Item was removed: - ----- Method: ZipReadStream>>updateCrc:from:to:in: (in category 'crc') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - ^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection! Item was removed: - ----- Method: ZipReadStream>>verifyCrc (in category 'crc') ----- - verifyCrc - "Verify the CRC-32 checksum calculated from the input against the expected CRC-32, if any. - Answer the calculated CRC-32 in any case. - Note that the CRC-32 used in Zip files is actually the bit inverse of the calculated value, so that is what is returned." - - | invertedCrc | - invertedCrc := crc bitXor: 16rFFFFFFFF. - (expectedCrc notNil and: [ expectedCrc ~= invertedCrc ]) - ifTrue: [ ^ self crcError: ('Wrong CRC-32 (expected {1} got {2}) (proceed to ignore)' translated format: { expectedCrc printStringHex. invertedCrc printStringHex }) ]. - ^invertedCrc! Item was removed: - ZipArchiveMember subclass: #ZipStringMember - instanceVariableNames: 'contents stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Compression-Archives'! - - !ZipStringMember commentStamp: '<historical>' prior: 0! - ZipStringMember instances are used to represent files that are going to be written to a ZipArchive. - Their data comes from in-image strings, though.! Item was removed: - ----- Method: ZipStringMember class>>newFrom:named: (in category 'as yet unclassified') ----- - newFrom: aString named: aFileName - ^(self new) contents: aString; localFileName: aFileName; yourself! Item was removed: - ----- Method: ZipStringMember>>contents (in category 'initialization') ----- - contents - ^contents! Item was removed: - ----- Method: ZipStringMember>>contents: (in category 'initialization') ----- - contents: aString - contents := aString. - compressedSize := uncompressedSize := aString size. - "set the file date to now" - self setLastModFileDateTimeFrom: Time totalSeconds! Item was removed: - ----- Method: ZipStringMember>>initialize (in category 'initialization') ----- - initialize - super initialize. - self contents: ''. - compressionMethod := desiredCompressionMethod := CompressionStored. - ! Item was removed: - ----- Method: ZipStringMember>>readRawChunk: (in category 'private') ----- - readRawChunk: n - ^stream next: n! Item was removed: - ----- Method: ZipStringMember>>rewindData (in category 'private-writing') ----- - rewindData - super rewindData. - stream := ReadStream on: contents. - readDataRemaining := contents size.! Item was removed: - DeflateStream subclass: #ZipWriteStream - instanceVariableNames: 'literals distances literalFreq distanceFreq litCount matchCount encoder crc crcPosition bytesWritten' - classVariableNames: 'CrcTable VerboseLevel' - poolDictionaries: 'ZipConstants' - category: 'Compression-Streams'! Item was removed: - ----- Method: ZipWriteStream class>>baseDistance (in category 'accessing') ----- - baseDistance - ^BaseDistance! Item was removed: - ----- Method: ZipWriteStream class>>baseLength (in category 'accessing') ----- - baseLength - ^BaseLength! Item was removed: - ----- Method: ZipWriteStream class>>compressAndDecompress:using:stats: (in category 'regression test') ----- - compressAndDecompress: aFile using: tempName stats: stats - | fileSize tempFile result | - aFile == nil ifTrue:[^nil]. - fileSize := aFile size. - (fileSize < 1"00000" "or:[fileSize > 1000000]") ifTrue:[aFile close. ^nil]. - Transcript cr; show:'Testing ', aFile name,' ... '. - tempFile := StandardFileStream new open: tempName forWrite: true. - 'Compressing ', aFile name,'...' - displayProgressFrom: 1 to: aFile size during:[:bar| - result := self regressionCompress: aFile into: tempFile notifiying: bar stats: stats]. - result ifTrue:[ - 'Validating ', aFile name,'...' - displayProgressFrom: 0 to: aFile size during:[:bar| - result := self regressionDecompress: aFile from: tempFile notifying: bar stats: stats]]. - aFile close. - tempFile close. - FileDirectory default deleteFileNamed: tempName ifAbsent:[]. - result ~~ false ifTrue:[ - Transcript show:' ok (', (result * 100 truncateTo: 0.01) printString,')']. - ^result! Item was removed: - ----- Method: ZipWriteStream class>>crcTable (in category 'accessing') ----- - crcTable - ^CrcTable! Item was removed: - ----- Method: ZipWriteStream class>>distanceCodes (in category 'accessing') ----- - distanceCodes - ^DistanceCodes! Item was removed: - ----- Method: ZipWriteStream class>>extraDistanceBits (in category 'accessing') ----- - extraDistanceBits - ^ExtraDistanceBits! Item was removed: - ----- Method: ZipWriteStream class>>extraLengthBits (in category 'accessing') ----- - extraLengthBits - ^ExtraLengthBits! Item was removed: - ----- Method: ZipWriteStream class>>initialize (in category 'class initialization') ----- - initialize - "ZipWriteStream initialize" - VerboseLevel := 0. - self initializeCrcTable.! Item was removed: - ----- Method: ZipWriteStream class>>initializeCrcTable (in category 'class initialization') ----- - initializeCrcTable - "ZipWriteStream initialize" - CrcTable := #(16r00000000 16r77073096 16rEE0E612C 16r990951BA 16r076DC419 - 16r706AF48F 16rE963A535 16r9E6495A3 16r0EDB8832 16r79DCB8A4 - 16rE0D5E91E 16r97D2D988 16r09B64C2B 16r7EB17CBD 16rE7B82D07 - 16r90BF1D91 16r1DB71064 16r6AB020F2 16rF3B97148 16r84BE41DE - 16r1ADAD47D 16r6DDDE4EB 16rF4D4B551 16r83D385C7 16r136C9856 - 16r646BA8C0 16rFD62F97A 16r8A65C9EC 16r14015C4F 16r63066CD9 - 16rFA0F3D63 16r8D080DF5 16r3B6E20C8 16r4C69105E 16rD56041E4 - 16rA2677172 16r3C03E4D1 16r4B04D447 16rD20D85FD 16rA50AB56B - 16r35B5A8FA 16r42B2986C 16rDBBBC9D6 16rACBCF940 16r32D86CE3 - 16r45DF5C75 16rDCD60DCF 16rABD13D59 16r26D930AC 16r51DE003A - 16rC8D75180 16rBFD06116 16r21B4F4B5 16r56B3C423 16rCFBA9599 - 16rB8BDA50F 16r2802B89E 16r5F058808 16rC60CD9B2 16rB10BE924 - 16r2F6F7C87 16r58684C11 16rC1611DAB 16rB6662D3D 16r76DC4190 - 16r01DB7106 16r98D220BC 16rEFD5102A 16r71B18589 16r06B6B51F - 16r9FBFE4A5 16rE8B8D433 16r7807C9A2 16r0F00F934 16r9609A88E - 16rE10E9818 16r7F6A0DBB 16r086D3D2D 16r91646C97 16rE6635C01 - 16r6B6B51F4 16r1C6C6162 16r856530D8 16rF262004E 16r6C0695ED - 16r1B01A57B 16r8208F4C1 16rF50FC457 16r65B0D9C6 16r12B7E950 - 16r8BBEB8EA 16rFCB9887C 16r62DD1DDF 16r15DA2D49 16r8CD37CF3 - 16rFBD44C65 16r4DB26158 16r3AB551CE 16rA3BC0074 16rD4BB30E2 - 16r4ADFA541 16r3DD895D7 16rA4D1C46D 16rD3D6F4FB 16r4369E96A - 16r346ED9FC 16rAD678846 16rDA60B8D0 16r44042D73 16r33031DE5 - 16rAA0A4C5F 16rDD0D7CC9 16r5005713C 16r270241AA 16rBE0B1010 - 16rC90C2086 16r5768B525 16r206F85B3 16rB966D409 16rCE61E49F - 16r5EDEF90E 16r29D9C998 16rB0D09822 16rC7D7A8B4 16r59B33D17 - 16r2EB40D81 16rB7BD5C3B 16rC0BA6CAD 16rEDB88320 16r9ABFB3B6 - 16r03B6E20C 16r74B1D29A 16rEAD54739 16r9DD277AF 16r04DB2615 - 16r73DC1683 16rE3630B12 16r94643B84 16r0D6D6A3E 16r7A6A5AA8 - 16rE40ECF0B 16r9309FF9D 16r0A00AE27 16r7D079EB1 16rF00F9344 - 16r8708A3D2 16r1E01F268 16r6906C2FE 16rF762575D 16r806567CB - 16r196C3671 16r6E6B06E7 16rFED41B76 16r89D32BE0 16r10DA7A5A - 16r67DD4ACC 16rF9B9DF6F 16r8EBEEFF9 16r17B7BE43 16r60B08ED5 - 16rD6D6A3E8 16rA1D1937E 16r38D8C2C4 16r4FDFF252 16rD1BB67F1 - 16rA6BC5767 16r3FB506DD 16r48B2364B 16rD80D2BDA 16rAF0A1B4C - 16r36034AF6 16r41047A60 16rDF60EFC3 16rA867DF55 16r316E8EEF - 16r4669BE79 16rCB61B38C 16rBC66831A 16r256FD2A0 16r5268E236 - 16rCC0C7795 16rBB0B4703 16r220216B9 16r5505262F 16rC5BA3BBE - 16rB2BD0B28 16r2BB45A92 16r5CB36A04 16rC2D7FFA7 16rB5D0CF31 - 16r2CD99E8B 16r5BDEAE1D 16r9B64C2B0 16rEC63F226 16r756AA39C - 16r026D930A 16r9C0906A9 16rEB0E363F 16r72076785 16r05005713 - 16r95BF4A82 16rE2B87A14 16r7BB12BAE 16r0CB61B38 16r92D28E9B - 16rE5D5BE0D 16r7CDCEFB7 16r0BDBDF21 16r86D3D2D4 16rF1D4E242 - 16r68DDB3F8 16r1FDA836E 16r81BE16CD 16rF6B9265B 16r6FB077E1 - 16r18B74777 16r88085AE6 16rFF0F6A70 16r66063BCA 16r11010B5C - 16r8F659EFF 16rF862AE69 16r616BFFD3 16r166CCF45 16rA00AE278 - 16rD70DD2EE 16r4E048354 16r3903B3C2 16rA7672661 16rD06016F7 - 16r4969474D 16r3E6E77DB 16rAED16A4A 16rD9D65ADC 16r40DF0B66 - 16r37D83BF0 16rA9BCAE53 16rDEBB9EC5 16r47B2CF7F 16r30B5FFE9 - 16rBDBDF21C 16rCABAC28A 16r53B39330 16r24B4A3A6 16rBAD03605 - 16rCDD70693 16r54DE5729 16r23D967BF 16rB3667A2E 16rC4614AB8 - 16r5D681B02 16r2A6F2B94 16rB40BBE37 16rC30C8EA1 16r5A05DF1B - 16r2D02EF8D - ).! Item was removed: - ----- Method: ZipWriteStream class>>logProblem:for: (in category 'regression test') ----- - logProblem: reason for: aFile - | errFile | - errFile := FileStream fileNamed:'problems.log'. - errFile position: errFile size. - errFile cr; nextPutAll: aFile name; - cr; nextPutAll: reason. - errFile close. - Transcript show:' failed (', reason,')'. - aFile close. - ^false! Item was removed: - ----- Method: ZipWriteStream class>>matchLengthCodes (in category 'accessing') ----- - matchLengthCodes - ^MatchLengthCodes! Item was removed: - ----- Method: ZipWriteStream class>>maxDistanceCodes (in category 'accessing') ----- - maxDistanceCodes - ^MaxDistCodes! Item was removed: - ----- Method: ZipWriteStream class>>maxLiteralCodes (in category 'accessing') ----- - maxLiteralCodes - ^MaxLiteralCodes! Item was removed: - ----- Method: ZipWriteStream class>>printRegressionStats:from: (in category 'regression test') ----- - printRegressionStats: stats from: fd - | raw compressed numFiles | - raw := stats at: #rawSize ifAbsent:[0]. - raw = 0 ifTrue:[^self]. - compressed := stats at: #compressedSize ifAbsent:[0]. - numFiles := stats at: #numFiles ifAbsent:[0]. - Transcript cr; nextPutAll: fd pathName. - Transcript crtab; nextPutAll:'Files compressed: ', numFiles asStringWithCommas. - Transcript crtab; nextPutAll:'Bytes compressed: ', raw asStringWithCommas. - Transcript crtab; nextPutAll:'Avg. compression ratio: '; - print: ((compressed / raw asFloat * 100.0) truncateTo: 0.01). - Transcript endEntry.! Item was removed: - ----- Method: ZipWriteStream class>>regressionCompress:into:notifiying:stats: (in category 'regression test') ----- - regressionCompress: aFile into: tempFile notifiying: progressBar stats: stats - "Compress aFile into tempFile" - | zip encoded buffer | - aFile binary. - aFile position: 0. - tempFile binary. - buffer := ByteArray new: 4096. - zip := self on: (ByteArray new: 10000). - encoded := zip encodedStream. - [aFile atEnd] whileFalse:[ - progressBar value: aFile position. - zip nextPutAll: (aFile nextInto: buffer). - encoded position > 0 ifTrue:[ - tempFile nextPutAll: encoded contents. - encoded position: 0]]. - zip close. - tempFile nextPutAll: encoded contents. - ^true! Item was removed: - ----- Method: ZipWriteStream class>>regressionDecompress:from:notifying:stats: (in category 'regression test') ----- - regressionDecompress: aFile from: tempFile notifying: progressBar stats: stats - "Validate aFile as decompressed from tempFile" - | unzip rawSize compressedSize buffer1 buffer2 | - rawSize := aFile size. - compressedSize := tempFile size. - aFile ascii. - aFile position: 0. - tempFile ascii. - tempFile position: 0. - buffer1 := ByteArray new: 4096. - buffer2 := buffer1 copy. - unzip := FastInflateStream on: tempFile. - [aFile atEnd] whileFalse:[ - progressBar value: aFile position. - buffer1 := aFile nextInto: buffer1. - buffer2 := unzip nextInto: buffer2. - buffer1 = buffer2 - ifFalse:[^self logProblem: 'contents ' for: aFile]. - ]. - unzip next = nil ifFalse:[^self logProblem: 'EOF' for: aFile]. - stats at: #rawSize put: - (stats at: #rawSize ifAbsent:[0]) + rawSize. - stats at: #compressedSize put: - (stats at: #compressedSize ifAbsent:[0]) + compressedSize. - ^compressedSize asFloat / rawSize asFloat.! Item was removed: - ----- Method: ZipWriteStream class>>regressionTest (in category 'regression test') ----- - regressionTest "ZipWriteStream regressionTest" - "Compress and decompress everything we can - find to validate that compression works as expected." - self regressionTestFrom: (FileDirectory default).! Item was removed: - ----- Method: ZipWriteStream class>>regressionTestFrom: (in category 'regression test') ----- - regressionTestFrom: fd - "ZipWriteStream regressionTestFrom: FileDirectory default" - "ZipWriteStream regressionTestFrom: (FileDirectory on:'')" - "ZipWriteStream regressionTestFrom: (FileDirectory on:'C:')" - | tempName stats | - Transcript clear. - stats := Dictionary new. - tempName := FileDirectory default fullNameFor: '$$sqcompress$$'. - FileDirectory default deleteFileNamed: tempName. - self regressionTestFrom: fd using: tempName stats: stats.! Item was removed: - ----- Method: ZipWriteStream class>>regressionTestFrom:using:stats: (in category 'regression test') ----- - regressionTestFrom: fd using: tempName stats: stats - | files | - files := fd fileNames sort. - files do:[:fName| | fullName file | - file := nil. - fullName := fd fullNameFor: fName. - fullName = tempName ifFalse:[ - file := StandardFileStream new open: fullName forWrite: false]. - self compressAndDecompress: file using: tempName stats: stats]. - stats at: #numFiles put: (stats at: #numFiles ifAbsent:[0]) + files size. - files := nil. - self printRegressionStats: stats from: fd. - fd directoryNames sort do:[:dName| - self regressionTestFrom: (fd directoryNamed: dName) using: tempName stats: stats. - ].! Item was removed: - ----- Method: ZipWriteStream class>>updateCrc:from:to:in: (in category 'crc') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - | newCrc | - <primitive: 'primitiveUpdateGZipCrc32' module: 'ZipPlugin'> - newCrc := oldCrc. - start to: stop do:[:i| - newCrc := (CrcTable at: ((newCrc bitXor: (aCollection byteAt: i)) - bitAnd: 255) + 1) bitXor: (newCrc bitShift: -8). - ]. - ^newCrc! Item was removed: - ----- Method: ZipWriteStream>>close (in category 'initialize-release') ----- - close - self deflateBlock. - self flushBlock: true. - encoder close.! Item was removed: - ----- Method: ZipWriteStream>>crc (in category 'accessing') ----- - crc - ^crc! Item was removed: - ----- Method: ZipWriteStream>>deflateBlock:chainLength:goodMatch: (in category 'deflating') ----- - deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch - "^DeflatePlugin doPrimitive:#primitiveDeflateBlock" - <primitive: 'primitiveDeflateBlock' module: 'ZipPlugin'> - ^super deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch! Item was removed: - ----- Method: ZipWriteStream>>dynamicBlockSizeFor:and:using:and: (in category 'dynamic blocks') ----- - dynamicBlockSizeFor: lTree and: dTree using: blTree and: blFreq - "Compute the length for the current block using dynamic huffman trees" - | bits index extra treeBits freq | - bits := 3 "block type" + 5 "literal codes length" + 5 "distance codes length". - - "Compute the # of bits for sending the bit length tree" - treeBits := 4. "Max index for bit length tree" - index := MaxBitLengthCodes. - [index >= 4] whileTrue:[ - (index = 4 or:[(blFreq at: (BitLengthOrder at: index)+1) > 0]) - ifTrue:[treeBits := treeBits + (index * 3). - index := -1] - ifFalse:[index := index - 1]]. - - "Compute the # of bits for sending the literal/distance tree. - Note: The frequency are already stored in the blTree" - 0 to: 15 do:[:i| "First, the non-repeating values" - freq := blFreq at: i+1. - freq > 0 ifTrue:[treeBits := treeBits + (freq * (blTree bitLengthAt: i))]]. - "Now the repeating values" - (Repeat3To6 to: Repeat11To138) with: #(2 3 7) do:[:i :addl| - freq := blFreq at: i+1. - freq > 0 ifTrue:[ - treeBits := treeBits + (freq * ((blTree bitLengthAt: i) + addl "addl bits"))]]. - VerboseLevel > 1 ifTrue:[ - Transcript show:'['; print: treeBits; show:' bits for dynamic tree]']. - bits := bits + treeBits. - - "Compute the size of the compressed block" - 0 to: NumLiterals do:[:i| "encoding of literals" - freq := literalFreq at: i+1. - freq > 0 ifTrue:[bits := bits + (freq * (lTree bitLengthAt: i))]]. - NumLiterals+1 to: lTree maxCode do:[:i| "encoding of match lengths" - freq := literalFreq at: i+1. - extra := ExtraLengthBits at: i-NumLiterals. - freq > 0 ifTrue:[bits := bits + (freq * ((lTree bitLengthAt: i) + extra))]]. - 0 to: dTree maxCode do:[:i| "encoding of distances" - freq := distanceFreq at: i+1. - extra := ExtraDistanceBits at: i+1. - freq > 0 ifTrue:[bits := bits + (freq * ((dTree bitLengthAt: i) + extra))]]. - - ^bits! Item was removed: - ----- Method: ZipWriteStream>>encodeLiteral: (in category 'encoding') ----- - encodeLiteral: lit - "Encode the given literal" - litCount := litCount + 1. - literals at: litCount put: lit. - distances at: litCount put: 0. - literalFreq at: lit+1 put: (literalFreq at: lit+1) + 1. - ^self shouldFlush! Item was removed: - ----- Method: ZipWriteStream>>encodeMatch:distance: (in category 'encoding') ----- - encodeMatch: length distance: dist - "Encode the given match of length length starting at dist bytes ahead" - | literal distance | - dist > 0 - ifFalse:[^self error:'Distance must be positive']. - length < MinMatch - ifTrue:[^self error:'Match length must be at least ', MinMatch printString]. - litCount := litCount + 1. - matchCount := matchCount + 1. - literals at: litCount put: length - MinMatch. - distances at: litCount put: dist. - literal := (MatchLengthCodes at: length - MinMatch + 1). - literalFreq at: literal+1 put: (literalFreq at: literal+1) + 1. - dist < 257 - ifTrue:[distance := DistanceCodes at: dist] - ifFalse:[distance := DistanceCodes at: 257 + (dist - 1 bitShift: -7)]. - distanceFreq at: distance+1 put: (distanceFreq at: distance+1) + 1. - ^self shouldFlush! Item was removed: - ----- Method: ZipWriteStream>>encodedStream (in category 'accessing') ----- - encodedStream - ^encoder encodedStream! Item was removed: - ----- Method: ZipWriteStream>>finish (in category 'initialize-release') ----- - finish - "Finish pending operation. Do not close output stream." - self deflateBlock. - self flushBlock: true. - encoder flush.! Item was removed: - ----- Method: ZipWriteStream>>fixedBlockSizeFor:and: (in category 'fixed blocks') ----- - fixedBlockSizeFor: lTree and: dTree - "Compute the length for the current block using fixed huffman trees" - | bits extra | - bits := 3 "block type". - "Compute the size of the compressed block" - 0 to: NumLiterals do:[:i| "encoding of literals" - bits := bits + ((literalFreq at: i+1) * (FixedLiteralTree bitLengthAt: i))]. - NumLiterals+1 to: lTree maxCode+1 do:[:i| "Encoding of match lengths" - extra := ExtraLengthBits at: i-NumLiterals. - bits := bits + ((literalFreq at: i+1) * ((FixedLiteralTree bitLengthAt: i) + extra))]. - 0 to: dTree maxCode do:[:i| "encoding of distances" - extra := ExtraDistanceBits at: i+1. - bits := bits + ((distanceFreq at: i+1) * ((FixedDistanceTree bitLengthAt: i) + extra))]. - - ^bits! Item was removed: - ----- Method: ZipWriteStream>>flushBlock (in category 'encoding') ----- - flushBlock - ^self flushBlock: false! Item was removed: - ----- Method: ZipWriteStream>>flushBlock: (in category 'encoding') ----- - flushBlock: lastBlock - "Send the current block" - | lastFlag bitsRequired method bitsSent - storedLength fixedLength dynamicLength - blTree lTree dTree blBits blFreq | - - lastFlag := lastBlock ifTrue:[1] ifFalse:[0]. - - "Compute the literal/length and distance tree" - lTree := ZipEncoderTree buildTreeFrom: literalFreq maxDepth: MaxBits. - dTree := ZipEncoderTree buildTreeFrom: distanceFreq maxDepth: MaxBits. - - "Compute the bit length tree" - blBits := lTree bitLengths, dTree bitLengths. - blFreq := WordArray new: MaxBitLengthCodes. - self scanBitLengths: blBits into: blFreq. - blTree := ZipEncoderTree buildTreeFrom: blFreq maxDepth: MaxBitLengthBits. - - "Compute the bit length for the current block. - Note: Most of this could be computed on the fly but it's getting - really ugly in this case so we do it afterwards." - storedLength := self storedBlockSize. - fixedLength := self fixedBlockSizeFor: lTree and: dTree. - dynamicLength := self dynamicBlockSizeFor: lTree and: dTree - using: blTree and: blFreq. - VerboseLevel > 1 ifTrue:[ - Transcript cr; show:'Block sizes (S/F/D):'; - space; print: storedLength // 8; - nextPut:$/; print: fixedLength // 8; - nextPut:$/; print: dynamicLength // 8; space; endEntry]. - - "Check which method to use" - method := self forcedMethod. - method ifNil:[ - method := (storedLength < fixedLength and:[storedLength < dynamicLength]) - ifTrue:[#stored] - ifFalse:[fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]]]. - (method == #stored and:[blockStart < 0]) ifTrue:[ - "Cannot use #stored if the block is not available" - method := fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]]. - - bitsSent := encoder bitPosition. "# of bits sent before this block" - bitsRequired := nil. - - (method == #stored) ifTrue:[ - VerboseLevel > 0 ifTrue:[Transcript show:'S']. - bitsRequired := storedLength. - encoder nextBits: 3 put: StoredBlock << 1 + lastFlag. - self sendStoredBlock]. - - (method == #fixed) ifTrue:[ - VerboseLevel > 0 ifTrue:[Transcript show:'F']. - bitsRequired := fixedLength. - encoder nextBits: 3 put: FixedBlock << 1 + lastFlag. - self sendFixedBlock]. - - (method == #dynamic) ifTrue:[ - VerboseLevel > 0 ifTrue:[Transcript show:'D']. - bitsRequired := dynamicLength. - encoder nextBits: 3 put: DynamicBlock << 1 + lastFlag. - self sendDynamicBlock: blTree - literalTree: lTree - distanceTree: dTree - bitLengths: blBits]. - - bitsRequired = (encoder bitPosition - bitsSent) - ifFalse:[self error:'Bits size mismatch']. - - lastBlock - ifTrue:[self release] - ifFalse:[self initializeNewBlock].! Item was removed: - ----- Method: ZipWriteStream>>forcedMethod (in category 'accessing') ----- - forcedMethod - "Return a symbol describing an enforced method or nil if the method should - be chosen adaptively. Valid symbols are - #stored - store blocks (do not compress) - #fixed - use fixed huffman trees - #dynamic - use dynamic huffman trees." - ^nil! Item was removed: - ----- Method: ZipWriteStream>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - literals := ByteArray new: WindowSize. - distances := WordArray new: WindowSize. - literalFreq := WordArray new: MaxLiteralCodes. - distanceFreq := WordArray new: MaxDistCodes. - self initializeNewBlock. - ! Item was removed: - ----- Method: ZipWriteStream>>initializeNewBlock (in category 'initialize-release') ----- - initializeNewBlock - "Initialize the encoder for a new block of data" - literalFreq atAllPut: 0. - distanceFreq atAllPut: 0. - literalFreq at: EndBlock+1 put: 1. - litCount := 0. - matchCount := 0.! Item was removed: - ----- Method: ZipWriteStream>>moveContentsToFront (in category 'private') ----- - moveContentsToFront - "Need to update crc here" - self updateCrc. - super moveContentsToFront. - crcPosition := position + 1.! Item was removed: - ----- Method: ZipWriteStream>>on: (in category 'initialize-release') ----- - on: aCollectionOrStream - crc := 16rFFFFFFFF. - crcPosition := 1. - bytesWritten := 0. - encoder := ZipEncoder on: aCollectionOrStream. - encoder isBinary - ifTrue:[super on: ByteArray new] - ifFalse:[super on: String new]. - self writeHeader. - ! Item was removed: - ----- Method: ZipWriteStream>>release (in category 'initialize-release') ----- - release - "We're done with compression. Do some cleanup." - literals := distances := literalFreq := distanceFreq := nil. - self updateCrc. - encoder flushBits. - self writeFooter.! Item was removed: - ----- Method: ZipWriteStream>>scanBitLength:repeatCount:into: (in category 'dynamic blocks') ----- - scanBitLength: bitLength repeatCount: repeatCount into: anArray - "Update the frequency for the aTree based on the given values" - | count | - count := repeatCount. - bitLength = 0 ifTrue:[ - [count >= 11] whileTrue:[ - anArray at: Repeat11To138+1 put: (anArray at: Repeat11To138+1) + 1. - count := (count - 138) max: 0]. - [count >= 3] whileTrue:[ - anArray at: Repeat3To10+1 put: (anArray at: Repeat3To10+1) + 1. - count := (count - 10) max: 0]. - count > 0 ifTrue:[anArray at: bitLength+1 put: (anArray at: bitLength+1) + count]. - ] ifFalse:[ - anArray at: bitLength+1 put: (anArray at: bitLength+1) + 1. - count := count - 1. - [count >= 3] whileTrue:[ - anArray at: Repeat3To6+1 put: (anArray at: Repeat3To6+1) + 1. - count := (count - 6) max: 0]. - count > 0 ifTrue:[anArray at: bitLength+1 put: (anArray at: bitLength+1) + count]. - ].! Item was removed: - ----- Method: ZipWriteStream>>scanBitLengths:into: (in category 'dynamic blocks') ----- - scanBitLengths: bits into: anArray - "Scan the trees and determine the frequency of the bit lengths. - For repeating codes, emit a repeat count." - | lastValue lastCount value | - bits size = 0 ifTrue:[^self]. - lastValue := bits at: 1. - lastCount := 1. - 2 to: bits size do:[:i| - value := bits at: i. - value = lastValue - ifTrue:[lastCount := lastCount + 1] - ifFalse:[self scanBitLength: lastValue repeatCount: lastCount into: anArray. - lastValue := value. - lastCount := 1]]. - self scanBitLength: lastValue repeatCount: lastCount into: anArray.! Item was removed: - ----- Method: ZipWriteStream>>sendBitLength:repeatCount:tree: (in category 'dynamic blocks') ----- - sendBitLength: bitLength repeatCount: repeatCount tree: aTree - "Send the given bitLength, repeating repeatCount times" - | count | - count := repeatCount. - bitLength = 0 ifTrue:[ - [count >= 11] whileTrue:[ - self sendBitLength: Repeat11To138 tree: aTree. - encoder nextBits: 7 put: (count min: 138) - 11. - count := (count - 138) max: 0]. - [count >= 3] whileTrue:[ - self sendBitLength: Repeat3To10 tree: aTree. - encoder nextBits: 3 put: (count min: 10) - 3. - count := (count - 10) max: 0]. - count timesRepeat:[self sendBitLength: bitLength tree: aTree]. - ] ifFalse:[ - self sendBitLength: bitLength tree: aTree. - count := count - 1. - [count >= 3] whileTrue:[ - self sendBitLength: Repeat3To6 tree: aTree. - encoder nextBits: 2 put: (count min: 6) - 3. - count := (count - 6) max: 0]. - count timesRepeat:[self sendBitLength: bitLength tree: aTree]. - ].! Item was removed: - ----- Method: ZipWriteStream>>sendBitLength:tree: (in category 'dynamic blocks') ----- - sendBitLength: bitLength tree: aTree - "Send the given bitLength" - encoder nextBits: (aTree bitLengthAt: bitLength) - put: (aTree codeAt: bitLength).! Item was removed: - ----- Method: ZipWriteStream>>sendBitLengthTree: (in category 'dynamic blocks') ----- - sendBitLengthTree: blTree - "Send the bit length tree" - | blIndex bitLength | - MaxBitLengthCodes to: 4 by: -1 do:[:maxIndex| - blIndex := BitLengthOrder at: maxIndex. - bitLength := blIndex <= blTree maxCode - ifTrue:[blTree bitLengthAt: blIndex] ifFalse:[0]. - (maxIndex = 4 or:[bitLength > 0]) ifTrue:[ - encoder nextBits: 4 put: maxIndex - 4. - 1 to: maxIndex do:[:j| - blIndex := BitLengthOrder at: j. - bitLength := blIndex <= blTree maxCode - ifTrue:[blTree bitLengthAt: blIndex] ifFalse:[0]. - encoder nextBits: 3 put: bitLength]. - ^self]].! Item was removed: - ----- Method: ZipWriteStream>>sendCompressedBlock:with: (in category 'dynamic blocks') ----- - sendCompressedBlock: litTree with: distTree - "Send the current block using the encodings from the given literal/length and distance tree" - | sum | - sum := encoder - sendBlock: (ReadStream on: literals from: 1 to: litCount) - with: (ReadStream on: distances from: 1 to: litCount) - with: litTree - with: distTree. - sum = (blockPosition - blockStart) ifFalse:[self error:'Wrong number of bytes'].! Item was removed: - ----- Method: ZipWriteStream>>sendDynamicBlock:literalTree:distanceTree:bitLengths: (in category 'dynamic blocks') ----- - sendDynamicBlock: blTree literalTree: lTree distanceTree: dTree bitLengths: bits - "Send a block using dynamic huffman trees" - self sendLiteralTree: lTree distanceTree: dTree using: blTree bitLengths: bits. - self sendCompressedBlock: lTree with: dTree.! Item was removed: - ----- Method: ZipWriteStream>>sendFixedBlock (in category 'fixed blocks') ----- - sendFixedBlock - "Send a block using fixed huffman trees" - self sendCompressedBlock: FixedLiteralTree with: FixedDistanceTree.! Item was removed: - ----- Method: ZipWriteStream>>sendLiteralTree:distanceTree:using:bitLengths: (in category 'dynamic blocks') ----- - sendLiteralTree: lTree distanceTree: dTree using: blTree bitLengths: bits - "Send all the trees needed for dynamic huffman tree encoding" - | lastValue lastCount value | - encoder nextBits: 5 put: (lTree maxCode - 256). - encoder nextBits: 5 put: (dTree maxCode). - self sendBitLengthTree: blTree. - bits size = 0 ifTrue:[^self]. - lastValue := bits at: 1. - lastCount := 1. - 2 to: bits size do:[:i| - value := bits at: i. - value = lastValue - ifTrue:[lastCount := lastCount + 1] - ifFalse:[self sendBitLength: lastValue repeatCount: lastCount tree: blTree. - lastValue := value. - lastCount := 1]]. - self sendBitLength: lastValue repeatCount: lastCount tree: blTree.! Item was removed: - ----- Method: ZipWriteStream>>sendStoredBlock (in category 'stored blocks') ----- - sendStoredBlock - "Send an uncompressed block" - | inBytes | - inBytes := blockPosition - blockStart. - encoder flushBits. "Skip to byte boundary" - encoder nextBits: 16 put: inBytes. - encoder nextBits: 16 put: (inBytes bitXor: 16rFFFF). - encoder flushBits. - 1 to: inBytes do:[:i| - encoder nextBytePut: (collection byteAt: blockStart+i)].! Item was removed: - ----- Method: ZipWriteStream>>shouldFlush (in category 'encoding') ----- - shouldFlush - "Check if we should flush the current block. - Flushing can be useful if the input characteristics change." - | nLits | - litCount = literals size ifTrue:[^true]. "We *must* flush" - (litCount bitAnd: 16rFFF) = 0 ifFalse:[^false]. "Only check every N kbytes" - matchCount * 10 <= litCount ifTrue:[ - "This is basically random data. - There is no need to flush early since the overhead - for encoding the trees will add to the overall size" - ^false]. - "Try to adapt to the input data. - We flush if the ratio between matches and literals - changes beyound a certain threshold" - nLits := litCount - matchCount. - nLits <= matchCount ifTrue:[^false]. "whow!! so many matches" - ^nLits * 4 <= matchCount! Item was removed: - ----- Method: ZipWriteStream>>storedBlockSize (in category 'stored blocks') ----- - storedBlockSize - "Compute the length for the current block when stored as is" - ^3 "block type bits" - + (8 - (encoder bitPosition + 3 bitAnd: 7) bitAnd: 7)"skipped bits to byte boundary" - + 32 "byte length + chksum" - + (blockPosition - blockStart * 8) "actual data bits".! Item was removed: - ----- Method: ZipWriteStream>>updateCrc (in category 'private') ----- - updateCrc - crcPosition <= position ifTrue:[ - bytesWritten := bytesWritten + position - crcPosition + 1. - crc := self updateCrc: crc from: crcPosition to: position in: collection. - crcPosition := position + 1].! Item was removed: - ----- Method: ZipWriteStream>>updateCrc:from:to:in: (in category 'private') ----- - updateCrc: oldCrc from: start to: stop in: aCollection - ^self class updateCrc: oldCrc from: start to: stop in: aCollection! Item was removed: - ----- Method: ZipWriteStream>>writeFooter (in category 'initialize-release') ----- - writeFooter - "Write footer information if necessary" - crc := crc bitXor: 16rFFFFFFFF.! Item was removed: - ----- Method: ZipWriteStream>>writeHeader (in category 'initialize-release') ----- - writeHeader - "Write header information if necessary"!
More information about the Squeak-dev mailing list |