diff --git a/src/BaselineOfPharoLauncher/BaselineOfPharoLauncher.class.st b/src/BaselineOfPharoLauncher/BaselineOfPharoLauncher.class.st index 3e1cd804..c531b768 100644 --- a/src/BaselineOfPharoLauncher/BaselineOfPharoLauncher.class.st +++ b/src/BaselineOfPharoLauncher/BaselineOfPharoLauncher.class.st @@ -38,19 +38,13 @@ BaselineOfPharoLauncher >> baseline: spec [ package: #FastTableExtentions with: [ spec repository: 'github://sbragagnolo/FastTableExtention/src' ]. spec - package: #'ConfigurationOfPharoLauncher'; + package: #'PharoLauncher-ZipArchive'; package: #'PharoLauncher-Core' with: [ - spec requires: #(#'XMLParser' #'Ston' #'OSProcess' #'ProcessWrapper'). ]; + spec requires: #(#'XMLParser' #'Ston' #'OSProcess' #'ProcessWrapper' #'PharoLauncher-ZipArchive'). ]; package: #'PharoLauncher-Spec' with: [ spec requires: #(#'PharoLauncher-Core' ). ]; package: #'PharoLauncher-IceTray' with: [ spec requires: #(#'PharoLauncher-Core' #Icetray #FastTableExtentions) ]; - for: #'pharo6.x' do: [ - spec - package: #'PharoLauncher-Pharo6'; - package: #'PharoLauncher-Core' with: [ - spec requires: #(#'PharoLauncher-Pharo6') ]. - ]; package: #'PharoLauncher-Tests-Core' with: [ spec requires: #(#'PharoLauncher-Core' ). ]; @@ -62,25 +56,4 @@ BaselineOfPharoLauncher >> baseline: spec [ spec requires: #(#'PharoLauncher-Core' #'PharoLauncher-Tests-Download'). ]. spec group: 'Default' with: #(#'PharoLauncher-Tests-Core' #'PharoLauncher-Tests-Download' #'PharoLauncher-Core' #'PharoLauncher-Spec' #'PharoLauncher-Tests-SpecUI' #'PharoLauncher-Tests-Functional' #'PharoLauncher-IceTray'). ]. - - spec for: #'pharo6.x' do: [ - self spec70: spec. - spec - baseline: 'PharoWin32' with: [ - spec - repository: 'github://tesonep/pharo-com' ]. - spec - package: #'PharoLauncher-Env'; - package: #'PharoLauncher-Core' with: [ - spec requires: #(#'PharoLauncher-Env'). ]; - package: #'PharoLauncher-Spec' with: [ - spec requires: #(#'Spec70Compatibility') ] ] -] - -{ #category : #baselines } -BaselineOfPharoLauncher >> spec70: spec [ - "for pharo6 compatibility" - spec - baseline: 'Spec70Compatibility' - with: [ spec repository: 'github://pharo-contributions/Spec70Compatibility:v1.0.0/src' ] ] diff --git a/src/PharoLauncher-Core/PhLTemplateGroupRepository.class.st b/src/PharoLauncher-Core/PhLTemplateGroupRepository.class.st index f848bb5d..30307ced 100644 --- a/src/PharoLauncher-Core/PhLTemplateGroupRepository.class.st +++ b/src/PharoLauncher-Core/PhLTemplateGroupRepository.class.st @@ -45,13 +45,13 @@ PhLTemplateGroupRepository >> createZipArchiveFrom: anImage named: aString [ | archive | archive := ZipArchive new. archive - addFile: anImage imageFile fullName as: aString , '.image'; - addFile: anImage changesFile fullName as: aString , '.changes'. - [ archive addFile: anImage sourcesFile fullName as: anImage sourcesFile basename ] + addFile: anImage imageFile as: aString , '.image'; + addFile: anImage changesFile as: aString , '.changes'. + [ archive addFile: anImage sourcesFile as: anImage sourcesFile basename ] on: NotFound do: [ :e | "ignore the file" ]. anImage versionFile exists - ifTrue: [ archive addFile: anImage versionFile fullName as: anImage versionFile basename ]. + ifTrue: [ archive addFile: anImage versionFile as: anImage versionFile basename ]. archive writeToFileNamed: (PhLDownloadedTemplateGroup default baseDirectory / aString , 'zip') fullName ] diff --git a/src/PharoLauncher-Tests-Functional/PhLCreateTemplateFromImageTest.class.st b/src/PharoLauncher-Tests-Functional/PhLCreateTemplateFromImageTest.class.st index 0ed612c6..ead5476d 100644 --- a/src/PharoLauncher-Tests-Functional/PhLCreateTemplateFromImageTest.class.st +++ b/src/PharoLauncher-Tests-Functional/PhLCreateTemplateFromImageTest.class.st @@ -19,10 +19,13 @@ PhLCreateTemplateFromImageTest >> tearDown [ { #category : #tests } PhLCreateTemplateFromImageTest >> testCanCreateATemplateFromImage [ - | image templateName templateRepository zipMemberNames | + | image templateName templateRepository zipMemberNames fs fileNames | templateName := 'newTemplate'. - image := PhLImage location: Smalltalk imageFile. + fs := FileSystem memory root. + fileNames := #('a.image' 'a.changes' 'pharo.version' 'a-23456ef.sources'). + fileNames do: [ :fileName | (fs / fileName) ensureCreateFile ]. + image := PhLImage location: fs / fileNames first. templateRepository := PhLTemplateGroupRepository newFromGroups: { PhLDownloadedTemplateGroup named: 'cache group' }. templateRepository createLocalTemplateFrom: image named: templateName. @@ -32,6 +35,6 @@ PhLCreateTemplateFromImageTest >> testCanCreateATemplateFromImage [ zipMemberNames := (ZipArchive new readFrom: template zipArchive) memberNames. self assertCollection: zipMemberNames - hasSameElements: { templateName,'.image' . templateName,'.changes' . 'pharo.version' . Smalltalk image sourcesFile basename }. + hasSameElements: {templateName , '.image' . templateName , '.changes'} , (fileNames allButFirst: 2). ] diff --git a/src/PharoLauncher-ZipArchive/Archive.extension.st b/src/PharoLauncher-ZipArchive/Archive.extension.st new file mode 100644 index 00000000..f8bbf467 --- /dev/null +++ b/src/PharoLauncher-ZipArchive/Archive.extension.st @@ -0,0 +1,30 @@ +Extension { #name : #Archive } + +{ #category : #'*PharoLauncher-ZipArchive' } +Archive >> addDirectory: aFileReference [ + ^self addDirectory: aFileReference as: aFileReference path pathString + +] + +{ #category : #'*PharoLauncher-ZipArchive' } +Archive >> addDirectory: aFileReference as: anotherFileName [ + | newMember | + newMember := self memberClass newFromDirectory: aFileReference. + self addMember: newMember. + newMember localFileName: anotherFileName. + ^newMember +] + +{ #category : #'*PharoLauncher-ZipArchive' } +Archive >> addFile: aFileReference [ + ^self addFile: aFileReference as: aFileReference path pathString +] + +{ #category : #'*PharoLauncher-ZipArchive' } +Archive >> addFile: aFileReference as: anotherFileName [ + | newMember | + newMember := self memberClass newFromFile: aFileReference. + newMember localFileName: anotherFileName. + self addMember: newMember. + ^newMember +] diff --git a/src/PharoLauncher-ZipArchive/ZipArchiveMember.extension.st b/src/PharoLauncher-ZipArchive/ZipArchiveMember.extension.st new file mode 100644 index 00000000..a2cf7cfe --- /dev/null +++ b/src/PharoLauncher-ZipArchive/ZipArchiveMember.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #ZipArchiveMember } + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipArchiveMember class >> newFromDirectory: aFileReference [ + ^ZipDirectoryMember newFromDirectory: aFileReference +] + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipArchiveMember class >> newFromFile: aFileReference [ + ^ZipNewFileMember newFromFile: aFileReference +] diff --git a/src/PharoLauncher-ZipArchive/ZipDirectoryMember.extension.st b/src/PharoLauncher-ZipArchive/ZipDirectoryMember.extension.st new file mode 100644 index 00000000..b5de3946 --- /dev/null +++ b/src/PharoLauncher-ZipArchive/ZipDirectoryMember.extension.st @@ -0,0 +1,20 @@ +Extension { #name : #ZipDirectoryMember } + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipDirectoryMember >> localFileName: aString [ + + self localFileNameFrom: aString asFileReference +] + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipDirectoryMember >> localFileNameFrom: aFileReference [ + + super localFileName: (aFileReference basename copyWith: $/). + aFileReference exists ifFalse: [ ^ self ]. + self modifiedAt: aFileReference entry modificationTime. +] + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipDirectoryMember class >> newFromDirectory: aFileReference [ + ^(self new) localFileNameFrom: aFileReference; yourself +] diff --git a/src/PharoLauncher-ZipArchive/ZipNewFileMember.extension.st b/src/PharoLauncher-ZipArchive/ZipNewFileMember.extension.st new file mode 100644 index 00000000..7f0929ab --- /dev/null +++ b/src/PharoLauncher-ZipArchive/ZipNewFileMember.extension.st @@ -0,0 +1,21 @@ +Extension { #name : #ZipNewFileMember } + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipNewFileMember >> from: aFileReference [ + + | entry | + "Now get the size, attributes, and timestamps, and see if the file exists" + stream := aFileReference binaryReadStream. + self localFileName: (externalFileName := aFileReference path pathString). + entry := aFileReference entry. + compressedSize := uncompressedSize := entry size. + desiredCompressionMethod := compressedSize > 0 ifTrue: [ CompressionDeflated ] ifFalse: [ CompressionStored ]. + self flag: 'When we replace Files with FileSystem, the following line won''t have to jump throught hoops (FS returns aDateAndTime)'. + self modifiedAt: entry modificationTime. + +] + +{ #category : #'*PharoLauncher-ZipArchive' } +ZipNewFileMember class >> newFromFile: aFileReference [ + ^(self new) from: aFileReference +] diff --git a/src/PharoLauncher-ZipArchive/package.st b/src/PharoLauncher-ZipArchive/package.st new file mode 100644 index 00000000..11a14b8e --- /dev/null +++ b/src/PharoLauncher-ZipArchive/package.st @@ -0,0 +1 @@ +Package { #name : #'PharoLauncher-ZipArchive' }