Tomsovi

  • Zvětšit velikost písma
  • Výchozí velikost písma
  • Zmenšit velikost písma
Domů Honza Škola 5. ročník Diplomová práce - Automatizované modelování - E Podpůrné třídy metamodelu UML

Diplomová práce - Automatizované modelování - E Podpůrné třídy metamodelu UML

Email Tisk PDF
seznam článků
Diplomová práce - Automatizované modelování
Obsah
1 Úvod
1.2 Typografické konvence
Tabulka 1: Slovník zkratek
2 Cíl práce
3 Metodika
4 Přehled vlastností modelovacích nástrojů
4.1 Úloha modelování v běžném životě
4.1 Úloha modelování v běžném životě - pokračování
4.1.1 Vhodnost použití objektových nástrojů pro modelování a transformace
4.2 Architektura řízená modelem - Model Driven Architecture
4.2.1 The Object Management Group
4.2.2 Základní cíle a přístupy MDA
4.2.3 Platforma
4.2.4 Hierarchie modelů dle MDA
4.2.5 Model nezávislý na počítačovém zpracování
4.2.6 Model nezávislý na platformě
4.2.7 Mapování a značkování
4.2.8 Model specifický ke konkrétní platformě
4.2.9 Zdrojový kód aplikace
4.3 MDA a Oracle Designer
4.4 Vlastní zkušenost
4.5 Vlastnosti modelovacích nástrojů
4.6 Craft.CASE
4.7 Eclipse Modeling Framework
4.8 Omondo EclipseUML2
4.9 Enterprise Architect
5 Transformační modelovací jazyky
5.2 Eclipse Modelling Framework
5.4 XSLT
Část II - Projekt
6 Vlastní projekt
7 Požadavky na informační systém
8 Analýza
8.1 Model případů užití
8.2 Doménový objektový model
9 Design informačního systému
10 Aplikace Architektury řízené modelem (MDA)
11 Vývoj generátoru
12 Generování kódu z modelu
13 Závěr
Literatura
Přílohy
A Případy užití
A.1 Hlavní případy užití
A.2 Správa skupin parametrů
A.3 Správa parametrů
A.4 Správa modelů
B Sada šablon EA pro generování kódu v jazyku Smalltalk
C Vygenerované zdrojové kódy FSM v jazyku Smalltalk
D UML profil systému DecisionMaker
E Podpůrné třídy metamodelu UML
F Generátor entit aplikace DecisionMaker
G Zdrojový kód aplikace DecisionMaker
Všechny strany

E Podpůrné třídy metamodelu UML


Obrázek 34: Metamodel UML
Obrázek 34: Metamodel UML

E.1 Zdrojový kód podpůrných tříd metamodelu UML

Object subclass: #UMLAssociationEnd
   instanceVariableNames: 'element role cardinality association'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:49'
asString
   ^'<<<', (self element elementName ) asString, '>>>'
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 14:21'
association
   ^ association
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 14:21'
association: anObject
   association := anObject
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
cardinality
   ^ cardinality
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
cardinality: anObject
   cardinality := anObject
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
element
   ^ element
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
element: anObject
   element := anObject
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:49'
printOn: aStream
   aStream nextPutAll: self asString.
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
role
   ^ role
UMLAssociationEnd methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
role: anObject
   role := anObject

Object subclass: #UMLAssociationTypeEnum
   instanceVariableNames: 'type'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 17:43'
= anUMLAssocitaionTypeEnum
   ^(anUMLAssocitaionTypeEnum respondsTo: #type)
      ifTrue: [(self type) = (anUMLAssocitaionTypeEnum type)]
      ifFalse: [false].
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:54'
isAssociation
   ^ (type = #Association)
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:55'
isDependency
   ^ (type = #Dependency)
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:55'
isGeneralization
   ^ (type = #Generalization)
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:56'
printOn: aStream
   aStream nextPutAll: type asString .
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:50'
type
   ^ type
UMLAssociationTypeEnum methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 13:50'
type: aSymbol
   type := aSymbol

UMLAssociationTypeEnum class
   instanceVariableNames: ''
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 16:42'
Aggregation
   ^self new: #Aggregation
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 13:53'
Association
   ^self new: #Association
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 16:43'
Composition
   ^self new: #Composition
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 13:53'
Dependency
   ^self new: #Dependency
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 13:52'
Generalization
   ^self new: #Generalization
UMLAssociationTypeEnum class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 17:26'
new: aSymbol
   ^self new
      type: aSymbol;
      yourself.

Object subclass: #UMLClassCompiler
   instanceVariableNames: 'umlClass'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 22:44'
createClassInSmalltalk
   | general umlClassName instVars |
   general := umlClass superType.
   general ifNil: [general := 'Object'].
   umlClassName := umlClass elementName.
   self assert: [umlClassName notNil].
   instVars := (umlClass attributes select: 
            [ :a | (a isStatic not) &amp; (a elementName notNil) ])
               inject: '' into: [ :a :b | a, ' ', b elementName].
   Compiler evaluate: 
   general,' subclass: #',umlClassName,'
   instanceVariableNames: ''',instVars,'''
   classVariableNames: ''''
   poolDictionaries: ''''
   category: ''',(umlClassName copyFrom: 1 to: 2),'-generated'''.
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 10:58'
createClassMethodsInSmalltalk
   | classMethods umlClassName |
   umlClassName := umlClass elementName.
   self assert: [umlClassName notNil].
   classMethods := umlClass operations
      select: [ :o | (o isStatic) &amp; (o elementName notNil) ].
   classMethods do: [ :o |
      self createMethodInSmalltalk: o ofUMLClasNamed: umlClassName,' class'
   ]
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 05:24'
createInSmalltalk
   self createClassInSmalltalk.
   self declareClassVarsInSmalltalk.
   self createClassMethodsInSmalltalk.
   self createInstMethodsInSmalltalk.
   "self class compileAll."
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 10:58'
createInstMethodsInSmalltalk
   | instMethods umlClassName |
   umlClassName := umlClass elementName.
   self assert: [umlClassName notNil].
   instMethods := umlClass operations
      select: [ :o | (o isStatic not) &amp; (o elementName notNil) ].
   instMethods do: [ :o |
      self createMethodInSmalltalk: o ofUMLClasNamed: umlClassName
   ]
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 21:49'
createMethodInSmalltalk: anUMLOperation ofUMLClasNamed: anUMLClassName
   | signature body params selectorParts operationName bodyWithDoubledApostrophes |
   operationName := anUMLOperation elementName.
   params := anUMLOperation parameters.
   (params size = 0)
      ifTrue: [
         signature := operationName.
      ]
      ifFalse: [
         (params size = 1)
            ifTrue: [
               signature := operationName,
                           ((operationName last isLetter) ifTrue: [': ']
                           ifFalse: [' ']),
                           (params first elementName)
            ]
            ifFalse: [ 
            "methods with more parameters must have the parts of selectors delimited by _"
                  signature := ''.
                  selectorParts := anUMLOperation elementName findTokens: '_'.
                  selectorParts doWithIndex: [ :sel :idx |
                     signature := signature, sel,': ',((params at: idx) elementName),' '
                  ]
            ]
      ].
   body := anUMLOperation behavior.
   body ifNil: [ body := 'Transcript cr.' ].
   bodyWithDoubledApostrophes :=
    (body inject: '' 
      into: [ :a :b | 
         a, 
         ((b = $')
         ifTrue: [ '''''' ]
         ifFalse: [ b asString ])
      ]).
   "here comes the magic"
   Compiler evaluate: 
      anUMLClassName,' compile: ''',signature,'
                               ',bodyWithDoubledApostrophes,'''
                              .'.
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 05:47'
declareClassVarsInSmalltalk
   | classVars umlClassName |
   classVars := umlClass attributes select: [ :a | 
                                              (a isStatic) & (a elementName notNil) 
                                            ].
   umlClassName := umlClass elementName.
   self assert: [umlClassName notNil].
   classVars do: [ :cv |
      Compiler evaluate: 
         (umlClassName,' class addInstVarName: ''',cv elementName, '''' ).
   ]
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 04:58'
umlClass
   ^ umlClass
UMLClassCompiler methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 04:58'
umlClass: anObject
   umlClass := anObject

UMLClassCompiler class
   instanceVariableNames: ''
UMLClassCompiler class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 04:58'
new: anUMLClass
   | me |
   me := self new.
   me umlClass: anUMLClass.
   ^me.

Object subclass: #UMLElement
   instanceVariableNames: 'elementName description taggedValues stereotypes associations id alias'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 14:14'
addAssociationEnd: anObject
   associations add: anObject
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 04:42'
addStereotype: anObject
   stereotypes add: anObject
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 04:43'
addTaggedValue: anObject
   taggedValues add: anObject
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 22:12'
addTaggedValues: anArray
   anArray do: [ :t | self addTaggedValue: t ]
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 22:22'
asString 
   ^ self elementName ifNil: [ '(unnamed)' ]
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 18:01'
associatedElements
   ^self associatedElementsWithBlock: [ :ass | true ] 
         and: [ :end | true ].
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 17:46'
associatedElementsWithBlock: aBlock
   ^associations 
      ifNotNil: [
         ((((associations select: aBlock) 
            inject: ( Set new )
            into: [ :a :b | a, (b ends) ]
           ) collect: [ :asEnd | asEnd element ]
          ) asSet
         ) select: [ :el | el ~= self ]
      ]
      ifNil: [ nil ].
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 17:51'
associatedElementsWithBlock: aBlock and: anotherBlock
   ^associations 
      ifNotNil: [
         (((((associations select: aBlock) 
            inject: ( Set new )
            into: [ :a :b | a, (b ends) ]
            ) select: anotherBlock 
           ) collect: [ :asEnd | asEnd element ]
          ) asSet
         ) select: [ :el | el ~= self ]
      ]
      ifNil: [ nil ].
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 17:49'
associatedElementsWithType: anAssocitationType
   ^self associatedElementsWithBlock: [ :a | a associationType = anAssocitationType].
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 16:39'
initialize
   elementName := 'unnamed element'.
   stereotypes := OrderedCollection new.
   taggedValues := OrderedCollection new.
   associations := OrderedCollection new.
UMLElement methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 15:03'
printOn: aStream
   aStream nextPutAll: self asString.
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 21:58'
alias
   ^ alias
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 21:58'
alias: aString
   alias := aString 
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:15'
associations
   ^ associations ifNil: [ associations := OrderedCollection new. ]
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 14:12'
associations: anObject
   associations := anObject
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:13'
description
   ^ description
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:13'
description: anObject
   description := anObject
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:36'
elementName
   ^elementName
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:36'
elementName: aName
   elementName := aName
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:50'
hasStereotypeNamed: aName
   ^(self stereotypes select: [ :s | s elementName = aName ]) size > 0.
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:22'
id
   ^ id
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:22'
id: aString
   id := aString 
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:47'
stereotypeNames
   ^self stereotypes collect: [ :s | s elementName ].
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:38'
stereotypes
   ^ stereotypes
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:38'
stereotypes: anObject
   stereotypes := anObject
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:45'
taggedValueAt: aName
   ^ self taggedValuesDict at: aName ifAbsent: nil.
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:52'
taggedValueAt: aName ifAbsent: anAlternative
   ^ self taggedValuesDict at: aName ifAbsent: anAlternative.
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:38'
taggedValues
   ^ taggedValues
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:38'
taggedValues: anObject
   taggedValues := anObject
UMLElement methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:44'
taggedValuesDict
   | dict |
   dict := Dictionary new.
   self taggedValues do: [ :t | dict add: (t elementName)->(t taggedValue) ].
   ^dict.

UMLElement class
   instanceVariableNames: ''
UMLElement class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 22:40'
new: aName
   | newInstance |
   newInstance := self new.
   newInstance elementName: aName.
   ^newInstance.
 

UMLElement subclass: #UMLAssociation
   instanceVariableNames: 'associationType ends'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:21'
addEnd: anAssociationEnd
   ends add: anAssociationEnd.
   anAssociationEnd association: self.
   (anAssociationEnd element associations) add: self.
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 17:19'
associationType
   ^ associationType
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 17:19'
associationType: anObject
   associationType := anObject
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
ends
   ^ ends
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:08'
ends: anObject
   ends := anObject
UMLAssociation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:35'
initialize 
   super initialize.
   ends := OrderedCollection new.

UMLAssociation class
   instanceVariableNames: ''
UMLAssociation class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 17:20'
new: anAssociationType
   ^self new
      associationType: anAssociationType;
      yourself.

UMLElement subclass: #UMLAttribute
   instanceVariableNames: 'type initialValue scope isStatic'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:50'
initialValue
   ^ initialValue
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:50'
initialValue: anObject
   initialValue := anObject
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 02:15'
initialize
   super initialize.
   isStatic := false.
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 23:23'
isStatic 
   ^ isStatic 
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 23:23'
isStatic: aBoolean
   isStatic := aBoolean 
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:57'
scope
   ^ scope
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:57'
scope: anObject
   scope := anObject
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:01'
type
   ^ type
UMLAttribute methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:01'
type: anObject
   type := anObject
UMLAttribute methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 03:46'
asString 
   ^ 
      ( isStatic ifNotNil: [ isStatic ifTrue: [ 'static ' ] ifFalse: [''] ]
                ifNil: [''] ),
      ( scope ifNotNil: [ scope asString, ' ' ] ifNil: [''] ),
      super asString,
      ( type ifNotNil: [ ' : ', type asString ] ifNil: [''] ),
      (self stereotypes inject: '' into: [ :s1 :s2 | s1 asString, ' ', s2 asString ])

UMLElement subclass: #UMLClass
   instanceVariableNames: 'attributes operations package forcedGeneral'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:45'
addAttribute: anObject
   attributes add: anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 20:40'
addAttributes: anArray
   anArray do: [ :a | self addAttribute: a ].
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:45'
addOperation: anObject
   operations add: anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 20:41'
addOperations: anArray
   anArray do: [ :o | self addOperation: o ]
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 22:47'
asString
   ^'Class: ', super asString,
      (self stereotypes inject: '' into: [ :s1 :s2 | s1 asString, ' ', s2 asString ]),  
    (Character cr asString),
    (attributes 
      ifNotEmpty: [
         '+-attributes: ', (Character cr asString),
         (attributes 
         inject: ''
         into: [ :a :b | a asString, '  ' ,b asString, (Character cr asString) ])
      ]
      ifEmpty: ['']
    ),
    (operations 
      ifNotEmpty: [
          '+-operations: ', (Character cr asString),
         (operations 
         inject: ''
         into: [ :a :b | a asString,'  ' ,b asString, (Character cr asString) ])
      ]
      ifEmpty: ['']
    ), (Character cr asString)
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:44'
attributes
   ^ attributes
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:44'
attributes: anObject
   attributes := anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 03:23'
forcedGeneral
   ^ forcedGeneral
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 03:23'
forcedGeneral: anObject
   forcedGeneral := anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:36'
initialize 
   super initialize.
   attributes := OrderedCollection new.
   operations := OrderedCollection new.
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 22:47'
linkedAttributes
   ^associations 
      ifNotNil: [
         ((associations select: 
               [ :as | 
                  (as associationType = UMLAssociationTypeEnum Association) 
                  or: [as associationType = UMLAssociationTypeEnum Aggregation]
               ]
            ) 
            inject: ( Set new )
            into: [ :a :b | a, (b ends select: [ :end | end element ~= self ]) ]
         ) collect: [ :asEnd | 
               ((UMLAttribute new: (asEnd role))
                  type: 
                     (asEnd element elementName), 
                     ((asEnd cardinality = '0..*') 
                        ifTrue: ['[]']
                        ifFalse: ['']
                     )
                  ;
                  yourself
               )
            ]
      ]
      ifNil: [ nil ].
 
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:44'
operations
   ^ operations
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:44'
operations: anObject
   operations := anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:46'
package
   ^ package
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 04:46'
package: anObject
   package := anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 15:13'
removeOperation: anObject
   operations remove: anObject
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 17:55'
subTypes
   ^ self associatedElementsWithBlock: 
      [ :as | as associationType = UMLAssociationTypeEnum Generalization]
      and:
      [ :end | end role = 'subType']
UMLClass methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 03:25'
superType
   | generals |
   forcedGeneral 
      ifNotNil: [ ^forcedGeneral ]
      ifNil: [
         generals := (self associatedElementsWithBlock: 
            [ :as | as associationType = UMLAssociationTypeEnum Generalization]
            and:
            [ :end | end role = 'superType']).
         ^generals 
            ifNotEmpty: [ generals first]
             ifEmpty: [ nil ].
      ].

UMLElement subclass: #UMLOperation
   instanceVariableNames: 'parameters type isStatic behavior'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
behavior
   ^ behavior
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
behavior: anObject
   behavior := anObject
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
isStatic
   ^ isStatic
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
isStatic: anObject
   isStatic := anObject
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:33'
parameters
   ^ parameters
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:33'
parameters: anObject
   parameters := anObject
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
type
   ^ type
UMLOperation methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:22'
type: anObject
   type := anObject
UMLOperation methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 05:33'
addParameter: anObject
   parameters add: anObject
UMLOperation methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 00:41'
addParameters: anArray
   anArray do: [ :p | parameters add: p ]
UMLOperation methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 03:44'
asString 
   | params |
   params := parameters 
      ifNotEmpty: 
         [   '(',
            (parameters inject: '' 
                     into: [ :a :b | 
                             a asString, (a
                                             ifNotEmpty: [','] 
                                             ifEmpty: ['']), b asString 
                           ]) asString,
            ')'
         ]
      ifEmpty: [''].
   ^ 
      ( isStatic ifNotNil: [ isStatic ifTrue: [ 'static ' ] ifFalse: [''] ]
                ifNil: [''] ),
      super asString,
      params,
      ( (type notNil &amp; (type = 'void') not) 
         ifTrue: [ ' : ', type asString ] 
         ifFalse: [''] )
UMLOperation methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 02:15'
initialize 
   super initialize.
   parameters := OrderedCollection new.
   isStatic := false.

UMLElement subclass: #UMLPackage
   instanceVariableNames: 'elements'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLPackage methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 20:38'
addClass: aUMLClass
   elements add: aUMLClass.
   aUMLClass package: self.
UMLPackage methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 20:39'
addClasses: anArray
   anArray do: [ :c | self addClass: c ].
UMLPackage methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 16:36'
initialize 
   super initialize.
   elements := OrderedCollection new.
UMLPackage methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 04:49'
removeClass: aUMLClass
   classes remove: aUMLClass.
   aUMLClass package: nil.

UMLElement subclass: #UMLParameter
   instanceVariableNames: 'type kind'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLParameter methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 03:41'
asString 
   ^ 
      super asString,
      ( kind ifNotNil: [ kind = 'out' ifTrue: ['*'] ifFalse: [''] ] ifNil: [''] ),
      ( type ifNotNil: [ ' : ', type asString ] ifNil: [''] )
UMLParameter methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:31'
kind
   ^ kind
UMLParameter methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:31'
kind: anObject
   kind := anObject
UMLParameter methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:31'
type
   ^ type
UMLParameter methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 05:31'
type: anObject
   type := anObject

UMLElement subclass: #UMLStereotype
   instanceVariableNames: ''
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLStereotype methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 22:46'
asString 
   ^ '<<', elementName, '>>'

UMLElement subclass: #UMLTaggedValue
   instanceVariableNames: 'taggedValue'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
UMLTaggedValue methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:37'
taggedValue
   ^ taggedValue
UMLTaggedValue methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 16:37'
taggedValue: anObject
   taggedValue := anObject

Object subclass: #UMLWorld
   instanceVariableNames: 'elements'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'

UMLWorld class
   instanceVariableNames: ''
UMLWorld class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 18:25'
findAllByName: aName
"finds all elements of given name"
   ^UMLElement allSubInstances select: [ :i | (i elementName) = aName ]
UMLWorld class methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/3/2010 04:33'
findByName: aName
"finds first element of given name"
   ^(self findAllByName: aName) first

Object subclass: #XMIUMLBuilder
   instanceVariableNames: 'xmi umlModel xmiExtension packages classes stereotypes'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'XMI-2-UML'
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/4/2010 22:20'
buildAssociation: anAssociationDefinition
   | umlAssociation sourceEnd targetEnd extAttElement |
   Transcript 
      show: 'Association: '; 
      show: (anAssociationDefinition attributeAt: 'name');
      cr.
   umlAssociation := UMLAssociation new: 
      (anAssociationDefinition attributeAt: 'name' ifAbsent: '(unnamed association)').
   umlAssociation id: (anAssociationDefinition attributes at: 'xmi:id').
   "============= build association ends =========="
   sourceEnd := UMLAssociationEnd new.
   targetEnd := UMLAssociationEnd new.
   extAttElement := xmiExtension firstTagNamed: 'connector'
         with: [ :tag | (tag attributeAt: #'xmi:idref') = umlAssociation id ].
   "TODO"
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/4/2010 22:43'
buildAttribute: anAttribute
   | umlAttribute extAttElement defValTag |
   Transcript 
      show: 'Attribute: '; 
      show: (anAttribute attributeAt: 'name');
      cr.
   umlAttribute := UMLAttribute new: (anAttribute attributeAt: 'name').
   umlAttribute id: (anAttribute attributes at: 'xmi:id').
   defValTag := (anAttribute firstTagNamed: 'defaultValue').
   defValTag ifNotNil: [
      umlAttribute initialValue: (defValTag attributeAt: #value).
   ].
   "--- hunt for type and other props ---"
   extAttElement := xmiExtension firstTagNamed: 'attribute'
         with: [ :tag | (tag attributeAt: #'xmi:idref') = umlAttribute id ].
   extAttElement ifNotNil: [
      umlAttribute scope: (extAttElement attributeAt: #scope).
      extAttElement elements do: [ :el |
         (el name = #documentation)
             ifTrue: [ umlAttribute description: (el attributeAt: #value) ].
         (el name = #properties)
             ifTrue: [ umlAttribute type: (el attributeAt: #type)].      
         (el name = #stereotype)
             ifTrue: [ umlAttribute 
                          addStereotype: (self buildStereotype: (el attributeAt: #stereotype)) 
                     ].
         (el name = #style)
             ifTrue: [ umlAttribute alias: (el attributeAt: #value) ].
         (el name = #tags) 
             ifTrue: [ 
                umlAttribute addTaggedValues: 
                   (el elements collect: [ :elel | self buildTaggedValue: elel ]) 
                     ].
      ].
   ].
   ^umlAttribute.
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/4/2010 22:43'
buildClass: aClassDefinition
   | umlClass extClaElement |
   Transcript 
      show: 'Class: '; 
      show: (aClassDefinition  attributes at: 'name');
      cr.
   umlClass := UMLClass new: (aClassDefinition  attributes at: 'name').
   umlClass id: (aClassDefinition attributes at: 'xmi:id').
   classes add: umlClass.
   "=============== build attributes ============"
   umlClass addAttributes: 
      ((aClassDefinition 
         elements select: [ :el | el name = #ownedAttribute ])
         collect: [ :el | self buildAttribute: el ]).
   "============ build operations =========="
   umlClass addOperations: 
      ((aClassDefinition 
         elements select: [ :el | el name = #ownedOperation ])
         collect: [ :el | self buildOperation: el ]).
   "--- hunt for type and other props ---"
   extClaElement := xmiExtension firstTagNamed: 'element'
         with: [ :tag | (tag attributeAt: #'xmi:idref') = umlClass id ].
   extClaElement ifNotNil: [
      extClaElement elements do: [ :el |
         (el name = #properties) ifTrue: [ 
            umlClass addStereotype: (self buildStereotype: (el attributeAt: #stereotype)) 
         ].
         (el name = #style) ifTrue: [ umlClass alias: (el attributeAt: #value) ].
         (el name = #tags) ifTrue: [ 
            umlClass addTaggedValues: 
               (el elements collect: [ :elel | self buildTaggedValue: elel ]) 
         ].
      ].
   ].
   ^umlClass.
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/3/2010 20:58'
buildOperation: anOperation
   | umlOperation |
   Transcript 
      show: 'Operation: '; 
      show: (anOperation attributes at: 'name');
      cr.
   umlOperation := UMLOperation new: (anOperation attributes at: 'name').
   umlOperation id: (anOperation attributes at: 'xmi:id').
   ^umlOperation 
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/3/2010 20:46'
buildPackage: aPackageDefinition
   | umlPackage |
   Transcript 
      show: 'Package: '; 
      show: (aPackageDefinition  attributes at: 'name');
      cr.
   umlPackage := UMLPackage new: (aPackageDefinition  attributes at: 'name').
   umlPackage id: (aPackageDefinition  attributes at: 'xmi:id').
   packages add: umlPackage.
   "=============== build classes ============"
   umlPackage addClasses:
      ((aPackageDefinition 
         elements select: [ :el | (el attributes at: 'xmi:type') = 'uml:Class' ])
         collect: [ :el | self buildClass: el ]).
   "============ build associations =========="
   (aPackageDefinition 
      elements select: [ :el | (el attributes at: 'xmi:type') = 'uml:Association' ])
      do: [ :el | self buildAssociation: el ].
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/3/2010 22:07'
buildRootPackages
   | rootUMLPackages |
   packages := OrderedCollection new.
   classes := OrderedCollection new.
   stereotypes := OrderedCollection new.
   rootUMLPackages := (umlModel elements select: [ :el | el name = #packagedElement ]).
   rootUMLPackages do: [ :pkg | self buildPackage: pkg ].
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/3/2010 22:07'
buildStereotype: aName
   | existingStereotypes newStereotype |
   existingStereotypes := (stereotypes select: [ :s | s elementName = aName ]).
   existingStereotypes size = 0
      ifTrue: [
         newStereotype := UMLStereotype new: aName.
         stereotypes add: newStereotype.
         ^newStereotype.
      ]
      ifFalse: [^existingStereotypes first].
XMIUMLBuilder methodsFor: 'building' stamp: 'JanTomsa 4/3/2010 22:50'
buildTaggedValue: aTVDefinition
   | umlTaggedValue |
   Transcript 
      show: 'Tagged value: '; 
      show: (aTVDefinition attributeAt: #name);
      cr.
   umlTaggedValue := UMLTaggedValue new: 
         (aTVDefinition attributeAt: #name).
   umlTaggedValue id: (aTVDefinition attributeAt: #'xmi:id');
         taggedValue: (aTVDefinition attributeAt: #value).
   ^umlTaggedValue.
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
classes
   ^ classes
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
classes: anObject
   classes := anObject
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
packages
   ^ packages
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
packages: anObject
   packages := anObject
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 22:02'
stereotypes
   ^stereotypes
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 22:01'
stereotypes: anObject
   stereotypes := anObject
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
umlModel
   ^ umlModel
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
umlModel: anObject
   umlModel := anObject
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
xmi
   ^ xmi
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
xmi: anObject
   xmi := anObject
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
xmiExtension
   ^ xmiExtension
XMIUMLBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/3/2010 18:32'
xmiExtension: anObject
   xmiExtension := anObject
XMIUMLBuilder methodsFor: 'initialisation' stamp: 'JanTomsa 4/3/2010 18:32'
initFromFileNamed: fileName
   xmi := XMLDOMParser parseDocumentFrom: (FileStream oldFileNamed: fileName ).
 
   umlModel := (((xmi elements first) elements) 
      select: [ :el | el name = #'uml:Model' ] ) first.

   xmiExtension := (((xmi elements first) elements) 
      select: [ :el | el name = #'xmi:Extension' ] ) first.