SystemOrganization addCategory: #'Package-Dependencies'! Object subclass: #PDPackage instanceVariableNames: 'dependencies packageInfo included' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDPackage class methodsFor: 'instance creation' stamp: 'jf 10/7/2008 09:12'! new self shouldNotImplement! ! !PDPackage class methodsFor: 'instance creation' stamp: 'jf 10/7/2008 09:12'! on: aPackageInfo ^ self basicNew initializeWithPackage: aPackageInfo; yourself! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 09:22'! add: aDependency ^ dependencies add: aDependency! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 09:49'! beIncluded included := true! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 11:41'! clearDependencies dependencies := Bag new! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 09:09'! dependencies ^ dependencies! ! !PDPackage methodsFor: 'accessing' stamp: 'lr 10/18/2008 11:11'! dependentPackages | result | result := OrderedCollection new. self dependencies do: [ :each | (result includes: each target) ifFalse: [ result add: each target ] ]. ^ result! ! !PDPackage methodsFor: 'testing' stamp: 'jf 10/7/2008 09:37'! hasCyclicDependencies ^ self dependencies anySatisfy: [ :each | each isCyclic ]! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 09:20'! info ^ packageInfo! ! !PDPackage methodsFor: 'initialization' stamp: 'jf 10/7/2008 11:41'! initializeWithPackage: aPackageInfo self initialize. packageInfo := aPackageInfo. self clearDependencies. included := false.! ! !PDPackage methodsFor: 'testing' stamp: 'jf 10/7/2008 09:49'! isIncluded ^ included! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 10:01'! packageName ^ self info packageName! ! !PDPackage methodsFor: 'as yet unclassified' stamp: 'pmm 10/18/2008 16:39'! printOn: aStream "please recategorize to printing, I can't because my OB is broken" super printOn: aStream. aStream nextPut: $(; nextPutAll: self packageName; nextPut: $)! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 13:21'! remove: aDependency ^ dependencies remove: aDependency! ! !PDPackage methodsFor: 'accessing' stamp: 'jf 10/7/2008 13:21'! removeAllInternal dependencies := dependencies reject: [ :each | each isInternal ]! ! Object subclass: #PDPackageAnalyzer instanceVariableNames: 'relation' 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: 'pmm 10/18/2008 17:20'! examples (self onPackagesNamed: self omnibrowserPackageNames) save: 'ob.dot'. (self onPackagesNamed: self allMonticelloPackageNames) save: 'monticello.dot'. (self onPackagesNamed: self allPackageNames) save: 'squeak.dot'. (self onPackagesNamed: self pierPackageNames) save: 'pier.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: 'jf 10/7/2008 10:56'! onPackages: aCollection ^ self basicNew initializeWithPackageInfos: 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 9/25/2008 09:07'! pierPackageNames ^ #( 'Magritte-Model' 'Magritte-Seaside' 'Magritte-Tests' 'Pier-Model' 'Pier-Seaside' 'Pier-Tests' 'Pier-Blog' 'Pier-Design' 'Pier-Documents' 'Pier-Forms' 'Pier-Randomizer' 'Pier-Security' 'Pier-Squeak-Persistency')! ! !PDPackageAnalyzer class methodsFor: 'examples' stamp: 'pmm 10/18/2008 17:26'! saveSeasideDependencyGraph "self saveSeasideDependencyGraph" (self onPackagesNamed: (Smalltalk at: #WADevelopment) packages) save: 'seaside.dot'! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'jf 10/7/2008 13:36'! dependencyColorFor: aDependency ^ aDependency isCyclic ifFalse: [ 'black' ] ifTrue: [ 'red' ]! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'jf 10/7/2008 13:42'! dependencyLabelFor: aDependency ^ String streamContents: [ :stream | aDependency printShortReasonOn: stream ]! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'jf 10/7/2008 13:43'! dependencyTooltipFor: aDependency ^ aDependency reason! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'jf 10/7/2008 13:58'! graph self relation removeInternalDependencies; removeOutgoingDependencies; combineDependencies; markCycles; reduce. ^ self graph: self relation! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'jf 10/7/2008 13:45'! graph: aRelation "Anser a GraphViz graph. Requires the GraphViz package to be loaded." | graph | graph := GraphViz new. graph beDirected. aRelation includedPackages do: [ :package | graph add: package packageName with: { #href -> '#'. #label -> (self packageLabelFor: package). #tooltip -> (self packageTooltipFor: package) } ] displayingProgress: 'Building graph nodes'. aRelation includedPackages do: [ :package | package dependencies do: [ :each | graph add: package packageName -> each target packageName with: { #href -> '#'. #color -> (self dependencyColorFor: each). #label -> (self dependencyLabelFor: each). #tooltip -> (self dependencyTooltipFor: each) } ] ] displayingProgress: 'Building graph edges'. ^ graph! ! !PDPackageAnalyzer methodsFor: 'initialization' stamp: 'jf 10/7/2008 12:09'! initializeWithPackageInfos: aCollection self initialize. relation := PDPackageRelation onPackages: (aCollection collect: [ :each | PDPackage on: each ]). self relation addStaticDependencies! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'! open self graph openInteractive! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'lr 9/12/2008 19:27'! packageLabelFor: aPackage | result | result := (MCWorkingCopy allManagers detect: [ :each | each packageName = aPackage packageName ] ifNone: [ ^ aPackage packageName ]) ancestry ancestorString. ^ result isEmptyOrNil ifTrue: [ aPackage packageName ] ifFalse: [ result ]! ! !PDPackageAnalyzer methodsFor: 'configuration' stamp: 'jf 10/7/2008 10:02'! packageTooltipFor: aPackage ^ String streamContents: [ :stream | stream nextPutAll: 'Classes: '; print: aPackage info classes size; nextPutAll: ', '. stream nextPutAll: 'Core Methods: '; print: aPackage info coreMethods size; nextPutAll: ', '. stream nextPutAll: 'Extension Methods: '; print: aPackage info extensionMethods size; nextPutAll: ', '. stream nextPutAll: 'Internal Dependencies: '; print: (aPackage dependencies count: [ :each | each isInternal ]); nextPutAll: ', '. stream nextPutAll: 'External Dependencies: '; print: (aPackage dependencies count: [ :each | each isExternal ]) ]! ! !PDPackageAnalyzer methodsFor: 'accessing' stamp: 'jf 10/7/2008 10:35'! relation ^ relation! ! !PDPackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'! save: aString FileStream forceNewFileNamed: aString do: [ :stream | stream nextPutAll: self graph dot ]! ! Object subclass: #PDPackageDependency instanceVariableNames: 'source target cyclic' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! PDPackageDependency subclass: #PDCompositeDependency instanceVariableNames: 'dependencies' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDCompositeDependency methodsFor: 'accessing' stamp: 'jf 10/7/2008 11:27'! add: aDependency dependencies add: aDependency! ! !PDCompositeDependency methodsFor: 'initialization' stamp: 'jf 10/7/2008 11:26'! initializeFrom: aSourcePackage to: aTargetPackage super initializeFrom: aSourcePackage to: aTargetPackage. dependencies := Bag new! ! !PDCompositeDependency methodsFor: 'printing' stamp: 'jf 10/7/2008 13:40'! printReasonOn: aStream aStream nextPutAll: dependencies size asString; nextPutAll: ' dependencies: '. dependencies do: [ :each | each printReasonOn: aStream ] separatedBy: [ aStream nextPutAll: ', ' ]! ! !PDCompositeDependency methodsFor: 'printing' stamp: 'jf 10/7/2008 13:39'! printShortReasonOn: aStream aStream nextPutAll: dependencies size asString! ! 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: 'jf 10/7/2008 11:26'! from: aSourcePackage to: aDestinationPackage ^ self new initializeFrom: aSourcePackage to: aDestinationPackage! ! !PDPackageDependency methodsFor: 'action' stamp: 'lr 9/13/2008 01:00'! beCyclic cyclic := true! ! !PDPackageDependency methodsFor: 'initialization' stamp: 'jf 10/7/2008 11:25'! initializeFrom: aSourcePackage to: aTargetPackage source := aSourcePackage. target := aTargetPackage. cyclic := false! ! !PDPackageDependency methodsFor: 'testing' stamp: 'lr 9/13/2008 00:59'! isCyclic ^ cyclic! ! !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: 'printing' stamp: 'jf 10/7/2008 13:39'! printShortReasonOn: aStream self 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! ! Object subclass: #PDPackageRelation instanceVariableNames: 'packages classToPackage' classVariableNames: '' poolDictionaries: '' category: 'Package-Dependencies'! !PDPackageRelation class methodsFor: 'instance creation' stamp: 'jf 10/7/2008 10:43'! new ^ self onPackages: OrderedCollection new! ! !PDPackageRelation class methodsFor: 'instance creation' stamp: 'jf 10/7/2008 10:41'! onPackages: aCollection ^ self basicNew initializeWithPackages: aCollection; yourself! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 11:17'! addStaticDependencies self packages do: [ :each | self addStaticDependencies: each ] displayingProgress: 'Analyzing Packages'! ! !PDPackageRelation methodsFor: 'private' stamp: 'jf 10/7/2008 11:18'! addStaticDependencies: aPackage aPackage info classes do: [ :class | class superclass ifNotNilDo: [ :superclass | aPackage add: ((PDInheritanceDependency from: aPackage to: (self packageForClass: superclass)) theClass: class; superclass: superclass) ] ]. aPackage info extensionMethods do: [ :method | aPackage add: ((PDExtensionDependency from: aPackage to: (self packageForClass: method actualClass)) theClass: method actualClass; selector: method methodSymbol) ]. aPackage info methods do: [ :method | method compiledMethod literals allButLast do: [ :literal | (literal isVariableBinding and: [ literal value isBehavior and: [ literal key = literal value name ] ]) ifTrue: [ aPackage add: ((PDReferenceDependency from: aPackage to: (self packageForClass: literal value)) theClass: method actualClass; selector: method methodSymbol; reference: literal value) ] ] ]! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 12:10'! combineDependencies "Combine all dependencies with the same source and target into one composite dependency." self packages do: [ :each | self combineDependencies: each ] displayingProgress: 'Combining Dependencies'! ! !PDPackageRelation methodsFor: 'private' stamp: 'jf 10/7/2008 11:49'! combineDependencies: aPackage | grouped composite | grouped := aPackage dependencies groupBy: [ :each | each target ] having: [ :each | true ]. aPackage clearDependencies. grouped keysAndValuesDo: [ :target :dependencies | composite := PDCompositeDependency from: aPackage to: target. dependencies do: [ :each | composite add: each ]. aPackage add: composite ]! ! !PDPackageRelation methodsFor: 'queries' stamp: 'jf 10/7/2008 11:33'! dependentPackagesFor: aPackage ^ aPackage dependencies inject: IdentityDictionary new into: [ :result :each | (each isExternal and: [ each target isIncluded ]) ifTrue: [ (result at: each target ifAbsentPut: [ OrderedCollection new ]) add: each ]. result ]! ! !PDPackageRelation methodsFor: 'testing' stamp: 'jf 10/7/2008 10:31'! hasCycles ^ self includedPackages anySatisfy: [ :each | each hasCyclicDependencies ]! ! !PDPackageRelation methodsFor: 'accessing' stamp: 'jf 10/7/2008 10:32'! includedPackages "Answer the currently analyzed set of packages." ^ self packages select: [ :each | each isIncluded ]! ! !PDPackageRelation methodsFor: 'initialization' stamp: 'jf 10/7/2008 11:20'! initializeWithPackages: aCollection self initialize. packages := aCollection. packages do: [ :each | each beIncluded ]. classToPackage := IdentityDictionary new.! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 11:03'! markCycles self includedPackages do: [ :each | self markCycles: each seen: OrderedCollection new ] displayingProgress: 'Finding Cycles'! ! !PDPackageRelation methodsFor: 'private' stamp: 'jf 10/7/2008 13:19'! markCycles: aPackage seen: aCollection | outgoing start edge | outgoing := OrderedCollection new. aPackage dependencies do: [ :each | each isInternal ifTrue: [ each beCyclic ] ifFalse: [ outgoing add: each ] ]. outgoing := outgoing groupBy: [ :each | each target ] having: [ :each | true ]. outgoing keysAndValuesDo: [ :package :alledges | edge := alledges atRandom. start := aCollection findLast: [ :each | each source = edge target ]. start isZero ifFalse: [ start to: aCollection size do: [ :index | (aCollection at: index) beCyclic ] ] ifTrue: [ aCollection addLast: edge. self markCycles: edge target seen: aCollection. aCollection removeLast ] ]! ! !PDPackageRelation methodsFor: 'accessing' stamp: 'jf 10/7/2008 10:35'! outgoing "Answer a collection of all dependencies that point out of the current package set." ^ self includedPackages inject: Bag new into: [ :outgoing :package | package dependencies do: [ :each | (each isInternal or: [ each target isIncluded ]) ifFalse: [ outgoing add: each ] ] ]! ! !PDPackageRelation methodsFor: 'queries' stamp: 'jf 10/7/2008 11:16'! packageForClass: aClass | info | ^ classToPackage at: aClass ifAbsentPut: [ self packages detect: [ :each | each info includesClass: aClass ] ifNone: [ info := PackageOrganizer default packageOfClass: aClass ifNone: [ nil ]. info isNil ifTrue: [ nil ] ifFalse: [ PDPackage on: info ] ] ]! ! !PDPackageRelation methodsFor: 'accessing' stamp: 'jf 10/7/2008 10:28'! packages "Answer all seen packages." ^ packages! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 14:10'! reduce "Compute the transitive reduction of the relation. That is, remove as many dependencies as possible, while still maintaining the same transitive closure. Cycles should already haven been marked, otherwise the algorithm will not terminate. This could be fixed by tracking cycles, picking an arbitrary root, and caching the distances for the whole cycle, considering every node in the cycle to have a distance of 0 from the root." self hasCycles ifTrue: [ ^ self ]. self packages do: [ :each | self reduceDependencies: each ] displayingProgress: 'Determining Transitive Reduction'! ! !PDPackageRelation methodsFor: 'private' stamp: 'jf 10/7/2008 13:10'! reduceDependencies: aPackage | distances removals | aPackage dependencies isEmpty ifTrue: [ ^ Dictionary new ]. distances := Dictionary new. removals := OrderedCollection new. aPackage dependencies do: [ :dependency | (self reduceDependencies: dependency target) keysAndValuesDo: [ :target :distance | distances at: target put: ((distances at: target ifAbsent: [ 0 ]) max: (distance + 1)) ] ]. aPackage dependencies do: [ :dependency | (distances includesKey: dependency target) ifTrue: [ removals add: dependency ] ifFalse: [ distances at: dependency target put: 1 ] ]. removals do: [ :each | aPackage remove: each ]. ^ distances ! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 13:25'! removeInternalDependencies "Remove all dependencies from a package to itself" self includedPackages do: [ :each | each removeAllInternal ] displayingProgress: 'Removing internal Dependencies'! ! !PDPackageRelation methodsFor: 'actions' stamp: 'jf 10/7/2008 13:58'! removeOutgoingDependencies "Remove all dependencies to packages not included in this relation" self includedPackages do: [ :each | self removeOutgoingDependencies: each ] displayingProgress: 'Removing outgoing Dependencies'! ! !PDPackageRelation methodsFor: 'private' stamp: 'jf 10/7/2008 13:57'! removeOutgoingDependencies: aPackage | removals | removals := aPackage dependencies reject: [ :each | each target isIncluded ]. removals do: [ :each | aPackage remove: each ]! !