Page 54 of 55
F Generátor entit aplikace DecisionMaker
Object subclass: #DMEntityBuilder instanceVariableNames: 'umlBuilder' classVariableNames: '' poolDictionaries: '' category: 'DecisionMaker-EntityBuilder'
DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 17:41' entityClasses ^ umlBuilder classes select: [ :c | c hasStereotypeNamed: 'entity' ].
DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 22:05' umlBuilder umlBuilder ifNil: [ umlBuilder := XMIUMLBuilder new ]. ^ umlBuilder
DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 22:03' umlBuilder: anObject umlBuilder := anObject
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:43' CRUDClassName: anUMLClass withPrefix: aPrefix ^(aPrefix, anUMLClass elementName), 'CRUD'.
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/6/2010 00:12' buildCRUDClass: anUMLClass withPrefix: aPrefix | CRUDClass CR modelClassName editorClassName textsClassName | CR := Character cr asString. modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ). editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ). textsClassName := (self textsClassName: anUMLClass withPrefix: aPrefix ). CRUDClass := UMLClass new: (self CRUDClassName: anUMLClass withPrefix: aPrefix). CRUDClass forcedGeneral: 'WAComponent'. "==================== Attributes ==================" CRUDClass addAttribute: ( (UMLAttribute new: 'listComponent') type: 'WATableReport'; yourself ). "==================== Operations ==================" CRUDClass addOperation: ( (UMLOperation new: 'children') type: 'Array'; behavior: '^Array with: listComponent'; yourself ). "--------------------- CRUD ---------------------" CRUDClass addOperation: ( (UMLOperation new: 'add') type: 'void'; behavior: '| editor instance answer |', CR, 'instance := ', modelClassName, ' new.',CR, 'editor := ', editorClassName, ' on: instance.',CR, 'answer := self call: editor.',CR, 'answer ifTrue: [ ',modelClassName,' instances add: instance ]' yourself ). CRUDClass addOperation: ( (UMLOperation new: 'edit') type: 'void'; addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName ); behavior: '| editor |', CR, 'editor := ', editorClassName, ' on: anInstance.',CR, 'self call: editor.'; yourself ). CRUDClass addOperation: ( (UMLOperation new: 'delete') type: 'void'; addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName ); behavior: modelClassName, ' instances remove: anInstance.'; yourself ). "--------------------- columns ---------------------" ((anUMLClass attributes ) select: [ :a | (a stereotypes select: [ :as | as elementName = 'column' ] ) size = 1 ]) do: [ :a | CRUDClass addOperation: ((UMLOperation new: (a elementName, 'ReportColumn')) type: 'void'; behavior: '^WAReportColumn new',CR, ' title: (',textsClassName,' labelFor: #',a elementName,');',CR, ' selector: #',a elementName,';',CR, ' clickBlock: [ :each | self edit: each ];',CR, ' yourself .'; yourself ) ]. "------------------ action column ------------------" CRUDClass addOperation: ( (UMLOperation new: ('actionReportColumn')) type: 'void'; behavior: '^WAReportColumn new',CR, ' title: DMTexts ACTIONS;',CR, ' valueBlock: [ :anInstance :html |',CR, ' html anchor ',CR, ' onClick: (''return confirm('''''', DMTexts CONFIRMQUESTION, '''''')'');',CR, ' callback: [ self delete: anInstance ];',CR, ' with: DMTexts DELETE',CR, ' ];',CR, 'yourself .'; yourself ). "----------------- initialization ------------------" CRUDClass addOperation: ( (UMLOperation new: 'initialize') type: 'void'; behavior: '| columns |',CR, 'super initialize.',CR, 'columns := OrderedCollection new.',CR, (((CRUDClass operations collect: [ :o | o elementName ]) select: [ :o | o endsWith: 'ReportColumn' ]) inject: '' into: [ :x :y | x,' columns add: self ',y,'.',CR] ), 'listComponent := WATableReport new',CR, ' columns: columns;',CR, ' rowPeriod: 1;',CR, ' yourself.'; yourself ). "-------------------- rendering --------------------" CRUDClass addOperation: ( (UMLOperation new: 'renderContentOn') type: 'void'; addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' ); behavior: 'canvas heading with: (', textsClassName, ' labelFor: #Instances); level: 3.',CR, 'listComponent rows: ', modelClassName, ' instances asSortedCollection.',CR, 'canvas render: listComponent.',CR, 'canvas anchor callback: [ self add ]; with: DMTexts NEW.'; yourself ). ^CRUDClass
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 18:22' buildEditorClass: anUMLClass withPrefix: aPrefix | editorClass CR modelClassName editorClassName textsClassName editorType | CR := Character cr asString. modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ). editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ). textsClassName := (self textsClassName: anUMLClass withPrefix: aPrefix ). editorClass := UMLClass new: editorClassName. editorClass forcedGeneral: 'WAComponent'. "==================== Attributes ==================" editorClass addAttribute: ( (UMLAttribute new: 'model') type: modelClassName; yourself ). "==================== Operations ==================" "--------------------- columns ---------------------" ((anUMLClass attributes ) select: [ :a | (a stereotypes select: [ :as | as elementName = 'column' ] ) size = 1 ]) do: [ :a | editorType := a taggedValueAt: 'editor' ifAbsent: 'textInput'. editorClass addOperation: ( (UMLOperation new: 'render',(a elementName) capitalized,'On') type: 'void'; addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' ); behavior: '| tagID |',CR, 'canvas div: [',CR, ' canvas label',CR, ' for: (tagID := canvas nextId);',CR, ' with: (',textsClassName,' labelFor: #',a elementName,').',CR, (self editorSourceCode: (a elementName) editorType: editorType), '].'; yourself ) ]. "----------------- initialization ------------------" editorClass addOperation: ( (UMLOperation new: 'initialize') type: 'void'; addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName ); behavior: 'self initialize.',CR, 'model := anInstance.'; yourself ). "-------------------- rendering --------------------" editorClass addOperation: ( (UMLOperation new: 'renderButtonsOn') type: 'void'; addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' ); behavior: 'canvas div: [',CR, ' canvas span: [',CR, ' canvas cancelButton callback: [self answer: false];',CR, ' with: DMTexts CANCEL.',CR, ' ].',CR, ' canvas span: [',CR, ' canvas submitButton callback: [self answer: true];',CR, ' with: DMTexts SAVE.',CR, ' ].',CR, '].'; yourself ). editorClass addOperation: ( (UMLOperation new: 'renderContentOn') type: 'void'; addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' ); behavior: 'canvas form',CR, ' class: ''dmEditor'';',CR, ' with: [',CR, ' self',CR, (((editorClass operations collect: [ :o | o elementName ]) select: [ :o | o beginsWith: 'render' ]) inject: '' into: [ :x :y | x,' ',y,': canvas;',CR] ), ' yourself.',CR, '].'; yourself ). "-------------------- constructor --------------------" editorClass addOperation: ( (UMLOperation new: 'on') type: modelClassName; isStatic: true; addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName ); behavior: '^self basicNew',CR, ' initialize: anInstance;',CR, ' yourself.'; yourself ). ^editorClass
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 22:02' buildModelClass: anUMLClass withPrefix: aPrefix | modelClass | modelClass := UMLClass new: (self modelClassName: anUMLClass withPrefix: aPrefix). "==================== Attributes ==================" anUMLClass attributes do: [ :att | modelClass addAttribute: ( (UMLAttribute new: (att elementName)) description: att description; id: att id; alias: att alias; initialValue: att initialValue; scope: att scope; type: att type; yourself ). ]. "-------------------- accessors -------------------" anUMLClass attributes do: [ :att | att elementName ifNotNil: [ "---- getter ----" modelClass addOperation: ( (UMLOperation new: (att elementName)) type: att type; behavior: '^',att elementName ; yourself ). "---- setter ----" modelClass addOperation: ( (UMLOperation new: (att elementName)) type: 'void'; addParameter: ((UMLParameter new: 'anObject') type: att type); behavior: att elementName,' := anObject'; yourself ) ] ]. "==================== Operations ==================" anUMLClass operations do: [ :op | modelClass addOperation: ( (UMLOperation new: (op elementName)) description: op description; id: op id; alias: op alias; type: op type; isStatic: op isStatic; behavior: op behavior; addParameters: ( op parameters collect: [ :p | (UMLParameter new: p elementName) type: p type; kind: p kind; yourself ] ); yourself ) ]. modelClass addAttribute: ( (UMLAttribute new: 'instances') isStatic: true; type: anUMLClass elementName,'[]'; scope: 'Private'; yourself ). modelClass addOperation: ( (UMLOperation new: 'instances') isStatic: true; type: anUMLClass elementName,'[]'; behavior: 'instances ifNil: [ instances := IdentitySet new ]. ^instances'); yourself. "-------------------- comparator -------------------" modelClass addOperation: ( (UMLOperation new: '<=') type: 'Boolean'; addParameter: ((UMLParameter new: 'anObject') type: modelClass elementName); behavior: '^self ',(anUMLClass attributes first elementName), '<= anObject ', (anUMLClass attributes first elementName)); yourself. ^modelClass
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 18:53' buildTextsClass: anUMLClass withPrefix: aPrefix | textsClass CR modelClassName editorClassName textsClassName instanceCZ instanceEN instancesCZ instancesEN | CR := Character cr asString. modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ). editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ). textsClassName := (self textsClassName: anUMLClass withPrefix: aPrefix ). textsClass := UMLClass new: textsClassName. "==================== Attributes ==================" textsClass addAttribute: ( (UMLAttribute new: 'labels') type: 'Dictionary'; isStatic: true; yourself ). "==================== Operations ==================" textsClass addOperation: ( (UMLOperation new: 'labelFor') type: 'String'; isStatic: true; addParameter: ( (UMLParameter new: 'aSymbol') type: 'Symbol' ); behavior: '^self labelFor: aSymbol inLanguage: (DMTexts defaultLanguage).'; yourself ). textsClass addOperation: ( (UMLOperation new: 'labelFor_inLanguage') type: 'String'; isStatic: true; addParameter: ( (UMLParameter new: 'aSymbol') type: 'Symbol' ); addParameter: ( (UMLParameter new: 'language') type: 'Symbol' ); behavior: '^(self labels at: language) at: aSymbol.'; yourself ). instanceCZ := anUMLClass taggedValueAt: 'label_cz_singular' ifAbsent: (anUMLClass class name asString). instancesCZ := anUMLClass taggedValueAt: 'label_cz_plural' ifAbsent: (anUMLClass class name asString),'s'. instanceEN := anUMLClass taggedValueAt: 'label_en_singular' ifAbsent: (anUMLClass class name asString). instancesEN := anUMLClass taggedValueAt: 'label_en_plural' ifAbsent: (anUMLClass class name asString),'s'. textsClass addOperation: ( (UMLOperation new: 'labels') type: 'Dictionary'; isStatic: true; behavior: '| labelsCzech labelsEnglish |',CR, 'labels ifNil: [',CR, ' labelsCzech := Dictionary new.',CR, ' labelsEnglish := Dictionary new.',CR, ' labelsCzech add: #Instance->''',instanceCZ,'''.',CR, ' labelsCzech add: #Instances->''',instancesCZ,'''.',CR, ' labelsEnglish add: #Instance->''',instanceEN,'''.',CR, ' labelsEnglish add: #Instances->''',instancesEN,'''.',CR, (((anUMLClass attributes ) select: [ :a | a hasStereotypeNamed: 'column' ]) inject: '' into: [ :a :b | a, 'labelsCzech add: #',b elementName,'->''', (b taggedValueAt: 'label_cz' ifAbsent: b elementName),'''.',CR, 'labelsEnglish add: #',b elementName,'->''', (b taggedValueAt: 'label_en' ifAbsent: b elementName),'''.',CR ] ), ' labels := Dictionary new.',CR, ' labels add: #czech->labelsCzech.',CR, ' labels add: #english->labelsEnglish.',CR, '].',CR, '^labels'; yourself ). ^textsClass
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:42' editorClassName: anUMLClass withPrefix: aPrefix ^(aPrefix, anUMLClass elementName), 'Editor'.
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 21:57' editorSourceCode: elementName editorType: editorType | CR sourceCode | CR := Character cr asString. (editorType ='textArea') ifTrue: [ sourceCode := ' canvas textArea',CR, ' id: tagID;',CR, ' value: model ',elementName,';',CR, ' callback: [ :value | model ',elementName,': value ]',CR. ] ifFalse: [ (editorType ='select') ifTrue: [ sourceCode := ' canvas select',CR, ' id: tagID;',CR, ' selected: model ',elementName,';',CR, ' list: model ',elementName,'List;',CR, ' callback: [ :value | model ',elementName,': value ].',CR. ] ifFalse: [ (editorType ='dateTimeSelector') ifTrue: [ sourceCode := ' canvas span',CR, ' id: tagID;',CR, ' with: [ canvas render: dateTimeSelector ].',CR. ] ifFalse: [ sourceCode := ' canvas textInput',CR, ' value: model ',elementName,';',CR, ' callback: [:value | model ',elementName,': value]',CR. ] ] ]. ^sourceCode.
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:40' modelClassName: anUMLClass withPrefix: aPrefix ^(aPrefix, anUMLClass elementName).
DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:43' textsClassName: anUMLClass withPrefix: aPrefix ^(aPrefix, anUMLClass elementName), 'Texts'.
DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 22:08' initFromFileNamed: aFileName self umlBuilder initFromFileNamed: aFileName. self umlBuilder buildRootPackages.
DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 23:01' transformClass: anUMLClass withPrefix: aPrefix | xformedClasses | xformedClasses := Dictionary new. xformedClasses add: #model->(self buildModelClass: anUMLClass withPrefix: aPrefix). xformedClasses add: #CRUD->(self buildCRUDClass: anUMLClass withPrefix: aPrefix). xformedClasses add: #editor->(self buildEditorClass: anUMLClass withPrefix: aPrefix). xformedClasses add: #texts->(self buildTextsClass: anUMLClass withPrefix: aPrefix). ^xformedClasses.
DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 17:47' transformEntityClassesWithPrefix: aPrefix | xformedEntities | xformedEntities := Dictionary new. self entityClasses do: [ :ec | xformedEntities add: (ec elementName)->(self transformClass: ec withPrefix: aPrefix). ]. ^xformedEntities.
DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 17:53' transformEntityClassesWithPrefixPlain: aPrefix | xformedEntities plainList | xformedEntities := self transformEntityClassesWithPrefix: aPrefix. plainList := OrderedCollection new. xformedEntities do: [ :xe | xe do: [ :xed | plainList add: xed ] ]. ^plainList.