SystemOrganization addCategory: #'Package-Dependencies'! Object subclass: #PDPackageAnalyzer instanceVariableNames: 'packages classToPackage dependencies packageToDependencies' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'lr 4/3/2008 19:11'! allMonticelloPackageNames ^ MCWorkingCopy allManagers collect: [ :each | each packageInfo packageName ]! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'lr 4/3/2008 19:12'! allPackageNames ^ PackageOrganizer default packages collect: [ :each | each packageName ]! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'lr 4/3/2008 19:12'! examples (self onPackagesNamed: self seasidePackageNames) save: 'seaside.dot'. (self onPackagesNamed: self omnibrowserPackageNames) save: 'ob.dot'. (self onPackagesNamed: self allMonticelloPackageNames) save: 'monticello.dot'. (self onPackagesNamed: self allPackageNames) save: 'squeak.dot'! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'lr 1/9/2008 14:29'! omnibrowserPackageNames ^ #( 'Bogus' 'BogusExt' 'BogusInfo' 'OB-Fake' 'OB-Monticello' 'OB-Morphic' 'OB-Refactory' 'OB-Standard' 'OB-Tests-Core' 'OB-Tests-Morphic' 'OB-Tests-Standard' 'OB-Tests-Web' 'OB-Web' 'OmniBrowser' )! ! !PDPackageAnalyzer class methodsFor: 'instance-creation' stamp: 'lr 1/5/2008 15:44'! onPackages: aCollection ^ self new setPackages: aCollection; yourself! ! !PDPackageAnalyzer class methodsFor: 'instance-creation' stamp: 'lr 1/5/2008 15:45'! onPackagesNamed: aCollection ^ self onPackages: (aCollection collect: [ :each | PackageInfo named: each ])! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'pmm 8/30/2008 12:27'! seasidePackageNames ^ #( 'Comet-Core' 'Comet-Examples' 'Comet-Squeak-Core' 'RSS-Core' 'RSS-Examples' 'RSS-Squeak-Core' 'RSS-Squeak-Examples' 'RSS-Tests' 'Scriptaculous-Core' 'Scriptaculous-Squeak-Core' 'Scriptaculous-Tests-Core' 'Scriptaculous-Components' 'Scriptaculous-Tests-Components' 'Seaside-Utils-Core' 'Seaside-Utils-Tests' 'Seaside-Squeak-Continuation' 'Seaside-Core' 'Seaside-Squeak-Core' 'Seaside-Tests' 'Seaside-Squeak-Tests' 'Seaside-Color-Tests' 'Seaside-Development-Core' 'Seaside-Development-Tests' 'Seaside-Squeak-Development' 'Seaside-Examples' 'Seaside-Internet-Explorer' 'Seaside-HTML5-Core' 'Seaside-HTML5-Tests' 'Seaside-Squeak-Kom' 'Seaside-Squeak-CodeGeneration')! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'lr 1/5/2008 18:29'! seasidePackageNamesWithoutTests ^ self seasidePackageNames reject: [ :each | each includesSubString: 'Test' ]! ! !PDPackageAnalyzer methodsFor: 'private' stamp: 'lr 1/9/2008 10:50'! add: aDependency "Add a new dependency to the internal collection, also updating the caches." self dependencies add: aDependency. (self dependenciesFor: aDependency source) add: aDependency! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 16:45'! analyze self packages do: [ :each | self analyze: each ] displayingProgress: 'Analyzing' ! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 4/9/2008 09:31'! analyze: aPackage aPackage classes do: [ :class | class superclass ifNotNilDo: [ :superclass | self add: ((PDInheritanceDependency from: aPackage to: (self packageForClass: superclass)) theClass: class; superclass: superclass) ] ]. aPackage extensionMethods do: [ :method | self add: ((PDExtensionDependency from: aPackage to: (self packageForClass: method actualClass)) theClass: method actualClass; selector: method methodSymbol) ]. aPackage methods do: [ :method | method compiledMethod literals allButLast do: [ :literal | (literal isVariableBinding and: [ literal value isBehavior and: [ literal key = literal value name ] ]) ifTrue: [ self add: ((PDReferenceDependency from: aPackage to: (self packageForClass: literal value)) theClass: method actualClass; selector: method methodSymbol; reference: literal value) ] ] ]! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'lr 8/31/2008 18:48'! dependencies "Answer a collection of all dependencies." ^ dependencies! ! !PDPackageAnalyzer methodsFor: 'queries' stamp: 'lr 1/9/2008 10:49'! dependenciesFor: aPackage "Return a list of dependencies of aPackage." ^ packageToDependencies at: aPackage ifAbsentPut: [ OrderedCollection new ]! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'lr 1/9/2008 11:22'! dependencyLabelFor: aCollection ^ aCollection size! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'lr 1/9/2008 11:30'! dependencyTooltipFor: aCollection ^ String streamContents: [ :stream | aCollection do: [ :each | stream nextPutAll: each reason ] separatedBy: [ stream nextPutAll: ', ' ] ]! ! !PDPackageAnalyzer methodsFor: 'queries' stamp: 'lr 1/9/2008 11:02'! dependentPackagesFor: aPackage ^ (self dependenciesFor: aPackage) inject: IdentityDictionary new into: [ :result :each | (each isExternal and: [ self packages includes: each target ]) ifTrue: [ (result at: each target ifAbsentPut: [ OrderedCollection new ]) add: each ]. result ]! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'lr 8/31/2008 18:50'! graph "Anser a GraphViz graph. Requires the GraphViz package to be loaded." | graph | graph := GraphViz new. graph beDirected. packages do: [ :package | graph add: package packageName with: { #href -> '#'. #label -> (self packageLabelFor: package). #tooltip -> (self packageTooltipFor: package) } ]. packages do: [ :sourcePackage | (self dependentPackagesFor: sourcePackage) keysAndValuesDo: [ :targetPackage :deps | graph add: sourcePackage packageName -> targetPackage packageName with: { #href -> '#'. #label -> (self dependencyLabelFor: deps). #tooltip -> (self dependencyTooltipFor: deps) } ] ]. ^ graph! ! !PDPackageAnalyzer methodsFor: 'initialization' stamp: 'lr 1/9/2008 11:57'! initialize super initialize. classToPackage := IdentityDictionary new. dependencies := OrderedCollection new. packageToDependencies := IdentityDictionary new.! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'! open self graph openInteractive! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'lr 8/31/2008 18:49'! outgoing "Answer a collection of all dependencies that point out of the current package set." ^ dependencies reject: [ :each | each isInternal or: [ packages includes: each target ] ]! ! !PDPackageAnalyzer methodsFor: 'queries' stamp: 'lr 3/29/2008 15:09'! packageForClass: aClass ^ classToPackage at: aClass ifAbsentPut: [ packages detect: [ :each | each includesClass: aClass ] ifNone: [ PackageOrganizer default packageOfClass: aClass ifNone: [ nil ] ] ]! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'lr 7/29/2008 19:24'! packageLabelFor: aPackage ^ (MCWorkingCopy allManagers detect: [ :each | each packageName = aPackage packageName ] ifNone: [ ^ aPackage packageName ]) ancestry ancestorString! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'lr 1/9/2008 11:30'! packageTooltipFor: aPackage ^ String streamContents: [ :stream | stream nextPutAll: 'Classes: '; print: aPackage classes size; nextPutAll: ', '. stream nextPutAll: 'Core Methods: '; print: aPackage coreMethods size; nextPutAll: ', '. stream nextPutAll: 'Extension Methods: '; print: aPackage extensionMethods size; nextPutAll: ', '. stream nextPutAll: 'Internal Dependencies: '; print: ((self dependenciesFor: aPackage) count: [ :each | each isInternal ]); nextPutAll: ', '. stream nextPutAll: 'External Dependencies: '; print: ((self dependenciesFor: aPackage) count: [ :each | each isExternal ]) ]! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'lr 8/31/2008 18:49'! packages "Answer the currently analyzed set of packages." ^ packages! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'! save: aString FileStream forceNewFileNamed: aString do: [ :stream | stream nextPutAll: self graph dot ]! ! !PDPackageAnalyzer methodsFor: 'initialization' stamp: 'lr 1/5/2008 18:35'! setPackages: aCollection packages := aCollection. self analyze! ! Object subclass: #PDPackageDependency instanceVariableNames: 'source target' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! PDPackageDependency subclass: #PDExtensionDependency instanceVariableNames: 'theClass selector' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDExtensionDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:23'! printReasonOn: aStream aStream nextPutAll: self theClass name; nextPutAll: '>>'; print: self selector! ! !PDExtensionDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! selector ^selector! ! !PDExtensionDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! selector: aSelector selector := aSelector! ! !PDExtensionDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! theClass ^theClass! ! !PDExtensionDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! theClass: aClass theClass := aClass! ! PDPackageDependency subclass: #PDInheritanceDependency instanceVariableNames: 'theClass superclass' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDInheritanceDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:24'! printReasonOn: aStream aStream nextPutAll: self theClass name; nextPutAll: ' inherits from '; nextPutAll: self superclass name! ! !PDInheritanceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:14'! superclass ^superclass! ! !PDInheritanceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! superclass: aClass superclass := aClass! ! !PDInheritanceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:14'! theClass ^theClass! ! !PDInheritanceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! theClass: aClass theClass := aClass! ! !PDPackageDependency class methodsFor: 'instance-creation' stamp: 'lr 1/9/2008 09:57'! from: aSourcePackage to: aDestinationPackage ^ self new initialzieFrom: aSourcePackage to: aDestinationPackage! ! !PDPackageDependency methodsFor: 'initialization' stamp: 'lr 1/9/2008 09:58'! initialzieFrom: aSourcePackage to: aTargetPackage source := aSourcePackage. target := aTargetPackage! ! !PDPackageDependency methodsFor: 'testing' stamp: 'lr 1/9/2008 10:39'! isExternal ^ self isInternal not! ! !PDPackageDependency methodsFor: 'testing' stamp: 'lr 1/9/2008 10:39'! isInternal ^ self source = self target! ! !PDPackageDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:23'! printOn: aStream self printPackageOn: aStream. self printReasonOn: aStream! ! !PDPackageDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:23'! printPackageOn: aStream aStream nextPutAll: self source packageName; nextPutAll: ' depends on '; nextPutAll: self target packageName; nextPutAll: ': '! ! !PDPackageDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:23'! printReasonOn: aStream! ! !PDPackageDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 11:24'! reason ^ String streamContents: [ :stream | self printReasonOn: stream ]! ! !PDPackageDependency methodsFor: 'comparing' stamp: 'lr 1/9/2008 10:01'! sameAs: aDependency ^ self source = aDependency source and: [ self target = aDependency target ]! ! !PDPackageDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 09:59'! source ^ source! ! !PDPackageDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 09:59'! target ^ target! ! PDPackageDependency subclass: #PDReferenceDependency instanceVariableNames: 'theClass selector reference' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDReferenceDependency methodsFor: 'printing' stamp: 'lr 1/9/2008 11:24'! printReasonOn: aStream aStream nextPutAll: self theClass name; nextPutAll: '>>'; print: self selector; nextPutAll: ' references '; nextPutAll: self reference name! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! reference ^reference! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! reference: aClass reference := aClass! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! selector ^selector! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! selector: aSymbol selector := aSymbol! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! theClass ^theClass! ! !PDReferenceDependency methodsFor: 'accessing' stamp: 'lr 1/9/2008 10:15'! theClass: aClass theClass := aClass! !