A new version of Sake-Bob was added to project Sake : http://www.squeaksource.com/Sake/Sake-Bob-kph.22.mcz
==================== Summary ====================
Name: Sake-Bob-kph.22 Author: kph Time: 14 July 2009, 5:02:54 pm UUID: df36935e-a6e0-41bd-9d26-e6a0685f8cc4 Ancestors: Sake-Bob-kph.21
- configStep* stepping is invokable from the Seaside UI - theScript is not £defaultScript - Script building has been pulled out into a separate object
=============== Diff against Sake-Bob-kph.21 ===============
Item was added: + ----- Method: BobBuild>>defaultBuild (in category 'as yet unclassified') ----- + defaultBuild + + "called after the meta data is initialized" + + script ifNil: [ script := self defaultScript ]. + self defaultUpload!
Item was changed: ----- Method: BobBuild>>makeLocal: (in category 'zip file') ----- makeLocal: aZipFile
"if the zip file is remote, check it wasnt one we generated in our output tree"
| localZipFile | localZipFile := nil. aZipFile executive isRemote ifTrue: [ (self outputDir parent all filesMatching: aZipFile fileName) firstOrNil ifNotNilDo: [ :found | self log info found: found. ^ localZipFile := found ] ] ifFalse: [ aZipFile exists ifTrue: [ ^ aZipFile ]].
(localZipFile := self class configImagesDir / aZipFile fileName) exists ifTrue: [ ^ localZipFile ].
"default is not to overwrite if the file exists" + localZipFile := self class configImagesDir add: aZipFile . - localZipFile := (self class configImagesDir add: (localZipFile ifNil: [ aZipFile ])). ^ localZipFile
!
Item was added: + ----- Method: BobScript>>contentsWithHalts: (in category 'as yet unclassified') ----- + contentsWithHalts: keep + + | replacement | + + replacement := keep ifTrue: ['self halt.', String cr ] ifFalse: [ '' ]. + + ^ stream contents copyReplaceAll: self commentedHalt with: replacement.!
Item was added: + ----- Method: BobBuild>>selector (in category 'accessing') ----- + selector + "Answer the value of selector" + + ^ selector!
Item was added: + ----- Method: BobBuildImage>>isInProgress (in category 'accessing') ----- + isInProgress + + ^ self linkInProgress exists!
Item was added: + ----- Method: BobScriptBuildImage>>scriptTranscriptLogToFileStart (in category 'as yet unclassified') ----- + scriptTranscriptLogToFileStart + + self nextScriptPut: '"self halt." Preferences setPreference: #logTranscriptToFile toValue: true.'. + + !
Item was added: + ----- Method: BobBuildImage class>>taskUpload (in category 'as yet unclassified') ----- + taskUpload + + ^ self taskUpload: (self lastSelectorPrefixed: #build)!
Item was changed: ----- Method: BobBuildImage class>>taskBuild: (in category 'as yet unclassified') ----- taskBuild: metaSelector
| reason | ^ self define: [ :task | + - "obtain latest meta-data from instance side" (task infoFor: metaSelector) ifNil: [ ^ self noop ]. "we set our start time to the time of the build request, the actual action may take a while longer to actually happen, however this helps to give builds instancated together a similar start time" task info timeInitiated: DateAndTime now. task if: [ task timeStart. + task stepNeeded ifTrue: [ self halt ]. reason := task isBuildWanted. + reason := reason ifNil: [ task isBuildNeeded ]. - reason := reason ifNil: [ - task stepNeeded. - task isBuildNeeded. - ]. "1. continue 2. symbol 3. msg" self log info build: task info name isNeeded: reason first because: reason third. . task info reason: reason third. reason first ]. task action: [ - task stepAction. task actionBuild. ] ]
!
Item was added: + ----- Method: BobBuild>>outputLatestDir (in category 'as yet unclassified') ----- + outputLatestDir + + ^ self linksDir / 'latest'!
Item was changed: ----- Method: BobBuildImage>>publishManifestTo: (in category 'as yet unclassified') ----- publishManifestTo: aPublishDir - - aPublishDir mkpath - addAll: (self imageDir filesMatching: (self stampedName, '.*')). + aPublishDir mkpath + addAll: { + (self imageDir / self stampedName + '.image'). + (self imageDir / self stampedName + '.changes'). + }. aPublishDir + addAll: (self imageDir all filesMatching: #('*.txt' '*.text' '*.pr' )) - addAll: (self imageDir all filesMatching: #('*.txt' '*.text' '*.pr' '*.pass' '*.fail' ))
!
Item was added: + ----- Method: BobScript>>contents (in category 'as yet unclassified') ----- + contents + + ^ stream contents!
Item was changed: ----- Method: BobBuild>>releaseDir (in category 'as yet unclassified') ----- releaseDir
+ ^ info releaseTo ifNil: [self class configReleaseDir ]! - ^ self linksDir / 'release'!
Item was added: + ----- Method: BobBuild>>outputReleaseDir (in category 'as yet unclassified') ----- + outputReleaseDir + + ^ self linksDir / 'latest'!
Item was added: + ----- Method: BobOneClickPackageGenerator>>workingOneClickDir (in category 'as yet unclassified') ----- + workingOneClickDir + + ^ (self workingDir + '-OneClick') asDirectory!
Item was added: + ----- Method: BobScriptBuildImage>>scriptAddTaskScript (in category 'as yet unclassified') ----- + scriptAddTaskScript + + | rs | + rs := (task class docAt: task info build) readStream. + + [ rs atEnd ] whileFalse: [ + self nextScriptPut: (rs upToAll: '""""""') asString + ].!
Item was added: + ----- Method: BobBuild>>stepNeeded: (in category 'accessing') ----- + stepNeeded: anObject + "Set the value of stepNeeded" + + stepNeeded := anObject!
Item was added: + ----- Method: BobScriptBuildImage>>scriptSetVersion (in category 'as yet unclassified') ----- + scriptSetVersion + + self scriptSetVersion: '' + !
Item was changed: BobUtilities subclass: #BobBuild + instanceVariableNames: 'selector stepAction stepNeeded stepScript' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Sake-Bob'!
!BobBuild commentStamp: 'kph 2/18/2009 05:49' prior: 0! [ self taskBuildAll run ] fork.!
Item was added: + ----- Method: BobScriptBuildImage>>scriptUpgradeMonticello (in category 'as yet unclassified') ----- + scriptUpgradeMonticello + + self nextScriptPut: 'Installer upgrade install: ''UpgradeMonticello''.' + !
Item was added: + ----- Method: BobScript class>>new: (in category 'as yet unclassified') ----- + new: aTask + + ^ self basicNew + task: aTask; + initialize; + yourself + + !
Item was added: + ----- Method: BobConfig class>>configVmDir (in category 'as yet unclassified') ----- + configVmDir + + ^ '/Squeak/vm' asDirectory ifAbsent: [ '../vm' asDirectory ] + + !
Item was added: + ----- Method: BobScriptBuildImage>>scriptOpenInWorkspace: (in category 'as yet unclassified') ----- + scriptOpenInWorkspace: afilename + + self nextScriptPut: 'Workspace openFile: ', afilename printString, '.'. + !
Item was changed: BobConfig subclass: #BobBuildImage instanceVariableNames: 'startImage' classVariableNames: '' poolDictionaries: '' category: 'Sake-Bob'!
+ !BobBuildImage commentStamp: 'kph 7/12/2009 23:26' prior: 0! - !BobBuildImage commentStamp: 'kph 3/8/2009 11:16' prior: 0! BobConfig is a class with only configuration data. This allows a bob installation to be customized to a local environment, and that configuation can be save by a class fileOut. + + If you specify #imageCreationTime for an image that you do not expect to change then this saves looking up the host site every time. + + Builds that are to be manually started may be marked as #interactive.
+ info when: #interactive! - If you specify #imageCreationTime for an image that you do not expect to change then this saves looking up the host site every time.!
Item was added: + ----- Method: BobScriptBuildImage>>scriptTranscriptLogToFileStop (in category 'as yet unclassified') ----- + scriptTranscriptLogToFileStop + + self nextScriptPut: '"self halt." Preferences setPreference: #logTranscriptToFile toValue: false.'. + !
Item was added: + ----- Method: BobBuild>>defaultScript (in category 'as yet unclassified') ----- + defaultScript + + self subclassResponsibility!
Item was changed: ----- Method: BobConfig>>defaultUpload (in category 'as yet unclassified') ----- defaultUpload + info upload: 'link://', self releaseDir, '/', info name. - " info upload: 'ssh://updates@squeakfoundation.org/var/www/files/3.11/' , info name." - - info upload: 'link:///bob/release/' , info name.
"http not yet supported" + info download: 'file://', self releaseDir, '/' , info name. - info download: 'ftp://squeak@bob.warwick.st/bob/release/' , info name. !
Item was added: + ----- Method: BobBuild>>stepAction: (in category 'accessing') ----- + stepAction: anObject + "Set the value of stepAction" + + stepAction := anObject!
Item was added: + ----- Method: BobConfig class>>configReleaseDir (in category 'as yet unclassified') ----- + configReleaseDir + + ^ self configBaseDir / 'release' !
Item was changed: + ----- Method: BobBuild>>stepNeeded (in category 'accessing') ----- - ----- Method: BobBuild>>stepNeeded (in category 'as yet unclassified') ----- stepNeeded + "Answer the value of stepNeeded"
+ ^ stepNeeded ifNil: [ false ]! - self class configStepNeeded = true ifTrue: [ self halt ]!
Item was added: + ----- Method: BobBuild>>infoFilesPublishAlongside: (in category 'as yet unclassified') ----- + infoFilesPublishAlongside: aDir + + "info file for alongside the published archive, (tidy it up first)" + + (self imageDir fileMatching: 'SystemOrganization*') + ifNotNil: [ :org | (org rename fileName: self stampedName, '.org.info') ]. + + aDir parent addAll: (self imageDir filesMatching: '*.info'). + + + + !
Item was added: + ----- Method: BobScriptBuildImage>>scriptOpenTranscript (in category 'as yet unclassified') ----- + scriptOpenTranscript + + self nextScriptPut: 'Transcript open'. + !
Item was added: + ----- Method: BobScriptBuildImage>>scriptGenerateOrganization (in category 'as yet unclassified') ----- + scriptGenerateOrganization + + self nextScriptPut: 'SystemOrganization fileOut'. + + + + !
Item was added: + ----- Method: BobScriptBuildImage class>>simple: (in category 'as yet unclassified') ----- + simple: task + + ^ (self new: task) + scriptSetCompilerToLenient; + scriptTranscriptLogToFileStart; + scriptSetVersion; + scriptAddTaskScript; + scriptTranscriptLogToFileStop; + scriptSaveImageAndQuit: true!
Item was added: + ----- Method: BobScript>>nextScriptPut: (in category 'as yet unclassified') ----- + nextScriptPut: aScript + + stream nextChunkPut: + String cr,String cr, + aScript asString, + String cr, String cr. + !
Item was added: + ----- Method: BobScriptBuildImage>>scriptSetVersion: (in category 'as yet unclassified') ----- + scriptSetVersion: suffix + + | s | + s := String new writeStream. + + s << '"self halt."' ; cr. + s << 'SystemVersion newVersion: ' << task name printString << ',' << suffix printString << '.' ; cr. + s << 'SystemVersion current date: ''' << task timeStart asTimeStamp printString << ''' asTimeStamp.'; cr. + s << 'Smalltalk at: #Scripter ifPresent: [ :scr | scr transcript windowLabel: ''' << + task stampedName << suffix <<''' ].' ; cr. + + self nextScriptPut: s contents!
Item was added: + ----- Method: BobScriptBuildImage>>scriptGeneratePackagesList (in category 'as yet unclassified') ----- + scriptGeneratePackagesList + + | s | + + s := String new writeStream. + + s << '| pkgs |' ; cr. + + s << '"self halt."' ; cr. + + s << 'pkgs := FileDirectory default newFileNamed: ''' << task stamp asString << '_'', SystemVersion current version, ''.pkgs.info''.'; cr. + + s << '(MCPackageManager allManagers collect: [ :wc | wc ancestry ancestorString ]) asSortedCollection' ; cr. + + s << ' do: [ :ea | pkgs nextPutAll: ea; nextPut: Character cr ].'; cr. + + s << 'pkgs close'; cr. + + self nextScriptPut: s contents. + + + + !
Item was added: + ----- Method: BobBuild>>stepScript: (in category 'accessing') ----- + stepScript: anObject + "Set the value of stepScript" + + stepScript := anObject!
Item was added: + ----- Method: BobScript class>>new (in category 'as yet unclassified') ----- + new + + self error: 'use new: task'!
Item was added: + ----- Method: BobScriptBuildImage>>scriptCleanUp (in category 'as yet unclassified') ----- + scriptCleanUp + + self nextScriptPut: '"self halt." + Smalltalk at: #Scripter ifPresent: [ :s | s nonTranscriptWindows do: #windowForceClose ]. + SmalltalkImage current cleanUpAllExcept: #(ChangeSet). + '!
Item was changed: ----- Method: BobConfig class>>configVm (in category 'as yet unclassified') ----- configVm
"the mac vm doesnt like to be opened via a symbolic link" + ^ self configVmDir / 'Squeak 3.8.21beta1U.app/Contents/MacOS/Squeak VM Opt' + + ! - ^ '/bob/vm/Squeak 3.8.21beta1U.app/Contents/MacOS/Squeak VM Opt' - !
Item was added: + ----- Method: BobBuildImage>>linkInProgressDuring: (in category 'accessing') ----- + linkInProgressDuring: aBlock + + [ self linkInProgress exists ] whileTrue: [ SakeBlock signalTask: self ]. + + [ + self linkInProgress parent mkpath. + self linkInProgress symbolicLinkTo: self workingDir. + + aBlock value. + + ] ensure: [ self exec: 'rm ', self linkInProgress ] + !
Item was added: + ----- Method: BobBuildImage>>defaultScript (in category 'as yet unclassified') ----- + defaultScript + + ^ (BobScriptBuildImage new: self) + scriptSetCompilerToLenient; + scriptTranscriptLogToFileStart; + scriptSetVersion: '=wip'; + scriptSaveImageAndQuit: false; + scriptAddTaskScript; + scriptCleanUp; + scriptSetVersion; + scriptGenerateOrganization; + scriptGeneratePackagesList; + scriptTranscriptLogToFileStop; + scriptSaveImageAndQuit: true.!
Item was changed: ----- Method: BobBuild>>infoFileReadLatest (in category 'as yet unclassified') ----- infoFileReadLatest "obtain the most recent info file" + + ^ Compiler evaluate: ((self outputLatestDir fileMatching: '*' , self name, '.info') ifNil: [ ^ self class infoNull ]) contents! - - ^ Compiler evaluate: ((self latestDir fileMatching: '*.info') ifNil: [ ^ self class infoNull ]) contents!
Item was added: + ----- Method: BobScriptBuildImage>>scriptSaveAllPackagesInDir: (in category 'as yet unclassified') ----- + scriptSaveAllPackagesInDir: dirRepoPath + + | s | + s := String new writeStream. + + s << '| comment |' ; cr. + + s << '"self halt."' ; cr. + + s << 'comment := String streamContents: [:s | ' ; cr. + s << ' Installer mantis fixesApplied asStringOn: s delimiter: String cr ].'; cr. + + s << 'MCWorkingCopy saveAllAdoptingHistoryIn:'; cr. + s << ' (MCDirectoryRepository new directory: (FileDirectory on: ' << + dirRepoPath asString printString << ')) withComment: comment contents printString.' ; cr. + + self nextScriptPut: s contents + !
Item was changed: ----- Method: BobBuildImage>>isUploadedFileAvailableForDownload (in category 'as yet unclassified') ----- isUploadedFileAvailableForDownload
+ ^ ([ ((info download asDirectory / self stamp / self stampedName + '.zip') ifAbsent: [ ^ false ]) fileSize ] + on: TelnetProtocolError, ConnectionTimedOut do: [ ^ false ]) = self uploadFiles first fileSize ! - ^ ([ (info download asDirectory / self stamp / self stampedName + '.zip') fileSize ] - on: TelnetProtocolError do: [ ^ false ]) = self uploadFiles first fileSize !
Item was added: + ----- Method: BobScriptBuildImage>>scriptSaveImageAndQuit: (in category 'as yet unclassified') ----- + scriptSaveImageAndQuit: quit + + | s | + s := String new writeStream. + + s << ' | image resuming |' ; cr. + s << '"self halt."' ; cr. + quit ifTrue: [ s << 'WorldState addDeferredUIMessage: [ (Delay forSeconds: 1) wait. '; cr ]. + s << 'image := SmalltalkImage current.'; cr. + s << 'resuming := image saveAs: ' << task stamp printString << ', ''_'', SystemVersion current version,''.image''.'; cr. + + quit ifTrue: [ + + s << 'resuming ifFalse: [ image snapshot: false andQuit: true ].' ; cr + + ]. + + quit ifTrue: [s << '].' ]. + + self nextScriptPut: s contents!
Item was added: + ----- Method: BobScriptBuildImage>>scriptCleanUpChangeSet (in category 'as yet unclassified') ----- + scriptCleanUpChangeSet + + self nextScriptPut: 'ChangeSet cleanUp.'!
Item was changed: ----- Method: BobBuildImage>>publish (in category 'as yet unclassified') ----- publish
"we publish to a temp directory and publish as an atomic operation otherwise the uploader might start uploading before it is ready" self info overwrite = true ifTrue: [ self outputDir all delete ]. + + self infoFileWrite. + - self publishManifestTo: self publishDir. - - self infoFilePublishAlongside: self publishDir. + self infoFilesPublishAlongside: self publishDir. + !
Item was added: + ----- Method: BobBuild>>infoFileReadRelease (in category 'as yet unclassified') ----- + infoFileReadRelease + "obtain the most recent info file" + + ^ Compiler evaluate: ((self outputReleaseDir fileMatching: '*' , self name, '.info') ifNil: [ ^ self class infoNull ]) contents!
Item was added: + ----- Method: BobUtilities class>>infoNull (in category 'as yet unclassified') ----- + infoNull + + "When No Previous Build" + + ^ SakeMeta new + timeStart: DateAndTime epoch; + build: #none; + yourself + + !
Item was added: + ----- Method: BobScriptBuildImage>>scriptSetBackground (in category 'as yet unclassified') ----- + scriptSetBackground + + self nextScriptPut: 'World fillStyle: ((GradientFillStyle ramp: {0.0 -> ', task class configBgColor1 printString ,'. 1.0 -> ', task class configBgColor2 printString ,'}) origin: 0@0 ; direction: 0@400; normal: 640@0; radial: false).' + !
Item was changed: ----- Method: BobBuildImage>>actionBuild (in category 'as yet unclassified') ----- actionBuild
+ self linkInProgressDuring: [ + + self stepAction ifTrue: [ self halt ]. + + self log bob notice BUILDING: info name. - self log notice BUILDING: info name. - - self expand: (self makeLocal: zipFile) to: (self workingDir mkpath clean). - - self startImage: (self workingDir all fileMatching: '*.image'). - - self blockDuring: [ + self expand: (self makeLocal: zipFile) to: (self workingDir mkpath clean). + + self startImage: (self workingDir all fileMatching: '*.image'). + self linkPackageCache. + self launchVm: self class configVm image: self startImage with: self scriptFileWrite. - (self perform: info scriptSelector) scriptFileWrite. - - self launchVm: self class configVm image: self startImage with: self scriptFile. self isSuccessfulBuild ifFalse: [ ^ self ]. info timeComplete: DateAndTime now. info timeDuration: ((info timeComplete - info timeStart) roundTo: 1 second). self publish. self package. self tidy. self publishLinks. self log notice BUILDING: info name COMPLETE: true.
]. (self class taskUpload: info build) run. !
Item was changed: ----- Method: BobBuildImage>>isBuildWanted (in category 'as yet unclassified') ----- isBuildWanted | | "if the output directory doesnt exist then - dont build" + self outputDir asDirectory exists ifFalse: [ ^ { false. #noOutput. 'Output directory not present: ', self outputDir.}. ]. - self outputDir asDirectory exists ifFalse: [ ^ { false. #notWanted. 'Output directory not present: ', self outputDir.}. ]. "if we have the don't flag - dont build" + #dont = info when ifTrue: [ ^ #(false #dontBuild 'when: #dont') ]. + false = info when ifTrue: [ ^ #(false #notWanted 'when: false') ]. + + self isInProgress ifTrue: [ ^ #(false #inProgress 'Currently in progress') ]. - #dont = info when ifTrue: [ ^ #(false #dont 'dont flag set') ]. - false = info when ifTrue: [ ^ #(false #dont 'dont flag false') ].
^ nil!
Item was added: + ----- Method: BobBuild>>infoFileWrite (in category 'as yet unclassified') ----- + infoFileWrite + + "info file for alongside the published archive, (tidy it up first)" + + | i | + + (self imageDir / self stampedName + '.info') delete writer: [ :str | + + i := self info copy. + + i keys do: [ :k | (k beginsWith: 'tmp') ifTrue: [ i removeKey: k ] ]. + + i storeOn: str + + ] + + !
Item was changed: ----- Method: BobUtilities>>latest (in category 'as yet unclassified') ----- latest
+ ^ latest ifNil: [ self class infoNull ]! - ^ latest!
Item was changed: ----- Method: BobBuild>>scriptFileWrite (in category 'as yet unclassified') ----- scriptFileWrite + ^ self scriptFile delete contents: (script contentsWithHalts: self stepScript). + + ! - self scriptFile delete contents: script contents. - - script reset. - - ^ self scriptFile!
Item was added: + Object subclass: #BobScript + instanceVariableNames: 'stream task' + classVariableNames: '' + poolDictionaries: '' + category: 'Sake-Bob'!
Item was added: + ----- Method: BobScript>>initialize (in category 'as yet unclassified') ----- + initialize + + stream := String new writeStream!
Item was changed: ----- Method: BobBuildImage>>isBuildNeeded (in category 'as yet unclassified') ----- isBuildNeeded "if an explicit build time has been set and not yet reached - dont build" | dependentFile wait | + (self name includesSubString: '10') ifTrue: [ self halt ]. - ((info when isKindOf: DateAndTime) and: [ info when > self timeStart ]) - ifTrue: [ ^ { false. #notYet. ('time is not yet ', info when asString). } ]. - latest := self infoFileReadLatest. + info when = #interactive ifTrue: [ ^ { false. #interactive. 'Interactive build - run manually' } ]. + info when = #manual ifTrue: [ ^ { false. #manual. 'Invoke manually' } ]. + + ((info when isKindOf: DateAndTime) and: [ info when > self timeStart ]) + ifTrue: [ ^ { false. #waiting. ('Waiting until ', info when asString). } ]. + "if 'when' is set to a file obtain creation time, if not use info image" + "info when = #image." + + dependentFile := zipFile := self resolveFile: info image asFile ifNone: [:msg | ^ { false. #inputNotFound. msg.} ]. + self info dependentCreationTime: (info imageCreationTime ifNil: [ zipFile creationTime ]). + - info when isFileOrDirectory ifTrue: [ - dependentFile := self resolveFile: info when ifNone: [:msg | ^ { false. #notFound. msg.}]. - self info dependentCreationTime: dependentFile creationTime. - zipFile := self resolveFile: info image ifNone: [:msg | ^ { false. msg.} ]. - ] ifFalse: [ - dependentFile := zipFile := self resolveFile: info image asFile ifNone: [:msg | ^ { false. #notFound. msg.} ]. - - self info dependentCreationTime: (info imageCreationTime ifNil: [ zipFile creationTime ]). - ].
"has our starting image changed? if so" (latest dependentCreationTime ~= self info dependentCreationTime) ifTrue: [ + (self dependentFileChanged: dependentFile) + ifTrue: [ ^ { true. #imageChanged. (dependentFile asString , ' has changed').} ] + ifFalse: [ ^ { true. #newStart. (dependentFile asString , ' is ready').} ]. - self dependentFileChanged: dependentFile. - ^ { true. #dependentChanged. (dependentFile asString , ' has changed').} ] ifFalse: [ + ((true = info when) or: [ info when isFileOrDirectory ]) ifTrue: [ ^ { false. #waitingForChange. ('Waiting for ', dependentFile asString , ' to change').} ]]. - ((true = info when) or: [ info when isFileOrDirectory ]) ifTrue: [ ^ { false. #waitingForChange. ('waiting for ', dependentFile asString , ' to change').} ]]. "we have a new build id, so we build" latest build ~= info build ifTrue: [ ^ { true. #newBuildNumber. ('new build number ',info build).} ]. (info when isKindOf: Duration) ifTrue: [ wait := latest startTime + info when - TimeStamp now wait > 0 ifTrue: [ ^ { false. #waiting. (wait seconds asString, ' seconds to go').} ]. ].
"an explicit build time has been given, and this is present existing latest" ((info when isKindOf: DateAndTime) and: [ info when <= latest timeStart ]) ifTrue: [ ^ { false. #done. ((latest package ifNil: [ latest name ]) , ' already built'). } ]. + ^ { true. #ready. ('building ', self info name). }. - ^ { true. #itsTime. ('building ', self info name). }.
!
Item was changed: ----- Method: BobBuild>>when: (in category 'as yet unclassified') ----- when: w
- (w isKindOf: ByteString) ifFalse:[ ^ info when: w ]. + - - FileExecutive allSubclassesDo: [ :ea | (ea canInstanciateFrom: w) > 0 ifTrue: [ ^ info when: w asFile ] ]. - ^ info when: ([[[ w asDateAndTime ] ifError: [ w asTimeStamp ]] ifError: [ w asDuration ]] ifError: [ w asTime ])
+ ! - - !
Item was added: + ----- Method: BobScriptBuildImage>>scriptSetCompilerToLenient (in category 'as yet unclassified') ----- + scriptSetCompilerToLenient + + self nextScriptPut: '"self halt." + + Preferences setPreference: #allowBlockArgumentAssignment toValue: true. + Preferences setPreference: #allowUnderscoreAssignment toValue: true. + '. + + !
Item was added: + ----- Method: BobScript>>commentedHalt (in category 'as yet unclassified') ----- + commentedHalt + + ^ '"self halt."' !
Item was added: + ----- Method: BobScriptBuildImage>>scriptTranscriptLogToFileLoad (in category 'as yet unclassified') ----- + scriptTranscriptLogToFileLoad + + self nextScriptPut: '"self halt." (HTTPSocket httpGet: ''ftp.squeak.org/3.11/scripts/TranscriptToFile.cs'') readStream fileIn.'. + + !
Item was added: + ----- Method: BobBuild>>stepScript (in category 'accessing') ----- + stepScript + "Answer the value of stepScript" + + ^ stepScript ifNil: [ false ]!
Item was changed: SakeTask subclass: #BobOneClickPackageGenerator instanceVariableNames: 'plist name' classVariableNames: '' poolDictionaries: '' category: 'Sake-Bob'! + + !BobOneClickPackageGenerator commentStamp: 'kph 7/14/2009 16:57' prior: 0! + Not yet finished!
Item was changed: ----- Method: BobBuild class>>taskUpload: (in category 'as yet unclassified') ----- taskUpload: metaSelector "the task of uploading is defined as a top level task, because it is more generic than image building, and may be applied to any result." | newInfo lock ul dl yes | ^ self define: [ :task | (task infoFor: metaSelector) ifNil: [ ^ self noop ]. task dependsOn: #(). newInfo := task info. "obtain and use the latest meta-data from the most recent build activity" + task info: task infoFileReadLatest. "some fields in the metadata we prefer new values over the older" task upload: newInfo upload. task download: newInfo download. task linkRelease: newInfo linkRelease. task comment: newInfo comment. task uploadLatest: newInfo uploadLatest. task if: [ lock := ul := dl := nil. yes := task name notNil and: [ (ul := task isUploadRequested) and: [ dl := task isUploadedFileAvailableForDownload. dl ifTrue: [ task uploadDirLock delete ]. dl not and: [ (lock := task uploadDirLock exists) not ] ] ]. task name ifNotNil:[ self log info name: task name uploadRequested: ul done: dl inProgress: lock. ]. "if we decide that we shall upload, we lock the upload dir to inform others" yes ifTrue: [ task uploadDirLock touch ]. yes. ]. task action: [
self log info UPLOADING: task publishDir. + task stepAction ifTrue: [ self halt ]. - self configStepUpload ifTrue: [ self halt ]. + task infoFilesPublishAlongside: task publishDir. - task infoFilePublishAlongside: task publishDir. task publishLinkRelease. task info oneClick = true ifTrue: [ BobOneClickPackageGenerator taskMakeOneClickfor: self build: task info build ]. task perform: ('uploadUsing', (task info upload upTo: $:) capitalized) asSymbol. task isUploadedFileAvailableForDownload ifTrue: [ task uploadDirLock delete ]. ] ]
!
Item was changed: SakeTask subclass: #BobUtilities instanceVariableNames: 'script zipFile latest' classVariableNames: '' poolDictionaries: '' category: 'Sake-Bob'! + + !BobUtilities commentStamp: 'kph 7/13/2009 00:19' prior: 0! + script - a stream for building a script on!
Item was added: + ----- Method: BobBuild>>selector: (in category 'accessing') ----- + selector: anObject + "Set the value of selector" + + selector := anObject!
Item was changed: ----- Method: BobBuild>>infoFor: (in category 'as yet unclassified') ----- + infoFor: metaDataSelector - infoFor: selector + selector := metaDataSelector. + metaDataSelector ifNil: [ ^ nil ]. - selector ifNil: [ ^ nil ]. self info name: self class label. + self info build: metaDataSelector. - self info build: selector. self info label: self class label. self when: self class configWhen. self linkRelease: self class configLinkRelease. self description ifNotEmpty: [ self description: self description ]. - info scriptSelector: #theScript. self perform: selector. + self defaultBuild. ^ info!
Item was changed: + ----- Method: BobBuild>>stepAction (in category 'accessing') ----- - ----- Method: BobBuild>>stepAction (in category 'as yet unclassified') ----- stepAction + "Answer the value of stepAction"
+ ^ stepAction ifNil: [ false ]! - self class configStepAction = true ifTrue: [ self halt ]!
Item was added: + ----- Method: BobScriptBuildImage>>scriptLoadScripter (in category 'as yet unclassified') ----- + scriptLoadScripter + + self nextScriptPut: '"self halt." Installer ss project: ''Scripter''; install: ''Scripter-Core''.'. + !
Item was added: + ----- Method: BobOneClickPackageGenerator>>workingDirOneClickIn (in category 'as yet unclassified') ----- + workingDirOneClickIn + + ^ (self workingDir + '-OneClick.in') asDirectory!
Item was changed: ----- Method: BobBuildImage>>dependentFileChanged: (in category 'as yet unclassified') ----- dependentFileChanged: aFile
| dependentInfo | + dependentInfo := (Compiler evaluate: (aFile copy ext: 'info') contents) ifNil: [ ^ false ]. - dependentInfo := (Compiler evaluate: (aFile copy ext: 'info') contents) ifNil: [ ^ self ]. info timeInitiated: dependentInfo timeInitiated. info description: (info description ifNil: ['']), String cr, String cr , 'Description from: ', dependentInfo name, String cr, String cr, (dependentInfo description ifNil: [ '' ]). + info comment: (info comment ifNil: ['']), String cr, String cr , 'Comment from: ', dependentInfo name, String cr, String cr, (dependentInfo comment ifNil: ['']). + + ^ true! - info comment: (info comment ifNil: ['']), String cr, String cr , 'Comment from: ', dependentInfo name, String cr, String cr, (dependentInfo comment ifNil: ['']).!
Item was changed: ----- Method: BobBuildImage class>>taskBuildNow: (in category 'as yet unclassified') ----- taskBuildNow: metaSelector
| isNeeded | ^ self define: [ :task | "obtain latest meta-data from instance side" (task infoFor: metaSelector) ifNil: [ ^ self noop ]. task if: [ task timeStart. + task stepNeeded ifTrue: [ self halt ]. - isNeeded := task isBuildWanted. + isNeeded := isNeeded ifNil: [ task isBuildNeededForBuildNow ]. - isNeeded := isNeeded ifNil: [ - task stepNeeded. - task isBuildNeededForBuildNow. - ]. self log info build: task info name isNeeded: isNeeded first because: isNeeded third. . task info reason: isNeeded third.
isNeeded first. ]. + task action: [ task actionBuild ] - task action: [ - task stepAction. - task actionBuild. - ] ]
!
Item was added: + ----- Method: BobScript>>task: (in category 'as yet unclassified') ----- + task: aTask + + task := aTask!
Item was added: + ----- Method: BobScriptBuildImage>>scriptLoadLevelPlayingField (in category 'as yet unclassified') ----- + scriptLoadLevelPlayingField + + self nextScriptPut: '"self halt." (HTTPSocket httpGet: ''ftp.squeak.org/3.11/scripts/LPF.st'') readStream fileIn.'. + !
Item was added: + BobScript subclass: #BobScriptBuildImage + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Sake-Bob'!
Item was added: + ----- Method: BobOneClickPackageGenerator>>workingDirOneClickOut (in category 'as yet unclassified') ----- + workingDirOneClickOut + + ^ (self workingDir + '-OneClick.out') asDirectory!
Item was changed: ----- Method: BobBuild class>>listAll (in category 'as yet unclassified') ----- listAll
+ ^ (self taskBuildAll allPriorTasksInOrder select: [ :e | e askFor: #isBobBuildTask ]) ! - ^ (self taskBuildAll allPriorTasksInOrder select: [ :e | e askFor: #isBobBuildTask ]) reject: [ :e | false = e info when ]!
Item was removed: - ----- Method: BobBuild>>nextScriptPut: (in category 'as yet unclassified') ----- - nextScriptPut: aScript - - | bScript | - - bScript := (self class configStepScript = true) ifFalse: [ aScript ] - ifTrue: [ - aScript asString copyReplaceAll: self scriptCommentedHalt with: 'self halt.' - ]. - - script nextChunkPut: bScript, String cr. - !
Item was removed: - ----- Method: BobBuildImage>>theScriptBasic (in category 'script') ----- - theScriptBasic - - script reset. - - self - scriptSetCompilerToLenient; - scriptTranscriptLogToFileStart; - scriptSetVersion; - scriptAddInfoScript; - scriptTranscriptLogToFileStop; - scriptSaveImageAndQuit: true!
Item was removed: - ----- Method: BobBuildImage>>workingDirOneClickIn (in category 'as yet unclassified') ----- - workingDirOneClickIn - - ^ (self workingDir + '-OneClick.in') asDirectory!
Item was removed: - ----- Method: BobBuild class>>infoNull (in category 'as yet unclassified') ----- - infoNull - - "When No Previous Build" - - ^ SakeMeta new - timeStart: DateAndTime epoch; - build: #none; - yourself - - !
Item was removed: - ----- Method: BobBuildImage>>workingDirOneClickOut (in category 'as yet unclassified') ----- - workingDirOneClickOut - - ^ (self workingDir + '-OneClick.out') asDirectory!
Item was removed: - ----- Method: BobBuild>>scriptCommentedHalt (in category 'as yet unclassified') ----- - scriptCommentedHalt - - ^ '"self halt."' !
Item was removed: - ----- Method: BobBuild>>latestDir (in category 'as yet unclassified') ----- - latestDir - - ^ self linksDir / 'latest'!
Item was removed: - ----- Method: BobBuild>>scriptSelector: (in category 'as yet unclassified') ----- - scriptSelector: aSelector - - info scriptSelector: aSelector!
Item was removed: - ----- Method: BobBuildImage>>scriptSetVersion (in category 'as yet unclassified') ----- - scriptSetVersion - - self scriptSetVersion: '' - !
Item was removed: - ----- Method: BobBuild class>>configStepUpload (in category 'as yet unclassified') ----- - configStepUpload - - ^ false!
Item was removed: - ----- Method: BobBuildImage>>scriptAddInfoScript (in category 'as yet unclassified') ----- - scriptAddInfoScript - - | rs | - rs := (self class docAt: self info build) readStream. - - [ rs atEnd ] whileFalse: [ - self nextScriptPut: (rs upToAll: '""""""') asString - ].!
Item was removed: - ----- Method: BobBuild>>infoFilePublishAlongside: (in category 'as yet unclassified') ----- - infoFilePublishAlongside: aDir - - "info file for alongside the published archive, (tidy it up first)" - - | i | - (aDir parent / self stampedName + '.info') delete writer: [ :str | - - i := self info copy. - - i keys do: [ :k | (k beginsWith: 'step') ifTrue: [ i removeKey: k ] ]. - i keys do: [ :k | (k beginsWith: 'tmp') ifTrue: [ i removeKey: k ] ]. - - i storeOn: str - - ] - - !
Item was removed: - ----- Method: BobBuildImage>>scriptUpgradeMonticello (in category 'as yet unclassified') ----- - scriptUpgradeMonticello - - self nextScriptPut: 'Installer upgrade install: ''UpgradeMonticello''.' - !
Item was removed: - ----- Method: BobBuild class>>configStepScript (in category 'as yet unclassified') ----- - configStepScript - - ^ false!
Item was removed: - ----- Method: BobBuild>>initialize (in category 'as yet unclassified') ----- - initialize - - script := String new writeStream!
Item was removed: - ----- Method: BobBuildImage>>scriptOpenInWorkspace: (in category 'as yet unclassified') ----- - scriptOpenInWorkspace: afilename - - self nextScriptPut: 'Workspace openFile: ', afilename printString, '.'. - !
Item was removed: - ----- Method: BobBuildImage>>workingOneClickDir (in category 'as yet unclassified') ----- - workingOneClickDir - - ^ (self workingDir + '-OneClick') asDirectory!
Item was removed: - ----- Method: BobBuild class>>configStepAction (in category 'as yet unclassified') ----- - configStepAction - - ^ false - - - !
Item was removed: - ----- Method: BobBuildImage>>publishManifest (in category 'as yet unclassified') ----- - publishManifest - - self publishDir mkpath - addAll: (self imageDir filesMatching: (self stampedName, '.*')). - - self publishDir - addTree: (self imageDir all filesMatching: #('*.txt' '*.text' '*.pr' '*.pass' '*.fail' '.pdf' '*.js' '*.css' '*.html' )) - - - !
Item was removed: - ----- Method: BobBuildImage>>scriptTranscriptLogToFileStop (in category 'as yet unclassified') ----- - scriptTranscriptLogToFileStop - - self nextScriptPut: '"self halt." Preferences setPreference: #logTranscriptToFile toValue: false.'. - !
Item was removed: - ----- Method: BobBuildImage>>scriptAddLPF (in category 'as yet unclassified') ----- - scriptAddLPF - - self nextScriptPut: '"self halt." (HTTPSocket httpGet: ''ftp.squeak.org/3.11/bob/LPF.st'') readStream fileIn.'. - !
Item was removed: - ----- Method: BobBuildImage>>scriptAddScripter (in category 'as yet unclassified') ----- - scriptAddScripter - - self nextScriptPut: '"self halt." Installer ss project: ''Scripter''; install: ''Scripter-Core''.'. - !
Item was removed: - ----- Method: BobBuildImage>>scriptOpenTranscript (in category 'as yet unclassified') ----- - scriptOpenTranscript - - self nextScriptPut: 'Transcript open'. - !
Item was removed: - ----- Method: BobBuildImage>>scriptSetVersion: (in category 'as yet unclassified') ----- - scriptSetVersion: suffix - - | s | - s := String new writeStream. - - s << '"self halt."' ; cr. - s << 'SystemVersion newVersion: ' << self name printString << ',' << suffix printString << '.' ; cr. - s << 'SystemVersion current date: ''' << self timeStart asTimeStamp printString << ''' asTimeStamp.'; cr. - s << 'Smalltalk at: #Scripter ifPresent: [ :scr | scr transcript windowLabel: ''' << - self stampedName << suffix <<''' ].' ; cr. - - self nextScriptPut: s contents!
Item was removed: - ----- Method: BobBuildImage>>scriptCleanUp (in category 'as yet unclassified') ----- - scriptCleanUp - - self nextScriptPut: '"self halt." - Smalltalk at: #Scripter ifPresent: [ :s | s nonTranscriptWindows do: #windowForceClose ]. - SmalltalkImage current cleanUpAllExcept: #(ChangeSet). - '!
Item was removed: - ----- Method: BobBuildImage>>scriptSaveAllPackagesInDir: (in category 'as yet unclassified') ----- - scriptSaveAllPackagesInDir: dirRepoPath - - | s | - s := String new writeStream. - - s << '| comment |' ; cr. - - s << '"self halt."' ; cr. - - s << 'comment := String streamContents: [:s | ' ; cr. - s << ' Installer mantis fixesApplied asStringOn: s delimiter: String cr ].'; cr. - - s << 'MCWorkingCopy saveAllAdoptingHistoryIn:'; cr. - s << ' (MCDirectoryRepository new directory: (FileDirectory on: ' << - dirRepoPath asString printString << ')) withComment: comment contents printString.' ; cr. - - self nextScriptPut: s contents - !
Item was removed: - ----- Method: BobBuildImage>>scriptCleanUpChangeSet (in category 'as yet unclassified') ----- - scriptCleanUpChangeSet - - self nextScriptPut: 'ChangeSet cleanUp.'!
Item was removed: - ----- Method: BobBuildImage>>scriptSaveImageAndQuit: (in category 'as yet unclassified') ----- - scriptSaveImageAndQuit: quit - - | s | - s := String new writeStream. - - s << ' | image resuming |' ; cr. - s << '"self halt."' ; cr. - quit ifTrue: [ s << 'WorldState addDeferredUIMessage: [ (Delay forSeconds: 1) wait. '; cr ]. - s << 'image := SmalltalkImage current.'; cr. - s << 'resuming := image saveAs: ' << self stamp printString << ', ''_'', SystemVersion current version,''.image''.'; cr. - - quit ifTrue: [ - - s << 'resuming ifFalse: [ image snapshot: false andQuit: true ].' ; cr - - ]. - - quit ifTrue: [s << '].' ]. - - self nextScriptPut: s contents!
Item was removed: - ----- Method: BobBuildImage>>packageOneClick (in category 'as yet unclassified') ----- - packageOneClick - - | appZip appDir resources plist bundleName imageName template filename | - - info oneClick = true ifFalse: [ ^ self ]. - - template := info oneClickTemplate ifNil: [ self class configOneClickTemplate ]. - - "use the match string given to find the template" - appZip := self resolveFile: template ifNone: [ :msg | self error: msg ]. - - "download to images cache, and decompress to the output area" - self expand: appZip to: self workingDirOneClickOut mkpath clean. - - "the result should have a .app dir, find it" - appDir := self workingDirOneClickOut directories detect: [ :ea | ea asString endsWith: '.app' ] ifNone: [ self error: '*.app not found' ]. - - "get our plist contribution" - plist := self configPlist. - - bundleName := plist at: 'CFBundleName'. - imageName := bundleName asLowercase. - plist at: 'SqueakImageName' put: (imageName, '.image'). - - "rename the .app dir to the desired name" - appDir beRenaming fileName: (bundleName , '.app'). - - "top level directory" - (appDir filesMatching: #('*.exe' '*.ini' '*.sh')) do: [ :ea | ea rename base: bundleName ]. - (appDir / bundleName + '.ini' ) delete contents: ((self configOneClickIni: imageName) copyReplaceAll: String cr with: String crlf). - (appDir / bundleName + '.sh' ) delete contents: (self configOneClickSh: imageName). - (appDir / 'COPYRIGHT') delete contents: (info oneClickCopyrightStatement ifNil: [ self configOneClickCopyrightStatement ] ). - - "Contents Directory" - appDir / 'Contents' / 'PkgInfo' contents: ((plist at: 'CFBundlePackageType') , (plist at: 'CFBundleSignature')). - self oneClickUpdatePlist: (appDir / 'Contents' / 'Info.plist') fromDictionary: plist. - - "Resources Directory" - resources := (appDir / 'Contents' / 'Resources') all delete mkpath. - - resources addTree: self imageDir entries. - (resources filesMatching: #('*.image' '*.changes')) do: [ :ea | ea rename base: imageName ]. - resources add: self configOneClickIcns asFile. - resources add: (info oneClickSources ifNil: [ self configOneClickSources ]) asFile. - - self halt. - filename := appDir fileName. - self packageDirectory: filename intoZip: (self stamp,'_', filename) from: appDir parent. - - !
Item was removed: - ----- Method: BobBuildImage>>theScript (in category 'as yet unclassified') ----- - theScript - - script reset. - - self - scriptSetCompilerToLenient; - scriptTranscriptLogToFileStart; - scriptSetVersion: '=wip'; - scriptSaveImageAndQuit: false; - scriptAddInfoScript; - scriptCleanUp; - scriptSetVersion; - scriptTranscriptLogToFileStop; - scriptSaveImageAndQuit: true.!
Item was removed: - ----- Method: BobBuildImage>>scriptSetBackground (in category 'as yet unclassified') ----- - scriptSetBackground - - self nextScriptPut: 'World fillStyle: ((GradientFillStyle ramp: {0.0 -> ', self class configBgColor1 printString ,'. 1.0 -> ', self class configBgColor2 printString ,'}) origin: 0@0 ; direction: 0@400; normal: 640@0; radial: false).' - !
Item was removed: - ----- Method: BobBuildImage>>scriptTranscriptLogToFileStart (in category 'as yet unclassified') ----- - scriptTranscriptLogToFileStart - - self nextScriptPut: '"self halt." Preferences setPreference: #logTranscriptToFile toValue: true.'. - - !
Item was removed: - ----- Method: BobBuildImage>>blockDuring: (in category 'accessing') ----- - blockDuring: aBlock - - [ self linkInProgress exists ] whileTrue: [ SakeBlock signalTask: self ]. - - [ self linkInProgress symbolicLinkTo: self imageDir. - - aBlock value. - - ] ensure: [ self exec: 'rm ', self linkInProgress ]!
Item was removed: - ----- Method: BobBuild class>>taskUpload (in category 'as yet unclassified') ----- - taskUpload - - ^ self taskUpload: (self lastSelectorPrefixed: #build)!
Item was removed: - Object subclass: #PRDelayedPersistency - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sake-Bob'!
Item was removed: - ----- Method: BobBuild>>theScript (in category 'as yet unclassified') ----- - theScript - "obtain the image build script from the metadata record" - - self subclassResponsibility!
Item was removed: - ----- Method: BobBuildImage>>scriptSetCompilerToLenient (in category 'as yet unclassified') ----- - scriptSetCompilerToLenient - - self nextScriptPut: '"self halt." - - Preferences setPreference: #allowBlockArgumentAssignment toValue: true. - Preferences setPreference: #allowUnderscoreAssignment toValue: true. - '. - - !
Item was removed: - ----- Method: BobBuildImage>>scriptTranscriptLogToFileLoad (in category 'as yet unclassified') ----- - scriptTranscriptLogToFileLoad - - self nextScriptPut: '"self halt." (HTTPSocket httpGet: ''ftp.squeak.org/3.11/bob/TranscriptToFile.cs'') readStream fileIn.'. - - !
Item was removed: - ----- Method: BobBuild class>>configStepNeeded (in category 'as yet unclassified') ----- - configStepNeeded - - ^ false!
packages@lists.squeakfoundation.org