[squeak-dev] Squeak 4.6: Installer-Core-cmm.397.mczcommits at source.squeak.org commits at source.squeak.orgFri Jun 5 20:16:30 UTC 2015
Chris Muller uploaded a new version of Installer-Core to project Squeak 4.6: http://source.squeak.org/squeak46/Installer-Core-cmm.397.mcz ==================== Summary ==================== Name: Installer-Core-cmm.397 Author: cmm Time: 13 April 2015, 8:28:57.87 pm UUID: e3825d75-2e08-4420-b2d0-25d7946a4371 Ancestors: Installer-Core-cmm.396 SqueakSource employs server-specific versions of OSProcess and RFB. ==================== Snapshot ==================== SystemOrganization addCategory: #'Installer-Core'! Object subclass: #Installer instanceVariableNames: 'answers packages messagesToSuppress useFileIn noiseLevel currentRepository' classVariableNames: 'InstallerBindings IsSetToTrapErrors Repositories SkipLoadingTests ValidationBlock' poolDictionaries: '' category: 'Installer-Core'! !Installer commentStamp: 'kph 3/30/2009 01:29' prior: 0! Documentation now available at http://installer.pbwiki.com/Installer useFileIn - flag to load source.st rather than using Monticello! ----- Method: Installer class>>actionMatch:reportOn:ifNoMatch: (in category 'action report') ----- actionMatch: theLine reportOn: report ifNoMatch: aBlock | line | line := theLine withBlanksCondensed. self allSubclassesDo: [:class | (class canReportLine: line) ifTrue: [ ^ class new action: theLine reportOn: report ]]. ^ aBlock value! ----- Method: Installer class>>airplaneMode (in category 'repository-overrides') ----- airplaneMode "Override all remote repositories with the package cache." self overrideRemoteRepostoriesWith: MCCacheRepository default! ----- Method: Installer class>>bootstrapTheRestOfInstaller (in category 'action report') ----- bootstrapTheRestOfInstaller (Installer url: 'www.squeaksource.com/Installer/Installer-Scripts') fileInSource; logCR: 'installer bootstrap - loaded'.! ----- Method: Installer class>>bug:fix: (in category 'mantis') ----- bug: n fix: filename Transcript cr; show: 'Code script in Mantis:', n asString, ' should read Installer mantis bug: ',n asString, ' fix: ', filename printString,'.'. ^ self mantis bug: n fix: filename! ----- Method: Installer class>>cache (in category 'monticello') ----- cache ^ self monticello cache! ----- Method: Installer class>>canReportLine: (in category 'action report') ----- canReportLine: line ^ false! ----- Method: Installer class>>cancelSkipLoadingTests (in category 'accessing') ----- cancelSkipLoadingTests "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages" SkipLoadingTests := false. ! ----- Method: Installer class>>clearOverrides (in category 'repository-overrides') ----- clearOverrides "Remove all repository overrides and load everthing from the specified default repositories when using #merge:." Repositories := Dictionary new! ----- Method: Installer class>>cobalt (in category 'repositories') ----- cobalt ^ self monticello http: 'http://croquet-src-01.oit.duke.edu:8886'! ----- Method: Installer class>>debug (in category 'debug') ----- debug IsSetToTrapErrors := false! ----- Method: Installer class>>defaultRepositoryFor: (in category 'private') ----- defaultRepositoryFor: anAssociation "private -- answer the MC repository specified by anAssociation." ^ (self perform: anAssociation key) project: anAssociation value ; mc! ----- Method: Installer class>>do: (in category 'launcher support') ----- do: webPageName | rs | rs := webPageName readStream. [ rs atEnd ] whileFalse: [ self install: (rs upTo: $;) ]. ! ----- Method: Installer class>>file (in category 'file') ----- file ^ InstallerFile new! ----- Method: Installer class>>file: (in category 'file') ----- file: fileName ^ InstallerFile new file: fileName; yourself ! ----- Method: Installer class>>fromUrl: (in category 'url') ----- fromUrl: aUrl "try and pick an Installer appropriate for the Url" | inst | ((aUrl endsWith: '.mcz') or: [ aUrl endsWith: '.mcm' ]) ifTrue: [ inst := Installer mc fromUrl: aUrl. inst packages isEmpty ifFalse: [ ^ inst ] ] . ^ Installer url: aUrl ! ----- Method: Installer class>>gemsource (in category 'repositories') ----- gemsource ^ self monticello http: 'http://seaside.gemstone.com/ss'! ----- Method: Installer class>>goran (in category 'repositories') ----- goran ^ self monticello http: 'squeak.krampe.se'; project: ''! ----- Method: Installer class>>gs (in category 'repositories') ----- gs ^ self gemsource! ----- Method: Installer class>>impara (in category 'repositories') ----- impara ^ self monticello http: 'source.impara.de'! ----- Method: Installer class>>install: (in category 'action report') ----- install: scriptName ^ (self scripts install: scriptName) ifNil:[ self web install: scriptName ] ! ----- Method: Installer class>>installFile: (in category 'file') ----- installFile: fileName ^ (self file: fileName) install. ! ----- Method: Installer class>>installSilentlyUrl: (in category 'url') ----- installSilentlyUrl: urlString ^ SystemChangeNotifier uniqueInstance doSilently: [ self url url: urlString; install ]. ! ----- Method: Installer class>>installUrl: (in category 'url') ----- installUrl: urlString ^ self url url: urlString; install. ! ----- Method: Installer class>>keith (in category 'repositories') ----- keith ^ self monticello ftp: 'squeak.warwick.st' directory: 'mc' user: 'squeak' password: 'viewpoints'! ----- Method: Installer class>>krestianstvo (in category 'repositories') ----- krestianstvo "Krestianstvo SDK code repository." ^ self monticello http: 'http://sdk.krestianstvo.org/sdk/'! ----- Method: Installer class>>launchFrom: (in category 'launcher support') ----- launchFrom: launcher ^self launchWith: launcher getParameters! ----- Method: Installer class>>launchHelp (in category 'launcher support') ----- launchHelp ^'path=/dir/*.txt Specify a search path for the item to install p=/dir1/*.txt;<url2>/ Multiple items delimited by ; The page name is typically appended to the path string, or if a "*" is present, it will be replaced by the page name. in,i,install=<page> Page appended to the path to begin the install process url,u=<url> Install using an explicit url from which to obtain a script or file file=<url> Install using a local file +debug Do not trap errors view=<page> Print the script that would have been installed. For more options use Script eval="Installer ... " ' ! ----- Method: Installer class>>launchWith: (in category 'launcher support') ----- launchWith: params params at: 'P' ifPresent: [ :v | params at: 'PATH' put: v ]. params at: 'I' ifPresent: [ :v | params at: 'INSTALL' put: v ]. params at: 'IN' ifPresent: [ :v | params at: 'INSTALL' put: v ]. params at: 'U' ifPresent: [ :v | params at: 'URL' put: v ]. params at: 'PATH' ifPresent: [ :v | self webSearchPathFrom: v. ]. params at: 'USER' ifPresent: [ :v | Utilities setAuthorInitials: v ]. params at: 'VERSION' ifPresent: [ :v | SystemVersion current version: v ]. params at: 'VIEW' ifPresent: [ :v | self view: v ]. IsSetToTrapErrors := true. params at: 'DEBUG' ifPresent: [ :v | IsSetToTrapErrors := (v == true) not ]. params at: 'URL' ifPresent: [ :v | self installUrl: v ]. params at: 'FILE' ifPresent: [ :v | self installFile: v ]. params at: 'INSTALL' ifPresent: [ :v | self do: v ]. params at: 'DO' ifPresent: [ :v | self do: v ]. ^true ! ----- Method: Installer class>>log: (in category 'logging') ----- log: aString Transcript show: aString; cr.! ----- Method: Installer class>>lukas (in category 'repositories') ----- lukas ^ self monticello http: 'http://source.lukas-renggli.ch'! ----- Method: Installer class>>mantis (in category 'mantis') ----- mantis ^ self mantis: 'http://bugs.squeak.org/'! ----- Method: Installer class>>mantis: (in category 'mantis') ----- mantis: host ^ InstallerMantis host: host! ----- Method: Installer class>>mc (in category 'monticello') ----- mc ^ self monticello! ----- Method: Installer class>>monticello (in category 'monticello') ----- monticello ^ InstallerMonticello new! ----- Method: Installer class>>noDebug (in category 'debug') ----- noDebug IsSetToTrapErrors := true! ----- Method: Installer class>>noProgressDuring: (in category 'during') ----- noProgressDuring: block [ block value: self ] on: ProgressInitiationException do: [ : note | note sendNotificationsTo: [ :min :max :curr | "ignore" ] ]! ----- Method: Installer class>>overrideRemoteRepostoriesWith: (in category 'repository-overrides') ----- overrideRemoteRepostoriesWith: aMCRepositoryOrGroup self remoteRepositories do: [ : each | self overrideRepository: each with: aMCRepositoryOrGroup ]! ----- Method: Installer class>>overrideRepository:with: (in category 'repository-overrides') ----- overrideRepository: scope with: anMCRepository "When configuring the image with #merge:, override the standard repository specified by scope with anMCRepository." "Installer override: #ss3->'htmlcssparser' with: (MCDirectoryRepository directory: (FileDirectory default / 'mc'))." "Installer override: #ss with: #ssMirror." self repositories at: scope put: anMCRepository! ----- Method: Installer class>>packageCache (in category 'repositories') ----- packageCache ^ MCCacheRepository default! ----- Method: Installer class>>path: (in category 'web') ----- path: aString "convenience abbreviation" self webSearchPathFrom: aString! ----- Method: Installer class>>privateUpgradeTheRest (in category 'instanciation') ----- privateUpgradeTheRest Installer ss project: 'Installer'; installQuietly: 'Installer-Scripts'; installQuietly: 'Installer-Formats'.. ^ self! ----- Method: Installer class>>remoteRepositories (in category 'repository-overrides') ----- remoteRepositories ^ #(#ss #ss3 #cobalt #gemsource #goran #gs #impara #keith #krestianstvo #lukas #saltypickle #sophie #squeak #squeakfoundation #squeaksource #squeaksource3 #ss #ss3 #swa #swasource #wiresong )! ----- Method: Installer class>>removeOverride: (in category 'repository-overrides') ----- removeOverride: scope "Remove override specified by scope and return to using the default repository for packages within that scope." ^ self repositories removeKey: scope ifAbsent: [ ]! ----- Method: Installer class>>repositories (in category 'accessing') ----- repositories ^ Repositories ifNil: [ Repositories := Dictionary new ]! ----- Method: Installer class>>repository: (in category 'monticello') ----- repository: host ^self monticello http: host ! ----- Method: Installer class>>repositoryFor: (in category 'private') ----- repositoryFor: anAssociation "private -- anAssociation key is the repository selector Symbol understood by Intsaller class. It's value is the project name within that HTTP repository." | rep | rep := self repositories at: anAssociation "<-- check for #rep->project overrides first" ifAbsent: [ self repositories at: anAssociation key "<-- override an entire repository." ifAbsent: [ ^ self defaultRepositoryFor: anAssociation ] ]. ^ rep isSymbol ifTrue: [ self defaultRepositoryFor: rep -> anAssociation value ] ifFalse: [ rep ]! ----- Method: Installer class>>sake (in category 'sake') ----- sake ^ self sake: InstallerSake sake! ----- Method: Installer class>>sake: (in category 'sake') ----- sake: aSakePackagesClass ^ InstallerSake new sake: aSakePackagesClass! ----- Method: Installer class>>saltypickle (in category 'repositories') ----- saltypickle ^ self monticello http: 'squeak.saltypickle.com'! ----- Method: Installer class>>setSakeToUse: (in category 'sake') ----- setSakeToUse: aClass InstallerSake sake: aClass! ----- Method: Installer class>>sf (in category 'documentation') ----- sf ^ self squeakfoundation ! ----- Method: Installer class>>skipLoadingTests (in category 'accessing') ----- skipLoadingTests "sets a flag to ignore loading of the testing portion of scripts embedded in pages" SkipLoadingTests := true. ! ----- Method: Installer class>>skipLoadingTestsDuring: (in category 'during') ----- skipLoadingTestsDuring: block | oldValue | oldValue := SkipLoadingTests. SkipLoadingTests := true. [ block value: self ] ensure:[ SkipLoadingTests := oldValue ].! ----- Method: Installer class>>sm (in category 'squeakmap') ----- sm ^ self squeakmap! ----- Method: Installer class>>sophie (in category 'repositories') ----- sophie ^ self monticello http: 'source.sophieproject.org' ! ----- Method: Installer class>>squeak (in category 'repositories') ----- squeak ^self monticello http: 'source.squeak.org'! ----- Method: Installer class>>squeakInbox (in category 'repositories') ----- squeakInbox ^self squeak project: 'inbox'! ----- Method: Installer class>>squeakTrunk (in category 'repositories') ----- squeakTrunk ^self squeak project: 'trunk'! ----- Method: Installer class>>squeakfoundation (in category 'repositories') ----- squeakfoundation ^ self monticello http: 'source.squeakfoundation.org'! ----- Method: Installer class>>squeakmap (in category 'squeakmap') ----- squeakmap ^ InstallerSqueakMap new sm: true; yourself! ----- Method: Installer class>>squeaksource (in category 'repositories') ----- squeaksource ^ self monticello http: 'http://www.squeaksource.com'! ----- Method: Installer class>>squeaksource3 (in category 'repositories') ----- squeaksource3 ^ self monticello http: 'http://ss3.gemtalksystems.com/ss/'! ----- Method: Installer class>>ss (in category 'repositories') ----- ss ^ self squeaksource ! ----- Method: Installer class>>ss3 (in category 'repositories') ----- ss3 ^ self squeaksource3.! ----- Method: Installer class>>ssMirror (in category 'repositories') ----- ssMirror "The Chilean mirror for the original SqueakSource." ^ self monticello http: 'http://dsal.cl/squeaksource/'! ----- Method: Installer class>>swa (in category 'repositories') ----- swa ^ self swasource! ----- Method: Installer class>>swasource (in category 'repositories') ----- swasource ^ self monticello http: 'http://www.hpi.uni-potsdam.de/hirschfeld/squeaksource'! ----- Method: Installer class>>universe (in category 'universe') ----- universe ^ InstallerUniverse default! ----- Method: Installer class>>upgrade (in category 'instanciation') ----- upgrade Installer ss project: 'Installer'; installQuietly: 'Installer-Core'. self privateUpgradeTheRest. ^ self! ----- Method: Installer class>>url (in category 'url') ----- url ^ InstallerUrl new url: ''! ----- Method: Installer class>>url: (in category 'url') ----- url: urlString ^self url url: urlString; yourself! ----- Method: Installer class>>validationBlock (in category 'accessing') ----- validationBlock ^ ValidationBlock! ----- Method: Installer class>>validationBlock: (in category 'accessing') ----- validationBlock: aBlock ValidationBlock := aBlock! ----- Method: Installer class>>view: (in category 'instanciation') ----- view: webPageNameOrUrl | theReport | theReport := String streamContents: [ :report | (webPageNameOrUrl beginsWith: 'http://') ifTrue: [ self actionMatch: ('Installer installUrl: ', (webPageNameOrUrl printString),'.') reportOn: report ifNoMatch: [] ] ifFalse: [ self actionMatch: ('Installer install: ', (webPageNameOrUrl printString),'.') reportOn: report ifNoMatch: [] ]]. Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl. ^theReport contents ! ----- Method: Installer class>>web (in category 'web') ----- web ^ InstallerWeb! ----- Method: Installer class>>webInstall: (in category 'web') ----- webInstall: webPageName ^ self web install: webPageName ! ----- Method: Installer class>>webSearchPath (in category 'web') ----- webSearchPath "a search path item, has the following format. prefix*suffix" ^ self web searchPath! ----- Method: Installer class>>webSearchPathFrom: (in category 'web') ----- webSearchPathFrom: string | reader wsp path | reader := string readStream. wsp := self webSearchPath. [ reader atEnd ] whileFalse: [ path := reader upTo: $;. (wsp includes: wsp) ifFalse: [ wsp addFirst: path ]]. ! ----- Method: Installer class>>websqueakmap (in category 'websqueakmap') ----- websqueakmap ^ InstallerWebSqueakMap new wsm: 'http://map.squeak.org'; yourself! ----- Method: Installer class>>websqueakmap: (in category 'websqueakmap') ----- websqueakmap: host ^ InstallerWebSqueakMap new wsm: host; yourself! ----- Method: Installer class>>wiresong (in category 'repositories') ----- wiresong ^ self monticello http: 'http://source.wiresong.ca'! ----- Method: Installer class>>wsm (in category 'websqueakmap') ----- wsm ^ self websqueakmap! ----- Method: Installer>>addPackage: (in category 'public interface') ----- addPackage: anObject self packages add: anObject! ----- Method: Installer>>allPackages (in category 'accessing') ----- allPackages ^ (self class withAllSuperclasses inject: OrderedCollection new into: [ : coll : each | coll addAll: (each methodsInCategory: 'package-definitions') ; yourself ]) sort! ----- Method: Installer>>answer:with: (in category 'auto answering') ----- answer: aString with: anAnswer ^self answers add: ( Array with: aString with: anAnswer )! ----- Method: Installer>>answers (in category 'accessing') ----- answers ^ answers ifNil: [ answers := OrderedCollection new ]! ----- Method: Installer>>answers: (in category 'accessing') ----- answers: anObject answers := anObject! ----- Method: Installer>>availablePackages (in category 'public interface') ----- availablePackages ^ self basicAvailablePackages! ----- Method: Installer>>basicAvailablePackages (in category 'basic interface') ----- basicAvailablePackages! ----- Method: Installer>>basicBrowse (in category 'basic interface') ----- basicBrowse! ----- Method: Installer>>basicInstall (in category 'basic interface') ----- basicInstall! ----- Method: Installer>>basicVersions (in category 'basic interface') ----- basicVersions! ----- Method: Installer>>basicView (in category 'basic interface') ----- basicView! ----- Method: Installer>>bindingOf: (in category 'script bindings') ----- bindingOf: aString self isThisEverCalled: 'Want to get rid of this and the class-var'. InstallerBindings isNil ifTrue: [ InstallerBindings := Dictionary new]. (InstallerBindings includesKey: aString) ifFalse: [InstallerBindings at: aString put: nil]. ^ InstallerBindings associationAt: aString.! ----- Method: Installer>>bootstrap (in category 'public interface') ----- bootstrap "keep for compatability" self deprecatedApi. useFileIn := true. self install.! ----- Method: Installer>>broomMorphsBase (in category 'package-definitions') ----- broomMorphsBase "Morph alignment user-interface tool." ^ { #ss3 -> 'Connectors'. 'BroomMorphs-Base' }! ----- Method: Installer>>browse (in category 'public interface') ----- browse self logErrorDuring: [self basicBrowse]! ----- Method: Installer>>browse: (in category 'public interface') ----- browse: packageNameCollectionOrDetectBlock self package: packageNameCollectionOrDetectBlock. self browse! ----- Method: Installer>>browse:from: (in category 'mantis') ----- browse: aFileName from: stream | mcThing ext browseSelector | self log: ' browsing...'. mcThing := self classMCReader ifNotNil: [ self mcThing: aFileName from: stream ]. mcThing ifNotNil: [ (mcThing respondsTo: #snapshot) ifTrue: [ mcThing browse ] ifFalse: [ (MCSnapshotBrowser forSnapshot: mcThing) showLabelled: 'Browsing ', aFileName ] ] ifNil: [ ext := aFileName copyAfterLast: $.. browseSelector := ('browse', ext asUppercase, ':from:') asSymbol. (self respondsTo: browseSelector) ifTrue: [ self perform: browseSelector with: aFileName with: stream ] ifFalse: [ self browseDefault: aFileName from: stream ]. ]! ----- Method: Installer>>browseCS:from: (in category 'mantis') ----- browseCS: aFileName from: stream | list | list := self classChangeList new scanFile: stream from: 1 to: stream size. self classChangeList open: list name: aFileName multiSelect: true. ! ----- Method: Installer>>browseDefault:from: (in category 'mantis') ----- browseDefault: aFileName from: stream self view: aFileName from: stream! ----- Method: Installer>>browseGZ:from: (in category 'mantis') ----- browseGZ: aFileName from: stream "FileIn the contents of a gzipped stream" | zipped unzipped | zipped := self classGZipReadStream on: stream. unzipped := MultiByteBinaryOrTextStream with: zipped contents asString. unzipped reset. ChangeList browseStream: unzipped ! ----- Method: Installer>>changeSetNamed: (in category 'utils') ----- changeSetNamed: aName (ChangeSet respondsTo: #named:) ifTrue: [ ^ ChangeSet named: aName ]. ^ ChangeSorter changeSetNamed: aName.! ----- Method: Installer>>classChangeList (in category 'class references') ----- classChangeList ^Smalltalk at: #ChangeList ifAbsent: [ self error: 'ChangeList not present' ]! ----- Method: Installer>>classChangeSet (in category 'class references') ----- classChangeSet ^Smalltalk at: #ChangeSet ifAbsent: [ self error: 'ChangeSet not present' ]! ----- Method: Installer>>classChangeSorter (in category 'class references') ----- classChangeSorter ^Smalltalk at: #ChangeSorter ifAbsent: [ self error: 'ChangeSorter not present' ]! ----- Method: Installer>>classGZipReadStream (in category 'class references') ----- classGZipReadStream ^Smalltalk at: #GZipReadStream ifAbsent: [ self error: 'Compression not present' ]! ----- Method: Installer>>classMCReader (in category 'class references') ----- classMCReader ^Smalltalk at: #MCReader ifAbsent: [ nil ] ! ----- Method: Installer>>classMczInstaller (in category 'class references') ----- classMczInstaller ^Smalltalk at: #MczInstaller ifAbsent: [ nil ] ! ----- Method: Installer>>classMultiByteBinaryOrTextStream (in category 'class references') ----- classMultiByteBinaryOrTextStream ^Smalltalk at: #MultiByteBinaryOrTextStream ifAbsent: [ self error: 'MultiByteBinaryOrTextStream not present' ]! ----- Method: Installer>>classSARInstaller (in category 'class references') ----- classSARInstaller ^Smalltalk at: #SARInstaller ifAbsent: [ self error: 'SARInstaller not present' ]! ----- Method: Installer>>connectors (in category 'package-definitions') ----- connectors "Connect Morphs together. Make diagrams." ^ { self broomMorphsBase. 'CGPrereqs'. 'FSM'. 'Connectors'. 'ConnectorsText'. 'ConnectorsShapes'. 'ConnectorsTools'. 'ConnectorsGraphLayout'. 'BroomMorphs-Connectors' }! ----- Method: Installer>>core (in category 'package-definitions') ----- core "A minimum core capable of expanding itself." ^ { #squeak -> MCMcmUpdater defaultUpdateURL asUrl path last. 'Kernel'. 'Collections'. 'Exceptions'. 'Files'. 'Network'. 'Monticello'. 'MonticelloConfigurations'. 'Installer-Core' }! ----- Method: Installer>>curvedSpaceExplorer (in category 'package-definitions') ----- curvedSpaceExplorer "Explore curved 3D spaces." ^ { self openGL. 'CCSpaceExplorer' }! ----- Method: Installer>>depthFirstOf:do: (in category 'private') ----- depthFirstOf: structure do: oneArgBlock self depthFirstOf: structure do: oneArgBlock ifNotIn: Set new! ----- Method: Installer>>depthFirstOf:do:ifNotIn: (in category 'private') ----- depthFirstOf: structure do: oneArgBlock ifNotIn: aSet (aSet includes: structure) ifTrue: [ ^ self ]. "Respect all repository directives even if encountered more than once." (structure isVariableBinding) ifFalse: [ aSet add: structure ]. structure isArray ifTrue: [ structure do: [ : each | self depthFirstOf: each do: oneArgBlock ifNotIn: aSet ] ] ifFalse: [ oneArgBlock value: structure ]! ----- Method: Installer>>ditchOldChangeSetFor: (in category 'utils') ----- ditchOldChangeSetFor: aFileName | changeSetName changeSet | changeSetName := (self validChangeSetName: aFileName) sansPeriodSuffix. changeSet := self changeSetNamed: changeSetName. changeSet ifNotNil: [ (self logCR:'Removing old change set ', changeSetName) cr. self removeChangeSet: changeSet ].! ----- Method: Installer>>ffi (in category 'package-definitions') ----- ffi "Foreign Function Interface." ^ { #squeak -> 'FFI'. 'FFI-Pools'. 'FFI-Kernel' }! ----- Method: Installer>>ffiTests (in category 'package-definitions') ----- ffiTests "Tests for Foreign Function Interface." ^ { self ffi. 'FFI-Tests' }! ----- Method: Installer>>fileInSource (in category 'public interface') ----- fileInSource useFileIn := true. self install.! ----- Method: Installer>>fuel (in category 'package-definitions') ----- fuel "Serialization package." ^ { #ss3 -> 'Fuel'. 'ConfigurationOfFuel' }! ----- Method: Installer>>htmlValidator (in category 'package-definitions') ----- htmlValidator "Validates HTML and CSS pages against W3C DTD." ^ { #ss3 -> 'htmlcssparser'. 'HTML' }! ----- Method: Installer>>initialize (in category 'public interface') ----- initialize useFileIn := false..! ----- Method: Installer>>install (in category 'public interface') ----- install noiseLevel = #quiet ifTrue: [ ^ self installQuietly ]. noiseLevel = #silent ifTrue: [ ^ self installSilently ]. ^ self installLogging! ----- Method: Installer>>install: (in category 'public interface') ----- install: packageNameCollectionOrDetectBlock "The parameter specifies the package to be installed in one of the following ways: - By Name e.g. install: 'Kernel' - Acceptable Versions e.g. install: #('Comet-lr' 'Comet-pmm') i.e. either of these - Specific version e.g. install: 'Scriptaculous-lr.148' - By Predicate e.g. install: [ :packageName | packageName beginsWith: 'Dynamic' ]" self addPackage: packageNameCollectionOrDetectBlock. self install! ----- Method: Installer>>install:from: (in category 'mantis') ----- install: aFileName from: stream self log: ' installing...'. self withAnswersDo: [ | ext installSelector mcThing | mcThing := self classMCReader ifNotNil: [ self mcThing: aFileName from: stream ]. mcThing ifNotNil: [ (mcThing respondsTo: #install) ifTrue: [ mcThing install ] ifFalse: [ (mcThing respondsTo: #load) ifTrue: [ mcThing load ] ] ] ifNil: [ ext := (aFileName copyAfterLast: $/) in: [ :path | path isEmpty ifTrue: [ aFileName ] ifFalse: [ path ] ]. ext := ext copyAfterLast: $.. ext = '' ifTrue: [ ext := 'st' ]. installSelector := ('install', ext asUppercase, ':from:') asSymbol. useFileIn ifTrue: [ [ SystemChangeNotifier uniqueInstance doSilently: [self install: aFileName from: stream using: installSelector ]] on: Warning do: [ :ex | ex resume: true ]. ] ifFalse: [ self install: aFileName from: stream using: installSelector. ] ] ]. self log: ' done.' ! ----- Method: Installer>>install:from:using: (in category 'mantis') ----- install: aFileName from: stream using: installSelector (self respondsTo: installSelector) ifTrue: [ self perform: installSelector with: aFileName with: stream ] ifFalse: [ self installDefault: aFileName from: stream ]. ! ----- Method: Installer>>installCS:from: (in category 'mantis') ----- installCS: aFileName from: stream self ditchOldChangeSetFor: aFileName. self newChangeSetFromStream: stream named: (self validChangeSetName: aFileName). ! ----- Method: Installer>>installDefault:from: (in category 'mantis') ----- installDefault: aFileName from: stream "Check for UTF-8 input before filing it in" | pos | pos := stream position. (stream next: 3) asByteArray = #[16rEF 16rBB 16rBF] "BOM" ifTrue: [(RWBinaryOrTextStream on: stream upToEnd utf8ToSqueak) fileIn] ifFalse: [stream position: pos; fileIn] ! ----- Method: Installer>>installGZ:from: (in category 'mantis') ----- installGZ: aFileName from: stream "FileIn the contents of a gzipped stream" | zipped unzipped | zipped := self classGZipReadStream on: stream. unzipped := MultiByteBinaryOrTextStream with: zipped contents asString. unzipped reset. self newChangeSetFromStream: unzipped named: (FileDirectory localNameFor: aFileName)! ----- Method: Installer>>installLogging (in category 'public interface') ----- installLogging self logErrorDuring: [ self basicInstall. packages := nil]. ! ----- Method: Installer>>installMCZ:from: (in category 'mantis') ----- installMCZ: aFileName from: stream | source pkg wc | pkg := aFileName copyUpToLast: $-. wc := Smalltalk at: #MCWorkingCopy ifAbsent: [ nil ]. wc ifNotNil: [ (wc allManagers select: [:each | each packageName = pkg ]) do: [ :ea | ea unregister ] ]. self classMczInstaller ifNotNil: [^ self classMczInstaller install: aFileName stream: stream]. source := ((ZipArchive new readFrom:stream) memberNamed: 'snapshot/source.st') contents. [ SystemChangeNotifier uniqueInstance doSilently: [ source readStream fileInAnnouncing: 'Booting ' , aFileName. ] ] on: Warning do: [ :ex | ex resume: true ].! ----- Method: Installer>>installMCZBasic:from: (in category 'mantis') ----- installMCZBasic: aFileName from: stream | source | self classMczInstaller ifNotNil: [^ self classMczInstaller install: aFileName stream: stream]. source := ((ZipArchive new readFrom:stream) memberNamed: 'snapshot/source.st') contents. [ SystemChangeNotifier uniqueInstance doSilently: [ source readStream fileInAnnouncing: 'Booting ' , aFileName. ] ] on: Warning do: [ :ex | ex resume: true ].! ----- Method: Installer>>installMCcs:from: (in category 'mantis') ----- installMCcs: aFileName from: stream | reader | reader := Smalltalk at: #MCCsReader ifPresent: [:class | class on: stream].! ----- Method: Installer>>installQuietly (in category 'public interface') ----- installQuietly [ self installLogging ] on: Warning do: [ :ex | ex resume: true ].! ----- Method: Installer>>installQuietly: (in category 'public interface') ----- installQuietly: packageNameCollectionOrDetectBlock self quietly install: packageNameCollectionOrDetectBlock. ! ----- Method: Installer>>installSAR:from: (in category 'mantis') ----- installSAR: aFileName from: stream | newCS | newCS := self classSARInstaller withCurrentChangeSetNamed: aFileName do: [:cs | self classSARInstaller new fileInFrom: stream]. newCS isEmpty ifTrue: [ self removeChangeSet: newCS ]! ----- Method: Installer>>installSilently (in category 'public interface') ----- installSilently SystemChangeNotifier uniqueInstance doSilently: [ self installLogging ] ! ----- Method: Installer>>isSkipLoadingTestsSet (in category 'accessing') ----- isSkipLoadingTestsSet ^SkipLoadingTests ifNil: [ false ]! ----- Method: Installer>>log: (in category 'logging') ----- log: text ^Transcript show: text.! ----- Method: Installer>>logCR: (in category 'logging') ----- logCR: text self validate. ^ Transcript show: text; cr! ----- Method: Installer>>logErrorDuring: (in category 'logging') ----- logErrorDuring: block (IsSetToTrapErrors = true) ifFalse: [ ^ block value ]. block on: Error do: [ :e | self halt. self logCR: '****', e class name, ': ', (e messageText ifNil: [ '']). (e isKindOf: MessageNotUnderstood) ifTrue: [ e pass ] ifFalse: [ e isResumable ifTrue:[ e resume: true ]]]! ----- Method: Installer>>maInstaller (in category 'package-definitions') ----- maInstaller "Select from a family of related packages for application development." ^ { #ss3 -> 'Ma-Installer'. 'Ma-Installer-Core' }! ----- Method: Installer>>match: (in category 'searching') ----- match: aMatch ^self packagesMatching: aMatch! ----- Method: Installer>>mathMorphs (in category 'package-definitions') ----- mathMorphs "MathMorphs is a project that combines mathematics and Smalltalk. See http://www.dm.uba.ar/MathMorphs/ and chapter 10 of the 'new blue book'." ^ { self morphicWrappers. 'Functions' }! ----- Method: Installer>>mcThing:from: (in category 'mantis') ----- mcThing: aFileName from: stream "dont use monticello for .cs or for .st use monticello for .mcs" | reader | useFileIn ifTrue: [ ^ nil ]. reader := self classMCReader readerClassForFileNamed: aFileName. reader name = 'MCStReader' ifTrue: [ ^ nil ]. reader ifNil: [ ^ nil ]. (reader respondsTo: #on:fileName:) ifTrue: [ reader := reader on: stream fileName: aFileName. ^ reader version ] ifFalse: [ reader := reader on: stream. ^ reader snapshot ].! ----- Method: Installer>>merge: (in category 'public interface') ----- merge: structureOrSymbol | toUncache | toUncache := Set new. structureOrSymbol isSymbol ifTrue: [ self merge: (self perform: structureOrSymbol) ] ifFalse: [ self depthFirstOf: structureOrSymbol do: [ : each | each isVariableBinding ifTrue: [ currentRepository := self class repositoryFor: each. currentRepository cacheAllFilenames. toUncache add: currentRepository ] ifFalse: [ each isString ifTrue: [ self primMerge: each ] ifFalse: [ self error: 'invalid specification' ] ] ] ]. toUncache do: [ : each | each flushAllFilenames ]! ----- Method: Installer>>messagesToSuppress (in category 'accessing') ----- messagesToSuppress ^ messagesToSuppress ifNil: [ messagesToSuppress := OrderedCollection new ]! ----- Method: Installer>>messagesToSuppress: (in category 'accessing') ----- messagesToSuppress: anObject messagesToSuppress := anObject! ----- Method: Installer>>morphicWrappers (in category 'package-definitions') ----- morphicWrappers "Provides 'type on air' workspaces. Results of evaluated expressions are represented as domain objects in the world." ^ { #ss -> 'MathMorphsRevival'. 'MorphicWrappers' }! ----- Method: Installer>>newChangeSetFromStream:named: (in category 'mantis') ----- newChangeSetFromStream: aStream named: aName "This code is based upon ChangeSet-c-#newChangesFromStream:named: which is in 3.9, implemented here for previous versions. The second branch is for 3.8, where ChangeSets are loaded by ChangeSorter. " | oldChanges newName newSet | (self classChangeSet respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSet newChangesFromStream: aStream named:aName ]. (self classChangeSorter respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSorter newChangesFromStream: aStream named: aName ]. oldChanges := ChangeSet current. "so a Bumper update can find it" newName := aName sansPeriodSuffix. newSet := self classChangeSet basicNewNamed: newName. [ | newStream | newSet ifNotNil: [(aStream respondsTo: #converter:) ifTrue: [newStream := aStream] ifFalse: [newStream := self classMultiByteBinaryOrTextStream with: aStream contentsOfEntireFile. newStream reset]. self classChangeSet newChanges: newSet. newStream setConverterForCode. newStream fileInAnnouncing: 'Loading ' , newName , '...'. Transcript cr; show: 'File ' , aName , ' successfully filed in to change set ' , newName]. aStream close] ensure: [self classChangeSet newChanges: oldChanges]. ^ newSet! ----- Method: Installer>>open (in category 'public interface') ----- open! ----- Method: Installer>>openGL (in category 'package-definitions') ----- openGL "3D library." ^ { self threeDtransform. #krestianstvo -> 'ccse'. 'OpenGL-Pools'. 'OpenGL-Core'. 'OpenGL-NameManager' }! ----- Method: Installer>>osProcess (in category 'package-definitions') ----- osProcess "Launch external executable programs." ^ { #ss -> 'OSProcess'. 'OSProcess' }! ----- Method: Installer>>package (in category 'accessing') ----- package ^ self packages isEmpty ifTrue: [ nil ] ifFalse: [ self packages last ]! ----- Method: Installer>>package: (in category 'accessing') ----- package: anObject self addPackage: anObject.! ----- Method: Installer>>packageAndVersionFrom: (in category 'squeakmap') ----- packageAndVersionFrom: pkg | p | p := ReadStream on: pkg . ^{(p upTo: $(). p upTo: $)} collect: [:s | s withBlanksTrimmed].! ----- Method: Installer>>packages (in category 'accessing') ----- packages ^ packages ifNil: [ packages := OrderedCollection new ]! ----- Method: Installer>>packages: (in category 'accessing') ----- packages: aCollection packages := aCollection! ----- Method: Installer>>packagesMatching: (in category 'searching') ----- packagesMatching: aMatch ^'search type not supported'! ----- Method: Installer>>primMerge: (in category 'private') ----- primMerge: packageName | version | version := (currentRepository includesVersionNamed: packageName) ifTrue: [ currentRepository versionNamed: packageName ] ifFalse: [ currentRepository highestNumberedVersionForPackageNamed: packageName ]. [ version shouldMerge ifTrue: [ version merge ] ifFalse: [ version load ] ] on: MCNoChangesException do: [ : req | req resume ] on: MCMergeResolutionRequest do: [ : request | request merger conflicts isEmpty ifTrue: [ request resume: true ] ifFalse: [ request pass ] ]. version workingCopy repositoryGroup addRepository: currentRepository! ----- Method: Installer>>quietly (in category 'public interface') ----- quietly noiseLevel := #quiet! ----- Method: Installer>>removeChangeSet: (in category 'utils') ----- removeChangeSet: cs (self classChangeSet respondsTo: #removeChangeSet:) ifTrue: [ ^ChangeSet removeChangeSet: cs ]. ^ self classChangeSorter removeChangeSet: cs .! ----- Method: Installer>>reportFor:page:on: (in category 'action report') ----- reportFor: theLine page: thePage on: report [ thePage atEnd ] whileFalse: [ | line | line := thePage nextLine. Installer actionMatch: line reportOn: report ifNoMatch: [ report nextPutAll: line; cr. ]].! ----- Method: Installer>>reportSection:on: (in category 'action report') ----- reportSection: line on: report report isEmpty ifFalse: [ report cr ]. report nextPutAll: '">>>> ' ; nextPutAll: (line copyWithout: $"); nextPut: $"; cr. ! ----- Method: Installer>>search: (in category 'searching') ----- search: aMatch ^'search type not supported'! ----- Method: Installer>>silently (in category 'public interface') ----- silently noiseLevel := #silent! ----- Method: Installer>>squeakRelease (in category 'package-definitions') ----- squeakRelease ^ { self system. '311Deprecated'. '39Deprecated'. '45Deprecated'. 'Nebraska'. 'SmallLand-ColorTheme'. 'ST80'. 'ST80Tools'. 'SystemReporter'. 'Universes'. 'XML-Parser' }! ----- Method: Installer>>squeakSslCore (in category 'package-definitions') ----- squeakSslCore "SSL implementation on top of WebClient. Requires the SqueakSSL VM plugin." ^ { self webClientCore. #ss -> 'SqueakSSL'. 'SqueakSSL-Core' }! ----- Method: Installer>>squeakSslTests (in category 'package-definitions') ----- squeakSslTests "SqueakSSL test package." ^ { self webClientTests. self squeakSslCore. 'SqueakSSL-Tests' }! ----- Method: Installer>>squeaksource (in category 'package-definitions') ----- squeaksource "A source code repository." ^ { #squeak -> 'ss'. 'OSProcess'. 'RFB'. 'SmaCC'. 'DynamicBindings'. 'KomServices'. 'KomHttpServer'. 'Seaside2'. 'Mewa'. 'TinyWiki'. 'SqueakSource' }! ----- Method: Installer>>suppress: (in category 'auto answering') ----- suppress: aMessage messagesToSuppress add: aMessage! ----- Method: Installer>>system (in category 'package-definitions') ----- system "Packages forming the Smalltalk development system." ^ { self core. 'System' }! ----- Method: Installer>>threeDtransform (in category 'package-definitions') ----- threeDtransform ^ { self ffiTests. #ss -> 'CroquetGL'. '3DTransform' }! ----- Method: Installer>>tools (in category 'package-definitions') ----- tools "A minimum core capable of expanding itself." ^ { self core. 'ToolBuilder-Kernel'. 'Tools' }! ----- Method: Installer>>updateStream (in category 'package-definitions') ----- updateStream ^ { self tools. 'UpdateStream' }! ----- Method: Installer>>validChangeSetName: (in category 'url') ----- validChangeSetName: aFileName " dots in the url confuses the changeset loader. I replace them with dashes" (aFileName beginsWith:'http:') ifTrue: [ | asUrl | asUrl := Url absoluteFromText: aFileName. ^String streamContents: [:stream | stream nextPutAll: (asUrl authority copyReplaceAll: '.' with: '-'). asUrl path allButLastDo: [:each | stream nextPutAll: '/'; nextPutAll: (each copyReplaceAll: '.' with: '-') ]. stream nextPutAll: '/'; nextPutAll: asUrl path last ] ]. ^aFileName! ----- Method: Installer>>validate (in category 'logging') ----- validate ValidationBlock value = false ifTrue: [ self error: 'Validation failed' ].! ----- Method: Installer>>versions (in category 'public interface') ----- versions ^ self basicVersions! ----- Method: Installer>>view (in category 'public interface') ----- view self logErrorDuring: [self basicView]! ----- Method: Installer>>view: (in category 'public interface') ----- view: packageNameCollectionOrDetectBlock self package: packageNameCollectionOrDetectBlock. self view! ----- Method: Installer>>view:from: (in category 'mantis') ----- view: aFileName from: stream self log: ' viewing...'. Workspace new contents: (stream contents); openLabel: aFileName. ! ----- Method: Installer>>webClientCore (in category 'package-definitions') ----- webClientCore "Simple, compact, and easy to use HTTP client implementation from Andreas Raab." ^ { #ss3 -> 'WebClient'. 'WebClient-Core' }! ----- Method: Installer>>webClientSsp (in category 'package-definitions') ----- webClientSsp "WebClient supports NTLM/SPNEGO authentication via the Microsoft SSP interface (Windows only)." ^ { self ffiTests. self webClientTests. 'WebClient-SSP' }! ----- Method: Installer>>webClientTests (in category 'package-definitions') ----- webClientTests "Help documentation and tests for Web Client." ^ { self webClientCore. 'WebClient-Tests'. 'WebClient-Help' }! ----- Method: Installer>>withAnswersDo: (in category 'auto answering') ----- withAnswersDo: aBlock (aBlock respondsTo: #valueSuppressingMessages:supplyingAnswers: ) ifTrue: [aBlock valueSuppressingMessages: self messagesToSuppress supplyingAnswers: self answers.] ifFalse: [ aBlock value ] ! Installer subclass: #InstallerFile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerFile>>basicBrowse (in category 'basic interface') ----- basicBrowse self browse: self file from: (FileDirectory readOnlyFileNamed: self file). ! ----- Method: InstallerFile>>basicInstall (in category 'basic interface') ----- basicInstall self install: self file from: (FileDirectory default readOnlyFileNamed: self file) ! ----- Method: InstallerFile>>basicView (in category 'basic interface') ----- basicView self view: self file from: (FileDirectory readOnlyFileNamed: self file). ! ----- Method: InstallerFile>>file (in category 'accessing') ----- file ^ self package! ----- Method: InstallerFile>>file: (in category 'accessing') ----- file: f self package: f! Installer subclass: #InstallerInternetBased instanceVariableNames: 'url pageDataStream markers' classVariableNames: 'Entities' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerInternetBased class>>entities (in category 'accessing') ----- entities ^ Entities ifNil: [ Entities := "enough entities to be going on with" Dictionary new. Entities at: 'lt' put: '<'; at: 'gt' put: '>'; at: 'amp' put: '&'; at: 'star' put: '*'; at: 'quot' put: '"'; at: 'nbsp' put: ' '; yourself ] ! ----- Method: InstallerInternetBased>>classHTTPSocket (in category 'class references') ----- classHTTPSocket ^Smalltalk at: #HTTPSocket ifAbsent: [ self error: 'Network package not present' ]! ----- Method: InstallerInternetBased>>extractFromHtml:option: (in category 'as yet unclassified') ----- extractFromHtml: html option: allOrLast | start stop test in | start := self markersBegin. stop := self markersEnd. test := self markersTest. in := WriteStream with: String new. [ html upToAll: start; atEnd ] whileFalse: [ | chunk | (allOrLast == #last) ifTrue: [ in resetToStart ]. chunk := html upToAll: stop. self isSkipLoadingTestsSet ifTrue: [ chunk := chunk readStream upToAll: test ]. in nextPutAll: chunk. ]. ^self removeHtmlMarkupFrom: in readStream ! ----- Method: InstallerInternetBased>>hasPage (in category 'url') ----- hasPage ^ pageDataStream notNil and: [ pageDataStream size > 0 ] ! ----- Method: InstallerInternetBased>>httpGet: (in category 'utils') ----- httpGet: aUrl | page | page := self classHTTPSocket httpGet: aUrl accept: 'application/octet-stream'. (page respondsTo: #reset) ifFalse: [ self error: 'unable to contact web site' ]. ^ page ! ----- Method: InstallerInternetBased>>isHtmlStream: (in category 'url') ----- isHtmlStream: page "matches '<!!DOCTYPE HTML', and <html>' " | first | first := (page next: 14) asUppercase. ^ (first = '<!!DOCTYPE HTML') | (first beginsWith: '<HTML>') ! ----- Method: InstallerInternetBased>>markers (in category 'as yet unclassified') ----- markers ^ markers ifNil: [ '<code st>..."test ...</code st>' ]! ----- Method: InstallerInternetBased>>markers: (in category 'as yet unclassified') ----- markers: anObject markers := anObject! ----- Method: InstallerInternetBased>>markersBegin (in category 'as yet unclassified') ----- markersBegin ^ self markers copyUpTo: $.! ----- Method: InstallerInternetBased>>markersEnd (in category 'as yet unclassified') ----- markersEnd "return the third marker or the second if there are only two" | str a | str := self markers readStream. a := str upToAll: '...'; upToAll: '...'. str atEnd ifTrue: [ ^a ] ifFalse: [ ^str upToEnd ] ! ----- Method: InstallerInternetBased>>markersTest (in category 'as yet unclassified') ----- markersTest ^ self markers readStream upToAll: '...'; upToAll: '...'! ----- Method: InstallerInternetBased>>removeHtmlMarkupFrom: (in category 'as yet unclassified') ----- removeHtmlMarkupFrom: in | out | out := WriteStream on: (String new: 100). [ in atEnd ] whileFalse: [ out nextPutAll: (in upTo: $<). (((in upTo: $>) asLowercase beginsWith: 'br') and: [ (in peek = Character cr) ]) ifTrue: [ in next ]. ]. ^self replaceEntitiesIn: out readStream. ! ----- Method: InstallerInternetBased>>replaceEntitiesIn: (in category 'url') ----- replaceEntitiesIn: in | out | out := WriteStream on: (String new: 100). [ in atEnd ] whileFalse: [ out nextPutAll: ((in upTo: $&) replaceAll: Character lf with: Character cr). in atEnd ifFalse: [ out nextPutAll: (self class entities at: (in upTo: $;) ifAbsent: '?') ]. ]. ^out readStream! ----- Method: InstallerInternetBased>>url (in category 'accessing') ----- url ^url! ----- Method: InstallerInternetBased>>url: (in category 'accessing') ----- url: aUrl url := aUrl! ----- Method: InstallerInternetBased>>urlGet (in category 'url') ----- urlGet ^ self urlGet: self urlToDownload! ----- Method: InstallerInternetBased>>urlGet: (in category 'url') ----- urlGet: aUrl | page | page := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'. (page respondsTo: #reset) ifFalse: [ ^ nil ]. (self isHtmlStream: page) ifTrue: [ page := self extractFromHtml: page option: nil ]. ^ page reset ! ----- Method: InstallerInternetBased>>wasPbwikiSpeedWarning (in category 'url') ----- wasPbwikiSpeedWarning ^ self hasPage and: [pageDataStream contents includesSubString: 'Please slow down a bit' ] ! InstallerInternetBased subclass: #InstallerUrl instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerUrl class>>canReportLine: (in category 'action report') ----- canReportLine: line ^ ((line beginsWith: 'Installer installUrl:') and: [ | ext | ext := (line readStream upToAll: '''.') copyAfterLast: $.. (#( 'cs' 'st' 'mcz' 'sar') includes: ext) not ])! ----- Method: InstallerUrl>>action:reportOn: (in category 'action report') ----- action: line reportOn: report url := line readStream upTo: $' ; upTo: $'. self reportSection: line on: report. (pageDataStream := self urlGet: self urlToDownload) ifNil: [ self error: 'unable to contact host' ]. self reportFor: line page: pageDataStream on: report ! ----- Method: InstallerUrl>>addPackage: (in category 'as yet unclassified') ----- addPackage: aPackageName super addPackage: aPackageName. (self url endsWith: '/') ifFalse: [self url: self url, '/'].! ----- Method: InstallerUrl>>basicBrowse (in category 'basic interface') ----- basicBrowse "(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') browse.". self browse: self urlToDownload from: self urlThing. ! ----- Method: InstallerUrl>>basicInstall (in category 'basic interface') ----- basicInstall self install: self urlToDownload from: self urlThing. ^ pageDataStream ! ----- Method: InstallerUrl>>basicView (in category 'basic interface') ----- basicView "(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') view.". self view: self urlToDownload from: self urlThing. ! ----- Method: InstallerUrl>>fileInSource (in category 'accessing') ----- fileInSource " (Installer url: 'http://www.squeaksource.com/Sake/Sake-Core-kph.47.mcz') bootstrap. " | pkg splitPos repo getFileName fileName | useFileIn := true. splitPos := url lastIndexOf: $/. pkg := url copyFrom: splitPos + 1 to: url size. repo := url copyFrom: 1 to: splitPos. getFileName := [ :pkgName | pkgName , ((HTTPSocket httpGet: repo) upToAll: pkgName; upTo: $") ]. fileName := getFileName value: pkg. url := repo,fileName. self install! ----- Method: InstallerUrl>>urlThing (in category 'url') ----- urlThing | retry delay | self logCR: 'retrieving ', self urlToDownload , ' ...'. delay := 0. [retry := false. pageDataStream := self urlGet: self urlToDownload. self wasPbwikiSpeedWarning ifTrue: [ retry := true. delay := delay + 5. self logCR: 'PBWiki speed warning. Retrying in ', delay printString, ' seconds'. (Delay forSeconds: delay) wait ]. retry ] whileTrue. pageDataStream ifNil: [ self error: 'unable to contact host' ]. ^ pageDataStream ! ----- Method: InstallerUrl>>urlToDownload (in category 'url') ----- urlToDownload ^ (self url, (self package ifNil: [ '' ])) asUrl asString. ! InstallerInternetBased subclass: #InstallerWebBased instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! InstallerWebBased subclass: #InstallerMantis instanceVariableNames: 'ma bug desc date array data status' classVariableNames: 'Fixes Status' poolDictionaries: '' category: 'Installer-Core'! !InstallerMantis commentStamp: 'test 1/14/2009 00:11' prior: 0! Search feature is based upon a custom mantis query ceveloped and maintained by Ken Causey <ken at kencausey.com> Installer mantis bugsAll select: [ :ea | ea status = 'testing' ].! ----- Method: InstallerMantis class>>canReportLine: (in category 'action report') ----- canReportLine: line ^ line beginsWith: 'Installer mantis fixBug:'! ----- Method: InstallerMantis class>>fixesApplied (in category 'accessing') ----- fixesApplied ^ Fixes ifNil: [ Fixes := OrderedCollection new ].! ----- Method: InstallerMantis class>>host: (in category 'instance creation') ----- host: host ^self new ma: host; markers: '"fix begin"..."fix test"..."fix end"'; yourself. ! ----- Method: InstallerMantis class>>initialize (in category 'instance creation') ----- initialize Status := Dictionary new at: '10' put: 'new'; at: '20' put: 'feedback'; at: '30' put: 'acknowledged'; at: '40' put: 'confirmed'; at: '50' put: 'assigned'; at: '60' put: 'pending'; at: '70' put: 'testing'; at: '80' put: 'resolved'; at: '90' put: 'closed'; yourself ! ----- Method: InstallerMantis>>= (in category 'accessing') ----- = other self == other ifTrue: [ ^ true ]. self species = other species ifFalse: [ ^ false ]. ^ array = other array! ----- Method: InstallerMantis>>action:reportOn: (in category 'action report') ----- action: line reportOn: report | param mantis | mantis := Installer mantis. param := line readStream upTo: $: ; upTo: $.. mantis setBug: ((param readStream upTo: $'; atEnd) ifTrue: [ param ] ifFalse: [ param readStream upTo: $'; upTo: $' ]). self reportSection: line on: report. report nextPutAll: (mantis replaceEntitiesIn: mantis markersBegin readStream). self reportFor: line page: mantis maScript on: report. report nextPutAll: (mantis replaceEntitiesIn: mantis markersEnd readStream); cr. ! ----- Method: InstallerMantis>>array (in category 'accessing') ----- array ^ array! ----- Method: InstallerMantis>>browseFile: (in category 'public interface') ----- browseFile: aFileName ^ self browse: aFileName from: (self maThing: aFileName date: nil)! ----- Method: InstallerMantis>>bug (in category 'accessing') ----- bug ^ bug ifNil: [ date := ((self dataAtName: 'Updated') replaceAll: $ with: $T) asDateAndTime. desc := (self dataAtName: 'Summary'). bug := (self dataAtName: 'Id'). self statusInit. ]! ----- Method: InstallerMantis>>bug: (in category 'public interface') ----- bug: aBugNo | page | self setBug: aBugNo. page := self maPage. date := ((self maRead: page field: 'Date Updated') value replaceAll: $ with: $T) asDateAndTime. status := (self maRead: page field: 'Status') value. " Installer mantis bug: 7235 "! ----- Method: InstallerMantis>>bug:browse: (in category 'public interface') ----- bug: aBugNo browse: aFileName self setBug: aBugNo. ^ self browseFile: aFileName! ----- Method: InstallerMantis>>bug:fix: (in category 'public interface') ----- bug: aBugNo fix: aFileName ^ self bug: aBugNo fix: aFileName date: nil! ----- Method: InstallerMantis>>bug:fix:date: (in category 'public interface') ----- bug: aBugNo fix: aFileName date: aDate | | self setBug: aBugNo. self ditchOldChangeSetFor: aFileName. self install: aFileName from: (self maThing: aFileName date: aDate). ^ date! ----- Method: InstallerMantis>>bug:retrieve: (in category 'public interface') ----- bug: aBugNo retrieve: aFileName self setBug: aBugNo. ^ (self maStreamForFile: aFileName) contents! ----- Method: InstallerMantis>>bug:view: (in category 'public interface') ----- bug: aBugNo view: aFileName "Installer mantis bug: 6089 browse: 'TTFSpeedUp-dgd.1.cs'" self setBug: aBugNo. ^ self view: aFileName from: (self maThing: aFileName date: nil)! ----- Method: InstallerMantis>>bugFiles: (in category 'public interface') ----- bugFiles: aBugNo "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " self setBug: aBugNo; files! ----- Method: InstallerMantis>>bugFilesView: (in category 'public interface') ----- bugFilesView: aBugNo "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " self setBug: aBugNo; viewFiles! ----- Method: InstallerMantis>>bugScript: (in category 'public interface') ----- bugScript: aBugNo ^ (self setBug: aBugNo) script ! ----- Method: InstallerMantis>>bugsAll (in category 'action report') ----- bugsAll ^ array ifNil: [ array := ( self bugsSqueak , (self dataGetFrom: '/installer_export.php') ) asSet asSortedCollection: [ :a :b | a date > b date ] ]. " Installer mantis bugsAll " ! ----- Method: InstallerMantis>>bugsClosed (in category 'search') ----- bugsClosed ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]! ----- Method: InstallerMantis>>bugsRelease: (in category 'search') ----- bugsRelease: version ^self bugsAll select: [ :ea | (ea status = 'resolved') and: [ ea fixedIn = version ]]! ----- Method: InstallerMantis>>bugsSqueak (in category 'search') ----- bugsSqueak ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?project=Squeak' ] " Installer mantis bugsSqueak. Installer mantis bugsAll. Installer mantis bugsClosed. "! ----- Method: InstallerMantis>>bugsTesting: (in category 'search') ----- bugsTesting: version ^self bugsAll select: [ :ea | ea status = 'testing' and: [ ea fixedIn = version ]]! ----- Method: InstallerMantis>>category (in category 'search') ----- category ^ self dataAtName: 'Category' " s bugs collect: [ :ea | ea category ] "! ----- Method: InstallerMantis>>dataAtName: (in category 'search') ----- dataAtName: key ^ array at: (self dataNames indexOf: key)! ----- Method: InstallerMantis>>dataAtName:put: (in category 'search') ----- dataAtName: key put: v ^ array at: (self dataNames indexOf: key) put: v! ----- Method: InstallerMantis>>dataClosed (in category 'search') ----- dataClosed ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]! ----- Method: InstallerMantis>>dataGetFrom: (in category 'public interface') ----- dataGetFrom: aPath | rs line first col row out | rs := HTTPSocket httpGet: ma, aPath. rs isString ifTrue: [ ^ ProtocolClientError signal: 'notFound' ]. first := true. out := OrderedCollection new. [ rs atEnd ] whileFalse: [ line := rs nextLine readStream. col := 1. row := Array new: 9. [ (line atEnd or: [ col > 9 ]) ] whileFalse: [ row at: col put: (line upTo: $|). col := col + 1 ]. rs next. [ out add: (self class new in: self row: row) ] ifError: [] ]. ^ out " self reset. self getBugsList "! ----- Method: InstallerMantis>>dataNames (in category 'public interface') ----- dataNames ^ #(Id Project Category Assigned Updated Status Severity FixedIn Summary)! ----- Method: InstallerMantis>>date (in category 'accessing') ----- date ^ date ! ----- Method: InstallerMantis>>date: (in category 'accessing') ----- date: anObject date := anObject ifNotNil: [anObject asDate ]! ----- Method: InstallerMantis>>desc (in category 'accessing') ----- desc ^ desc! ----- Method: InstallerMantis>>desc: (in category 'accessing') ----- desc: anObject desc := anObject! ----- Method: InstallerMantis>>ensureFix (in category 'public interface') ----- ensureFix | fixesAppliedNumbers | fixesAppliedNumbers := self fixesApplied collect: [ :fixDesc | fixDesc asInteger ]. (fixesAppliedNumbers includes: bug) ifFalse: [ self fixBug ]! ----- Method: InstallerMantis>>ensureFix: (in category 'public interface') ----- ensureFix: aBugNo ^self ensureFix: aBugNo date: nil! ----- Method: InstallerMantis>>ensureFix:date: (in category 'public interface') ----- ensureFix: aBugNo date: aDate self setBug: aBugNo. self date: aDate. self ensureFix.! ----- Method: InstallerMantis>>ensureFixes: (in category 'public interface') ----- ensureFixes: aBugNos aBugNos do: [ :bugNo | self ensureFix: bugNo ].! ----- Method: InstallerMantis>>files (in category 'public interface') ----- files "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " ^ (self maFiles associations asSortedCollection: [ :a :b | a value asInteger < b value asInteger ]) collect: [ :a | a key ]! ----- Method: InstallerMantis>>fixBug (in category 'public interface') ----- fixBug self install: self maUrl from: self maScript. self maCheckDateAgainst: date. self fixesAppliedNumbers in: [ :fixed | (fixed isEmpty or: [ (fixed includes: bug asInteger) not]) ifTrue: [ self fixesApplied add: (bug asString, ' ', desc) ]]. ! ----- Method: InstallerMantis>>fixBug: (in category 'public interface') ----- fixBug: aBugNo ^ self fixBug: aBugNo date: nil. ! ----- Method: InstallerMantis>>fixBug:date: (in category 'public interface') ----- fixBug: aBugNo date: aDate self setBug: aBugNo. self date: aDate. self fixBug. ! ----- Method: InstallerMantis>>fixedIn (in category 'search') ----- fixedIn ^ self dataAtName: 'FixedIn' ! ----- Method: InstallerMantis>>fixesApplied (in category 'public interface') ----- fixesApplied ^ Fixes ifNil: [ Fixes := OrderedCollection new ].! ----- Method: InstallerMantis>>fixesAppliedNumbers (in category 'public interface') ----- fixesAppliedNumbers ^ self fixesApplied collect: [ :fixDesc | fixDesc asInteger ]. ! ----- Method: InstallerMantis>>getView (in category 'accessing') ----- getView "Installer mantis viewBug: 5639." | page text | page := self maPage. text := String streamContents: [ :str | #('Bug ID' 'Category' 'Severity' 'Reproducibility' 'Date Submitted' 'Date Updated' 'Reporter' 'View Status' 'Handler' 'Priority' 'Resolution' 'Status' 'Product Version' 'Summary' 'Description' 'Additional Information' ) do: [ :field | | f | f := self maRead: page field: field. str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr. ]. str nextPutAll: 'Notes: '; cr. (self maReadNotes: page) do: [ :note | str nextPutAll: note; cr; cr ]. str nextPutAll: 'Files: '; nextPutAll: self maFiles keys asArray printString. ]. ^ text ! ----- Method: InstallerMantis>>hash (in category 'accessing') ----- hash ^ array hash! ----- Method: InstallerMantis>>in:row: (in category 'public interface') ----- in: parent row: dataRow self ma: parent ma. self markers: parent markers. self setArray: dataRow.! ----- Method: InstallerMantis>>justFixBug: (in category 'public interface') ----- justFixBug: aBugNo ^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: nil ]! ----- Method: InstallerMantis>>justFixBug:date: (in category 'public interface') ----- justFixBug: aBugNo date: d ^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: d ]! ----- Method: InstallerMantis>>ma (in category 'accessing') ----- ma ^ ma! ----- Method: InstallerMantis>>ma: (in category 'accessing') ----- ma: aUrl ma := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! ----- Method: InstallerMantis>>maCheckDateAgainst: (in category 'utils') ----- maCheckDateAgainst: okDate (okDate notNil and: [date < okDate asDate ]) ifTrue: [ self notify: 'bug ', self bug asString, ' updated on ', date printString ]. ! ----- Method: InstallerMantis>>maFiles (in category 'mantis') ----- maFiles | file files bugPage id | files := Dictionary new. bugPage := self maPage. [ id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<. ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ]. id notEmpty ] whileTrue. ^files ! ----- Method: InstallerMantis>>maPage (in category 'mantis') ----- maPage " self mantis bug: 5251." | page | page := self httpGet: self maUrl. date := ((self maRead: page field: 'Date Updated') value copyUpTo: $ ). date isEmpty ifTrue: [ ^self error: bug asString, ' not found' ]. date := date asDate. ^page reset! ----- Method: InstallerMantis>>maRead:field: (in category 'mantis') ----- maRead: page field: fieldKey | value | value := page upToAll: ('!!-- ', fieldKey, ' -->'); upToAll: '<td'; upTo: $>; upToAll: '</td>'. page upTo: $<. page peek = $t ifTrue: [ value := page upToAll: 'td'; upTo: $>; upToAll: '</td>' ]. ^Association key: fieldKey value: (self removeHtmlMarkupFrom: value withBlanksTrimmed readStream) contents! ----- Method: InstallerMantis>>maReadNotes: (in category 'mantis') ----- maReadNotes: page | notes note | notes := OrderedCollection new. [ page upToAll: 'tr class="bugnote"'; upTo: $>. page atEnd ] whileFalse: [ note := (self removeHtmlMarkupFrom: (page upToAll: '</tr>') readStream) contents. note := note withBlanksCondensed. note replaceAll: Character lf with: Character cr. notes add: note ]. ^notes! ----- Method: InstallerMantis>>maScript (in category 'mantis') ----- maScript ^self extractFromHtml: self maPage option: #last ! ----- Method: InstallerMantis>>maStreamForFile: (in category 'mantis') ----- maStreamForFile: aFileName | fileId | fileId := self maFiles at: aFileName ifAbsent: [ self error: aFileName, ' not found' ]. ^ self httpGet: (self ma, 'file_download.php?file_id=' , fileId , '&type=bug'). ! ----- Method: InstallerMantis>>maThing:date: (in category 'mantis') ----- maThing: aFileName date: aDate self logCR: 'obtaining ', aFileName, '...'. pageDataStream := self maStreamForFile: aFileName. self maCheckDateAgainst: aDate. ^ pageDataStream ! ----- Method: InstallerMantis>>maUrl (in category 'mantis') ----- maUrl ^ url := self ma, 'view.php?id=', bug asString ! ----- Method: InstallerMantis>>maUrlFor: (in category 'mantis') ----- maUrlFor: maBugNo ^ url := self ma, 'view.php?id=', maBugNo asString ! ----- Method: InstallerMantis>>printOn: (in category 'accessing') ----- printOn: stream super printOn: stream. (array ifNil: [ ^ self ]) printOn: stream.! ----- Method: InstallerMantis>>project (in category 'search') ----- project ^ self dataAtName: 'Project' ! ----- Method: InstallerMantis>>report (in category 'public interface') ----- report "Installer mantis viewBug: 5639." | page text | page := self maPage. text := String streamContents: [ :str | #('Bug ID' 'Category' 'Severity' 'Reproducibility' 'Date Submitted' 'Date Updated' 'Reporter' 'View Status' 'Handler' 'Priority' 'Resolution' 'Status' 'Product Version' 'Summary' 'Description' 'Additional Information' ) do: [ :field | | f | f := self maRead: page field: field. str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr. ]. str nextPutAll: 'Notes: '; cr. (self maReadNotes: page) do: [ :note | str nextPutAll: note; cr; cr ]. str nextPutAll: 'Files: '; nextPutAll: self maFiles keys asArray printString. ]. ^ text ! ----- Method: InstallerMantis>>script (in category 'public interface') ----- script ^ self maScript contents. ! ----- Method: InstallerMantis>>selectCategoryCollections (in category 'public interface') ----- selectCategoryCollections ^ self select: [ :ea | ea category = 'Collections' ]! ----- Method: InstallerMantis>>setArray: (in category 'public interface') ----- setArray: dataRow (array := dataRow) ifNotNil: [ self bug ].! ----- Method: InstallerMantis>>setBug: (in category 'mantis') ----- setBug: stringOrNumber | newBug | (newBug := stringOrNumber asInteger) = bug ifTrue: [ ^ self ]. self logCR: 'Installer accessing bug: ' , stringOrNumber asString. bug := newBug. stringOrNumber = bug ifTrue: [ desc := ''. ^ self ]. desc := stringOrNumber withoutLeadingDigits ! ----- Method: InstallerMantis>>status (in category 'accessing') ----- status ^ status! ----- Method: InstallerMantis>>statusInit (in category 'accessing') ----- statusInit status ifNil: [ status := Status at: (self dataAtName: 'Status'). self dataAtName:'Status' put: status. ]. ! ----- Method: InstallerMantis>>summary (in category 'search') ----- summary ^ self dataAtName: 'Summary'! ----- Method: InstallerMantis>>validChangeSetName: (in category 'action report') ----- validChangeSetName: aFileName | csn prefix | csn := super validChangeSetName: aFileName. prefix := 'M' , self bug asInteger asString. csn := csn replaceAll: ('-', prefix) with: ''. csn := csn replaceAll: (prefix,'-') with: ''. csn := csn replaceAll: prefix with: ''. ^ prefix, '-', csn ! ----- Method: InstallerMantis>>view (in category 'public interface') ----- view ^ Workspace new contents: self report; openLabel: ('Mantis ', bug printString). ! ----- Method: InstallerMantis>>viewBug: (in category 'public interface') ----- viewBug: aBugNo self setBug: aBugNo; view! ----- Method: InstallerMantis>>viewFile: (in category 'public interface') ----- viewFile: aFileName "Installer mantis bug: 6089 browse: 'TTFSpeedUp-dgd.1.cs'" ^ self view: aFileName from: (self maThing: aFileName date: nil)! ----- Method: InstallerMantis>>viewFiles (in category 'public interface') ----- viewFiles ^ self files do: [ :ea | self viewFile: ea ].! InstallerWebBased subclass: #InstallerWeb instanceVariableNames: '' classVariableNames: 'WebSearchPath' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerWeb class>>canReportLine: (in category 'action report') ----- canReportLine: line ^ ((line beginsWith: 'Installer install:') | (line beginsWith: 'Installer do:'))! ----- Method: InstallerWeb class>>initialize (in category 'instanciation') ----- initialize WebSearchPath := nil! ----- Method: InstallerWeb class>>install: (in category 'compatability') ----- install: webPageName "This keeps the syntax Installer web install: working" ^ self new install: webPageName! ----- Method: InstallerWeb class>>searchPath (in category 'accessing') ----- searchPath "a search path item, has the following format. prefix*suffix" ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].! ----- Method: InstallerWeb>>action:reportOn: (in category 'action report') ----- action: line reportOn: report self package: (line readStream upTo: $' ; upTo: $'). self reportSection: line on: report. url := self urlToDownload. self reportFor: line page: pageDataStream on: report ! ----- Method: InstallerWeb>>basicBrowse (in category 'basic interface') ----- basicBrowse self thing size > 0 ifTrue: [ self browse: url from: pageDataStream ] ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ]. ! ----- Method: InstallerWeb>>basicInstall (in category 'basic interface') ----- basicInstall self thing size > 0 ifTrue: [ self install: url from: pageDataStream ] ifFalse: [ url ifNil: [ ^ self logCR: self package, ' not found on webSearchPath' ]. self logCR: '...',url,' was empty' ]. ! ----- Method: InstallerWeb>>basicView (in category 'basic interface') ----- basicView self thing size > 0 ifTrue: [ self view: url from: pageDataStream ] ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ]. ! ----- Method: InstallerWeb>>thing (in category 'web install') ----- thing self logCR: 'searching for web package ''', self package, ''''. url := self urlToDownload. url ifNil: [ self logCR: 'page ', self package, ' not found on path' ] ifNotNil: [ self logCR: 'found ', url, ' ...'. ]. ^ pageDataStream! ----- Method: InstallerWeb>>urlToDownload (in category 'web install') ----- urlToDownload "while we look for a url which returns what we are looking for, we get the data anyway" | delay | delay := 0. self class webSearchPath do: [ :pathSpec | | potentialUrl readPathSpec retry | readPathSpec := pathSpec value readStream. potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]). [retry := false. pageDataStream := self urlGet: potentialUrl. self wasPbwikiSpeedWarning ifTrue: [ retry := true. delay := delay + 5. self logCR: 'PBWiki speed warning. Retrying in ', delay printString, ' seconds'. (Delay forSeconds: delay) wait] ifFalse: [ self hasPage ifTrue: [ pageDataStream reset. ^ potentialUrl ] ]. retry ] whileTrue ]. ^nil ! InstallerWebBased subclass: #InstallerWebSqueakMap instanceVariableNames: 'wsm' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerWebSqueakMap>>basicAvailablePackages (in category 'websqueakmap') ----- basicAvailablePackages | html id name pkgs | pkgs := Dictionary new. html := self httpGet: (self wsm, 'packagesbyname'). [ id := html upToAll: '/package/'; upToAll: '">'. name := html upTo: $<. (id notEmpty and: [ name notEmpty ])] whileTrue: [ pkgs at: name put: id ]. ^ pkgs ! ----- Method: InstallerWebSqueakMap>>basicInstall (in category 'basic interface') ----- basicInstall | it | it := self wsmThing. self install: it from: it asUrl retrieveContents contentStream. ! ----- Method: InstallerWebSqueakMap>>basicVersions (in category 'basic interface') ----- basicVersions | pkgAndVersion packageId packageName packageVersion versions | pkgAndVersion := self packageAndVersionFrom: self package . packageName := pkgAndVersion first. packageVersion := pkgAndVersion last. packageVersion isEmpty ifTrue: [ packageVersion := #latest ]. packageId := self availablePackages at: packageName. versions := (self wsmReleasesFor: packageId) keys asSet. versions remove: #latest. ^ versions collect: [ :version | self copy package: (packageName,'(', version ,')'); yourself ]. ! ----- Method: InstallerWebSqueakMap>>basicView (in category 'basic interface') ----- basicView | it | it := self wsmThing. self view: it from: (self httpGet: it). ! ----- Method: InstallerWebSqueakMap>>packagesMatching: (in category 'searching') ----- packagesMatching: aMatch ^ (self availablePackages select: [ :p | ( aMatch) match: p ]) collect: [ :p | self copy package: p ; yourself ]! ----- Method: InstallerWebSqueakMap>>wsm (in category 'websqueakmap') ----- wsm ^ wsm! ----- Method: InstallerWebSqueakMap>>wsm: (in category 'websqueakmap') ----- wsm: aUrl wsm := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! ----- Method: InstallerWebSqueakMap>>wsmDownloadUrl (in category 'websqueakmap') ----- wsmDownloadUrl | pkgAndVersion packageId packageName packageVersion releaseAutoVersion downloadPage | pkgAndVersion := self packageAndVersionFrom: self package. packageName := pkgAndVersion first. packageVersion := pkgAndVersion last. packageVersion isEmpty ifTrue: [ packageVersion := #latest ]. packageId := self availablePackages at: packageName. releaseAutoVersion := (self wsmReleasesFor: packageId) at: packageVersion. downloadPage := self httpGet: (self wsm,'packagebyname/', packageName,'/autoversion/', releaseAutoVersion,'/downloadurl') asUrl asString. ^ downloadPage contents ! ----- Method: InstallerWebSqueakMap>>wsmReleasesFor: (in category 'websqueakmap') ----- wsmReleasesFor: packageId | html autoVersion version releases | releases := Dictionary new. html := self httpGet: (self wsm, '/package/', packageId ). [releases at: #latest put: autoVersion. autoVersion := html upToAll: '/autoversion/'; upTo: $". version := html upTo: $-; upTo: $<. (autoVersion notEmpty and: [version notEmpty ])] whileTrue: [ releases at: version put: autoVersion ]. ^ releases ! ----- Method: InstallerWebSqueakMap>>wsmThing (in category 'websqueakmap') ----- wsmThing | downloadUrl | self logCR: 'finding ', self package, ' from websqueakmap(', self wsm, ') ...'. downloadUrl := self wsmDownloadUrl. self logCR: 'found at ', downloadUrl asString, ' ...'. ^ downloadUrl ! Installer subclass: #InstallerMonticello instanceVariableNames: 'mc root project' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerMonticello>>basicAvailablePackages (in category 'basic interface') ----- basicAvailablePackages ^ self mc allPackageNames! ----- Method: InstallerMonticello>>basicBrowse (in category 'basic interface') ----- basicBrowse "Installer ss project: 'Installer'; browse: 'Installer-Core'." | it | it := self mcThing. (it class includesSelector: #browse) ifTrue: [ ^ it browse ]. (it instVarNamed: 'versions') do: [ :each | each browse ].! ----- Method: InstallerMonticello>>basicInstall (in category 'basic interface') ----- basicInstall self withAnswersDo: [ self mcThing load ]. self logCR: 'loaded'. ! ----- Method: InstallerMonticello>>basicVersions (in category 'basic interface') ----- basicVersions ^ (self availablePackages select: [ :p | ( self package,'-*.mcz' ) match: p ]) collect: [ :p | self copy package: p ; yourself ]. ! ----- Method: InstallerMonticello>>basicView (in category 'basic interface') ----- basicView "Installer ss project: 'Installer'; view: 'Installer-Core'. " | it | packages isEmptyOrNil ifTrue: [ self mc morphicOpen: nil ]. it := self mcThing. (it respondsTo: #open) ifTrue: [ ^ it open ]. "in case an old mc doesnt have #open" (it instVarNamed: 'versions') do: [ :each | each open ]. ! ----- Method: InstallerMonticello>>cache (in category 'instance creation') ----- cache mc := self classMCCacheRepository default. root := mc directory localName ! ----- Method: InstallerMonticello>>classMCCacheRepository (in category 'class references') ----- classMCCacheRepository ^Smalltalk at: #MCCacheRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCDirectoryRepository (in category 'class references') ----- classMCDirectoryRepository ^Smalltalk at: #MCDirectoryRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCFtpRepository (in category 'class references') ----- classMCFtpRepository ^Smalltalk at: #MCFtpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCGOODSRepository (in category 'class references') ----- classMCGOODSRepository ^Smalltalk at: #MCGOODSRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCHttpRepository (in category 'class references') ----- classMCHttpRepository ^Smalltalk at: #MCHttpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCMagmaRepository (in category 'class references') ----- classMCMagmaRepository ^Smalltalk at: #MCMagmaRepository ifAbsent: [ self error: 'Magma not present' ] ! ----- Method: InstallerMonticello>>classMCSmtpRepository (in category 'class references') ----- classMCSmtpRepository ^Smalltalk at: #MCSmtpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ----- Method: InstallerMonticello>>classMCVersionLoader (in category 'class references') ----- classMCVersionLoader ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]! ----- Method: InstallerMonticello>>directory: (in category 'instance creation') ----- directory: dir | directory | directory := dir isString ifTrue: [ FileDirectory on: (FileDirectory default fullNameFor: dir) ] ifFalse: [ dir ]. mc := self classMCDirectoryRepository new directory: directory; yourself. root := dir ! ----- Method: InstallerMonticello>>fromUrl: (in category 'accessing') ----- fromUrl: aUrl | url path | url := aUrl asUrl. self http: url authority. path := url path. path size = 2 ifTrue: [ self project: path first. path removeFirst. ]. path size = 1 ifTrue: [ self package: path first ].! ----- Method: InstallerMonticello>>ftp:directory:user:password: (in category 'instance creation') ----- ftp: host directory: dir user: name password: secret "Installer mc ftp: 'mc.gjallar.se' directory: '' user: 'gjallar' password: secret." mc := self classMCFtpRepository host: host directory: dir user: name password: secret. root := dir. ! ----- Method: InstallerMonticello>>goods:port: (in category 'instance creation') ----- goods: host port: aport mc := (self classMCGOODSRepository new) host: host port: aport; yourself ! ----- Method: InstallerMonticello>>http: (in category 'instance creation') ----- http: aUrl self http: aUrl user: '' password: '' ! ----- Method: InstallerMonticello>>http:user:password: (in category 'instance creation') ----- http: aUrl user: name password: secret | url | url := (aUrl includesSubString: '://') ifTrue: [aUrl] ifFalse: ['http://', aUrl]. mc := self classMCHttpRepository location: url user: name password: secret. root := mc locationWithTrailingSlash ! ----- Method: InstallerMonticello>>initialize (in category 'public interface') ----- initialize super initialize. mc := MCRepositoryGroup default! ----- Method: InstallerMonticello>>latest (in category 'accessing') ----- latest | newPackage | newPackage := self package copyUpToLast: $-. self packages removeLast. self package: newPackage " Installer mc fromUrl: 'http://www.squeaksource.com/Installer/Installer-Core-kph.100.mcz'. "! ----- Method: InstallerMonticello>>latestFromUsers: (in category 'accessing') ----- latestFromUsers: list | newPackage | newPackage := self package copyUpToLast: $-. self packages removeLast. self package: (list collect: [ :ea | newPackage, '-', ea ])! ----- Method: InstallerMonticello>>magma:port: (in category 'instance creation') ----- magma: host port: aport mc := (self classMCMagmaRepository new) host: host port: aport; yourself ! ----- Method: InstallerMonticello>>mc (in category 'accessing') ----- mc ^ mc! ----- Method: InstallerMonticello>>mc: (in category 'accessing') ----- mc: aRepo mc := aRepo! ----- Method: InstallerMonticello>>mcDetectFileBlock: (in category 'monticello') ----- mcDetectFileBlock: pkg pkg isString ifTrue: [ ^ [ :aMCVersionName | (pkg beginsWith: aMCVersionName packageAndBranchName) and: [aMCVersionName beginsWith: pkg ] ] ]. (pkg isKindOf: Array) ifTrue: [ ^ [ :aMCVersionName | pkg anySatisfy: [ :item | (item beginsWith: aMCVersionName packageAndBranchName) and: [aMCVersionName beginsWith: item ] ] ] ]. pkg isBlock ifTrue: [ ^ pkg ]. ! ----- Method: InstallerMonticello>>mcSortFileBlock (in category 'monticello') ----- mcSortFileBlock ^ [:a :b | [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].! ----- Method: InstallerMonticello>>mcThing (in category 'monticello') ----- mcThing | loader | loader := self classMCVersionLoader new. "several attempts to read files - repository readableFileNames sometimes fails" self packages do: [:pkg | | versionNames fileToLoad version | versionNames := mc versionNamesForPackageNamed: (pkg asMCVersionName versionNumber = 0 ifTrue: [ "Just a package name specified, use it whole." pkg ] ifFalse: [pkg asMCVersionName packageName]). fileToLoad := (versionNames sorted: self mcSortFileBlock) detect: (self mcDetectFileBlock: pkg) ifNone: [ nil ]. fileToLoad ifNotNil: [version := mc versionNamed: fileToLoad. (version isKindOf: MCConfiguration) ifTrue: [^ version] ifFalse: [self normalizedRepositories do: [:repo | MCRepositoryGroup default addRepository: repo]. self normalizedRepositories do: [:repo | version workingCopy repositoryGroup addRepository: repo]. loader addVersion: version]. self logCR: ' found ' , version fileName , '...']]. ^ loader! ----- Method: InstallerMonticello>>mcUrl (in category 'monticello') ----- mcUrl ^ self mc description ! ----- Method: InstallerMonticello>>normalizedRepositories (in category 'monticello') ----- normalizedRepositories "Find an existing instance of any active repository so that we use whatever name and password the user usually uses. If not found, answer a copy" ^ mc repositories replace: [:repo | (MCRepositoryGroup default repositories includes: repo) ifTrue: [repo] ifFalse: [repo copy]]! ----- Method: InstallerMonticello>>open (in category 'public interface') ----- open self mc morphicOpen: nil! ----- Method: InstallerMonticello>>packagesMatching: (in category 'searching') ----- packagesMatching: aMatch ^ (self availablePackages select: [:p | ( aMatch , '.mcz' ) match: p]) collect: [:p | self copy package: p ; yourself]! ----- Method: InstallerMonticello>>project (in category 'accessing') ----- project ^ project! ----- Method: InstallerMonticello>>project: (in category 'accessing') ----- project: name project := name. packages := nil. (mc respondsTo: #location:) ifTrue:[ mc := mc copy location: root , name ]. (mc respondsTo: #directory:) ifTrue: [ mc := mc copy directory: root / name ]. ^self copy.! ----- Method: InstallerMonticello>>unload (in category 'public interface') ----- unload (MCWorkingCopy allManagers select: [ : each | self package match: each package name ]) do: [ : each | self logCR: 'Unloading ' , each package name. each unload. MCMcmUpdater disableUpdatesOfPackage: each package name ]. self unloadCleanUp! ----- Method: InstallerMonticello>>unload: (in category 'public interface') ----- unload: match self addPackage: match. self unload.! ----- Method: InstallerMonticello>>unloadCleanUp (in category 'public interface') ----- unloadCleanUp SystemOrganization removeEmptyCategories. "Until Mantis 5718 is addressed" Smalltalk at: #PackagePaneBrowser ifPresent: [ :ppbClass | ppbClass allInstancesDo: [ :ppb | ppb updatePackages ] ]. Smalltalk at: #Browser ifPresent: [ :bClass | bClass allInstancesDo: [ :b | b updateSystemCategories ] ]. Smalltalk fixObsoleteReferences.! Installer subclass: #InstallerSake instanceVariableNames: 'sake' classVariableNames: 'Sake' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerSake class>>classPackages (in category 'accessing system') ----- classPackages ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]! ----- Method: InstallerSake class>>sake (in category 'accessing') ----- sake ^ Sake ifNil: [ self classPackages current ]! ----- Method: InstallerSake class>>sake: (in category 'accessing') ----- sake: aClass Sake := aClass! ----- Method: InstallerSake>>basicInstall (in category 'basic interface') ----- basicInstall self withAnswersDo: [ (self packages collect: [ :packageName | sake named: packageName ]) asTask run ]. ! ----- Method: InstallerSake>>sake (in category 'websqueakmap') ----- sake ^ sake ! ----- Method: InstallerSake>>sake: (in category 'websqueakmap') ----- sake: aSakePackagesClass sake := aSakePackagesClass! Installer subclass: #InstallerSqueakMap instanceVariableNames: 'sm' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerSqueakMap>>basicAvailablePackages (in category 'basic interface') ----- basicAvailablePackages ^self classSMSqueakMap default packagesByName! ----- Method: InstallerSqueakMap>>basicBrowse (in category 'basic interface') ----- basicBrowse self smThing explore! ----- Method: InstallerSqueakMap>>basicInstall (in category 'basic interface') ----- basicInstall self log: ' installing '. self withAnswersDo: [ self smThing install ]. self log: ' done'. ! ----- Method: InstallerSqueakMap>>basicVersions (in category 'basic interface') ----- basicVersions ^ (self smReleasesForPackage: self package) collect: [ :v | self copy package: (v package name,'(',v version,')'); yourself. ] ! ----- Method: InstallerSqueakMap>>basicView (in category 'basic interface') ----- basicView self smThing explore! ----- Method: InstallerSqueakMap>>classSMLoader (in category 'class references') ----- classSMLoader ^Smalltalk at: #SMLoader ifAbsent: [ self error: 'SqueakMap Loader not present' ]! ----- Method: InstallerSqueakMap>>classSMSqueakMap (in category 'class references') ----- classSMSqueakMap ^Smalltalk at: #SMSqueakMap ifAbsent: [ self error: 'SqueakMap not present' ]! ----- Method: InstallerSqueakMap>>open (in category 'public interface') ----- open self classSMLoader open! ----- Method: InstallerSqueakMap>>packagesMatching: (in category 'searching') ----- packagesMatching: aMatch ^ (self availablePackages select: [ :p | aMatch match: p name ]) collect: [ :p | self copy package: p name; yourself ]! ----- Method: InstallerSqueakMap>>search: (in category 'searching') ----- search: aMatch | results | results := Set new. self availablePackages do: [ :pkg | ({ 'name:',pkg name. 'summary:', pkg summary. 'description:', pkg description. 'author:', pkg author. } anySatisfy: [ :field | aMatch match: field ]) ifTrue: [ results add: (self copy package: pkg name) ]. ]. ^results ! ----- Method: InstallerSqueakMap>>sm (in category 'accessing') ----- sm ^ sm ifNil: [ false ]! ----- Method: InstallerSqueakMap>>sm: (in category 'accessing') ----- sm: anObject sm := anObject! ----- Method: InstallerSqueakMap>>smPackageAndVersion (in category 'squeakmap') ----- smPackageAndVersion ^ self packageAndVersionFrom: self package.! ----- Method: InstallerSqueakMap>>smReleasesForPackage: (in category 'squeakmap') ----- smReleasesForPackage: name ^(self classSMSqueakMap default packageWithName: name) releases! ----- Method: InstallerSqueakMap>>smThing (in category 'squeakmap') ----- smThing | pkgAndVersion releases release | pkgAndVersion := self packageAndVersionFrom: self package. self logCR: 'retrieving ', self package, ' from SqueakMap...'. releases := self smReleasesForPackage: pkgAndVersion first. release := pkgAndVersion last isEmpty ifTrue: [ releases last ] ifFalse:[ releases detect: [ :rel | rel version = pkgAndVersion last ] ]. ^ release ! ----- Method: InstallerSqueakMap>>update (in category 'squeakmap') ----- update "Updates the local map for SqueakMap, upgrading SqueakMap to the latest version if necessary. When SqueakMap is old and needs to be upgraded, it does four things that mostly make sense in the interactive world SM was built for, but are totally evil here in the world of automatic scripting: 1. It asks the user if she wants to upgrade, in the form of a pop-up (see SMSqueakMap >> #checkVersion:). 2. It terminates its own process. 3. It creates a new UI process. (see the last line of the SqueakMap upgrade file-in: ''Project spawnNewProcessAndTerminateOld: true'', from http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/files/SqueakMap8.st 4. It opens a SqueakMap window We work around these three problems seperately: 1. We use #answer:with: and #withAnswersDo: to automatically answer ''Yes'' when asked if we want to upgrade 2. We don't want this process to be terminated, so we run the update in a forked process and wait for it to finish, using #fork, #ensure:, and a Semaphore 3. We keep track of the UI process before updating, and if it changes, we terminate the new UI process and reinstall the old one using Project >> #resumeProcess: 4. We don't bother with the newly opened window. The other three problems are much worse. We do all this in a new process, since it is not unlikely that this method is executing in the UI process" | oldUIProcess doneSema | self answer: 'You need to upgrade the SqueakMap package' with: true. oldUIProcess := Project uiProcess. doneSema := Semaphore new. [[self withAnswersDo: [self classSMSqueakMap default loadUpdates]] ensure: [ | newUIProcess | newUIProcess := Project uiProcess. (oldUIProcess ~~ newUIProcess and: [oldUIProcess notNil and: [oldUIProcess isTerminated not]]) ifTrue: [ newUIProcess ifNotNil: [newUIProcess terminate]. oldUIProcess suspend. Project resumeProcess: oldUIProcess.]. doneSema signal]] fork. doneSema wait! Installer subclass: #InstallerUniverse instanceVariableNames: 'universe' classVariableNames: 'LastUniUpdate' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerUniverse class>>classUGlobalInstaller (in category 'accessing system') ----- classUGlobalInstaller ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]! ----- Method: InstallerUniverse class>>classUUniverse (in category 'accessing system') ----- classUUniverse ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]! ----- Method: InstallerUniverse class>>default (in category 'instance creation') ----- default ^ self universe: (self classUGlobalInstaller universe: self classUUniverse systemUniverse)! ----- Method: InstallerUniverse class>>universe: (in category 'instance creation') ----- universe: u ^ self new universe: u! ----- Method: InstallerUniverse>>basicInstall (in category 'basic interface') ----- basicInstall self packages do: [ :packageName | | potentials pkg pkgAndVersion version | pkgAndVersion := self packageAndVersionFrom: packageName. pkg := pkgAndVersion first. version := pkgAndVersion last. potentials := universe packageVersionsForPackage: pkg. pkg := version isEmpty ifTrue: [ potentials last ] ifFalse: [ version := self classUVersion readFrom: version readStream. (potentials anySatisfy: [ :p | p version = version]) ifFalse: [ ^ self error: 'version not found'] ]. universe planToInstallPackage: pkg. ]. self uniDoInstall! ----- Method: InstallerUniverse>>classUVersion (in category 'class references') ----- classUVersion ^Smalltalk at: #UVersion ifAbsent: [ self error: 'Universes code not present' ]! ----- Method: InstallerUniverse>>uniDoInstall (in category 'universes') ----- uniDoInstall self withAnswersDo: [ self universe doInstall ] ! ----- Method: InstallerUniverse>>universe (in category 'universes') ----- universe ^ universe! ----- Method: InstallerUniverse>>universe: (in category 'universes') ----- universe: u universe := u. self update.! ----- Method: InstallerUniverse>>update (in category 'public interface') ----- update (LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ]) ifTrue: [universe requestPackageList. LastUniUpdate := DateAndTime now]! Installer subclass: #InstallerUpdateStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! ----- Method: InstallerUpdateStream>>changesetNamesFromUpdates:through: (in category 'updates') ----- changesetNamesFromUpdates: startNumber through: stopNumber "Answer the concatenation of summary strings for updates numbered in the given range" "self new changesetNamesFromUpdates: 7059 through: 7061" ^ String streamContents: [:aStream | ((ChangeSet changeSetsNamedSuchThat: [:aName | aName first isDigit and: [aName initialIntegerOrNil >= startNumber and: [aName initialIntegerOrNil <= stopNumber]]]) asArray sort: [:a :b | a name < b name]) do: [:aChangeSet | aStream cr; nextPutAll: aChangeSet summaryString]] ! ----- Method: InstallerUpdateStream>>loadUpdatesFromDisk (in category 'updates') ----- loadUpdatesFromDisk | updateDirectory updateNumbers | updateDirectory := self updateDirectoryOrNil. updateDirectory ifNil: [^ self]. updateNumbers := updateDirectory fileNames collect: [:fn | fn initialIntegerOrNil] thenSelect: [:fn | fn notNil]. self loadUpdatesFromDiskToUpdateNumber: updateNumbers max stopIfGap: false ! ----- Method: InstallerUpdateStream>>loadUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'updates') ----- loadUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag "To use this mechanism, be sure all updates you want to have considered are in a folder named 'updates' which resides in the same directory as your image. Having done that, simply evaluate: Installer new loadUpdatesFromDiskToUpdateNumber: 100020 stopIfGap: false and all numbered updates <= lastUpdateNumber not yet in the image will be loaded in numerical order." "apparently does not use the updatelist too bad!! and to rewrite - sd 7 March 2008" | previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded | updateDirectory := self updateDirectoryOrNil. updateDirectory ifNil: [^ self]. previousHighest := SystemVersion current highestUpdate. currentUpdateNumber := previousHighest. done := false. loaded := 0. [done] whileFalse: [currentUpdateNumber := currentUpdateNumber + 1. currentUpdateNumber > lastUpdateNumber ifTrue: [done := true] ifFalse: [fileNames := updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'. fileNames size > 1 ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , ' (at this point it is probably best to remedy the situation on disk, then try again.)']. fileNames size = 0 ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'. done := stopIfGapFlag] ifFalse: [ChangeSet newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first) named: fileNames first. SystemVersion current registerUpdate: currentUpdateNumber. loaded := loaded + 1]]]. aMessage := loaded = 0 ifTrue: ['No new updates found.'] ifFalse: [loaded printString , ' update(s) loaded.']. self inform: aMessage , ' Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'! ----- Method: InstallerUpdateStream>>parseUpdateListContents: (in category 'updates') ----- parseUpdateListContents: listContentString "Parse the contents of an updates.list into {{releaseTag. {fileNames*}}*}, and return it." | sections releaseTag strm line fileNames | sections := OrderedCollection new. fileNames := OrderedCollection new: 1000. releaseTag := nil. strm := ReadStream on: listContentString. [strm atEnd] whileFalse: [line := strm nextLine. line size > 0 ifTrue: [line first = $# ifTrue: [releaseTag ifNotNil: [sections addLast: {releaseTag. fileNames asArray}]. releaseTag := line allButFirst. fileNames resetTo: 1] ifFalse: [line first = $* ifFalse: [fileNames addLast: line]]]]. releaseTag ifNotNil: [sections addLast: {releaseTag. fileNames asArray}]. ^ sections asArray ! ----- Method: InstallerUpdateStream>>updateDirectoryOrNil (in category 'updates') ----- updateDirectoryOrNil ^ (FileDirectory default directoryNames includes: 'updates') ifTrue: [FileDirectory default directoryNamed: 'updates'] ifFalse: [self inform: 'Error: cannot find "updates" folder'. nil]! ----- Method: InstallerUpdateStream>>writeList:toStream: (in category 'updates') ----- writeList: listContents toStream: strm "Write a parsed updates.list out as text. This is the inverse of parseUpdateListContents:" strm reset. listContents do: [:pair | | releaseTag fileNames | releaseTag := pair first. fileNames := pair last. strm nextPut: $#; nextPutAll: releaseTag; cr. fileNames do: [:fileName | strm nextPutAll: fileName; cr]]. strm close!
More information about the Squeak-dev mailing list |