[squeak-dev] The Inbox: Compression-ct.56.mcz
Marcel Taeumel
marcel.taeumel at hpi.de
Mon Jan 17 11:49:30 UTC 2022
Hi Christoph --
Please elaborate. If you found a place where a non-translated string was used in a serialization process, please do not translate that string. And add a comment.
Best,
Marcel
Am 03.01.2022 19:10:10 schrieb christoph.thiede at student.hpi.uni-potsdam.de <christoph.thiede at student.hpi.uni-potsdam.de>:
Inbox because ZipArchiveMember >> #extractInDirectory:overwrite: is a breaking change that *hypothetically* could break any of your automated extraction workflows, even though I do not really expect that. Please check. If no one objects, I will move this to the Trunk after one week or so. :-)
Best,
Christoph
---
Sent from Squeak Inbox Talk [https://github.com/hpi-swa-lab/squeak-inbox-talk]
On 2022-01-03T18:07:40+00:00, commits at source.squeak.org wrote:
> A new version of Compression was added to project The Inbox:
> http://source.squeak.org/inbox/Compression-ct.56.mcz
>
> ==================== Summary ====================
>
> Name: Compression-ct.56
> Author: ct
> Time: 3 January 2022, 7:07:37.018703 pm
> UUID: af841abb-44db-044e-b8d8-a6e8231c690e
> Ancestors: Compression-dtl.55
>
> Makes the Compression package 100% multilingual.
> Rewrites ZipArchiveMember >> #extractInDirectory:overwrite: to use new UIManager >> #chooseFromLabeledValues:title: and avoid infinite loops if the user closes the dialog window or #valueSuppressingAllMessages is used.
> Also includes some recategorizations.
>
> =============== Diff against Compression-dtl.55 ===============
>
> Item was changed:
> ----- Method: Archive>>writeToFileNamed: (in category 'archive operations') -----
> writeToFileNamed: aFileName
> | stream |
> "Catch attempts to overwrite existing zip file"
> (self canWriteToFileNamed: aFileName)
> + ifFalse: [ ^self error: ('{1} is needed by one or more members in this archive' translated format: {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 changed:
> + ----- Method: ArchiveMember class>>newDirectoryNamed: (in category 'instance creation') -----
> - ----- Method: ArchiveMember class>>newDirectoryNamed: (in category 'as yet unclassified') -----
> newDirectoryNamed: aString
> self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ArchiveMember class>>newFromFile: (in category 'instance creation') -----
> - ----- Method: ArchiveMember class>>newFromFile: (in category 'as yet unclassified') -----
> newFromFile: aFileName
> self subclassResponsibility!
>
> Item was changed:
> + ----- Method: ArchiveMember class>>newFromString: (in category 'instance creation') -----
> - ----- Method: ArchiveMember class>>newFromString: (in category 'as yet unclassified') -----
> newFromString: aString
> self subclassResponsibility!
>
> Item was changed:
> + ----- Method: CRCError>>isResumable (in category 'priv handling') -----
> - ----- Method: CRCError>>isResumable (in category 'as yet unclassified') -----
> isResumable
> ^true!
>
> Item was changed:
> + ----- Method: CompressedSourceStream class>>on: (in category 'instance creation') -----
> - ----- Method: CompressedSourceStream class>>on: (in category 'as yet unclassified') -----
> on: aFile
> ^ self basicNew openOn: aFile!
>
> Item was changed:
> ----- Method: CompressedSourceStream>>binary (in category 'open/close') -----
> binary
> + self error: 'Compressed source files are ascii to the user (though binary underneath)' translated!
> - self error: 'Compressed source files are ascii to the user (though binary underneath)'!
>
> Item was changed:
> ----- Method: CompressedSourceStream>>position: (in category 'access') -----
> position: newPosition
> | compressedBuffer newSegmentIndex |
> newPosition > endOfFile ifTrue:
> + [self error: 'Attempt to position beyond the end of file' translated].
> - [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' translated].
> - [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' translated].
> - [self error: 'Internal logic error'].
> collection size = segmentSize ifFalse:
> + [self error: 'Internal logic error' translated].
> - [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.!
> - position := newPosition \\ segmentSize.
> - !
>
> Item was changed:
> ----- 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' translated].
> - [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' translated].
> - [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' translated].
> - [self error: 'This file is not in valid compressed source format'].
> dirty := false.
> self position: 0.!
>
> Item was changed:
> ----- 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' translated].
> - 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.!
> - self writeSegment.
> - !
>
> Item was changed:
> ----- 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' translated]].
> - ifFalse:[^self error:'Not a match']].
> ^true!
>
> Item was changed:
> ----- 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 {1}' translated format: {fullFileName})
> - '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 changed:
> ----- 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' translated].
> - ifFalse:[^self error:'Not a GZipped stream'].
> method := self nextBits: 8.
> (method = GZipDeflated)
> + ifFalse:[^self error: 'Bad compression method' translated].
> - ifFalse:[^self error:'Bad compression method'].
> flags := self nextBits: 8.
> (flags anyMask: GZipEncryptFlag)
> + ifTrue:[^self error: 'Cannot decompress encrypted stream' translated].
> - ifTrue:[^self error:'Cannot decompress encrypted stream'].
> (flags anyMask: GZipReservedFlags)
> + ifTrue:[^self error: 'Cannot decompress stream with unknown flags' translated].
> - 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].!
> - ifTrue:[[(self nextBits: 8) = 0] whileFalse].
> - !
>
> Item was changed:
> ----- 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)' translated ].
> - 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)' translated ].
> - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ].
> ^stored!
>
> Item was changed:
> + ----- Method: GZipSurrogateStream class>>newFileNamed:inDirectory: (in category 'instance creation') -----
> - ----- Method: GZipSurrogateStream class>>newFileNamed:inDirectory: (in category 'as yet unclassified') -----
> newFileNamed: fName inDirectory: aDirectory
>
> ^self new newFileNamed: fName inDirectory: aDirectory!
>
> Item was changed:
> ----- 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' translated]]].
> - 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 changed:
> ----- 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' translated]].
> - bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']].
> ^value!
>
> Item was changed:
> ----- 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' translated].
> - 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 changed:
> ----- 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' translated].
> - ifFalse:[^self error:'Bad block length'].
> litTable := nil.
> distTable := length.
> state := state bitOr: BlockProceedBit.
> ^self proceedStoredBlock!
>
> Item was changed:
> ----- 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' translated].
> + (method bitShift: -4) + 8 > 15 ifTrue:[^self error: 'Invalid window size' translated].
> - (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' translated].
> + (byte anyMask: 32) ifTrue:[^self error: 'Need preset dictionary' translated].!
> - (method bitShift: 8) + byte \\ 31 = 0 ifFalse:[^self error:'Incorrect header'].
> - (byte anyMask: 32) ifTrue:[^self error:'Need preset dictionary'].
> - !
>
> Item was changed:
> ----- 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)' translated ].
> - 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)' translated ].
> - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ].
> ^stored!
>
> Item was changed:
> ----- 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: {1}' translated format: {stream name})].
> - 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 changed:
> ----- 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 {1}' translated format: {entry fileName})].
> - 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 {1}' translated format: {entry fileName})].
> - 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 {1}. Proceed?' translated format: {entry fileName})) ifFalse: [^self].
> - (self confirm: 'Failed to extract ', entry fileName, '. Proceed?') ifFalse:[^self].
> ].
> ].
> + ].!
> - ].
> - !
>
> Item was changed:
> ----- 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 {1}' translated format: {aStream position}) ].
> - 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.!
> - zipFileComment := aStream next: zipFileCommentLength.
> - !
>
> Item was changed:
> ----- 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: ('{1} cannot find EOCD position in {2}' translated format: {self class name. aStreamOrFileName name})].
> - 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 changed:
> ----- 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 {1}' translated format: {(stream position - 4) printStringHex}) ].
> - 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 changed:
> ----- 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 {1} at position {2}' translated format: {signatureData asString asHex. stream position - 4}) ].
> - ifFalse: [ ^self error: 'bad signature ', signatureData asString asHex, ' at position ', (stream position - 4) asString ].
> ^signatureData
> !
>
> Item was changed:
> ----- 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: ('{1} is needed by one or more members in this archive' translated format: {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 changed:
> ----- 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: ('{1} is needed by one or more members in this archive' translated format: {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 changed:
> ----- 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 localName |
> + path := fileName findTokens: '/'.
> - | path fileDir file index localName |
> - path := fileName findTokens:'/'.
> localName := path last.
> + fileDir := path allButLast inject: aDirectory into: [:base :part | base directoryNamed: part].
> - fileDir := path allButLast inject: aDirectory into:[:base :part| base directoryNamed: part].
> fileDir assureExistence.
> +
> + overwriteAll ifFalse: [
> + [file := fileDir newFileNamed: localName]
> + on: FileExistsException
> + do: [
> + (Project uiManager
> + chooseFromLabeledValues: (OrderedDictionary new
> + at: 'Yes, overwrite' translated put: [#overwrite];
> + at: 'No, don''t overwrite' translated put: [^ #okay];
> + at: 'Overwrite ALL files' translated put: [^ #retryWithOverwrite];
> + at: 'Cancel operation' translated put: [];
> + yourself)
> + title: ('{1} already exists. Overwrite?' translated format: {fileName})) value
> + ifNil: [^ #abort]]].
> + file ifNil: [
> + file := ([fileDir forceNewFileNamed: localName]
> + on: Error do: [])
> + ifNil: [^ #failed]].
> +
> - file := [fileDir newFileNamed: localName] on: FileExistsException do:[:ex| ex return: nil].
> - file ifNil:[
> - overwriteAll ifFalse:[
> - [index := UIManager default chooseFrom: {
> - '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!
> - ^#okay!
>
> Item was changed:
> ----- Method: ZipArchiveMember>>extractTo: (in category 'extraction') -----
> extractTo: aStream
> | oldCompression |
> + self isEncrypted ifTrue: [ self error: 'encryption is unsupported' translated ].
> - 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 changed:
> ----- Method: ZipArchiveMember>>extractTo:from:to: (in category 'extraction') -----
> extractTo: aStream from: start to: finish
> | oldCompression |
> + self isEncrypted ifTrue: [ self error: 'encryption is unsupported' translated ].
> - 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 changed:
> ----- Method: ZipArchiveMember>>extractToFileNamed:inDirectory: (in category 'accessing') -----
> extractToFileNamed: aLocalFileName inDirectory: dir
> | stream fullName fullDir |
> + self isEncrypted ifTrue: [ ^self error: 'encryption unsupported' translated ].
> - 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 changed:
> ----- 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' translated ].
> - 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 changed:
> + ----- Method: ZipDirectoryMember class>>newNamed: (in category 'instance creation') -----
> - ----- Method: ZipDirectoryMember class>>newNamed: (in category 'as yet unclassified') -----
> newNamed: aFileName
> ^(self new) localFileName: aFileName; yourself!
>
> Item was changed:
> ----- 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' translated].
> - 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 changed:
> ----- 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' translated]].
> - 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 changed:
> + ----- Method: ZipFileMember class>>newFrom:named: (in category 'instance creation') -----
> - ----- Method: ZipFileMember class>>newFrom:named: (in category 'as yet unclassified') -----
> newFrom: stream named: fileName
> ^(self new) stream: stream externalFileName: fileName!
>
> Item was changed:
> ----- 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 {1}' translated format: {localHeaderRelativeOffset printStringHex}) ].
> - ^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 changed:
> ----- Method: ZipFileMember>>rewindData (in category 'private-reading') -----
> rewindData
> super rewindData.
> (stream isNil or: [ stream closed ])
> + ifTrue: [ self error: 'stream missing or closed' translated ].
> - ifTrue: [ self error: 'stream missing or closed' ].
> stream position: (localHeaderRelativeOffset + 4).
> self skipLocalDirectoryFileHeaderFrom: stream.!
>
> Item was changed:
> + ----- Method: ZipStringMember class>>newFrom:named: (in category 'instance creation') -----
> - ----- Method: ZipStringMember class>>newFrom:named: (in category 'as yet unclassified') -----
> newFrom: aString named: aFileName
> ^(self new) contents: aString; localFileName: aFileName; yourself!
>
> Item was changed:
> ----- 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' translated].
> - ifFalse:[^self error:'Distance must be positive'].
> length < MinMatch
> + ifTrue: [^self error: ('Match length must be at least {1}' translated format: {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 changed:
> ----- 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' translated].
> - ifFalse:[self error:'Bits size mismatch'].
>
> lastBlock
> ifTrue:[self release]
> ifFalse:[self initializeNewBlock].!
>
> Item was changed:
> ----- 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' translated].!
> - sum = (blockPosition - blockStart) ifFalse:[self error:'Wrong number of bytes'].!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220117/b8fe76bf/attachment-0001.html>
More information about the Squeak-dev
mailing list
|