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: 'pmm 9/25/2008 09:07'!
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'.
	(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: '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 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 9/24/2008 08:05'!
seasidePackageNames
	^ #(
		'Comet-Core'
		'Comet-Examples'
		'Comet-Squeak-Core'
		
		'RSS-Core'
		'RSS-Examples'
		'RSS-Squeak-Core'
		'RSS-Squeak-Examples'
		'RSS-Tests-Core'
		
		'Scriptaculous-Core'
		'Scriptaculous-Squeak-Core'
		'Scriptaculous-Tests-Core'
		'Scriptaculous-Components'
		'Scriptaculous-Tests-Components'
		
		'Seaside-Squeak-Continuation'
		'Seaside-RenderLoop'
		'Seaside-Platform'
		'Seaside-Squeak-Platform'
		'Seaside-Core'
		'Seaside-Squeak-Core'
		'Seaside-Session'
		'Seaside-Component'
		'Seaside-Canvas'
		'Seaside-Tests-All'
		'Seaside-Tests-Squeak-All'
		
		'Seaside-Tests-Color'
		'Seaside-Development-Core'
		'Seaside-Tests-Development'
		'Seaside-Squeak-Development'
		'Seaside-Examples'
		'Seaside-Environment'
		
		'Seaside-Internet-Explorer-Core'
		'Seaside-Internet-Explorer-Tests'
		'Seaside-HTML5'
		'Seaside-Tests-HTML5'
		'Seaside-Email'
		'Seaside-Tests-Email'
		'Seaside-Squeak-Email'
		
		'Seaside-Squeak-Kom-Core'
		'Seaside-Tests-Squeak-Kom'
		'Seaside-Adapters-Swazoo'
		'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 9/13/2008 10:02'!
analyze
	self packages 
		do: [ :each | self analyze: each ]
		displayingProgress: 'Analyzing Packages'.
	self packages
		do: [ :each | self findCycles: each seen: OrderedCollection new ]
		separatedBy: 'Finding Cycles'! !

!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 9/13/2008 09:49'!
dependencyColorFor: aCollection
	^ (aCollection anySatisfy: [ :each | each isCyclic ]) ifFalse: [ 'black' ] ifTrue: [ 'red' ]! !

!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: 'private' stamp: 'lr 9/13/2008 10:00'!
findCycles: aPackage seen: aCollection
	| outgoing start edge |
	outgoing := packageToDependencies 
		at: aPackage 
		ifAbsent: [ ^ self ].
	outgoing := outgoing
		select: [ :each | each isExternal ].
	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 findCycles: edge target seen: aCollection.
				aCollection removeLast ] ]! !

!PDPackageAnalyzer methodsFor: 'accessing' stamp: 'lr 9/13/2008 01:01'!
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 -> '#'.
					#color -> (self dependencyColorFor: deps).
					#label -> (self dependencyLabelFor: deps).
					#tooltip -> (self dependencyTooltipFor: deps) } ] ].
	^ graph! !

!PDPackageAnalyzer methodsFor: 'testing' stamp: 'pmm 9/17/2008 22:13'!
hasCycles
	^self dependencies anySatisfy: [ :each |
		each isCyclic ]! !

!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 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: '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 cyclic'
	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: 'action' stamp: 'lr 9/13/2008 01:00'!
beCyclic
	cyclic := true! !

!PDPackageDependency methodsFor: 'initialization' stamp: 'lr 9/13/2008 01:00'!
initialzieFrom: 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: '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! !