2013-04-08 06:40:20 +00:00
"
(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 < h t t p : / / www . gnu . org / licenses /> .
"
STInST . RBProgramNodeVisitor subclass: M2UAStateMachineVisitor [
| states |
2013-05-14 15:18:17 +00:00
<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.'>
2013-04-08 06:40:20 +00:00
<category: 'OsmoNetwork-M2UA-States'>
acceptMessageNode: aNode [
aNode selector = #moveToState:
i f T r u e : [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 [
2013-06-17 13:15:35 +00:00
| machine |
2013-04-08 06:40:20 +00:00
<category: 'OsmoNetwork-M2UA-States'>
2013-05-14 15:18:17 +00:00
<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.'>
2013-04-08 06:40:20 +00:00
M2UAStateBase class >> addStateFrom: aMethod to: newState class: aClass on: aStream [
aStream
nextPutAll: aClass name asString ;
n e x t P u t A l l : ' -> ' ;
nextPutAll: newState ;
n e x t P u t A l l : ' [ label = "' ;
nextPutAll: aMethod asString allButLast ;
n e x t P u t A l l : '"];' ;
nl .
]
M2UAStateBase class >> generateGraphviz [
| stream |
stream := WriteStream on: String new .
stream
n e x t P u t A l l : '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
n e x t P u t A l l : '}' ;
contents
]
2013-06-17 13:15:35 +00:00
M2UAStateBase class >> on: aMachine [
"Create a new state for a machine"
^ self new
machine: aMachine ;
yourself
]
entered [
"The state has been entered"
]
left [
"The state has been left"
]
machine: aMachine [
machine := aMachine
]
moveToState: aNewState [
<category: 'transition'>
machine moveToState: aNewState
]
2013-04-08 06:40:20 +00:00
]
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
i f T r u e : [self moveToState: M2UAAsStateInactive ]
i f F a l s e : [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.'>
2013-06-17 13:15:35 +00:00
M2UAAspState class >> nextPossibleStates [
^ self subclassResponsibility
]
2013-04-08 06:40:20 +00:00
]
M2UAAspState subclass: M2UAAspStateActive [
<category: 'OsmoNetwork-M2UA-States'>
<comment: nil>
2013-06-17 13:15:35 +00:00
M2UAAspStateActive class >> nextPossibleStates [
^ {M2UAAspStateInactive . M2UAAspStateDown }
]
2013-04-08 06:40:20 +00:00
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>
2013-06-17 13:15:35 +00:00
M2UAAspStateDown class >> nextPossibleStates [
^ {M2UAAspStateInactive }
]
2013-04-08 06:40:20 +00:00
onAspUp: anEvent [
<category: 'state-changes'>
^ self moveToState: M2UAAspStateInactive
]
]
M2UAAspState subclass: M2UAAspStateInactive [
<category: 'OsmoNetwork-M2UA-States'>
<comment: nil>
2013-06-17 13:15:35 +00:00
M2UAAspStateInactive class >> nextPossibleStates [
^ {M2UAAspStateActive . M2UAAspStateDown }
]
2013-04-08 06:40:20 +00:00
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
]
]