Printed on: 2/10/99

CompositeObservation

class name CompositeObservation
superclass Observation
instance variable names observations
class variable names none
pool dictionaries none

CompositeObservation is exactly an implemention of the Composite Pattern for Observations. For example, a Cholesterol Observation is composed of two PrimitiveObservations of HDL and LDL.

Instance Variables:
        observations        <Collection of Observations>        The actual observations that it is composed of.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for accessing

observations: aCollection
        observations := aCollection

observations
        ^observations isNil
                ifTrue: [observations := OrderedCollection new]
                ifFalse: [observations]


Protocol for composite elements

removeComponent: anObservation
        ^self observations remove: anObservation ifAbsent: []

componentFor: aPhenomenon
        ^self observations detect: [:each | each phenomenon = aPhenomenon]
                ifNone: [nil]

addComponent: anObservation
        self observations add: anObservation


Protocol for CRUD

update
        ^super update

create
        "Inserts a new row into the db if object is valid."

        self isValid ifFalse: [^nil].
        self assignUniqueKey.
        super create


Protocol for Initialization

initialize: aRow
        objectIdentifier := aRow at: 'ID_OBJ'.
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        comments := self typeConverter convertToString: (aRow at: 'comments').
        recordedTime := self typeConverter
                                convertToNumber: (aRow at: 'recordedTi').
        type := ObservationType instanceFromDatabaseIdentified: (aRow at: 'type').
        observations := self componentsFromDatabase

componentsFromDatabase
        | aStream aCollection |
        aCollection := OrderedCollection new.
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT ID_OBJ2 FROM OBJLNKTB WHERE ID_OBJ1=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        (self class databaseConnection
                resultTableFromQuerySpec: (AbtQuerySpec new statement: aStream contents))
                        do: [:aRow | aCollection add: (aRow at: 'ID_OBJ2')].
        ^aCollection
                collect: [:eachOID | Observation instanceFromDatabaseIdentified: eachOID]


Protocol for Persistence Layer

saveComponentIfDirty
        self observations do: [:each | each saveAsTransaction]


Protocol for SQLCode

insertRowSql
        "Build the insert statement from the object. The class table method returns the
        physical table name. The typeConverter method is located in PPLPersistentObject.
        The prepForSql: method is located in the PPLTypeConverter class and is part of the
        Type converter pattern. It takes the object and formats it for what the database
        requires. Each attribute is formatted for the database and placed on the stream."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: self class table;
                nextPutAll: ' (ID_OBJ,
                        ID_OBJ_OWN,
                        rowLastCha,
                        recordedTi,
                        comments,
                        type)
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self owningObject);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self comments);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self type objectIdentifier);
                nextPutAll: ')'.
        ^aStream contents

updateRowSql
        "Build the update sql statement from the object."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'UPDATE ';
                nextPutAll: self class table;
                nextPutAll: ' SET ';
                nextPutAll: ' rowLastCha=';
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPutAll: ', recordedTi=';
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPutAll: ', comments=';
                nextPutAll: (self typeConverter prepForSql: self comments);
                nextPutAll: ' WHERE ID_OBJ=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        ^aStream contents


Protocol for testing

isCompositeObservation
        ^true

isValid
        ^self components inject: true
                into: [:isValid :each | isValid and: [each isValid]]

includesComponent: anObservation
        | compositeObservations |
        compositeObservations := self observations
                                select: [:each | each isComposite].
        ^(self observations includes: anObservation) or:
                        [compositeObservations
                                detect: [:each | each includesComponent: anObservation]
                                ifNone: [false].
                        true]


CompositeObservation class


Protocol for Persistence Layer

dBNickName
        ^'COB'


Protocol for SQL Code

buildSqlStatement: aWhereCondition
        "This method builds the actual sql statement required to read records from the table.
        The aString passed in is the selection where clause produced by the selectionClause
        method of the object. The conditional check for where clause. Provides the ability to
        load all (PPLPersistentObject>>loadAll ) the records from the table."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT
                                        ID_OBJ,
                                        ID_OBJ_OWN,
                                        recordedTi,
                                        comments,
                                        type ';
                nextPutAll: 'FROM ';
                nextPutAll: self table.
        "Conditional check for where clause. Provides the ability to load all (loadAll method) the records from the table."
        (aWhereCondition isNil or: [aWhereCondition trimBlanks isEmpty])
                ifFalse:
                        [aStream
                                setToEnd;
                                nextPutAll: ' WHERE ';
                                nextPutAll: aWhereCondition].
        ^aStream contents

tableName
        ^'CompositeObservation'


CompositeObservationType

class name CompositeObservationType
superclass ObservationType
instance variable names components
class variable names none
pool dictionaries none

CompositeObservationType is exactly an implemention of the Composite Pattern for ObservationTypes. For example, a Cholesterol ObservationType is composed of two PrimitiveObservationTypes which are HDL and LDL.

Instance Variables:
        components        <Collection of ObservationTypes>        These are the actual components that this ObservationType is composed of.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for accessing

components
        ^components isNil
                ifTrue: [components := OrderedCollection new]
                ifFalse: [components]

components: anObject
        components := anObject


Protocol for composite elements

composingTypes
        ^self components

addNewComponent: anObservationType
        self components add: anObservationType


Protocol for Initialization

initialize: aRow
        objectIdentifier := aRow at: 'ID_OBJ'.
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        phenomenon := (aRow at: 'phenomenon') asSymbol.
        validator := Validator validatorFromDatabaseFor: self.
        components := self componentsFromDatabase

componentsFromDatabase
        | aStream aCollection |
        aCollection := OrderedCollection new.
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT ID_OBJ2 FROM OBJLNKTB WHERE ID_OBJ1=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        (self class databaseConnection
                resultTableFromQuerySpec: (AbtQuerySpec new statement: aStream contents))
                        do: [:aRow | aCollection add: (aRow at: 'ID_OBJ2')].
        ^aCollection
                collect: [:eachOID | ObservationType instanceFromDatabaseIdentified: eachOID]


Protocol for Persistence Layer

saveComponentIfDirty
        "Verifies existence of the address object and also verifies a proxy pattern
        is not holding the position. The address owning object is set to the current object
        and then the address object is saved as part of the current transaction."

        self validator owningObject: self objectIdentifier.
        self validator saveAsTransaction


Protocol for printing

speciesPrintString
        ^'<a Composite Observation Type>'


Protocol for SQLCode

addComponentRelationship: anObservationType
        | aStream |
        (self objectIdentifier isNil
                or: [anObservationType objectIdentifier isNil]) ifTrue: [^self].
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: 'ObjLnkTb';
                nextPutAll: ' (ID_OBJ1,
                        ID_OBJ2 )
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter
                                        prepForSql: anObservationType objectIdentifier);
                nextPutAll: ')'.
        self class executeSql: aStream contents

removeComponentRelationship: anObservationType
        | aStream |
        (self objectIdentifier isNil
                or: [anObservationType objectIdentifier isNil]) ifTrue: [^self].
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'DELETE FROM ObjLnkTb';
                cr.
        aStream nextPutAll: 'WHERE ID_OBJ1='.
        aStream nextPutAll: self objectIdentifier printString.
        aStream nextPutAll: 'AND ID_OBJ2='.
        aStream nextPutAll: anObservationType objectIdentifier printString.
        self class executeSql: aStream contents


Protocol for testing

includes: anObservationType
        ^self components includes: anObservationType phenomenon

isCompositeType
        ^true


CompositeObservationType class


Protocol for Observation Class

observationClass
        ^CompositeObservation


Protocol for Persistence Layer

dBNickName
        ^'COT'


Protocol for SQL Code

tableName
        ^'CompositeObservationType'


DiscreteValidator

class name DiscreteValidator
superclass Validator
instance variable names descriptorSet
class variable names none
pool dictionaries none

DiscreteValidator is used to validate observations that can have a discrete set of values. For example, eye color might be (#brown #blue #green #red).

Instance Variables:
        descriptorSet        <Set of Symbols>        The descriptorSet is the set of discrete values used for validation.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu



Protocol for accessing

descriptors
        ^self descriptorSet asOrderedCollection

descriptorsAsList
        ^self descriptors

removeDescriptor: aDescriptor
        self makeDirty.
        self descriptorSet remove: aDescriptor ifAbsent: [].
        self signalEvent: #descriptors with: aDescriptor

descriptorSet
        ^descriptorSet isNil
                ifTrue: [descriptorSet := Set new]
                ifFalse: [descriptorSet]

addDescriptor: aDescriptor
        self makeDirty.
        self descriptorSet add: aDescriptor.
        self signalEvent: #descriptors with: aDescriptor


Protocol for Initialization

descriptorsFrom: anString
        ^anString abrSubstrings: $,

initialize: aRow
        "Initializes an instance from the database row. This method is called from the
        PPLPersistentObject: read method and produces an instance of the class
        with attribute values retrieved from the database. The aRow parameter is a
        row from a result set. Each attribute is sent to a Type Conversion Pattern method
        in order to format the value to the format the object expects. Generally, with a
        one to one relation a join should be used for performance reason but this
        demonstrates a one to many or when a join is not possible. For the one to
        many relation use the loadAllLike method."

        objectIdentifier := aRow at: 'ID_OBJ'.
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        descriptorSet := (self descriptorsFrom: (self typeConverter
                                                convertToString: (aRow at: 'descriptor')))
                                asSet


Protocol for SQLCode

descriptorsAsDBString
        | aStream |
        aStream := WriteStream on: String new.
        self descriptors do:
                        [:each |
                        aStream nextPutAll: each asString.
                        aStream nextPut: $,].
        ^aStream contents

insertRowSql
        "Build the insert statement from the object. The class table method returns the
        physical table name. The typeConverter method is located in PPLPersistentObject.
        The prepForSql: method is located in the PPLTypeConverter class and is part of the
        Type converter pattern. It takes the object and formats it for what the database
        requires. Each attribute is formatted for the database and placed on the stream."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: self class table;
                nextPutAll: ' (ID_OBJ,
                        ID_OBJ_OWN,
                        descriptor)
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self owningObject);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self descriptorsAsDBString);
                nextPutAll: ')'.
        ^aStream contents

updateRowSql
        "Build the update sql statement from the object."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'UPDATE ';
                nextPutAll: self class table;
                nextPutAll: ' SET ';
                nextPutAll: 'descriptor =';
                nextPutAll: (self typeConverter prepForSql: self descriptorsAsDBString);
                nextPutAll: ' WHERE ID_OBJ=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        ^aStream contents


Protocol for testing

isValid: aDiscreteValue
        ^self descriptors includes: aDiscreteValue


DiscreteValidator class


Protocol for Persistence Layer

dBNickName
        ^'DVL'


Protocol for SQL Code

buildSqlStatement: aWhereCondition
        "This method builds the actual sql statement required to read records from the table.
        The aString passed in is the selection where clause produced by the selectionClause
        method of the object. The conditional check for where clause. Provides the ability to
        load all (PPLPersistentObject>>loadAll ) the records from the table."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT
                                        ID_OBJ,
                                        ID_OBJ_OWN,
                                        descriptor ';
                nextPutAll: 'FROM ';
                nextPutAll: self table.

        "Conditional check for where clause. Provides the ability to load all (loadAll method)
        the records from the table."
        (aWhereCondition isNil or: [aWhereCondition trimBlanks isEmpty])
                ifFalse:
                        [aStream
                                setToEnd;
                                nextPutAll: ' WHERE ';
                                nextPutAll: aWhereCondition].
        ^aStream contents

tableName
        ^'DiscreteValidator'


NullValidator

class name NullValidator
superclass Validator
instance variable names none
class variable names none
pool dictionaries none

NullValidator follows the Null Object pattern and is just the default validator. Currently is always returns true whenever it is asked to validate an observation.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu



Protocol for accessing

descriptors
        ^OrderedCollection new

removeDescriptor: aDescriptor
        ^self

addDescriptor: aDescriptor
        ^self


Protocol for CRUD

update
        ^self

create
        ^self

isValid
        ^true


Protocol for Persistance Layer

save
        ^self


Protocol for SQLCode

insertRowSql
        ^String new

selectionClause
        ^String new

updateRowSql
        ^String new


Protocol for testing

isValid: anObservationValue
        ^true


NullValidator class


Protocol for Persistence Layer

dBNickName
        ^'NVL'


ObservartionBuilder

class name ObservartionBuilder
superclass Object
instance variable names none
class variable names none
pool dictionaries none

ObservartionBuilder is a support class used by the GUI to assist with building Observations based on ObservationTypes and Validators.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for instance creation

createAnObservationFrom: anObservationType
        | newObservation |
        newObservation := anObservationType class observationClass new.
        newObservation type: anObservationType.
        (self componentsToInstantiateFrom: anObservationType) do:
                        [:eachType |
                        newObservation observations add: (self createAnObservationFrom: eachType)].
        ^newObservation


Protocol for Public

componentsToInstantiateFrom: anObservationType
        ^anObservationType composingTypes


Observation

class name Observation
superclass PPLPersistentObject
instance variable names type recordedTime comments
class variable names none
pool dictionaries none

Observations are used to capture instances of Observations as presented in Martin Fowler's Analysis Patterns. Our architecture extends Martin's idea by allowing for Composite Observations.

Our implementation uses the Type Object pattern for creating different types of Observations. There are two basic types of Observations that can be created which are either Primitive Observations or Composite Observations. Composite Observations follow the composite pattern from the Gang of Four.

Subclasses must implement the following messages:
        accessing
                componentFor:

Instance Variables:
        comments        <String>        This is some general comments about the observation
        recordedTime        <Timestamp>        This is the actual time that the observation was recorded
        type        <ObservationType>        This is the type for the type object

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for accessing

comments: anObject
        self makeDirty.
        comments := anObject.
        self signalEvent: #comments with: anObject

type: anObject
        self makeDirty.
        type := anObject.
        self signalEvent: #type with: anObject

observationValue
        ^nil

type
        ^type

recordedTime: anObject
        self makeDirty.
        recordedTime := anObject.
        self signalEvent: #recordedTime with: anObject

recordedTime
        ^recordedTime

comments
        ^comments

phenomenon
        ^self type isNil ifTrue: [nil] ifFalse: [type phenomenon]


Protocol for composite elements

componentFor: aPhenomenon
        ^self subclassResponsibility


Protocol for CRUD

update
        "Update the row in the table if valid otherwise remove from table."

        self isValid
                ifFalse:
                        [self isPersisted ifTrue: [^self deleteAsTransaction] ifFalse: [^nil]].
        super update

create
        "Inserts a new row into the db if object is valid."

        self isValid ifFalse: [^nil].
        self assignUniqueKey.
        super create


Protocol for printing

printString
        | stream prefix |
        stream := WriteStream with: String new.
        stream
                nextPutAll: self class name;
                nextPut: $-.
        self type isNil
                ifTrue: [prefix := '<a new Observation>']
                ifFalse: [prefix := self phenomenon asString].
        stream
                nextPutAll: prefix;
                nextPut: $-.
        self value isNil
                ifTrue: [stream nextPutAll: '<no vaue>']
                ifFalse: [stream nextPutAll: self value printString].
        ^stream contents


Protocol for SQLCode

selectionClause
        "Answer a string representation of selection criteria based on the contents of the
        instance. This is basically a where condition for a sql select statement. Each class
        has a selectionClause method that determines what selection criteria can be used
        with the object it is located in."

        | aStream |
        aStream := WriteStream on: String new.
        self objectIdentifier isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ=';
                                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
                        ^aStream contents].
        self owningObject isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ_OWN= ';
                                nextPutAll: (self typeConverter prepForSql: self owningObject)].
        ^aStream contents


Protocol for testing

isCompositeObservation
        ^false

isValid
        ^self type isValid: self observationValue


Observation class


Protocol for Instance retrieval

instanceFromDatabaseIdentified: anOID
        | aClass |
        aClass := self allSubclasses detect: [:each | each canInstantiate: anOID]
                                ifNone: [^nil].
        ^(aClass read: 'ID_OBJ=' , (PPLTypeConverter prepForSql: anOID)) first


Protocol for SQL Code

table
        "This method collaborates with the table manager to retrieve the physical
        name of the table."

        ^PPLTableManager getTable: self tableName

tableName
        ^self subclassResponsibility


ObservationType

class name ObservationType
superclass PPLPersistentObject
instance variable names validator phenomenon
class variable names none
pool dictionaries none

ObservationType are used to describe the phenomenon types of Observations as presented in Martin Fowler's Analysis Patterns. Our architecture extends Martin's idea by allowing for Composite Observations.

ObservationType is an implementation of the Type Object pattern for creating different types of Observations. There are two basic types of Observations that can be created which are either Primitive Observations or Composite Observations. Composite Observations follow the composite pattern from the Gang of Four.

The ObservationTypes are extened through the Type Object pattern by associating with each type of observation its Validator. The Validator has additional Type information that describes more about the type of Observations; for example Traits or Measurements.

Instance Variables:
        phenomenon        <String>        The name of the phenomenon being observed
        validator        <Validator>        The validator is used for validating the observed phenomenon

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu



Protocol for accessing

validator: aNewValidator
        "set the receiver validator with aNewValidator"

        self makeDirty.
        validator := aNewValidator.
        self signalEvent: #validator with: aNewValidator

validValues
        " answer a collection containing valid values"

        ^self validator validValues

phenomenon: aNewPhenomenon
        "set the receiver phenomenon with aNewPhenomenon"

        self makeDirty.
        phenomenon := aNewPhenomenon asSymbol.
        self signalEvent: #phenomenon with: aNewPhenomenon

validator
        ^validator isNil
                ifTrue: [validator := NullValidator new]
                ifFalse: [validator]

phenomenon
        "answer the receiver phenomenon"

        ^phenomenon isNil ifTrue: [phenomenon := String new] ifFalse: [phenomenon]


Protocol for composite elements

composingTypes
        ^OrderedCollection new


Protocol for CRUD

update
        "Update the row in the table if valid otherwise remove from table."

        self isValid
                ifFalse:
                        [self isPersisted ifTrue: [^self deleteAsTransaction] ifFalse: [^nil]].
        super update

create
        "Inserts a new row into the db if object is valid."

        self isValid ifFalse: [^nil].
        self assignUniqueKey.
        super create

isValid
        ^true


Protocol for Persistence Layer

saveComponentIfDirty
        "Verifies existence of the address object and also verifies a proxy pattern
        is not holding the position. The address owning object is set to the current object
        and then the address object is saved as part of the current transaction."

        self validator owningObject: self objectIdentifier.
        self validator saveAsTransaction


Protocol for printing

speciesPrintString
        ^'<an ObservationType>'

printString
        | prefix |
        phenomenon isNil
                ifTrue: [prefix := self speciesPrintString]
                ifFalse: [prefix := phenomenon asString].
        ^prefix , '-' , self validator class name


Protocol for SQLCode

insertRowSql
        "Build the insert statement from the object. The class table method returns the
        physical table name. The typeConverter method is located in PPLPersistentObject.
        The prepForSql: method is located in the PPLTypeConverter class and is part of the
        Type converter pattern. It takes the object and formats it for what the database
        requires. Each attribute is formatted for the database and placed on the stream."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: self class table;
                nextPutAll: ' (ID_OBJ,
                        ID_OBJ_OWN,
                        phenomenon)
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self owningObject);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self phenomenon);
                nextPutAll: ')'.
        ^aStream contents

selectionClause
        "Answer a string representation of selection criteria based on the contents of the
        instance. This is basically a where condition for a sql select statement. Each class
        has a selectionClause method that determines what selection criteria can be used
        with the object it is located in."

        | aStream |
        aStream := WriteStream on: String new.
        self objectIdentifier isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ=';
                                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
                        ^aStream contents].
        self owningObject isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ_OWN= ';
                                nextPutAll: (self typeConverter prepForSql: self owningObject)].
        ^aStream contents

updateRowSql
        "Build the update sql statement from the object."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'UPDATE ';
                nextPutAll: self class table;
                nextPutAll: ' SET ';
                nextPutAll: 'phenomenon =';
                nextPutAll: (self typeConverter prepForSql: self phenomenon);
                nextPutAll: ' WHERE ID_OBJ=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        ^aStream contents


Protocol for testing

isValid: anObservationValue
        ^self validator isValid: anObservationValue

isCompositeType
        ^false


ObservationType class


Protocol for Instance retrieval

instances
        | collection |
        collection := OrderedCollection new.
        self allSubclasses do: [:each | collection addAll: each loadAll].
        ^collection

instanceFromDatabaseIdentified: anOID
        | aClass |
        aClass := self allSubclasses detect: [:each | each canInstantiate: anOID]
                                ifNone: [^nil].
        ^(aClass read: 'ID_OBJ=' , (PPLTypeConverter prepForSql: anOID)) first


Protocol for SQL Code

table
        "This method collaborates with the table manager to retrieve the physical
        name of the table."

        ^PPLTableManager getTable: self tableName

buildSqlStatement: aWhereCondition
        "This method builds the actual sql statement required to read records from the table.
        The aString passed in is the selection where clause produced by the selectionClause
        method of the object. The conditional check for where clause. Provides the ability to
        load all (PPLPersistentObject>>loadAll ) the records from the table."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT
                                        ID_OBJ,
                                        ID_OBJ_OWN,
                                        phenomenon ';
                nextPutAll: 'FROM ';
                nextPutAll: self table.
        "Conditional check for where clause. Provides the ability to load all (loadAll method) the records from the table."
        (aWhereCondition isNil or: [aWhereCondition trimBlanks isEmpty])
                ifFalse:
                        [aStream
                                setToEnd;
                                nextPutAll: ' WHERE ';
                                nextPutAll: aWhereCondition].
        ^aStream contents

tableName
        ^self subclassResponsibility


PrimitiveObservation

class name PrimitiveObservation
superclass Observation
instance variable names observationValue
class variable names none
pool dictionaries none

PrimitiveObservation are the values associated with a phenomenon. This value could be either a discrete value such as the color of the hair, or it could be a ranged value such as weight. The phenomenon is described by the ObservationType.

Instance Variables:
        observationValue        <Symbol | Number>        The actual observed value for this observation.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for accessing

componentFor: aPhenomenon
        ^self phenomenon = aPhenomenon ifTrue: [self] ifFalse: [nil]

observationValue: anObject
        self makeDirty.
        observationValue := anObject.
        self signalEvent: #value with: anObject

observationValue
        ^observationValue


Protocol for Initialization

initialize
        "Initialize the instance to empty values."

        super initialize

initialize: aRow
        objectIdentifier := self typeConverter
                                convertToNumber: (aRow at: 'ID_OBJ').
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        comments := self typeConverter convertToString: (aRow at: 'comments').
        recordedTime := self typeConverter
                                convertToNumber: (aRow at: 'recordedTi').
        observationValue := self typeConverter
                                convertToString: (aRow at: '_value').
        type := ObservationType instanceFromDatabaseIdentified: (aRow at: 'type')


Protocol for SQLCode

insertRowSql
        "Build the insert statement from the object. The class table method returns the
        physical table name. The typeConverter method is located in PPLPersistentObject.
        The prepForSql: method is located in the PPLTypeConverter class and is part of the
        Type converter pattern. It takes the object and formats it for what the database
        requires. Each attribute is formatted for the database and placed on the stream."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: self class table;
                nextPutAll: ' (ID_OBJ,
                        ID_OBJ_OWN,
                        rowLastCha,
                        recordedTi,
                        comments,
                        _value,
                        type)
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self owningObject);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self comments);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self value asString);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self type objectIdentifier);
                nextPutAll: ')'.
        ^aStream contents

updateRowSql
        "Build the update sql statement from the object."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'UPDATE ';
                nextPutAll: self class table;
                nextPutAll: ' SET ';
                nextPutAll: ' rowLastCha=';
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPutAll: ', recordedTi=';
                nextPutAll: (self typeConverter prepForSql: nil);
                nextPutAll: ', _value =';
                nextPutAll: (self typeConverter prepForSql: self value asString);
                nextPutAll: ', comments=';
                nextPutAll: (self typeConverter prepForSql: self comments);
                nextPutAll: ' WHERE ID_OBJ=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        ^aStream contents


PrimitiveObservation class


Protocol for Persistence Layer

dBNickName
        ^'POB'


Protocol for SQL Code

buildSqlStatement: aWhereCondition
        "This method builds the actual sql statement required to read records from the table.
        The aString passed in is the selection where clause produced by the selectionClause
        method of the object. The conditional check for where clause. Provides the ability to
        load all (PPLPersistentObject>>loadAll ) the records from the table."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT
                                        ID_OBJ,
                                        ID_OBJ_OWN,
                                        RECORDEDTI
                                        comments,
                                        _value,
                                        type ';
                nextPutAll: 'FROM ';
                nextPutAll: self table.
        "Conditional check for where clause. Provides the ability to load all (loadAll method) the records from the table."
        (aWhereCondition isNil or: [aWhereCondition trimBlanks isEmpty])
                ifFalse:
                        [aStream
                                setToEnd;
                                nextPutAll: ' WHERE ';
                                nextPutAll: aWhereCondition].
        ^aStream contents

tableName
        ^'PrimitiveObservation'


PrimitiveObservationType

class name PrimitiveObservationType
superclass ObservationType
instance variable names none
class variable names none
pool dictionaries none

PrimitiveObservationType are the descriptions of PrimitiveObservations such as Hair Color, Eye Color, Weight, etc.

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu


Protocol for Initialization

initialize: aRow
        objectIdentifier := aRow at: 'ID_OBJ'.
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        phenomenon := (aRow at: 'phenomenon') asSymbol.
        validator := Validator validatorFromDatabaseFor: self


Protocol for printing

speciesPrintString
        ^'<a Primitive Observation Type>'


PrimitiveObservationType class


Protocol for Observation Class

observationClass
        ^PrimitiveObservation


Protocol for Persistence Layer

dBNickName
        ^'POT'


Protocol for SQL Code

tableName
        ^'PrimitiveObservationType'


RangedValidator

class name RangedValidator
superclass Validator
instance variable names intervalSet
class variable names none
pool dictionaries none

RangedValidator is used to validate observations that have a range of values. For example, weight could have a valid range of 0 <= weight <= 1000. There can be multiple interval sets in which the validation rule checks to see if the observation's value is contained within any one of the intervals.

Instance Variables:
        intervalSet        <Set of Intervals>        This is the set of intervals

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu




Protocol for accessing

descriptors
        ^self intervalSet asOrderedCollection

descriptorsAsList
        | collection |
        collection := OrderedCollection new.
        self descriptors
                do: [:each | collection addAll: (each collect: [:element | element])].
        ^collection

intervalSet
        ^intervalSet isNil ifTrue: [intervalSet := Set new] ifFalse: [intervalSet]

removeDescriptor: aDescriptor
        self intervalSet remove: aDescriptor ifAbsent: []

addDescriptor: aDescriptor
        self makeDirty.
        self intervalSet add: aDescriptor.
        self signalEvent: #descriptors with: aDescriptor


Protocol for Initialization

initialize: aRow
        "Initializes an instance from the database row. This method is called from the
        PPLPersistentObject: read method and produces an instance of the class
        with attribute values retrieved from the database. The aRow parameter is a
        row from a result set. Each attribute is sent to a Type Conversion Pattern method
        in order to format the value to the format the object expects. Generally, with a
        one to one relation a join should be used for performance reason but this
        demonstrates a one to many or when a join is not possible. For the one to
        many relation use the loadAllLike method."

        objectIdentifier := aRow at: 'ID_OBJ'.
        owningObject := aRow at: 'ID_OBJ_OWN'.
        isPersisted := true.
        intervalSet := self
                                intervalsFrom: (self typeConverter convertToString: (aRow at: 'rangedDesc'))

intervalsFrom: anString
        | aCollection subCollection |
        aCollection := OrderedCollection new.
        (anString abrSubstrings: $,) do:
                        [:each |
                        subCollection := each abrSubstrings: $-.
                        aCollection
                                add: (subCollection first asNumber to: subCollection last asNumber)].
        ^aCollection asSet


Protocol for SQLCode

descriptorsAsDBString
        | aStream |
        aStream := WriteStream on: String new.
        self descriptors do:
                        [:each |
                        aStream nextPutAll: each from printString.
                        aStream nextPut: $-.
                        aStream nextPutAll: each to printString.
                        aStream nextPut: $,].
        ^aStream contents

insertRowSql
        "Build the insert statement from the object. The class table method returns the
        physical table name. The typeConverter method is located in PPLPersistentObject.
        The prepForSql: method is located in the PPLTypeConverter class and is part of the
        Type converter pattern. It takes the object and formats it for what the database
        requires. Each attribute is formatted for the database and placed on the stream."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'INSERT INTO ';
                nextPutAll: self class table;
                nextPutAll: ' (ID_OBJ,
                        ID_OBJ_OWN,
                        rangedDesc)
                        VALUES (';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self owningObject);
                nextPut: $,;
                nextPutAll: (self typeConverter prepForSql: self descriptorsAsDBString);
                nextPutAll: ')'.
        ^aStream contents

updateRowSql
        "Build the update sql statement from the object."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'UPDATE ';
                nextPutAll: self class table;
                nextPutAll: ' SET ';
                nextPutAll: 'rangedDesc =';
                nextPutAll: (self typeConverter prepForSql: self descriptorsAsDBString);
                nextPutAll: ' WHERE ID_OBJ=';
                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
        ^aStream contents


Protocol for testing

isValid: aMeasurementValue
        ^(self descriptors select: [:each | each includes: aMeasurementValue])
                isEmpty not


RangedValidator class


Protocol for Persistence Layer

dBNickName
        ^'RVL'


Protocol for SQL Code

buildSqlStatement: aWhereCondition
        "This method builds the actual sql statement required to read records from the table.
        The aString passed in is the selection where clause produced by the selectionClause
        method of the object. The conditional check for where clause. Provides the ability to
        load all (PPLPersistentObject>>loadAll ) the records from the table."

        | aStream |
        aStream := WriteStream on: String new.
        aStream
                nextPutAll: 'SELECT
                                        ID_OBJ,
                                        ID_OBJ_OWN,
                                        rangedDesc ';
                nextPutAll: 'FROM';
                space;
                nextPutAll: self table.

        "Conditional check for where clause. Provides the ability to load all (loadAll method)
        the records from the table."
        (aWhereCondition isNil or: [aWhereCondition trimBlanks isEmpty])
                ifFalse:
                        [aStream
                                setToEnd;
                                nextPutAll: ' WHERE ';
                                nextPutAll: aWhereCondition].
        ^aStream contents

tableName
        ^'RangedValidator'


Validator

class name Validator
superclass PPLPersistentObject
instance variable names validatorName
class variable names none
pool dictionaries none

Validator is used to capture the validation rules for different types of observations.

Subclasses must implement the following messages:
        accessing
                addDescriptor:
                descriptors
                removeDescriptor:
        testing
                isValid:

Instance Variables:
        validatorName        <String>        The name of the validator

Developed - January 1999
Federico Balaguer balaguer@uiuc.edu
Joseph W. Yoder j-yoder@uiuc.edu




Protocol for accessing

descriptors
        ^self subclassResponsibility

removeDescriptor: aDescriptor
        ^self subclassResponsibility

addDescriptor: aDescriptor
        ^self subclassResponsibility


Protocol for CRUD

isValid
        ^true

update
        "Update the row in the table if valid otherwise remove from table."

        self isValid
                ifFalse:
                        [self isPersisted ifTrue: [^self deleteAsTransaction] ifFalse: [^nil]].
        super update

create
        "Inserts a new row into the db if object is valid."

        self isValid ifFalse: [^nil].
        self assignUniqueKey.
        super create


Protocol for SQLCode

selectionClause
        "Answer a string representation of selection criteria based on the contents of the
        instance. This is basically a where condition for a sql select statement. Each class
        has a selectionClause method that determines what selection criteria can be used
        with the object it is located in."

        | aStream |
        aStream := WriteStream on: String new.
        self objectIdentifier isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ=';
                                nextPutAll: (self typeConverter prepForSql: self objectIdentifier).
                        ^aStream contents].
        self owningObject isNil
                ifFalse:
                        [aStream
                                nextPutAll: 'ID_OBJ_OWN= ';
                                nextPutAll: (self typeConverter prepForSql: self owningObject)].
        ^aStream contents


Protocol for testing

isValid: aDiscreteValue
        ^self subclassResponsibility


Validator class


Protocol for instance retrieval

availableInstances
        ^self allSubclasses collect: [:each | each new]

validatorFromDatabaseFor: anObject
        | aStream result |
        anObject objectIdentifier isNil ifTrue: [^NullValidator new].
        result := DiscreteValidator loadAll
                                select: [:each | each owningObject = anObject objectIdentifier].
        result isEmpty
                ifTrue:
                        [result := RangedValidator loadAll
                                                select: [:each | each owningObject = anObject objectIdentifier]].
        ^result isEmpty ifTrue: [NullValidator new] ifFalse: [result first]


Protocol for SQL Code

table
        "This method collaborates with the table manager to retrieve the physical
        name of the table."

        ^PPLTableManager getTable: self tableName

tableName
        ^self subclassResponsibility


EntObservationModel

class name EntObservationModel
superclass Application
instance variable names none
class variable names none
pool dictionaries none