'From Squeak3.3alpha of 24 January 2002 [latest update: #4860] on 8 May 2002 at 3:03:46 pm'! "Change Set: Fix of ClassBuilderFix for 3.3a Date: 08 May 2002 Author: Nathanael SchŠrli & Andreas Raab Fixes a problem in the cleanup method of the ClassBuilderFix. Also includes class ResourceCollector in case it got lost."! Object subclass: #ResourceCollector instanceVariableNames: 'stubMap originalMap locatorMap localDirectory baseUrl resourceDirectory internalStubs ' classVariableNames: 'Current ' module: #(Squeak Technology Support)! !ResourceCollector commentStamp: '' prior: 0! The ResourceCollector collects resources that are encountered during project loading or publishing. It merely decouples the places where resources are held from the core object enumeration so that resources can be stored independently from what is enumerated for publishing.! ResourceCollector class instanceVariableNames: ''! !ClassBuilder class methodsFor: 'cleanup obsolete classes' stamp: 'NS 5/8/2002 11:47'! cleanupClassHierarchyFor: aClassDescription | myName mySuperclass | mySuperclass _ aClassDescription superclass. (self isReallyObsolete: aClassDescription) ifTrue: [ "Remove class >>>from SystemDictionary if it is obsolete" myName _ aClassDescription name asString. "myName is a String in an IdentityDictionary, take care!!!!" Module root deepSubmodulesDo: [:mod | (mod definedNames keys asArray detect: [:key | key = myName and: [(mod definedNames at: key) == aClassDescription]] ifNone: []) ifNotNilDo: [:key | mod privateDefinedNames removeKey: key. mod privateExportedNames removeKey: key ifAbsent: []]]. "Make class officially obsolete if it is not" (aClassDescription name asString beginsWith: 'AnObsolete') ifFalse: [aClassDescription obsolete]. aClassDescription isObsolete ifFalse: [self error: 'Something wrong!!']. "Add class to obsoleteSubclasses of its superclass" mySuperclass ifNil: [self error: 'Obsolete subclasses of nil cannot be stored']. (mySuperclass obsoleteSubclasses includes: aClassDescription) ifFalse: [mySuperclass addObsoleteSubclass: aClassDescription]. ] ifFalse:[ "check if superclass has aClassDescription in its obsolete subclasses" mySuperclass ifNil:[mySuperclass _ Class]. "nil subclasses" mySuperclass removeObsoleteSubclass: aClassDescription. ]. "And remove its obsolete subclasses if not actual superclass" aClassDescription obsoleteSubclasses do:[:obs| obs superclass == aClassDescription ifFalse:[ aClassDescription removeObsoleteSubclass: obs]]. ! ! !ResourceCollector methodsFor: 'initialize' stamp: 'ar 2/27/2001 23:08'! forgetObsolete "Forget obsolete locators, e.g., those that haven't been referenced and not been stored on a file." locatorMap keys "copy" do:[:k| (locatorMap at: k) localFileName ifNil:[locatorMap removeKey: k]].! ! !ResourceCollector methodsFor: 'initialize' stamp: 'ar 3/3/2001 19:49'! initialize | fd pvt | originalMap _ IdentityDictionary new. stubMap _ IdentityDictionary new. locatorMap _ IdentityDictionary new. internalStubs _ IdentityDictionary new. fd _ ScriptingSystem formDictionary. pvt _ ScriptingSystem privateGraphics asSet. fd keysAndValuesDo:[:sel :form| (pvt includes: sel) ifFalse:[ internalStubs at: form put: (DiskProxy global: #ScriptingSystem selector: #formAtKey:extent:depth: args: {sel. form extent. form depth})]].! ! !ResourceCollector methodsFor: 'initialize' stamp: 'ar 2/27/2001 22:36'! initializeFrom: aResourceManager "Initialize the receiver from aResourceManager." aResourceManager resourceMap keysAndValuesDo:[:loc :res| (res notNil) ifTrue:[locatorMap at: res put: loc. loc localFileName: nil]. ].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 20:32'! baseUrl ^baseUrl! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 20:39'! baseUrl: aString baseUrl _ aString. baseUrl isEmpty ifFalse:[ baseUrl last = $/ ifFalse:[baseUrl _ baseUrl copyWith: $/]. ].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/24/2001 22:23'! localDirectory ^localDirectory! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/24/2001 22:24'! localDirectory: aDirectory localDirectory _ aDirectory! ! !ResourceCollector methodsFor: 'accessing' stamp: 'tk 6/28/2001 15:58'! locatorMap "allow outsiders to store in it. For files that are not resources that do want to live in the resource directory locally and on the server. (.t files for example)" ^locatorMap! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 22:54'! locators ^locatorMap values! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 20:07'! locatorsDo: aBlock ^locatorMap valuesDo: aBlock! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 17:01'! noteResource: aResourceStub replacing: anObject "Remember the fact that we need to load aResource which will replace anObject." stubMap at: aResourceStub put: anObject.! ! !ResourceCollector methodsFor: 'accessing' stamp: 'mir 6/21/2001 14:06'! objectForDataStream: refStream fromForm: aForm "Return a replacement for aForm to be stored instead" | stub fName copy loc fullSize nameAndSize | "First check if the form is one of the intrinsic Squeak forms" stub _ internalStubs at: aForm ifAbsent:[nil]. stub ifNotNil:[ refStream replace: aForm with: stub. ^stub]. "Now see if we have created the stub already (this may happen if for instance some form is shared)" stub _ originalMap at: aForm ifAbsent:[nil]. stub ifNotNil:[^aForm]. aForm hibernate. (aForm bits byteSize < 4096) ifTrue:[^aForm]. "too small to be of interest" "Create our stub form" stub _ FormStub extent: (aForm width min: 32) @ (aForm height min: 32) depth: (aForm depth min: 8). aForm displayScaledOn: stub. aForm hibernate. "Create a copy of the original form which we use to store those bits" copy _ Form extent: aForm extent depth: aForm depth bits: nil. copy setResourceBits: aForm bits. "Get the locator for the form (if we have any)" loc _ locatorMap at: aForm ifAbsent:[nil]. "Store the resource file" nameAndSize _ self writeResourceForm: copy locator: loc. fName _ nameAndSize first. fullSize _ nameAndSize second. ProgressNotification signal: '2:resourceFound' extra: stub. stub hibernate. "See if we need to assign a new locator" (loc notNil and:[loc hasRemoteContents not]) ifTrue:[ "The locator describes some local resource. If we're preparing to upload the entire project to a remote server, make it a remote URL instead." " (baseUrl isEmpty not and:[baseUrl asUrl hasRemoteContents]) ifTrue:[loc urlString: baseUrl, fName]. " baseUrl isEmpty not ifTrue:[loc urlString: self resourceDirectory , fName]]. loc ifNil:[ loc _ ResourceLocator new urlString: self resourceDirectory , fName. locatorMap at: aForm put: loc]. loc localFileName: (localDirectory fullNameFor: fName). loc resourceFileSize: fullSize. stub locator: loc. "Map old against stub form" aForm setResourceBits: stub. originalMap at: aForm put: copy. stubMap at: stub put: aForm. locatorMap at: aForm put: loc. "note: *must* force aForm in out pointers if in IS or else won't get #comeFullyUpOnReload:" refStream replace: aForm with: aForm. ^aForm! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 22:59'! removeLocator: loc locatorMap keys "copy" do:[:k| (locatorMap at: k) = loc ifTrue:[locatorMap removeKey: k]].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 20:21'! replaceAll "Replace all resources by their originals. Done after the resource have been collected to get back to the original state." originalMap keysAndValuesDo:[:k :v| v ifNotNil:[k replaceByResource: v]. ].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'mir 6/21/2001 14:51'! resourceDirectory resourceDirectory ifNil: [resourceDirectory _ self baseUrl copyFrom: 1 to: (self baseUrl lastIndexOf: $/)]. ^resourceDirectory! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 20:08'! resourceFileNames "Return a list of all the resource files created" ^locatorMap values asArray collect:[:loc| loc localFileName].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 2/27/2001 17:01'! stubMap ^stubMap! ! !ResourceCollector methodsFor: 'objects from disk' stamp: 'ar 2/24/2001 22:37'! objectForDataStream: refStream "This should never happen; when projects get written they must be decoupled from the resource collector. If you get the error message below something is seriously broken." self error:'Cannot write resource manager'! ! !ResourceCollector methodsFor: 'resource writing' stamp: 'mir 4/30/2002 16:42'! writeResourceForm: aForm fromLocator: aLocator "The given form has been externalized before. If it was reasonably compressed, use the bits of the original data - this allows us to recycle GIF, JPEG, PNG etc. data without using the internal compression (which is in most cases inferior). If necessary the data will be retrieved from its URL location. This retrieval is done only if the resouce comes from either * the local disk (in which case the file has never been published) * the browser cache (in which case we don't cache the resource locally) In any other case we will *not* attempt to retrieve it, because doing so can cause the system to connect to the network which is probably not what we want. It should be a rare case anyways; could only happen if one clears the squeak cache selectively." | fName fStream url data | "Try to be smart about the name of the file" fName _ (aLocator urlString includes: $:) ifTrue: [ url _ aLocator urlString asUrl. url path last] ifFalse: [aLocator urlString]. fName isEmptyOrNil ifFalse:[fName _ fName asFileName]. (fName isEmptyOrNil or:[localDirectory isAFileNamed: fName]) ifTrue:[ "bad luck -- duplicate name" fName _ localDirectory nextNameFor:'resource' extension: (FileDirectory extensionFor: aLocator urlString)]. "Let's see if we have cached it locally" ResourceManager lookupCachedResource: self baseUrl , aLocator urlString ifPresentDo:[:stream | data _ stream upToEnd]. "Check if the cache entry is without qualifying baseUrl. Workaround for older versions." data ifNil:[ ResourceManager lookupCachedResource: aLocator urlString ifPresentDo:[:stream | data _ stream upToEnd]]. data ifNil:[ "We don't have it cached locally. Retrieve it from its original location." ((url notNil and: [url hasRemoteContents]) and:[HTTPClient isRunningInBrowser not]) ifTrue:[^nil]. "see note above" (Url schemeNameForString: aLocator urlString) ifNil: [^nil]. data _ HTTPLoader default retrieveContentsFor: aLocator urlString. data ifNil:[^nil]. data _ data content. ]. data size > aForm bits byteSize ifTrue:[^nil]. fStream _ localDirectory newFileNamed: fName. fStream nextPutAll: data. fStream close. ^{fName. data size}! ! !ResourceCollector methodsFor: 'resource writing' stamp: 'mir 5/3/2002 19:01'! writeResourceForm: aForm locator: aLocator "Store the given form on a file. Return an array with the name and the size of the file" | fName fStream fullSize result writerClass | aLocator ifNotNil:[ result _ self writeResourceForm: aForm fromLocator: aLocator. result ifNotNil:[^result] "else fall through" ]. fName _ localDirectory nextNameFor:'resource' extension:'form'. fStream _ localDirectory newFileNamed: fName. fStream binary. "aForm storeResourceOn: fStream." writerClass _ ((Smalltalk includesKey: #JPEGReaderWriter2) and: [(Smalltalk at: #JPEGReaderWriter2) new isPluginPresent]) ifTrue: [(Smalltalk at: #JPEGReaderWriter2)] ifFalse: [GIFReadWriter]. writerClass putForm: aForm onStream: fStream. fStream open. fullSize _ fStream size. fStream close. "Compress contents here" " fStream position: 0. fStream compressFile. localDirectory deleteFileNamed: fName. localDirectory rename: fName, FileDirectory dot, 'gz' toBe: fName. fStream _ localDirectory readOnlyFileNamed: fName. fullSize _ fStream size. fStream close. " ^{fName. fullSize}! ! !ResourceCollector class methodsFor: 'instance creation' stamp: 'ar 2/24/2001 22:44'! new ^super new initialize! ! !ResourceCollector class methodsFor: 'accessing' stamp: 'ar 2/24/2001 21:41'! current ^Current! ! !ResourceCollector class methodsFor: 'accessing' stamp: 'ar 2/24/2001 21:41'! current: aResourceManager Current _ aResourceManager! !