SystemOrganization addCategory: #'Package-Dependencies'!

Object subclass: #PackageAnalyzer
	instanceVariableNames: 'packages explanations classToPackage inheritanceDependencies extensionDependencies directDependencies'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Package-Dependencies'!

!PackageAnalyzer class methodsFor: 'examples' stamp: 'lr 1/5/2008 19:03'!
examples
	(self onPackagesNamed: self seasidePackageNames) save: 'packages.dot'.
	(self onPackagesNamed: self seasidePackageNamesWithoutTests) save: 'packages-withouttests.dot'.
	! !

!PackageAnalyzer class methodsFor: 'instance-creation' stamp: 'lr 1/5/2008 15:44'!
onPackages: aCollection
	^ self new
		setPackages: aCollection;
		yourself! !

!PackageAnalyzer class methodsFor: 'instance-creation' stamp: 'lr 1/5/2008 15:45'!
onPackagesNamed: aCollection
	^ self onPackages: (aCollection collect: [ :each | PackageInfo named: each ])! !

!PackageAnalyzer class methodsFor: 'examples' stamp: 'lr 1/5/2008 18:29'!
seasidePackageNames
	^ #( 'Comet-Core' 'Comet-Examples' 'Comet-Squeak' 'Comet-Squeak-Core' 'RSS-Core' 'RSS-Examples' 'RSS-Squeak-Core' 'RSS-Squeak-Examples' 'RSS-Tests' 'Scriptaculous-Core' 'Scriptaculous-Tests' 'Seaside-Adapters-Core' 'Seaside-Core' 'Seaside-Development-Core' 'Seaside-Examples' 'Seaside-Squeak-Adapters' 'Seaside-Squeak-Core' 'Seaside-Squeak-Development' 'Seaside-Squeak-Kom' 'Seaside-Squeak-Tests' 'Seaside-Tests' )! !

!PackageAnalyzer class methodsFor: 'examples' stamp: 'lr 1/5/2008 18:29'!
seasidePackageNamesWithoutTests
	^ self seasidePackageNames reject: [ :each | each includesSubString: 'Test' ]! !

!PackageAnalyzer methodsFor: 'private' stamp: 'lr 1/5/2008 16:45'!
analyze
	self packages 
		do: [ :each | self analyze: each ]
		displayingProgress: 'Analyzing'
		! !

!PackageAnalyzer methodsFor: 'private' stamp: 'lr 1/5/2008 21:28'!
analyze: aPackage
	aPackage classes do: [ :class |
		class superclass ifNotNilDo: [ :superclass |
			self
				from: aPackage
				to: (self packageForClass: superclass)
				using: inheritanceDependencies
				explanation: 'Subclasses: ' , superclass name ] ].
	aPackage extensionMethods do: [ :method |
		self
			from: aPackage
			to: (self packageForClass: method actualClass)
			using: extensionDependencies
			explanation: 'Extends: ' , method classSymbol ].
	aPackage methods do: [ :method |
		method compiledMethod literals allButLast do: [ :literal |
			(literal isVariableBinding and: [ literal value isBehavior and: [ literal key = literal value name ] ]) ifTrue: [
				self
					from: aPackage
					to: (self packageForClass: literal value)
					using: directDependencies
					explanation: 'References: ' , literal value name ] ] ]! !

!PackageAnalyzer methodsFor: 'accessing' stamp: 'lr 1/5/2008 18:28'!
dependencies: aBag
	^ (aBag select: [ :each | (packages includes: each key) and: [ packages includes: each value ] ])
		valuesAndCounts! !

!PackageAnalyzer methodsFor: 'accessing' stamp: 'lr 1/5/2008 19:31'!
explanationFor: anAssociation
	^ explanations at: anAssociation ifPresent: [ :elements |
		String streamContents: [ :stream |
			elements asArray sort
				do: [ :each | stream nextPutAll: each ]
				separatedBy: [ stream nextPutAll: ', ' ] ] ]! !

!PackageAnalyzer methodsFor: 'private' stamp: 'lr 1/5/2008 18:50'!
from: aFirstPackage to: aSecondPackage using: aCollection explanation: aString
	| association |
	aFirstPackage = aSecondPackage ifTrue: [ ^ self ].
	aCollection add: (association := aFirstPackage -> aSecondPackage).
	aString isEmptyOrNil ifTrue: [ ^ self ].
	(explanations at: association ifAbsentPut: [ Set new ])
		add: aString! !

!PackageAnalyzer methodsFor: 'accessing' stamp: 'lr 1/5/2008 21:41'!
graph
	| graph |
	graph := GraphViz new.
	graph beDirected.
	
	packages do: [ :package | 
		graph 
			add: package packageName
			with: {
				#style -> #filled.
				#fillcolor -> ((package packageName beginsWith: 'Seaside')
					ifTrue: [ #gray ] ifFalse: [ #white ]) } ].

	(self dependencies: inheritanceDependencies , extensionDependencies , directDependencies) keysDo: [ :each |
		graph
			add: each key packageName -> each value packageName
			with: { 
				#label -> (explanations at: each ifAbsent: [ 0 ]) size asString. 
				#href -> '#'. #tooltip -> (self explanationFor: each) } ].

	^ graph! !

!PackageAnalyzer methodsFor: 'initialization' stamp: 'lr 1/5/2008 18:35'!
initialize
	super initialize.
	explanations := Dictionary new.
	classToPackage := IdentityDictionary new.
	inheritanceDependencies := Bag new.
	extensionDependencies := Bag new.
	directDependencies := Bag new! !

!PackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'!
open
	self graph openInteractive! !

!PackageAnalyzer methodsFor: 'accessing' stamp: 'lr 1/5/2008 18:28'!
packageForClass: aClass
	^ classToPackage at: aClass ifAbsentPut: [ 
		self packages 
			detect: [ :each | each includesClass: aClass ]
			ifNone: [ 
				PackageOrganizer default
					packageOfClass: aClass
					ifNone: [ nil ] ] ]! !

!PackageAnalyzer methodsFor: 'accessing' stamp: 'lr 1/5/2008 15:52'!
packages
	^ packages! !

!PackageAnalyzer methodsFor: 'actions' stamp: 'lr 1/5/2008 15:53'!
save: aString
	FileStream
		forceNewFileNamed: aString
		do: [ :stream | stream nextPutAll: self graph dot ]! !

!PackageAnalyzer methodsFor: 'initialization' stamp: 'lr 1/5/2008 18:35'!
setPackages: aCollection
	packages := aCollection.
	self analyze! !