> On 16 Aug 2017, at 19:29, "[email protected]" <[email protected]> 
> wrote:
> 
>> Am 16.08.17 um 18:08 schrieb Esteban Lorenzano:
>> but if he is using Glorp for Pharo and cincom takes the bug and fixes it, it 
>> still will not hit Pharo until someone ports it.
> 
> OTOH: if nobody at Cincom reads about it, chances are you do a complete fork 
> of Glorp for Pharo. Not sure I like that idea... And I am not sure anybody 
> here has enough insight into Glorp to tell whether the fix is good or not.
> 
> 
>> So, while I have literally no idea of what Herby
> You see: I am in the same boat and would have a hard time deciding whether 
> the fix is good or not ;-)
> 
>> is asking for, I encourage to keep discussion also here, then solution can 
>> hit both platforms.
> 
> No complains about having the discussion on both groups in parallel ;-) I 
> just don't like the idea of private fixes to Glorp on any of the 
> non-Cincom-platforms, be it Pharo or VA Smalltalk or any other (if there are 
> any).

I never asked for that :)

Esteban 

> 
> just my 2c
> 
> Joachim
> 
> 
>> 
>> Esteban
>> 
>>> On 16 Aug 2017, at 00:07, [email protected] wrote:
>>> 
>>> BTW I took the latter way (as method tries to be as optimized as
>>> possible), it is in
>>> http://smalltalkhub.com/#!/~herby/Glorp/versions/Glorp-HerbyVojcik.127,
>>> consider merging in. Thanks.
>>> 
>>> Herby Vojčík wrote:
>>>> Hello!
>>>> 
>>>> I think I found the culprit. Few methods posted here:
>>>> 
>>>> 
>>>> Mapping >> expressionFor: anObject basedOn: anExpression relation:
>>>> aSymbol
>>>> "Return our expression using the object's values. e.g. if this was a
>>>> direct mapping from id->ID and the object had id: 3, then return
>>>> TABLE.ID=3. Used when rewriting object=object into field=field"
>>>> 
>>>> | myValue result |
>>>> myValue := self expressionFor: anObject.
>>>> result := nil.
>>>> myValue with: self join allTargetFields do: [:eachValue :eachField |
>>>> | source |
>>>> source := anExpression get: self attribute name.
>>>> source hasDescriptor ifTrue: [source := source getField: eachField].
>>>> result := (source get: aSymbol withArguments: (Array with: eachValue))
>>>> AND: result].
>>>> ^result
>>>> 
>>>> 
>>>> 
>>>> DirectMapping >> expressionFor: anObject basedOn: anExpression relation:
>>>> aSymbol
>>>> "Return our expression using the object's values. e.g. if this was a
>>>> direct mapping from id->ID and the object had id: 3, then return
>>>> TABLE.ID=3"
>>>> 
>>>> | value |
>>>> value := anObject isNil
>>>> ifTrue: [nil]
>>>> ifFalse:
>>>> [anObject isGlorpExpression
>>>> ifTrue: [anObject getMapping: self named: self attributeName]
>>>> ifFalse: [anObject glorpIsCollection
>>>> ifTrue: [anObject collect: [:each | attribute getValueFrom: each]]
>>>> ifFalse: [attribute getValueFrom: anObject]]].
>>>> ^(anExpression get: self attribute name) get: aSymbol withArguments:
>>>> (Array with: value)
>>>> 
>>>> 
>>>> 
>>>> Mapping >> expressionFor: anObject
>>>> "Return an expression representing the value of the object. This can be
>>>> nil, an object value or values, an expression, or a collection of
>>>> expressions (for a composite key, if we're passed an expression)"
>>>> 
>>>> anObject isNil ifTrue: [^#(nil)].
>>>> anObject isGlorpExpression ifFalse: [
>>>> ^self mappedFields collect: [:each |
>>>> self valueOfField: each fromObject: anObject]].
>>>> ^self mappedFields
>>>> collect: [:each | (anObject getField: each)]
>>>> 
>>>> 
>>>> 
>>>> Mapping >> getValueFrom: anObject
>>>> 
>>>> ^self attribute getValueFrom: anObject
>>>> 
>>>> 
>>>> 
>>>> DirectMapping >> valueOfField: aField fromObject: anObject
>>>> field = aField ifFalse: [self error: 'Mapping doesn''t describe field'].
>>>> ^self convertedDbValueOf: (self getValueFrom: anObject)
>>>> 
>>>> 
>>>> 
>>>> DirectMapping >> mappedFields
>>>> "Return a collection of fields that this mapping will write into any of
>>>> the containing object's rows"
>>>> 
>>>> ^Array with: self field
>>>> 
>>>> 
>>>> The thing is, both Mapping >> expressionFor:basedOn:relation: and the
>>>> overridden DirectMapping's version eventually send
>>>> 
>>>> someSource get: aSymbol withArguments: (Array with: eachValue)
>>>> 
>>>> but in Mapping's code, the value is taken from `myValue := self
>>>> expressionFor: anObject`. which, as seen in #expressionFor: code, gets
>>>> the value via
>>>> 
>>>> self valueOfField: aMappedField fromObject: anObject
>>>> 
>>>> and indeed, if tried aDirectMapping expressionFor: anObject in debugger,
>>>> it gets the value of the primary key converted in the below case (that
>>>> is, as a ByteArray). This is clear from the DirectMapping >>
>>>> valueOfField:fromObject: code above, which does `self getValueFrom:
>>>> anObject` (which passes it to `attribute getValueFrom: anObject`)
>>>> _and_converts_it_.
>>>> 
>>>> But in the overridden DirectMapping >> expressionFor:basedOn:relation:,
>>>> the value to be passed in the
>>>> 
>>>> someSource get: aSymbol withArguments: (Array with: value)
>>>> 
>>>> is obtained by direct
>>>> 
>>>> attribute getValueFrom: anObject
>>>> 
>>>> but _is_not_converted_. IOW, it seems this method was heavily optimized
>>>> (`attribute getValueFrom:` instead of `self getValueFrom:`, for
>>>> example), but the conversion, normally present via expressionFor: and
>>>> ultimately valueOfField:fromObject: was optimized away as well.
>>>> 
>>>> 
>>>> 
>>>> 
>>>> Now, what is the correct way to fix the method (I hope you agree it is a
>>>> bug)?
>>>> 
>>>> 
>>>> This?
>>>> 
>>>> DirectMapping >> expressionFor: anObject basedOn: anExpression relation:
>>>> aSymbol
>>>> "Return our expression using the object's values. e.g. if this was a
>>>> direct mapping from id->ID and the object had id: 3, then return
>>>> TABLE.ID=3"
>>>> 
>>>> | value |
>>>> value := anObject isNil
>>>> ifTrue: [nil]
>>>> ifFalse:
>>>> [anObject isGlorpExpression
>>>> ifTrue: [anObject getMapping: self named: self attributeName]
>>>> ifFalse: [anObject glorpIsCollection
>>>> ifTrue: [anObject collect: [:each | self valueOfField: aField
>>>> fromObject: each]]
>>>> ifFalse: [self valueOfField: aField fromObject: anObject]]].
>>>> ^(anExpression get: self attribute name) get: aSymbol withArguments:
>>>> (Array with: value)
>>>> 
>>>> 
>>>> 
>>>> or this?
>>>> 
>>>> DirectMapping >> expressionFor: anObject basedOn: anExpression relation:
>>>> aSymbol
>>>> "Return our expression using the object's values. e.g. if this was a
>>>> direct mapping from id->ID and the object had id: 3, then return
>>>> TABLE.ID=3"
>>>> 
>>>> | value |
>>>> value := anObject isNil
>>>> ifTrue: [nil]
>>>> ifFalse:
>>>> [anObject isGlorpExpression
>>>> ifTrue: [anObject getMapping: self named: self attributeName]
>>>> ifFalse: [anObject glorpIsCollection
>>>> ifTrue: [anObject collect: [:each | self convertedDbValueOf: (attribute
>>>> getValueFrom: each)]]
>>>> ifFalse: [self convertedDbValueOf: (attribute getValueFrom: anObject)]]].
>>>> ^(anExpression get: self attribute name) get: aSymbol withArguments:
>>>> (Array with: value)
>>>> 
>>>> 
>>>> 
>>>> Or something completely different?
>>>> 
>>>> 
>>>> Thanks, Herby
>>>> 
>>>> Herby Vojčík wrote:
>>>>> Hello!
>>>>> 
>>>>> I encountered a problem with OneToOneMapping and type coercion. When
>>>>> writing data, thing work; when reading data, the right child of relation
>>>>> fails to convert.
>>>>> 
>>>>> I tried everything possible to inject converters (even subclassing
>>>>> GlorpBlobType), but to no avail. RelationExpression passes conversion to
>>>>> its left child:
>>>>> 
>>>>> convertedDbValueOf: anObject
>>>>> "Assume that our types match, so we can ask either child to do the
>>>>> conversion. That isn't guaranteed, but should at least work for the
>>>>> common cases."
>>>>> ^leftChild convertedDbValueOf: anObject.
>>>>> 
>>>>> but the left child is FieldExpression in case of OneToOneMapping, which:
>>>>> 
>>>>> convertedDbValueOf: anObject
>>>>> "We don't do any conversion"
>>>>> ^anObject
>>>>> 
>>>>> What is strange, writing works (even the OneToOneMapping, I opened the
>>>>> sqlite file with an explorer), but second SELECT, one using the relation
>>>>> (`state := self dao findStateByAgent: agent` in clientSync), fails with
>>>>> "GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first
>>>>> one _does_ convert when creating bindings, as it uses MappingExpression
>>>>> as left child (stepped over it in debugger).
>>>>> 
>>>>> 
>>>>> 
>>>>> Is it meant to be a strange case that primary key is something
>>>>> non-primitive needing coercion (in this case, it is a UUID which needs
>>>>> coercion to ByteArray, even if it is its subclass)?
>>>>> 
>>>>> 
>>>>> 
>>>>> Here's the stack of running the test which fails:
>>>>> 
>>>>> PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for:
>>>>> [ :ex | self handleError: ex for: command ] in [ | result |
>>>>> self checkPermissionFor: command.
>>>>> result := [ (self useBinding and: [ command useBinding ])
>>>>> ifTrue: [ command executeBoundIn: self ]
>>>>> ifFalse: [ command executeUnboundIn: self ] ]
>>>>> on: Dialect error
>>>>> do: [ :ex | self handleError: ex for: command ].
>>>>> aBoolean
>>>>> ifTrue: [ result ]
>>>>> ifFalse: [ result upToEnd ] ] in
>>>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>>>> BlockClosure>>cull:
>>>>> Context>>evaluateSignal:
>>>>> Context>>handleSignal:
>>>>> Error(Exception)>>signal
>>>>> Error(Exception)>>signal:
>>>>> ExternalLibraryFunction(Object)>>error:
>>>>> ExternalLibraryFunction(Object)>>externalCallFailed
>>>>> ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments:
>>>>> UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with:
>>>>> UDBCSQLite3Library>>with:at:putBlob:
>>>>> UDBCSQLite3Statement>>at:putByteArray:
>>>>> UDBCSQLite3ResultSet>>execute:withIndex:withValue:
>>>>> [ :v | i := self execute: statement withIndex: i withValue: v ] in
>>>>> UDBCSQLite3ResultSet>>execute:withCollection:
>>>>> OrderedCollection>>do:
>>>>> UDBCSQLite3ResultSet>>execute:withCollection:
>>>>> UDBCSQLite3ResultSet>>execute:with:on:
>>>>> UDBCSQLite3Connection>>execute:with:
>>>>> GlorpSQLite3Driver>>basicExecuteSQLString:binding:
>>>>> PharoDatabaseAccessor>>executeCommandBound:
>>>>> QuerySelectCommand(DatabaseCommand)>>executeBoundIn:
>>>>> [ (self useBinding and: [ command useBinding ])
>>>>> ifTrue: [ command executeBoundIn: self ]
>>>>> ifFalse: [ command executeUnboundIn: self ] ] in [ | result |
>>>>> self checkPermissionFor: command.
>>>>> result := [ (self useBinding and: [ command useBinding ])
>>>>> ifTrue: [ command executeBoundIn: self ]
>>>>> ifFalse: [ command executeUnboundIn: self ] ]
>>>>> on: Dialect error
>>>>> do: [ :ex | self handleError: ex for: command ].
>>>>> aBoolean
>>>>> ifTrue: [ result ]
>>>>> ifFalse: [ result upToEnd ] ] in
>>>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>>>> BlockClosure>>on:do:
>>>>> [ | result |
>>>>> self checkPermissionFor: command.
>>>>> result := [ (self useBinding and: [ command useBinding ])
>>>>> ifTrue: [ command executeBoundIn: self ]
>>>>> ifFalse: [ command executeUnboundIn: self ] ]
>>>>> on: Dialect error
>>>>> do: [ :ex | self handleError: ex for: command ].
>>>>> aBoolean
>>>>> ifTrue: [ result ]
>>>>> ifFalse: [ result upToEnd ] ] in
>>>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>>>> [ caught := true.
>>>>> self wait.
>>>>> blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical:
>>>>> BlockClosure>>ensure:
>>>>> Semaphore>>critical:
>>>>> PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor:
>>>>> [ session accessor executeCommand: command returnCursor: true ] in
>>>>> SimpleQuery>>rowsFromDatabaseWithParameters:
>>>>> BlockClosure>>on:do:
>>>>> SimpleQuery>>rowsFromDatabaseWithParameters:
>>>>> SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters:
>>>>> SimpleQuery(AbstractReadQuery)>>executeWithParameters:in:
>>>>> GlorpSession>>execute:
>>>>> GlorpSession>>readOneOf:where:
>>>>> TowergameDao>>findStateByAgent:
>>>>> [ | agent state |
>>>>> agent := self dao findAgentById: anObject agentId.
>>>>> state := self dao findStateByAgent: agent.
>>>>> ^ NeoJSONObject new
>>>>> agentId: agent id;
>>>>> stateVersion: state version;
>>>>> totalAnsweredQuestions:
>>>>> (NeoJSONObject new
>>>>> good: 0;
>>>>> bad: 0;
>>>>> yourself);
>>>>> yourself ] in Towergame>>clientSync:
>>>>> [ myUnitOfWork := self hasUnitOfWork not.
>>>>> myUnitOfWork
>>>>> ifTrue: [ self beginUnitOfWork ].
>>>>> result := aBlock numArgs = 1
>>>>> ifTrue: [ aBlock value: self ]
>>>>> ifFalse: [ aBlock value ].
>>>>> myUnitOfWork
>>>>> ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo:
>>>>> BlockClosure>>ifCurtailed:
>>>>> GlorpSession>>inUnitOfWorkDo:
>>>>> TowergameDao>>inUnitOfWorkDo:
>>>>> Towergame>>clientSync:
>>>>> TowergameSyncTests>>testPlayerChecksStateVersion
>>>>> TowergameSyncTests(TestCase)>>performTest
>>>>> [ self setUp.
>>>>> self performTest ] in TowergameSyncTests(TestCase)>>runCase
>>>>> BlockClosure>>ensure:
>>>>> TowergameSyncTests(TestCase)>>runCase
>>>>> [ aTestCase runCase ] in [ [ aTestCase runCase ]
>>>>> on: Halt
>>>>> do: [ :halt |
>>>>> "if test was halted we should resume all background failures
>>>>> to debug all of them together with test process"
>>>>> failedProcesses keysDo: #resume.
>>>>> halt pass ] ] in TestExecutionEnvironment>>runTestCaseSafelly:
>>>>> BlockClosure>>on:do:
>>>>> [ [ aTestCase runCase ]
>>>>> on: Halt
>>>>> do: [ :halt |
>>>>> "if test was halted we should resume all background failures
>>>>> to debug all of them together with test process"
>>>>> failedProcesses keysDo: #resume.
>>>>> halt pass ] ] in TestExecutionEnvironment>>runTestCaseSafelly:
>>>>> BlockClosure>>on:do:
>>>>> TestExecutionEnvironment>>runTestCaseSafelly:
>>>>> [ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly:
>>>>> aTestCase ]
>>>>> ensure: [ testCompleted := true.
>>>>> watchDogSemaphore signal ]. "signal that test case completes"
>>>>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>>>>> BlockClosure>>ensure:
>>>>> [ [ self runTestCaseSafelly: aTestCase ]
>>>>> ensure: [ testCompleted := true.
>>>>> watchDogSemaphore signal ]. "signal that test case completes"
>>>>> self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase:
>>>>> BlockClosure>>ifCurtailed:
>>>>> TestExecutionEnvironment>>runTestCase:
>>>>> [ testEnv runTestCase: aTestCase ] in
>>>>> DefaultExecutionEnvironment>>runTestCase:
>>>>> [ self value: anExecutionEnvironment.
>>>>> anExecutionEnvironment activated.
>>>>> aBlock value ] in CurrentExecutionEnvironment class>>activate:for:
>>>>> BlockClosure>>ensure:
>>>>> CurrentExecutionEnvironment class>>activate:for:
>>>>> TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring:
>>>>> DefaultExecutionEnvironment>>runTestCase:
>>>>> CurrentExecutionEnvironment class>>runTestCase:
>>>>> TowergameSyncTests(TestCase)>>runCaseManaged
>>>>> [ aTestCase announce: TestCaseStarted withResult: self.
>>>>> aTestCase runCaseManaged.
>>>>> aTestCase announce: TestCaseEnded withResult: self.
>>>>> self addPass: aTestCase ] in TestResult>>runCaseForDebug:
>>>>> BlockClosure>>on:do:
>>>>> TestResult>>runCaseForDebug:
>>>>> [ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug
>>>>> BlockClosure>>ensure:
>>>>> TowergameSyncTests(TestCase)>>debug
>>>>> [ :each |
>>>>> each debug.
>>>>> self announceTest: each.
>>>>> self changed: each ] in [ self tests
>>>>> do: [ :each |
>>>>> each debug.
>>>>> self announceTest: each.
>>>>> self changed: each ] ] in TestSuite>>debug
>>>>> OrderedCollection>>do:
>>>>> [ self tests
>>>>> do: [ :each |
>>>>> each debug.
>>>>> self announceTest: each.
>>>>> self changed: each ] ] in TestSuite>>debug
>>>>> BlockClosure>>ensure:
>>>>> TestSuite>>debug
>>>>> [ :aSuite | aSuite debug ] in TestRunner>>debugSuite:
>>>>> BlockClosure>>cull:
>>>>> BlockClosure>>cull:cull:
>>>>> [ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as:
>>>>> BlockClosure>>ensure:
>>>>> TestRunner>>executeSuite:as:
>>>>> TestRunner>>debugSuite:
>>>>> TestRunner>>debug:
>>>>> TestRunner>>errorSelected:
>>>>> PluggableListMorph>>changeModelSelection:
>>>>> PluggableListMorph>>mouseUpOnSingle:
>>>>> PluggableListMorph>>mouseUp:
>>>>> PluggableListMorph(Morph)>>handleMouseUp:
>>>>> MouseButtonEvent>>sentTo:
>>>>> PluggableListMorph(Morph)>>handleEvent:
>>>>> MorphicEventDispatcher>>dispatchDefault:with:
>>>>> MorphicEventDispatcher>>handleMouseUp:
>>>>> MouseButtonEvent>>sentTo:
>>>>> [ ^ anEvent sentTo: self ] in
>>>>> MorphicEventDispatcher>>dispatchEvent:with:
>>>>> BlockClosure>>ensure:
>>>>> MorphicEventDispatcher>>dispatchEvent:with:
>>>>> PluggableListMorph(Morph)>>processEvent:using:
>>>>> PluggableListMorph(Morph)>>processEvent:
>>>>> PluggableListMorph>>handleFocusEvent:
>>>>> [ ActiveHand := self.
>>>>> ActiveEvent := anEvent.
>>>>> result := focusHolder
>>>>> handleFocusEvent: (anEvent transformedBy: (focusHolder transformedFrom:
>>>>> self)) ] in HandMorph>>sendFocusEvent:to:clear:
>>>>> BlockClosure>>on:do:
>>>>> WorldMorph(PasteUpMorph)>>becomeActiveDuring:
>>>>> HandMorph>>sendFocusEvent:to:clear:
>>>>> HandMorph>>sendEvent:focus:clear:
>>>>> HandMorph>>sendMouseEvent:
>>>>> HandMorph>>handleEvent:
>>>>> HandMorph>>processEventsFromQueue:
>>>>> HandMorph>>processEvents
>>>>> [ :h |
>>>>> self activeHand: h.
>>>>> h processEvents.
>>>>> self activeHand: nil ] in WorldState>>doOneCycleNowFor:
>>>>> Array(SequenceableCollection)>>do:
>>>>> WorldState>>handsDo:
>>>>> WorldState>>doOneCycleNowFor:
>>>>> WorldState>>doOneCycleFor:
>>>>> WorldMorph>>doOneCycle
>>>>> WorldMorph class>>doOneCycle
>>>>> [ [ WorldMorph doOneCycle.
>>>>> Processor yield.
>>>>> false ] whileFalse: [ ] ] in MorphicUIManager>>spawnNewProcess
>>>>> [ self value.
>>>>> Processor terminateActive ] in BlockClosure>>newProcess
>>>>> 
>>>>> 
>>>>> 
>>>>> And here's the code:
>>>>> 
>>>>> 
>>>>> Towergame.st:
>>>>> 
>>>>> GlorpBlobType subclass: #GlorpBlob2Type
>>>>> instanceVariableNames: ''
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> 
>>>>> !GlorpBlob2Type methodsFor: 'types' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> converterForStType: aClass
>>>>> aClass = UUID ifTrue: [ ^ UuidConverter new ].
>>>>> ^ super converterForStType: aClass! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgAct
>>>>> instanceVariableNames: 'agent tool timestamp'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgAct commentStamp: 'HerbyVojcik 8/5/2017 19:23' prior: 0!
>>>>> I represent a relationship between a player (TgAgent)
>>>>> and a device (TgTool).
>>>>> 
>>>>> In particular, I am created whenever a player logs in to the game from
>>>>> different device
>>>>> than it was last time (or first time, ever).!
>>>>> 
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> agent
>>>>> ^ agent! !
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> agent: anObject
>>>>> agent := anObject! !
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> timestamp: anObject
>>>>> timestamp := anObject! !
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> tool
>>>>> ^ tool! !
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> tool: anObject
>>>>> tool := anObject! !
>>>>> 
>>>>> !TgAct methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> timestamp
>>>>> ^ timestamp! !
>>>>> 
>>>>> 
>>>>> !TgAct methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> agent := nil.
>>>>> timestamp := DateAndTime now asUTC.
>>>>> tool := nil.! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgAct class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgAct class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> agent: aTgAgent tool: aTgTool
>>>>> ^ self new
>>>>> agent: aTgAgent;
>>>>> tool: aTgTool;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgAgent
>>>>> instanceVariableNames: 'id'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgAgent commentStamp: 'HerbyVojcik 8/5/2017 19:22' prior: 0!
>>>>> I represent a towergame player.
>>>>> 
>>>>> I only contain player-related information;
>>>>> the game state itself is in TgState.!
>>>>> 
>>>>> 
>>>>> !TgAgent methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> id := nil.! !
>>>>> 
>>>>> 
>>>>> !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> id: anObject
>>>>> id := anObject! !
>>>>> 
>>>>> !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> id
>>>>> ^ id! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgAgent class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgAgent class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> id: aString
>>>>> ^ self new
>>>>> id: aString;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgAnswers
>>>>> instanceVariableNames: 'good bad'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgAnswers commentStamp: 'HerbyVojcik 8/5/2017 20:23' prior: 0!
>>>>> I represent the answered question stats.
>>>>> 
>>>>> I know how many good / bad answered questions there is.!
>>>>> 
>>>>> 
>>>>> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> good
>>>>> ^ good! !
>>>>> 
>>>>> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> bad: anObject
>>>>> bad := anObject! !
>>>>> 
>>>>> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> bad
>>>>> ^ bad! !
>>>>> 
>>>>> !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> good: anObject
>>>>> good := anObject! !
>>>>> 
>>>>> 
>>>>> !TgAnswers methodsFor: 'initialization' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> bad := 0.
>>>>> good := 0.! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgAnswers class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgAnswers class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> good: anInteger bad: anInteger2
>>>>> ^ self new
>>>>> good: anInteger;
>>>>> bad: anInteger2;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgFloors
>>>>> instanceVariableNames: 'total reinforced'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgFloors commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
>>>>> I represent the floor building status.
>>>>> 
>>>>> I know how many floors are build and how many of them is reinforced.!
>>>>> 
>>>>> 
>>>>> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> total
>>>>> ^ total! !
>>>>> 
>>>>> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> total: anObject
>>>>> total := anObject! !
>>>>> 
>>>>> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> reinforced
>>>>> ^ reinforced! !
>>>>> 
>>>>> !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> reinforced: anObject
>>>>> reinforced := anObject! !
>>>>> 
>>>>> 
>>>>> !TgFloors methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> reinforced := 0.
>>>>> total := 0.! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgFloors class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> total: anInteger
>>>>> ^ self total: anInteger reinforced: 0! !
>>>>> 
>>>>> !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> total: anInteger reinforced: anInteger2
>>>>> ^ self new
>>>>> total: anInteger;
>>>>> reinforced: anInteger2;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgState
>>>>> instanceVariableNames: 'agent version packs valuables score bestScore
>>>>> answers'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgState commentStamp: 'HerbyVojcik 8/5/2017 20:20' prior: 0!
>>>>> I represent the game state.
>>>>> 
>>>>> I have relation to a player (TgAgent) and have a version.
>>>>> Then, I contain (directly or indirectly) other parts that
>>>>> make up the player's game state.
>>>>> 
>>>>> Whenever I am changed by game progress, my version is changed as well.!
>>>>> 
>>>>> 
>>>>> !TgState methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> agent := nil.
>>>>> answers := nil.
>>>>> bestScore := nil.
>>>>> packs := Set new.
>>>>> score := nil.
>>>>> valuables := nil.
>>>>> version := nil.! !
>>>>> 
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> score: anObject
>>>>> score := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> bestScore: anObject
>>>>> bestScore := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> agent: anObject
>>>>> agent := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> score
>>>>> ^ score! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> packs
>>>>> ^ packs! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> version
>>>>> ^ version! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> bestScore
>>>>> ^ bestScore! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> agent
>>>>> ^ agent! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> answers: anObject
>>>>> answers := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> valuables: anObject
>>>>> valuables := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> valuables
>>>>> ^ valuables! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> version: anObject
>>>>> version := anObject! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> answers
>>>>> ^ answers! !
>>>>> 
>>>>> !TgState methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> packs: anObject
>>>>> packs := anObject! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgState class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgState class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> agent: aTgAgent version: aString
>>>>> ^ self new
>>>>> agent: aTgAgent;
>>>>> version: aString;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgTool
>>>>> instanceVariableNames: 'id'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgTool commentStamp: 'HerbyVojcik 8/5/2017 19:26' prior: 0!
>>>>> I represent the device (mobile phone, web browser, ..)
>>>>> that player uses to connect to game.!
>>>>> 
>>>>> 
>>>>> !TgTool methodsFor: 'initialization' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> id := nil.! !
>>>>> 
>>>>> 
>>>>> !TgTool methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> id: anObject
>>>>> id := anObject! !
>>>>> 
>>>>> !TgTool methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> id
>>>>> ^ id! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgTool class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgTool class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> id: aString
>>>>> ^ self new
>>>>> id: aString;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TgValuables
>>>>> instanceVariableNames: 'coins gems'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !TgValuables commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0!
>>>>> I represent a purse.
>>>>> 
>>>>> I know how many coins and gems there is.!
>>>>> 
>>>>> 
>>>>> !TgValuables methodsFor: 'initialization' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> coins := 0.
>>>>> gems := 0.! !
>>>>> 
>>>>> 
>>>>> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> gems: anObject
>>>>> gems := anObject! !
>>>>> 
>>>>> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> coins: anObject
>>>>> coins := anObject! !
>>>>> 
>>>>> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> gems
>>>>> ^ gems! !
>>>>> 
>>>>> !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> coins
>>>>> ^ coins! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TgValuables class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TgValuables class methodsFor: 'instance creation' stamp:
>>>>> 'HerbertVojčík 8/14/2017 18:09:53'!
>>>>> coins: anInteger gems: anInteger2
>>>>> ^ self new
>>>>> coins: anInteger;
>>>>> gems: anInteger2;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #Towergame
>>>>> instanceVariableNames: 'dao'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> !Towergame commentStamp: 'HerbyVojcik 5/17/2017 17:19' prior: 0!
>>>>> I am the Towergame app class.
>>>>> 
>>>>> I configure and start towergame server processing.!
>>>>> 
>>>>> 
>>>>> !Towergame methodsFor: 'actions' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> clientSync: anObject
>>>>> self dao inUnitOfWorkDo: [
>>>>> | agent state |
>>>>> agent := self dao findAgentById: anObject agentId.
>>>>> state := self dao findStateByAgent: agent.
>>>>> ^ NeoJSONObject new
>>>>> agentId: agent id;
>>>>> stateVersion: state version;
>>>>> totalAnsweredQuestions: (NeoJSONObject new good: 0; bad: 0; yourself);
>>>>> yourself ]! !
>>>>> 
>>>>> 
>>>>> !Towergame methodsFor: 'initialization' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> dao := nil.
>>>>> ! !
>>>>> 
>>>>> 
>>>>> !Towergame methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> dao: anObject
>>>>> dao := anObject! !
>>>>> 
>>>>> !Towergame methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> dao
>>>>> ^ dao! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> Towergame class
>>>>> instanceVariableNames: 'default'!
>>>>> 
>>>>> !Towergame class methodsFor: 'instance creation' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> dao: aDao
>>>>> ^ self new
>>>>> dao: aDao;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> defaultDbLogin
>>>>> | databaseFile |
>>>>> databaseFile := Smalltalk imageDirectory asFileReference /
>>>>> 'towergame.db'.
>>>>> ^ Login new
>>>>> database: UDBCSQLite3Platform new;
>>>>> host: '';
>>>>> port: '';
>>>>> username: '';
>>>>> password: '';
>>>>> databaseName: databaseFile fullPath asZnUrl asString;
>>>>> yourself ! !
>>>>> 
>>>>> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> default
>>>>> ^ default ifNil: [ default := self
>>>>> dao: (self daoForLogin: self defaultDbLogin)
>>>>> ]! !
>>>>> 
>>>>> !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> defaultPort
>>>>> ^ 4998! !
>>>>> 
>>>>> 
>>>>> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> configureServer
>>>>> (self serverFor: self default on: self defaultPort) start; register
>>>>> ! !
>>>>> 
>>>>> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> configureSqlite3
>>>>> 
>>>>> PharoDatabaseAccessor DefaultDriver: GlorpSQLite3Driver! !
>>>>> 
>>>>> !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> configure
>>>>> self configureSqlite3.
>>>>> self configureServer.! !
>>>>> 
>>>>> 
>>>>> !Towergame class methodsFor: 'factory' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> daoForLogin: aLogin
>>>>> ^ TowergameDao forLogin: aLogin! !
>>>>> 
>>>>> !Towergame class methodsFor: 'factory' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> serverFor: aTowergame on: port
>>>>> ^ (ZnServer on: port)
>>>>> delegate: (TowergameDelegate on: aTowergame);
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> Object subclass: #TowergameDao
>>>>> instanceVariableNames: 'glorpSession glorpLogin'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> 
>>>>> !TowergameDao methodsFor: 'transactions' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> inUnitOfWorkDo: aBlock
>>>>> ^ self glorpSession inUnitOfWorkDo: aBlock! !
>>>>> 
>>>>> 
>>>>> !TowergameDao methodsFor: 'initialization' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> initialize
>>>>> 
>>>>> super initialize.
>>>>> 
>>>>> glorpLogin := nil.
>>>>> glorpSession := nil.! !
>>>>> 
>>>>> 
>>>>> !TowergameDao methodsFor: 'initialize-release' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> reset
>>>>> glorpSession := nil.! !
>>>>> 
>>>>> 
>>>>> !TowergameDao methodsFor: 'query' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> findStateByAgent: anAgent
>>>>> ^ self glorpSession readOneOf: TgState where: [ :one | one agent =
>>>>> anAgent ]! !
>>>>> 
>>>>> !TowergameDao methodsFor: 'query' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> findAgentById: anUUID
>>>>> ^ self glorpSession readOneOf: TgAgent where: [ :one | one id = anUUID
>>>>> ]! !
>>>>> 
>>>>> 
>>>>> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> glorpLogin: anObject
>>>>> glorpLogin := anObject! !
>>>>> 
>>>>> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> glorpLogin
>>>>> ^ glorpLogin! !
>>>>> 
>>>>> !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> glorpSession
>>>>> glorpSession ifNil: [
>>>>> glorpSession := TowergameDescriptorSystem sessionForLogin: self
>>>>> glorpLogin ].
>>>>> glorpSession accessor isLoggedIn ifFalse: [
>>>>> glorpSession accessor login ].
>>>>> ^ glorpSession! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TowergameDao class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TowergameDao class methodsFor: 'instance creation' stamp:
>>>>> 'HerbertVojčík 8/14/2017 18:09:53'!
>>>>> forLogin: aLogin
>>>>> ^ self new
>>>>> glorpLogin: aLogin;
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> ZnDispatcherDelegate subclass: #TowergameDelegate
>>>>> instanceVariableNames: 'towergame'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> 
>>>>> !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> towergame
>>>>> ^ towergame! !
>>>>> 
>>>>> !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> towergame: anObject
>>>>> towergame := anObject! !
>>>>> 
>>>>> 
>>>>> !TowergameDelegate methodsFor: 'initialization' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> initialize
>>>>> super initialize.
>>>>> towergame := nil.
>>>>> self
>>>>> map: '/api/v1/sync'
>>>>> to: [ :request :response | self syncRequest: request toResponse:
>>>>> response ]! !
>>>>> 
>>>>> 
>>>>> !TowergameDelegate methodsFor: 'action' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> syncRequest: request toResponse: response
>>>>> | requestPayload responsePayload uuidKeys |
>>>>> uuidKeys := #(agentId stateVersion deviceId).
>>>>> request method == #POST ifFalse: [ ^ ZnResponse methodNotAllowed:
>>>>> request ].
>>>>> requestPayload := NeoJSONObject fromString: request contents.
>>>>> requestPayload ifNotNil: [
>>>>> uuidKeys do: [ :each | requestPayload at: each ifPresentPut: [ :s | UUID
>>>>> fromString: s ] ] ].
>>>>> responsePayload := self towergame clientSync: requestPayload.
>>>>> responsePayload ifNotNil: [
>>>>> uuidKeys do: [ :each | responsePayload at: each ifPresentPut: #asString
>>>>> ] ].
>>>>> ^ response
>>>>> entity: (ZnEntity
>>>>> with: (NeoJSONWriter toString: responsePayload)
>>>>> type: ZnMimeType applicationJson);
>>>>> yourself! !
>>>>> 
>>>>> "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
>>>>> 
>>>>> TowergameDelegate class
>>>>> instanceVariableNames: ''!
>>>>> 
>>>>> !TowergameDelegate class methodsFor: 'instance creation' stamp:
>>>>> 'HerbertVojčík 8/14/2017 18:09:53'!
>>>>> on: aTowergame
>>>>> ^ self new towergame: aTowergame; yourself! !
>>>>> 
>>>>> 
>>>>> DescriptorSystem subclass: #TowergameDescriptorSystem
>>>>> instanceVariableNames: 'uuidConverter'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> tableForAGENT: aTable
>>>>> 
>>>>> (aTable createFieldNamed: 'id' type: platform blob2) bePrimaryKey.
>>>>> ! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> classModelForTgAgent: aClassModel
>>>>> aClassModel
>>>>> newAttributeNamed: #id type: UUID! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbyVojcik
>>>>> 8/14/2017 18:24'!
>>>>> tableForSTATE: aTable
>>>>> 
>>>>> (aTable createFieldNamed: 'agent' type: platform blob2) in: [
>>>>> :agentField |
>>>>> agentField bePrimaryKey.
>>>>> aTable addForeignKeyFrom: agentField to: ((self tableNamed: 'AGENT')
>>>>> fieldNamed: 'id') ].
>>>>> (aTable createFieldNamed: 'version' type: platform blob) beIndexed.
>>>>> ! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> descriptorForTgAgent: aDescriptor
>>>>> | table |
>>>>> table := self tableNamed: 'AGENT'.
>>>>> aDescriptor table: table.
>>>>> (aDescriptor newMapping: DirectMapping)
>>>>> from: #id to: (table fieldNamed: 'id').! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> tableForACT: aTable
>>>>> 
>>>>> (aTable createFieldNamed: 'agent' type: platform blob2) beIndexed.
>>>>> (aTable createFieldNamed: 'tool' type: platform blob2) beIndexed.
>>>>> (aTable createFieldNamed: 'timestamp' type: platform timestamp)
>>>>> beIndexed.
>>>>> ! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> descriptorForTgState: aDescriptor
>>>>> | table |
>>>>> table := self tableNamed: 'STATE'.
>>>>> aDescriptor table: table.
>>>>> (aDescriptor newMapping: OneToOneMapping) attributeName: #agent.
>>>>> (aDescriptor newMapping: DirectMapping)
>>>>> from: #version to: (table fieldNamed: 'version').! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> converterBetweenStType: aClass andField: aField
>>>>> (aClass = UUID and: [ aField impliedSmalltalkType = ByteArray])
>>>>> ifTrue: [ ^ self uuidConverter ].
>>>>> ^ super converterBetweenStType: aClass andField: aField! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> classModelForTgState: aClassModel
>>>>> "agent version packs valuables score bestScore answers"
>>>>> aClassModel
>>>>> newAttributeNamed: #agent type: TgAgent;
>>>>> newAttributeNamed: #version type: UUID! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> classModelForTgTool: aClassModel
>>>>> aClassModel
>>>>> newAttributeNamed: #id
>>>>> ! !
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> classModelForTgAct: aClassModel
>>>>> aClassModel
>>>>> newAttributeNamed: #timestamp;
>>>>> newAttributeNamed: #agent type: TgAgent;
>>>>> newAttributeNamed: #tool type: TgTool! !
>>>>> 
>>>>> 
>>>>> !TowergameDescriptorSystem methodsFor: 'accessing' stamp:
>>>>> 'HerbertVojčík 8/14/2017 18:09:53'!
>>>>> uuidConverter
>>>>> ^ uuidConverter ifNil: [ uuidConverter := UuidConverter new name:
>>>>> 'uuid'; yourself ]! !
>>>>> 
>>>>> 
>>>>> DatabaseConverter subclass: #UuidConverter
>>>>> instanceVariableNames: ''
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame'!
>>>>> 
>>>>> !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> convert: anObject toDatabaseRepresentationAs: aDatabaseType
>>>>> ^ anObject ifNotNil: [ ByteArray withAll: anObject ]! !
>>>>> 
>>>>> !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> convert: anObject fromDatabaseRepresentationAs: aDatabaseType
>>>>> ^ anObject ifNotNil: [ UUID withAll: anObject ]! !
>>>>> 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017
>>>>> at 6:26:30.67905 pm'!
>>>>> 
>>>>> !DatabasePlatform methodsFor: '*Towergame' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> blob2
>>>>> ^self typeNamed: #blob ifAbsentPut: [GlorpBlob2Type new].! !
>>>>> 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017
>>>>> at 6:26:30.68005 pm'!
>>>>> 
>>>>> !Dictionary methodsFor: '*Towergame' stamp: 'HerbertVojčík 8/14/2017
>>>>> 18:09:53'!
>>>>> at: key ifPresentPut: aBlock
>>>>> "Lookup the given key in the receiver. If it is present, update it
>>>>> with the value of evaluating the given block with the value associated
>>>>> with the key. Otherwise, answer nil."
>>>>> 
>>>>> ^ self at: key ifPresent: [ :value | self at: key put: (aBlock cull:
>>>>> value) ]! !
>>>>> 
>>>>> 
>>>>> 
>>>>> 
>>>>> TowergameTests.st:
>>>>> 
>>>>> TestCase subclass: #TowergameServerTests
>>>>> instanceVariableNames: 'randomPort towergame server'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame-Tests'!
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> uidy: aString
>>>>> ^ UUID fromString36: aString ! !
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> setUp
>>>>> randomPort := 1700 + 32 atRandom.
>>>>> towergame := Mock new.
>>>>> server := Towergame serverFor: towergame on: randomPort.
>>>>> server start.
>>>>> self
>>>>> assert: server isRunning & server isListening
>>>>> description: ('Failed to start server on port {1}. Is there one
>>>>> already?' format: { server port })
>>>>> ! !
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> tearDown
>>>>> server stop! !
>>>>> 
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> testEmptySyncRequest
>>>>> | znClient response |
>>>>> (towergame stub clientSync: Arg payload) willReturn: nil.
>>>>> znClient := self znClientForSync: 'null'.
>>>>> response := znClient timeout: 1; post; response.
>>>>> response should satisfy: #isSuccess.
>>>>> response contentType should equal: ZnMimeType applicationJson.
>>>>> (STON fromString: response entity contents) should equal: nil.
>>>>> Arg payload should equal: nil! !
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> testRejectEmptyGetSyncRequest
>>>>> | znClient response |
>>>>> (towergame stub clientSync: Arg payload) willReturn: nil.
>>>>> znClient := self znClientForSync: 'null'.
>>>>> response := znClient timeout: 1; get; response.
>>>>> response code should equal: ZnStatusLine methodNotAllowed code.
>>>>> towergame should not receive clientSync: Any! !
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> testNonEmptySyncRequest
>>>>> | znClient response |
>>>>> (towergame stub clientSync: Arg payload) willReturn: { #agentId -> (self
>>>>> uidy: '007') } asDictionary.
>>>>> znClient := self znClientForSync:
>>>>> ('\{"deviceId":"{1}","agentAnsweredQuestions":\{"good":1,"bad":2\}\}'
>>>>> format: { self uidy: 'Q' }).
>>>>> response := znClient timeout: 1; post; response.
>>>>> response should satisfy: #isSuccess.
>>>>> response contentType should equal: ZnMimeType applicationJson.
>>>>> (STON fromString: response entity contents) should equal: { 'agentId' ->
>>>>> (self uidy: '007') asString } asDictionary.
>>>>> Arg payload in: [ :arg |
>>>>> arg deviceId should equal: (self uidy: 'Q').
>>>>> arg agentAnsweredQuestions should satisfy: #notNil.
>>>>> arg agentAnsweredQuestions good should equal: 1.
>>>>> arg agentAnsweredQuestions bad should equal: 2 ]
>>>>> ! !
>>>>> 
>>>>> 
>>>>> !TowergameServerTests methodsFor: 'private' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> znClientForSync: jsonString
>>>>> ^ ZnClient new
>>>>> url: server localUrl;
>>>>> path: '/api/v1/sync';
>>>>> entity:
>>>>> (ZnEntity
>>>>> with: jsonString
>>>>> type: ZnMimeType applicationJson)
>>>>> ! !
>>>>> 
>>>>> 
>>>>> TestCase subclass: #TowergameSyncTests
>>>>> instanceVariableNames: 'towergame session dao'
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'Towergame-Tests'!
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> testPlayerChecksStateVersionAndIsBehind
>>>>> | result payload |
>>>>> session createTables.
>>>>> session inUnitOfWorkDo: [
>>>>> | agent state |
>>>>> agent := TgAgent id: (self uidy: '007').
>>>>> state := (TgState agent: agent version: (self uidy: '18-eff'))
>>>>> packs: #('foopack' 'barpack') asSet;
>>>>> valuables: (TgValuables coins: 20 gems: 3);
>>>>> score: (TgFloors total: 4 reinforced: 1);
>>>>> bestScore: (TgFloors total: 18);
>>>>> answers: (TgAnswers good: 2 bad: 3);
>>>>> yourself.
>>>>> session registerAll: {state. TgAct agent: agent tool: (TgTool id: (self
>>>>> uidy: 'Q7') ) } ].
>>>>> towergame := Towergame dao: dao.
>>>>> payload := NeoJSONObject new
>>>>> agentId: (self uidy: '007'); stateVersion: (self uidy: '23-fefe');
>>>>> deviceId: (self uidy: 'Q7').
>>>>> result := towergame clientSync: payload.
>>>>> result where agentId should equal: (self uidy: '007').
>>>>> result where stateVersion should equal: (self uidy: '18-eff').
>>>>> result where purchasedPacks should satisfy: [ :x | x asSet should equal:
>>>>> #('foopack' 'barpack') asSet ].
>>>>> result where valuables coins should equal: 20.
>>>>> result where valuables gems should equal: 3.
>>>>> result where floorsNumber current should equal: 4.
>>>>> result where floorsNumber best should equal: 18.
>>>>> result where floorsNumber reinforced should equal: 1.
>>>>> result where agentAnsweredQuestions good should equal: 2.
>>>>> result where agentAnsweredQuestions bad should equal: 3.
>>>>> result where totalAnsweredQuestions good should equal: 2.
>>>>> result where totalAnsweredQuestions bad should equal: 3! !
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbyVojcik 8/14/2017
>>>>> 18:18'!
>>>>> testPlayerChecksStateVersion
>>>>> | result payload |
>>>>> session createTables.
>>>>> session inUnitOfWorkDo: [
>>>>> | agent state |
>>>>> agent := TgAgent id: (self uidy: '007').
>>>>> state := TgState agent: agent version: (self uidy: '23-fefe').
>>>>> session registerAll: {state. TgAct agent: agent tool: (TgTool id: (self
>>>>> uidy: 'Q7') ) } ].
>>>>> towergame := Towergame dao: dao.
>>>>> payload := NeoJSONObject new
>>>>> agentId: (self uidy: '007'); stateVersion: (self uidy: '23-fefe');
>>>>> deviceId: (self uidy: 'Q7').
>>>>> result := towergame clientSync: payload.
>>>>> result where agentId should equal: (self uidy: '007').
>>>>> result where stateVersion should equal: (self uidy: '23-fefe').
>>>>> result where totalAnsweredQuestions good should equal: 0.
>>>>> result where totalAnsweredQuestions bad should equal: 0! !
>>>>> 
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> uidy: aString
>>>>> ^ UUID fromString36: aString ! !
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> setUp
>>>>> dao := Towergame daoForLogin: self loginToTemporaryDatabase.
>>>>> session := dao glorpSession.
>>>>> ! !
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> tearDown
>>>>> session logout! !
>>>>> 
>>>>> !TowergameSyncTests methodsFor: 'running' stamp: 'HerbyVojcik 8/14/2017
>>>>> 18:16'!
>>>>> loginToTemporaryDatabase
>>>>> ^ Login new
>>>>> database: UDBCSQLite3Platform new;
>>>>> host: '';
>>>>> port: '';
>>>>> username: '';
>>>>> password: '';
>>>>> databaseName: '';
>>>>> yourself! !
>>>>> 
>>>>> 
>>>>> 
>>>>> 
>>>>> 
>>>>> BaselineOfTowergame.st:
>>>>> BaselineOf subclass: #BaselineOfTowergame
>>>>> instanceVariableNames: ''
>>>>> classVariableNames: ''
>>>>> poolDictionaries: ''
>>>>> category: 'BaselineOfTowergame'!
>>>>> 
>>>>> !BaselineOfTowergame methodsFor: 'baseline' stamp: 'HerbertVojčík
>>>>> 8/14/2017 18:09:53'!
>>>>> baseline: spec
>>>>> <baseline>
>>>>> spec for: #common do: [ spec
>>>>> 
>>>>> package: 'Towergame' with: [ spec
>>>>> requires: #('GlorpSQLite' 'NeoJSON') ];
>>>>> package: 'Towergame-Tests' with: [ spec
>>>>> requires: #('Towergame' 'Mocketry') ];
>>>>> 
>>>>> configuration: 'GlorpSQLite' with: [ spec
>>>>> version: #stable;
>>>>> repository:
>>>>> 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
>>>>> configuration: 'NeoJSON' with: [ spec
>>>>> version: #stable;
>>>>> repository:
>>>>> 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ];
>>>>> baseline: 'Mocketry' with: [ spec
>>>>> repository: 'github://dionisiydk/Mocketry:v4.0.x' ];
>>>>> 
>>>>> group: 'default' with: #('Core');
>>>>> group: 'development' with: #('Core' 'Tests');
>>>>> group: 'Core' with: #('Towergame');
>>>>> group: 'Tests' with: #('Towergame-Tests') ]
>>>>> ! !
>>>>> 
>>>>> 
>>>>> 
>>>> 
>>>> 
>>> 
>> 
>> 
> 
> 
> -- 
> -----------------------------------------------------------------------
> Objektfabrik Joachim Tuchel          mailto:[email protected]
> Fliederweg 1                         http://www.objektfabrik.de
> D-71640 Ludwigsburg                  http://joachimtuchel.wordpress.com
> Telefon: +49 7141 56 10 86 0         Fax: +49 7141 56 10 86 1
> 
> 

Reply via email to