257 lines
5.6 KiB
Smalltalk
257 lines
5.6 KiB
Smalltalk
"
|
||
(C) 2013 by Holger Hans Peter Freyther
|
||
All Rights Reserved
|
||
|
||
This program is free software: you can redistribute it and/or modify
|
||
it under the terms of the GNU Affero General Public License as
|
||
published by the Free Software Foundation, either version 3 of the
|
||
License, or (at your option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU Affero General Public License for more details.
|
||
|
||
You should have received a copy of the GNU Affero General Public License
|
||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
"
|
||
|
||
STInST.RBProgramNodeVisitor subclass: M2UAStateMachineVisitor [
|
||
| states |
|
||
|
||
<comment: 'I can read the compiled methods of a M2UA state machine and generate graphviz code about the state machine and transitions that occur in it. They can be rendered by invoking the dot program on the string.'>
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
|
||
acceptMessageNode: aNode [
|
||
aNode selector = #moveToState:
|
||
ifTrue: [self addTransition: aNode arguments first name asString].
|
||
super acceptMessageNode: aNode
|
||
]
|
||
|
||
addTransition: aStateName [
|
||
<category: 'states'>
|
||
self stateSet add: aStateName
|
||
]
|
||
|
||
stateSet [
|
||
<category: 'states'>
|
||
^states ifNil: [states := Set new]
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Object subclass: M2UAStateBase [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: 'I am the base class of all M2UA state machines. My direct subclasses are state machines and their subclasses are the individual states that make up the statemachine.'>
|
||
|
||
M2UAStateBase class >> addStateFrom: aMethod to: newState class: aClass on: aStream [
|
||
aStream
|
||
nextPutAll: aClass name asString;
|
||
nextPutAll: ' -> ';
|
||
nextPutAll: newState;
|
||
nextPutAll: ' [ label = "';
|
||
nextPutAll: aMethod asString allButLast;
|
||
nextPutAll: '"];';
|
||
nl.
|
||
]
|
||
|
||
M2UAStateBase class >> generateGraphviz [
|
||
| stream |
|
||
stream := WriteStream on: String new.
|
||
stream
|
||
nextPutAll: 'digraph {';
|
||
nl.
|
||
self subclassesDo:
|
||
[:class |
|
||
class selectors do: [:selector |
|
||
| codeVisitor method |
|
||
method := class >> selector.
|
||
codeVisitor := (STInST.RBBracketedMethodParser
|
||
parseMethod: method methodSourceString) body
|
||
acceptVisitor: M2UAStateMachineVisitor new.
|
||
codeVisitor stateSet do:
|
||
[:newState |
|
||
self
|
||
addStateFrom: method selector asString
|
||
to: newState
|
||
class: class
|
||
on: stream]]].
|
||
^stream
|
||
nextPutAll: '}';
|
||
contents
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAStateBase subclass: M2UAAsState [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
]
|
||
|
||
|
||
|
||
M2UAAsState subclass: M2UAAsStateInactive [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAllAspDown: anEvent [
|
||
"All ASP trans to ASP-DOWN"
|
||
|
||
<category: 'state-changes'>
|
||
self moveToState: M2UAAsStateDown
|
||
]
|
||
|
||
onAspActive: anEvent [
|
||
"one ASP trans to ACTIVE"
|
||
|
||
<category: 'state-changes'>
|
||
self moveToState: M2UAAsStateActive
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAAsState subclass: M2UAAsStatePending [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAspUp: anEvent [
|
||
"One ASP trans to ASP-ACTIVE"
|
||
|
||
<category: 'state-change'>
|
||
self stopTr.
|
||
self moveToState: M2UAAsStateActive
|
||
]
|
||
|
||
onTrExpiry [
|
||
"Tr Expiry, at least one ASP in ASP-INACTIVE -> AS-INACTIVE"
|
||
|
||
"Tr Expiry and no ASPin ASP-INACTIVE state"
|
||
|
||
<category: 'state-change'>
|
||
self hasInactiveAsp
|
||
ifTrue: [self moveToState: M2UAAsStateInactive]
|
||
ifFalse: [self moveToState: M2UAAsStateDown]
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAStateBase subclass: M2UAAspState [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: 'I am the base class of the ASP State Machine from RFC 3331 on Page 61.'>
|
||
]
|
||
|
||
|
||
|
||
M2UAAspState subclass: M2UAAspStateActive [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAspDown: anEvent [
|
||
<category: 'state-changes'>
|
||
self moveToState: M2UAAspStateDown
|
||
]
|
||
|
||
onAspInactive: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateInactive
|
||
]
|
||
|
||
onOtherAspInAsOverrides: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateInactive
|
||
]
|
||
|
||
onSctpCdi: anEvent [
|
||
<category: 'state-changes'>
|
||
self moveToState: M2UAAspStateDown
|
||
]
|
||
|
||
onSctpRi: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateDown
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAAspState subclass: M2UAAspStateDown [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAspUp: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateInactive
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAAspState subclass: M2UAAspStateInactive [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAspActive: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateActive
|
||
]
|
||
|
||
onAspDown: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateDown
|
||
]
|
||
|
||
onSctpCdi: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateDown
|
||
]
|
||
|
||
onSctpRi: anEvent [
|
||
<category: 'state-changes'>
|
||
^self moveToState: M2UAAspStateDown
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAAsState subclass: M2UAAsStateDown [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onAspInactive: anEvent [
|
||
"One ASP trans to ASP-INACTIVE"
|
||
|
||
<category: 'state-changes'>
|
||
self movesToState: M2UAAsStateInactive
|
||
]
|
||
]
|
||
|
||
|
||
|
||
M2UAAsState subclass: M2UAAsStateActive [
|
||
|
||
<category: 'OsmoNetwork-M2UA-States'>
|
||
<comment: nil>
|
||
|
||
onLastActiveAspDown: anEvent [
|
||
"Last ACTIVEASP trans to ASP-INACTIVE or ASP-Down"
|
||
|
||
<category: 'state-changes'>
|
||
self startTr.
|
||
self moveToState: M2UAAsStatePending
|
||
]
|
||
]
|
||
|