What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
26 messages Options
12
Reply | Threaded
Open this post in threaded view
|

What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Herby Vojčík
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') ]
> ! !
>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

jtuchel
Herby,

I think the better place to discuss fixes to Glorp is the Glorp Mailing list, where some Cincomers are also reading: [hidden email]

Joachim







Am 15.08.17 um 13:30 schrieb Herby Vojčík:
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          [hidden email]
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 | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Herby Vojčík
In reply to this post by Herby Vojčík
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') ]
>> ! !
>>
>>
>>
>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

EstebanLM
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.
So, while I have literally no idea of what Herby is asking for, I encourage to keep discussion also here, then solution can hit both platforms.

Esteban

> On 16 Aug 2017, at 00:07, [hidden email] 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') ]
>>> ! !
>>>
>>>
>>>
>>
>>
>>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Herby Vojčík
Esteban Lorenzano wrote:
> 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.
> So, while I have literally no idea of what Herby is asking for, I encourage to keep discussion also here, then solution can hit both platforms.

Thank you.

In short, if there is DirectMapping with converter in the field used to foreign-key to other table's primary key (and I put one there as I use UUID which needs to be converted to/from ByteArray; in FK as well as in other side's PK), a relation is created with expressionFor:basedOn:relation: (as is done for other mappings in case relation like #= is used). Mapping has generic one, which correctly takes stValue(s) of the left side(s), and converts it to dbValue(s). DirectMapping's one was heavily optimized (probablly for perf reasons) and the conversion was thus lost in the process, I presume.

The fix adds the conversion back, so I can do

where: [ :one | one agent = anA
gentObject ] and have it correctly translated to WHERE table.agentfield = converted_to_dbvalue(anAgentObject primaryKey).

Herby

>
> Esteban
>
>> On 16 Aug 2017, at 00:07, [hidden email] 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>>  expressionF
or: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
>>>
>>> attri
bute 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: ea
ch]]

>>> 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 th
e 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>>basicExecute
SQLString: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: [ tes
tCompleted := 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>>runCaseForDeb
ug:

>>>> 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:
>>>> PluggableLi
stMorph>>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:0
9: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: 'accessin
g' 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 t
otal: 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! !
>>>>
>>>> !Tg
State 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: 'accessi
ng' 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 initia
lize.

>>>>
>>>> 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 subclas
s: #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: 'accessi
ng' 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 ! !
>>>>
>>>> !Towerga
me 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-rele
ase' 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: [
>>>> g
lorpSession := 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.
>>>> ! !
>>>>
>>>> !TowergameDescriptorSyst
em 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 uuid
Converter ].

>>>> ^ 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: aSt
ring ! !

>>>>
>>>> !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 contentTy
pe 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: 'towerga
me 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').
>>>> res
ult := 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.
>>>> ses
sion 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
>>>>
>>>> pa
ckage: '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') ]
>>>> ! !
>>>>
>>>>
>>>>
>>>
>>>
>>
>
>



Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Herby Vojčík
Herby Vojčík wrote:

> Esteban Lorenzano wrote:
>> 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.
>> So, while I have literally no idea of what Herby is asking for, I
>> encourage to keep discussion also here, then solution can hit both
>> platforms.
>
> Thank you.
>
> In short, if there is DirectMapping with converter in the field used to
> foreign-key to other table's primary key (and I put one there as I use
> UUID which needs to be converted to/from ByteArray; in FK as well as in
> other side's PK), a relation is created with
> expressionFor:basedOn:relation: (as is done for other mappings in case
> relation like #= is used). Mapping has generic one, which correctly
> takes stValue(s) of the left side(s), and converts it to dbValue(s).

Errata: right side(s)

> DirectMapping's one was heavily optimized (probablly for perf reasons)
> and the conversion was thus lost in the process, I presume.
>
> The fix adds the conversion back, so I can do
>
> where: [ :one | one agent = anA
> gentObject ] and have it correctly translated to WHERE table.agentfield
> = converted_to_dbvalue(anAgentObject primaryKey).
>
> Herby
>
>>
>> Esteban
>>
>>> On 16 Aug 2017, at 00:07, [hidden email] 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>> expressionF
> or: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
>>>>
>>>> attri
> bute 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: ea
> ch]]
>>>> 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 th
> e 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>>basicExecute
> SQLString: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: [ tes
> tCompleted := 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>>runCaseForDeb
> ug:
>>>>> 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:
>>>>> PluggableLi
> stMorph>>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:0
> 9: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: 'accessin
> g' 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 t
> otal: 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! !
>>>>>
>>>>> !Tg
> State 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: 'accessi
> ng' 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 initia
> lize.
>>>>>
>>>>> 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 subclas
> s: #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: 'accessi
> ng' 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 ! !
>>>>>
>>>>> !Towerga
> me 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-rele
> ase' 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: [
>>>>> g
> lorpSession := 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.
>>>>> ! !
>>>>>
>>>>> !TowergameDescriptorSyst
> em 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 uuid
> Converter ].
>>>>> ^ 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: aSt
> ring ! !
>>>>>
>>>>> !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 contentTy
> pe 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: 'towerga
> me 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').
>>>>> res
> ult := 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.
>>>>> ses
> sion 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
>>>>>
>>>>> pa
> ckage: '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') ]
>>>>> ! !
>>>>>
>>>>>
>>>>>
>>>>
>>>>
>>>
>>
>>
>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

jtuchel
In reply to this post by EstebanLM
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).

just my 2c

Joachim


>
> Esteban
>
>> On 16 Aug 2017, at 00:07, [hidden email] 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:[hidden email]
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 | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Esteban A. Maringolo
In reply to this post by Herby Vojčík
Herby,

Please apologize I can't take the time to look into your code.

I granted you write access to
<http://smalltalkhub.com/#!/~DBXTalk/Glorp/>, could you upload your
latter version to it?

Regards!
Esteban A. Maringolo


2017-08-15 19:07 GMT-03:00  <[hidden email]>:

> 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') ]
>>> ! !
>>>
>>>
>>>
>>
>>
>>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

EstebanLM
In reply to this post by jtuchel


> On 16 Aug 2017, at 19:29, "[hidden email]" <[hidden email]> 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, [hidden email] 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:[hidden email]
> 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 | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

jtuchel
Am 16.08.17 um 19:33 schrieb Esteban Lorenzano:
>
>>> 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 :)

So you volunteered to discuss problem and fix with Cincom? ;-)


Joachim


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this? (was: Re: Big Glorp problem w/ type coercion, pls help)

Herby Vojčík
In reply to this post by Esteban A. Maringolo
Esteban A. Maringolo wrote:
> Herby,
>
> Please apologize I can't take the time to look into your code.

Np, if someone eventually will.

> I granted you write access to
> <http://smalltalkhub.com/#!/~DBXTalk/Glorp/>, could you upload your
> latter version to it?

Uploaded.

> Regards!
> Esteban A. Maringolo

P.S.: I did not gain understanding of Glorp innards in that small amount
of time, of course, but I went by the intuition that at the place I made
the fix, the normal (base class, Mapping >>) behaviour is to convert the
right sides of the relation, and the only subclass which has it
overridden, namely DirectMapping, seems to do the same thing (when
looking at the code), just in an optimized way. Except, it does not
convert, which I believe, strongly, to be a bug left out while doing
that optimization.

Herby

Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

jtuchel
Herby,

my ccomments were not meant to say you are not competent enough to fix Glorp. I know you have been active as the maintainer of Amber for quite a while now and know you are an experienced Smalltalker. So this is not an attempt to make you look incompetent or "unqualified".

I just wanted to point out that
  • I think that if there is a bug in Glorp, it should be communicated to the maintainers in order to make sure the fix is making it into newer Glorp versions and from there to all dialects that have a port of Glorp (Smalltalk is too much of a niche to be able to stand more and more niche-ification of forks and stuff, esp. for such a central part as Glorp which are way too important to only be maintained by one or two developers - which they unfortunately are, at least to my knowledge)
  • I am not sure if anybody from Cincom is listening here looking for Glorp problems, so I saw/see the danger of "private" fixes / forks
  • I fixed a few bugs in Glorp in the past just to find out that the concept was correct but the place to fix it was wrong (or at least would not heal all related problems). Glorp is complex and it has lots of layers. It is a good example of the "avoid responsibility" concept that was once (what a coincidence) formulated by Alan Knight in an article named "All I've learned about object orientation I learnt from Dilbert" (or similar) - so I was gad Niall looked into these and gave me feedback as well as a "full" fix

So I mainly ask you to post your fix and problem description to the Glorp Mailing list / Google group. It would be a pity if your fix is buried in some fork of Glorp.

Joachim



Am 16.08.17 um 20:02 schrieb Herby Vojčík:
Esteban A. Maringolo wrote:
Herby,

Please apologize I can't take the time to look into your code.

Np, if someone eventually will.

I granted you write access to
<http://smalltalkhub.com/#!/~DBXTalk/Glorp/>, could you upload your
latter version to it?

Uploaded.

Regards!
Esteban A. Maringolo

P.S.: I did not gain understanding of Glorp innards in that small amount of time, of course, but I went by the intuition that at the place I made the fix, the normal (base class, Mapping >>) behaviour is to convert the right sides of the relation, and the only subclass which has it overridden, namely DirectMapping, seems to do the same thing (when looking at the code), just in an optimized way. Except, it does not convert, which I believe, strongly, to be a bug left out while doing that optimization.

Herby




-- 
-----------------------------------------------------------------------
Objektfabrik Joachim Tuchel          [hidden email]
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 | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

Herby Vojčík
[hidden email] wrote:
> Herby,
>
> my ccomments were not meant to say you are not competent enough to fix
> Glorp. I know you have been active as the maintainer of Amber for quite
> a while now and know you are an experienced Smalltalker. So this is not

Not really. Actually, never did any production-ready project in
Smalltalk. The one I do now is the first time.

> an attempt to make you look incompetent or "unqualified".
>
> I just wanted to point out that
>
>   * I think that if there is a bug in Glorp, it should be communicated
>     to the maintainers in order to make sure the fix is making it into
>     newer Glorp versions and from there to all dialects that have a port

Yeah, sure. But Esteban's mail suggested that it is a long process, so
maybe it _is_ beneficial to try to shortcut the fix at Pharo side.

Don't know the local politics, so can't say myself.

>     of Glorp (Smalltalk is too much of a niche to be able to stand more
>     and more niche-ification of forks and stuff, esp. for such a central
>     part as Glorp which are way too important to only be maintained by
>     one or two developers - which they unfortunately are, at least to my
>     knowledge)

:-(

>   * I am not sure if anybody from Cincom is listening here looking for
>     Glorp problems, so I saw/see the danger of "private" fixes / forks
>   * I fixed a few bugs in Glorp in the past just to find out that the
>     concept was correct but the place to fix it was wrong (or at least
>     would not heal all related problems). Glorp is complex and it has
>     lots of layers. It is a good example of the "avoid responsibility"
>     concept that was once (what a coincidence) formulated by Alan Knight
>     in an article named "All I've learned about object orientation I
>     learnt from Dilbert" (or similar) - so I was gad Niall looked into

Yeah, the classic (that is, for me; lots of ppl out there do not know
it, though they should).

>     these and gave me feedback as well as a "full" fix

Yeah, that would be nice.

> So I mainly ask you to post your fix and problem description to the
> Glorp Mailing list / Google group. It would be a pity if your fix is

I posted (that is, I tried to; I hope it got there).

Maybe I should reply there with a few more words... or find out if it
got there in the first place.


> buried in some fork of Glorp.
>
> Joachim

Herby

Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

EstebanLM

> On 17 Aug 2017, at 10:18, Herby Vojčík <[hidden email]> wrote:
>
> [hidden email] wrote:
>> Herby,
>>
>> my ccomments were not meant to say you are not competent enough to fix
>> Glorp. I know you have been active as the maintainer of Amber for quite
>> a while now and know you are an experienced Smalltalker. So this is not
>
> Not really. Actually, never did any production-ready project in Smalltalk. The one I do now is the first time.
>
>> an attempt to make you look incompetent or "unqualified".
>>
>> I just wanted to point out that
>>
>>  * I think that if there is a bug in Glorp, it should be communicated
>>    to the maintainers in order to make sure the fix is making it into
>>    newer Glorp versions and from there to all dialects that have a port
>
> Yeah, sure. But Esteban's mail suggested that it is a long process, so maybe it _is_ beneficial to try to shortcut the fix at Pharo side.
>
> Don't know the local politics, so can't say myself.

Is not about politics :)
basically: cincom does not maintains other platforms than themselves (and *I am not* complaining, this is a fair choice, we do the same with pharo related things). So if we want to keep the port updated is this community who has to do it.
Now, in the case of Glorp this is not easy to do and last year we (the consortium) spent money to get an updated port. Now, if there is a bug and is *we* who found it, I would like to have a fix for our port (and of course inform it to cincom guys).

In fact… complexity is so big in this project that every port of Glorp from VW to Pharo is a “de facto” fork (not desired, but necessary). And any new port/update of the port will require important efforts we cannot do at the moment (I guess we could diff versions and update just the changes we find… just to simplify. But still, this is a lot of work :P).

Anyway, this is why if we have the opportunity to fix a bug in our platform, I would apply it regardless the cincom process (and our own update process).

cheers,
Esteban

>
>>    of Glorp (Smalltalk is too much of a niche to be able to stand more
>>    and more niche-ification of forks and stuff, esp. for such a central
>>    part as Glorp which are way too important to only be maintained by
>>    one or two developers - which they unfortunately are, at least to my
>>    knowledge)
>
> :-(
>
>>  * I am not sure if anybody from Cincom is listening here looking for
>>    Glorp problems, so I saw/see the danger of "private" fixes / forks
>>  * I fixed a few bugs in Glorp in the past just to find out that the
>>    concept was correct but the place to fix it was wrong (or at least
>>    would not heal all related problems). Glorp is complex and it has
>>    lots of layers. It is a good example of the "avoid responsibility"
>>    concept that was once (what a coincidence) formulated by Alan Knight
>>    in an article named "All I've learned about object orientation I
>>    learnt from Dilbert" (or similar) - so I was gad Niall looked into
>
> Yeah, the classic (that is, for me; lots of ppl out there do not know it, though they should).
>
>>    these and gave me feedback as well as a "full" fix
>
> Yeah, that would be nice.
>
>> So I mainly ask you to post your fix and problem description to the
>> Glorp Mailing list / Google group. It would be a pity if your fix is
>
> I posted (that is, I tried to; I hope it got there).
>
> Maybe I should reply there with a few more words... or find out if it got there in the first place.
>
>
>> buried in some fork of Glorp.
>>
>> Joachim
>
> Herby
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

Guillermo Polito


On Thu, Aug 17, 2017 at 10:32 AM, Esteban Lorenzano <[hidden email]> wrote:

> On 17 Aug 2017, at 10:18, Herby Vojčík <[hidden email]> wrote:
>
> [hidden email] wrote:
>> Herby,
>>
>> my ccomments were not meant to say you are not competent enough to fix
>> Glorp. I know you have been active as the maintainer of Amber for quite
>> a while now and know you are an experienced Smalltalker. So this is not
>
> Not really. Actually, never did any production-ready project in Smalltalk. The one I do now is the first time.
>
>> an attempt to make you look incompetent or "unqualified".
>>
>> I just wanted to point out that
>>
>>  * I think that if there is a bug in Glorp, it should be communicated
>>    to the maintainers in order to make sure the fix is making it into
>>    newer Glorp versions and from there to all dialects that have a port
>
> Yeah, sure. But Esteban's mail suggested that it is a long process, so maybe it _is_ beneficial to try to shortcut the fix at Pharo side.
>
> Don't know the local politics, so can't say myself.

Is not about politics :)
basically: cincom does not maintains other platforms than themselves (and *I am not* complaining, this is a fair choice, we do the same with pharo related things). So if we want to keep the port updated is this community who has to do it.
Now, in the case of Glorp this is not easy to do and last year we (the consortium) spent money to get an updated port. Now, if there is a bug and is *we* who found it, I would like to have a fix for our port (and of course inform it to cincom guys).

In fact… complexity is so big in this project that every port of Glorp from VW to Pharo is a “de facto” fork (not desired, but necessary). And any new port/update of the port will require important efforts we cannot do at the moment (I guess we could diff versions and update just the changes we find… just to simplify. But still, this is a lot of work :P).

Anyway, this is why if we have the opportunity to fix a bug in our platform, I would apply it regardless the cincom process (and our own update process).

Just a thought out of thin air: wasn't filetree supposed to provide common ground for this kind of scenarios? If we shared a single repository in github that would save us a lot of discussion :P
 

cheers,
Esteban

>
>>    of Glorp (Smalltalk is too much of a niche to be able to stand more
>>    and more niche-ification of forks and stuff, esp. for such a central
>>    part as Glorp which are way too important to only be maintained by
>>    one or two developers - which they unfortunately are, at least to my
>>    knowledge)
>
> :-(
>
>>  * I am not sure if anybody from Cincom is listening here looking for
>>    Glorp problems, so I saw/see the danger of "private" fixes / forks
>>  * I fixed a few bugs in Glorp in the past just to find out that the
>>    concept was correct but the place to fix it was wrong (or at least
>>    would not heal all related problems). Glorp is complex and it has
>>    lots of layers. It is a good example of the "avoid responsibility"
>>    concept that was once (what a coincidence) formulated by Alan Knight
>>    in an article named "All I've learned about object orientation I
>>    learnt from Dilbert" (or similar) - so I was gad Niall looked into
>
> Yeah, the classic (that is, for me; lots of ppl out there do not know it, though they should).
>
>>    these and gave me feedback as well as a "full" fix
>
> Yeah, that would be nice.
>
>> So I mainly ask you to post your fix and problem description to the
>> Glorp Mailing list / Google group. It would be a pity if your fix is
>
> I posted (that is, I tried to; I hope it got there).
>
> Maybe I should reply there with a few more words... or find out if it got there in the first place.
>
>
>> buried in some fork of Glorp.
>>
>> Joachim
>
> Herby
>





--

   

Guille Polito


Research Engineer

French National Center for Scientific Research - http://www.cnrs.fr



Web: http://guillep.github.io

Phone: +33 06 52 70 66 13

Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

EstebanLM

On 17 Aug 2017, at 10:35, Guillermo Polito <[hidden email]> wrote:

Just a thought out of thin air: wasn't filetree supposed to provide common ground for this kind of scenarios? If we shared a single repository in github that would save us a lot of discussion :P

it doesn’t :)
while exporting VM-Glorp to github will simplify a lot the process, truth is dialects are so different they cannot talk each other in general, and changes needs to be applied (by hand).

but… having a github mirror to be able to diff properly is a good thing.

Esteban

Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

Herby Vojčík
In reply to this post by Guillermo Polito
Guillermo Polito wrote:

>
>
> On Thu, Aug 17, 2017 at 10:32 AM, Esteban Lorenzano <[hidden email]
> <mailto:[hidden email]>> wrote:
>
>
>     >  On 17 Aug 2017, at 10:18, Herby Vojčík <[hidden email]
>     <mailto:[hidden email]>> wrote:
>     >
>     >  [hidden email] <mailto:[hidden email]> wrote:
>     > > Herby,
>     > >
>     > > my ccomments were not meant to say you are not competent enough
>     to fix
>     > > Glorp. I know you have been active as the maintainer of Amber for
>     quite
>     > > a while now and know you are an experienced Smalltalker. So this
>     is not
>     >
>     >  Not really. Actually, never did any production-ready project in
>     Smalltalk. The one I do now is the first time.
>     >
>     > > an attempt to make you look incompetent or "unqualified".
>     > >
>     > > I just wanted to point out that
>     > >
>     > >  * I think that if there is a bug in Glorp, it should be communicated
>     > >    to the maintainers in order to make sure the fix is making it into
>     > >    newer Glorp versions and from there to all dialects that have
>     a port
>     >
>     >  Yeah, sure. But Esteban's mail suggested that it is a long
>     process, so maybe it _is_ beneficial to try to shortcut the fix at
>     Pharo side.
>     >
>     >  Don't know the local politics, so can't say myself.
>
>     Is not about politics :)
>     basically: cincom does not maintains other platforms than themselves
>     (and *I am not* complaining, this is a fair choice, we do the same
>     with pharo related things). So if we want to keep the port updated
>     is this community who has to do it.
>     Now, in the case of Glorp this is not easy to do and last year we
>     (the consortium) spent money to get an updated port. Now, if there
>     is a bug and is *we* who found it, I would like to have a fix for
>     our port (and of course inform it to cincom guys).
>
>     In fact… complexity is so big in this project that every port of
>     Glorp from VW to Pharo is a “de facto” fork (not desired, but
>     necessary). And any new port/update of the port will require
>     important efforts we cannot do at the moment (I guess we could diff
>     versions and update just the changes we find… just to simplify. But
>     still, this is a lot of work :P).
>
>     Anyway, this is why if we have the opportunity to fix a bug in our
>     platform, I would apply it regardless the cincom process (and our
>     own update process).
>
>
> Just a thought out of thin air: wasn't filetree supposed to provide
> common ground for this kind of scenarios? If we shared a single
> repository in github that would save us a lot of discussion :P

I'd prefer on-premise git.smalltalkhub.com, but it's just me. :-(

OTOH, it can be interesting if the system it runs on is decently
extensible so Smalltalk-specific plugins be added (edit in place via run
in squeakjs, deep-linking-like integration when open in internal browser
inside pharo image, ...).

>     cheers,
>     Esteban
>
>      >
>      >>    of Glorp (Smalltalk is too much of a niche to be able to
>     stand more
>      >>    and more niche-ification of forks and stuff, esp. for such a
>     central
>      >>    part as Glorp which are way too important to only be
>     maintained by
>      >>    one or two developers - which they unfortunately are, at
>     least to my
>      >>    knowledge)
>      >
>      > :-(
>      >
>      >>  * I am not sure if anybody from Cincom is listening here
>     looking for
>      >>    Glorp problems, so I saw/see the danger of "private" fixes /
>     forks
>      >>  * I fixed a few bugs in Glorp in the past just to find out that the
>      >>    concept was correct but the place to fix it was wrong (or at
>     least
>      >>    would not heal all related problems). Glorp is complex and it has
>      >>    lots of layers. It is a good example of the "avoid
>     responsibility"
>      >>    concept that was once (what a coincidence) formulated by Alan
>     Knight
>      >>    in an article named "All I've learned about object orientation I
>      >>    learnt from Dilbert" (or similar) - so I was gad Niall looked
>     into
>      >
>      > Yeah, the classic (that is, for me; lots of ppl out there do not
>     know it, though they should).
>      >
>      >>    these and gave me feedback as well as a "full" fix
>      >
>      > Yeah, that would be nice.
>      >
>      >> So I mainly ask you to post your fix and problem description to the
>      >> Glorp Mailing list / Google group. It would be a pity if your fix is
>      >
>      > I posted (that is, I tried to; I hope it got there).
>      >
>      > Maybe I should reply there with a few more words... or find out
>     if it got there in the first place.
>      >
>      >
>      >> buried in some fork of Glorp.
>      >>
>      >> Joachim
>      >
>      > Herby
>      >
>
>
>
>
>
> --
>
>
>
> Guille Polito
>
>
> Research Engineer
>
> French National Center for Scientific Research - _http://www.cnrs.fr_
>
>
>
> *Web:* _http://guillep.github.io_
>
> *Phone: *+33 06 52 70 66 13
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

EstebanLM

> On 17 Aug 2017, at 10:49, Herby Vojčík <[hidden email]> wrote:
>
> Guillermo Polito wrote:
>>
>>
>> On Thu, Aug 17, 2017 at 10:32 AM, Esteban Lorenzano <[hidden email]
>> <mailto:[hidden email]>> wrote:
>>
>>
>>    >  On 17 Aug 2017, at 10:18, Herby Vojčík <[hidden email]
>>    <mailto:[hidden email]>> wrote:
>>    >
>>    >  [hidden email] <mailto:[hidden email]> wrote:
>>    > > Herby,
>>    > >
>>    > > my ccomments were not meant to say you are not competent enough
>>    to fix
>>    > > Glorp. I know you have been active as the maintainer of Amber for
>>    quite
>>    > > a while now and know you are an experienced Smalltalker. So this
>>    is not
>>    >
>>    >  Not really. Actually, never did any production-ready project in
>>    Smalltalk. The one I do now is the first time.
>>    >
>>    > > an attempt to make you look incompetent or "unqualified".
>>    > >
>>    > > I just wanted to point out that
>>    > >
>>    > >  * I think that if there is a bug in Glorp, it should be communicated
>>    > >    to the maintainers in order to make sure the fix is making it into
>>    > >    newer Glorp versions and from there to all dialects that have
>>    a port
>>    >
>>    >  Yeah, sure. But Esteban's mail suggested that it is a long
>>    process, so maybe it _is_ beneficial to try to shortcut the fix at
>>    Pharo side.
>>    >
>>    >  Don't know the local politics, so can't say myself.
>>
>>    Is not about politics :)
>>    basically: cincom does not maintains other platforms than themselves
>>    (and *I am not* complaining, this is a fair choice, we do the same
>>    with pharo related things). So if we want to keep the port updated
>>    is this community who has to do it.
>>    Now, in the case of Glorp this is not easy to do and last year we
>>    (the consortium) spent money to get an updated port. Now, if there
>>    is a bug and is *we* who found it, I would like to have a fix for
>>    our port (and of course inform it to cincom guys).
>>
>>    In fact… complexity is so big in this project that every port of
>>    Glorp from VW to Pharo is a “de facto” fork (not desired, but
>>    necessary). And any new port/update of the port will require
>>    important efforts we cannot do at the moment (I guess we could diff
>>    versions and update just the changes we find… just to simplify. But
>>    still, this is a lot of work :P).
>>
>>    Anyway, this is why if we have the opportunity to fix a bug in our
>>    platform, I would apply it regardless the cincom process (and our
>>    own update process).
>>
>>
>> Just a thought out of thin air: wasn't filetree supposed to provide
>> common ground for this kind of scenarios? If we shared a single
>> repository in github that would save us a lot of discussion :P
>
> I'd prefer on-premise git.smalltalkhub.com, but it's just me. :-(

yeah, that will not happen, sorry.
we are moving to github *also* because of marketing and visibility.

Esteban

>
> OTOH, it can be interesting if the system it runs on is decently extensible so Smalltalk-specific plugins be added (edit in place via run in squeakjs, deep-linking-like integration when open in internal browser inside pharo image, ...).
>
>>    cheers,
>>    Esteban
>>
>>     >
>>     >>    of Glorp (Smalltalk is too much of a niche to be able to
>>    stand more
>>     >>    and more niche-ification of forks and stuff, esp. for such a
>>    central
>>     >>    part as Glorp which are way too important to only be
>>    maintained by
>>     >>    one or two developers - which they unfortunately are, at
>>    least to my
>>     >>    knowledge)
>>     >
>>     > :-(
>>     >
>>     >>  * I am not sure if anybody from Cincom is listening here
>>    looking for
>>     >>    Glorp problems, so I saw/see the danger of "private" fixes /
>>    forks
>>     >>  * I fixed a few bugs in Glorp in the past just to find out that the
>>     >>    concept was correct but the place to fix it was wrong (or at
>>    least
>>     >>    would not heal all related problems). Glorp is complex and it has
>>     >>    lots of layers. It is a good example of the "avoid
>>    responsibility"
>>     >>    concept that was once (what a coincidence) formulated by Alan
>>    Knight
>>     >>    in an article named "All I've learned about object orientation I
>>     >>    learnt from Dilbert" (or similar) - so I was gad Niall looked
>>    into
>>     >
>>     > Yeah, the classic (that is, for me; lots of ppl out there do not
>>    know it, though they should).
>>     >
>>     >>    these and gave me feedback as well as a "full" fix
>>     >
>>     > Yeah, that would be nice.
>>     >
>>     >> So I mainly ask you to post your fix and problem description to the
>>     >> Glorp Mailing list / Google group. It would be a pity if your fix is
>>     >
>>     > I posted (that is, I tried to; I hope it got there).
>>     >
>>     > Maybe I should reply there with a few more words... or find out
>>    if it got there in the first place.
>>     >
>>     >
>>     >> buried in some fork of Glorp.
>>     >>
>>     >> Joachim
>>     >
>>     > Herby
>>     >
>>
>>
>>
>>
>>
>> --
>>
>>
>>
>> Guille Polito
>>
>>
>> Research Engineer
>>
>> French National Center for Scientific Research - _http://www.cnrs.fr_
>>
>>
>>
>> *Web:* _http://guillep.github.io_
>>
>> *Phone: *+33 06 52 70 66 13
>>
>
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

Herby Vojčík
In reply to this post by EstebanLM
Esteban Lorenzano wrote:

>
>> On 17 Aug 2017, at 10:35, Guillermo Polito <[hidden email]
>> <mailto:[hidden email]>> wrote:
>>
>> Just a thought out of thin air: wasn't filetree supposed to provide
>> common ground for this kind of scenarios? If we shared a single
>> repository in github that would save us a lot of discussion :P
>
> it doesn’t :)
> while exporting VM-Glorp to github will simplify a lot the process,
> truth is dialects are so different they cannot talk each other in
> general, and changes needs to be applied (by hand).

I know it sounds like pipe dream, but I had the impression
non-dialect-specific parts of Glorp (that is, most of it) is (was?)
deliberately written in subset of Smalltalk (not ifNotNil: but isNil
ifFalse: etc.) that it aimed to actually _be_ portable.

That part at least (and the high-level part with descriptors, mappings,
queries, glorpexpressions etc. is such) would be nice to actually be
generic enough to be "any Smalltalk out there".

Herby

> but… having a github mirror to be able to diff properly is a good thing.
>
> Esteban
>


Reply | Threaded
Open this post in threaded view
|

Re: What is proper fix for this?

Guillermo Polito
but! we could have github.pharo.org that redirects to the pharo organization in github :P

On Thu, Aug 17, 2017 at 10:53 AM, Herby Vojčík <[hidden email]> wrote:
Esteban Lorenzano wrote:

On 17 Aug 2017, at 10:35, Guillermo Polito <[hidden email]
<mailto:[hidden email]>> wrote:

Just a thought out of thin air: wasn't filetree supposed to provide
common ground for this kind of scenarios? If we shared a single
repository in github that would save us a lot of discussion :P

it doesn’t :)
while exporting VM-Glorp to github will simplify a lot the process,
truth is dialects are so different they cannot talk each other in
general, and changes needs to be applied (by hand).

I know it sounds like pipe dream, but I had the impression non-dialect-specific parts of Glorp (that is, most of it) is (was?) deliberately written in subset of Smalltalk (not ifNotNil: but isNil ifFalse: etc.) that it aimed to actually _be_ portable.

That part at least (and the high-level part with descriptors, mappings, queries, glorpexpressions etc. is such) would be nice to actually be generic enough to be "any Smalltalk out there".

Herby

but… having a github mirror to be able to diff properly is a good thing.

Esteban






--

   

Guille Polito


Research Engineer

French National Center for Scientific Research - http://www.cnrs.fr



Web: http://guillep.github.io

Phone: +33 06 52 70 66 13

12