SystemOrganization addCategory: #'GraphBuilder-Monticello'! SystemOrganization addCategory: #'GraphBuilder-Log'! Object subclass: #GBAncestryBuilder instanceVariableNames: 'repository graph versions' classVariableNames: '' poolDictionaries: '' category: 'GraphBuilder-Monticello'! !GBAncestryBuilder class methodsFor: 'instance creation' stamp: 'lr 4/2/2005 13:29'! on: aRepository ^self new repository: aRepository; yourself.! ! !GBAncestryBuilder class methodsFor: 'instance creation' stamp: 'lr 4/2/2005 13:32'! select | repositories | repositories := MCRepositoryGroup default repositories. ^self on: (MCRepositoryGroup default repositories at: (PopUpMenu withCaption: 'Choose Repository' chooseFrom: (repositories collect: [ :each | each name ])) ifAbsent: [ ^nil ]).! ! !GBAncestryBuilder methodsFor: 'actions' stamp: 'lr 4/13/2005 22:38'! build self initializeGraph; initializeVersions. self buildNodes; buildEdgesAncestry; buildEdgesDependencies.! ! !GBAncestryBuilder methodsFor: 'actions' stamp: 'lr 4/13/2005 22:53'! buildEdgesAncestry self versions do: [ :version | version ancestors do: [ :ancestor | self graph add: ancestor uid -> version uid with: { } ] ] displayingProgress: 'Writing Ancestry Edges'.! ! !GBAncestryBuilder methodsFor: 'actions' stamp: 'lr 4/13/2005 23:37'! buildEdgesDependencies | roots ranked | roots := self versions copy. ranked := Set new. self versions do: [ :version | version dependencies do: [ :each | roots remove: each ifAbsent: nil ] ] displayingProgress: 'Searching Dependency Root'. roots asSortedCollection do: [ :root | root deep in: [ :dependencies | dependencies size > 1 ifTrue: [ self graph rank: root uid add: (Array streamContents: [ :stream | dependencies do: [ :each | (ranked includes: each) ifFalse: [ stream nextPut: each uid. ranked add: each ] ] ]) ] ] ] displayingProgress: 'Writing Dependency Edges'.! ! !GBAncestryBuilder methodsFor: 'actions' stamp: 'lr 4/13/2005 22:53'! buildNodes self versions do: [ :version | self graph add: version uid with: { 'label' -> version label } ] displayingProgress: 'Writing Nodes'.! ! !GBAncestryBuilder methodsFor: 'accessing-readonly' stamp: 'lr 4/2/2005 13:26'! graph ^graph! ! !GBAncestryBuilder methodsFor: 'private' stamp: 'lr 4/19/2005 08:38'! initializeGraph graph := GraphViz new. graph beDirected; add: 'graph' with: { 'overlap' -> 'scale'. 'concentrate' -> 'true'. 'ranksep' -> '0.25'. 'label' -> self repository asString }; add: 'edge' with: { 'arrowsize' -> '1.0' }; add: 'node' with: { 'shape' -> 'Mrecord' }; yourself.! ! !GBAncestryBuilder methodsFor: 'private' stamp: 'lr 11/16/2005 20:13'! initializeVersions versions := Set new. self repository readableFileNames do: [ :filename | versions add: (GBVersion repository: self repository filename: filename) ] displayingProgress: 'Reading Versions'. versions copy do: [ :version | versions addAll: (version info allAncestors collect: [ :ancestor | GBVersion info: ancestor ]) ] displayingProgress: 'Building Nodes'. versions do: [ :version | version setAncestors: Set new. version info ancestors do: [ :ancestor | (versions like: (GBVersion info: ancestor)) ifNotNilDo: [ :each | version ancestors add: each ] ]. version setDependencies: Set new. version version ifNotNilDo: [ :ver | ver dependencies do: [ :dependency | (versions like: (GBVersion info: dependency versionInfo)) ifNotNilDo: [ :each | version dependencies add: each ] ] ] ] displayingProgress: 'Building Edges'.! ! !GBAncestryBuilder methodsFor: 'accessing' stamp: 'lr 4/2/2005 13:25'! repository ^repository! ! !GBAncestryBuilder methodsFor: 'accessing' stamp: 'lr 4/2/2005 13:25'! repository: aRepository repository := aRepository! ! !GBAncestryBuilder methodsFor: 'accessing-readonly' stamp: 'lr 4/2/2005 13:28'! versions ^versions! ! Object subclass: #GBFlowAnalyzer instanceVariableNames: 'entries graph continuation' classVariableNames: '' poolDictionaries: '' category: 'GraphBuilder-Log'! !GBFlowAnalyzer class methodsFor: 'instance-creation' stamp: 'lr 11/16/2005 20:22'! on: aStream ^ self new initializeFromStream: aStream; yourself.! ! !GBFlowAnalyzer methodsFor: 'adding' stamp: 'lr 11/16/2005 22:09'! add: aFlowEntry entries add: aFlowEntry. continuation at: aFlowEntry currentCC put: aFlowEntry.! ! !GBFlowAnalyzer methodsFor: 'building' stamp: 'lr 11/16/2005 22:29'! build graph := GraphViz new. " initialize " graph beDirected; add: #graph with: { #overlap -> #scale. #concentrate -> true. #ranksep -> 0.25 }; add: #edge with: { #arrowsize -> '1.0' }. " timeline " graph add: #node with: { #shape -> #plaintext }. entries do: [ :each | self graph add: 't' , each uuid asString with: { #label -> each timestamp time asString } ]. entries allButFirst inject: entries first into: [ :previous :current | self graph add: ('t' , previous uuid asString) -> ('t' , current uuid asString). current ]. " browsing " graph add: #node with: { #shape -> #box }. entries do: [ :each | graph add: #node with: { #label -> each type }. self graph rank: 't' , each uuid asString add: 'n' , each uuid asString ]. entries do: [ :each | continuation at: each previousCC ifPresent: [ :previous | self graph add: ('n' , previous uuid asString) -> ('n' , each uuid asString) ] ].! ! !GBFlowAnalyzer methodsFor: 'accessing' stamp: 'lr 11/16/2005 21:39'! entries ^ entries! ! !GBFlowAnalyzer methodsFor: 'accessing' stamp: 'lr 11/16/2005 21:39'! graph graph isNil ifTrue: [ self build ]. ^ graph.! ! !GBFlowAnalyzer methodsFor: 'initialize-release' stamp: 'lr 11/16/2005 22:09'! initialize super initialize. entries := OrderedCollection new. continuation := Dictionary new.! ! !GBFlowAnalyzer methodsFor: 'initialize-release' stamp: 'lr 11/16/2005 21:32'! initializeFromStream: aStream [ aStream atEnd ] whileFalse: [ self add: (GBFlowEntry fromString: (aStream upTo: Character lf)) ].! ! Object subclass: #GBFlowEntry instanceVariableNames: 'timestamp method components referee type fields previousCC currentCC' classVariableNames: 'EntryRegex ContinuationRegex' poolDictionaries: 'ChronologyConstants' category: 'GraphBuilder-Log'! !GBFlowEntry class methodsFor: 'instance creation' stamp: 'lr 11/16/2005 20:23'! fromString: aString ^ self new initializeFromString: aString; yourself.! ! !GBFlowEntry class methodsFor: 'class initialization' stamp: 'lr 11/16/2005 21:27'! initialize EntryRegex := '\d+\.\d+\.\d+\.\d+ \S+ \S+ \[(\d\d/\w\w\w/\d\d\d\d)\:(\d\d\:\d\d\:\d\d) \+\d+\] "(POST|GET) (\S+) [^"]+" \d+ \d+ "([^"]+)" "[^"]+" (\w+) \d+ (.*);' asRegex. ContinuationRegex := '_k=(\w+)' asRegex.! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 22:20'! components ^ components! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 22:09'! currentCC ^ currentCC! ! !GBFlowEntry methodsFor: 'initialize-release' stamp: 'lr 11/16/2005 21:41'! initializeFromString: aString (EntryRegex search: aString) ifFalse: [ self error: 'Invalid Log Entry: ' , aString ]. " parse log entry " timestamp := TimeStamp date: (Date fromString: (EntryRegex subexpression: 2)) time: (Time fromString: (EntryRegex subexpression: 3)). method := EntryRegex subexpression: 4. components := EntryRegex subexpression: 5. referee := EntryRegex subexpression: 6. type := EntryRegex subexpression: 7. fields := EntryRegex subexpression: 8. " find continuations " ContinuationRegex matchesIn: referee do: [ :value | previousCC := ContinuationRegex subexpression: 2 ]. ContinuationRegex matchesIn: fields do: [ :value | currentCC := ContinuationRegex subexpression: 2 ].! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 22:29'! method ^ method! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 22:13'! previousCC ^ previousCC! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 21:41'! timestamp ^ timestamp! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 22:29'! type ^ type! ! !GBFlowEntry methodsFor: 'accessing' stamp: 'lr 11/16/2005 21:50'! uuid ^ timestamp julianDayNumber * NanosInSecond * SecondsInDay + timestamp asNanoSeconds + self identityHash.! ! Object subclass: #GBVersion instanceVariableNames: 'version info uid ancestors dependencies' classVariableNames: '' poolDictionaries: '' category: 'GraphBuilder-Monticello'! !GBVersion class methodsFor: 'instance creation' stamp: 'lr 4/2/2005 15:17'! info: aVersionInfo ^self new setInfo: aVersionInfo; yourself.! ! !GBVersion class methodsFor: 'instance creation' stamp: 'lr 4/2/2005 15:17'! repository: aRepository filename: aFilename ^self version: (aRepository versionFromFileNamed: aFilename).! ! !GBVersion class methodsFor: 'instance creation' stamp: 'lr 4/2/2005 15:16'! version: aVersion ^self new setVersion: aVersion; yourself.! ! !GBVersion methodsFor: 'comparing' stamp: 'lr 4/2/2005 16:06'! <= anObject self package < anObject package ifTrue: [ ^true ]. self package = anObject package ifTrue: [ ^self number asNumber > anObject number asNumber ]. ^false.! ! !GBVersion methodsFor: 'comparing' stamp: 'lr 4/2/2005 13:48'! = anObject ^self class = anObject class and: [ self uid = anObject uid ].! ! !GBVersion methodsFor: 'accessing' stamp: 'lr 4/2/2005 13:59'! ancestors ^ancestors! ! !GBVersion methodsFor: 'accessing-dynamic' stamp: 'lr 4/2/2005 14:11'! author ^self info author.! ! !GBVersion methodsFor: 'accessing-dynamic' stamp: 'lr 4/13/2005 23:11'! deep ^Array streamContents: [ :stream | self dependencies do: [ :each | stream nextPut: each. stream nextPutAll: each deep ] ].! ! !GBVersion methodsFor: 'accessing' stamp: 'lr 4/2/2005 15:11'! dependencies ^dependencies! ! !GBVersion methodsFor: 'comparing' stamp: 'lr 4/2/2005 13:48'! hash ^self uid hash.! ! !GBVersion methodsFor: 'accessing' stamp: 'lr 4/2/2005 13:45'! info ^info! ! !GBVersion methodsFor: 'accessing-dynamic' stamp: 'lr 6/29/2005 12:01'! label ^String streamContents: [ :stream | stream nextPutAll: self package; nextPut: $|. stream nextPutAll: self author; nextPut: $|. stream nextPutAll: self number asString ].! ! !GBVersion methodsFor: 'accessing-dynamic' stamp: 'lr 5/17/2005 09:12'! number | number | number := self info name copyAfterLast: $.. ^ (number notEmpty and: [ number isAllDigits ]) ifTrue: [ number asNumber ] ifFalse: [ 0 ].! ! !GBVersion methodsFor: 'accessing-dynamic' stamp: 'lr 4/2/2005 14:11'! package ^self info name copyUpToLast: $-! ! !GBVersion methodsFor: 'printing' stamp: 'lr 4/2/2005 14:13'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' ['; nextPutAll: self info name; nextPutAll: ']'! ! !GBVersion methodsFor: 'initialization' stamp: 'lr 4/2/2005 13:59'! setAncestors: aSet ancestors := aSet! ! !GBVersion methodsFor: 'initialization' stamp: 'lr 4/2/2005 15:11'! setDependencies: aSet dependencies := aSet! ! !GBVersion methodsFor: 'initialization' stamp: 'lr 4/2/2005 15:17'! setInfo: aVersionInfo info := aVersionInfo. uid := aVersionInfo id asString36.! ! !GBVersion methodsFor: 'initialization' stamp: 'lr 4/2/2005 15:17'! setVersion: aVersion version := aVersion. self setInfo: aVersion info.! ! !GBVersion methodsFor: 'accessing' stamp: 'lr 4/2/2005 13:48'! uid ^uid! ! !GBVersion methodsFor: 'accessing' stamp: 'lr 4/2/2005 15:15'! version ^version! ! !Collection methodsFor: '*graphbuilder' stamp: 'lr 4/13/2005 22:51'! do: aBlock displayingProgress: aString | index | index := 1. aString displayProgressAt: Sensor cursorPoint from: 0 to: self size during: [ :bar | self do: [ :each | bar value: (index := index + 1). aBlock value: each ] ].! ! GBFlowEntry initialize!