Glorp port changeset and documentation - Squeak-dev

1 Jun 2002


      I've spent about a dozen hours playing around with Glorp under Squeak 
(using PostgreSQL).  I've got all of the Glorp SUnit tests passing.
THIS WAS DONE RAPIDLY, and BUGS WILL EXISTS!!  Consider it even earlier 
than an alpha.  But at least the tests all pass.
Attached you will find a MickeySoft Word document ('GlorpPort.doc') that 
contains my "diary" of what I did.  I hope you find it entertaining :-)
Also attached you will find the 'glorp.cs' changeset with the code.
As you read the "diary", please note that there is workspace code listed 
in the "diary" that needs to be executed after you filein the changeset 
code.  If you don't execute that workspace code, the port won't work.
The diary also documents what image code you need to start with before 
filing in the changeset.
Nevin
'From Squeak3.2gamma of 15 January 2002 [latest update: #4881] on 31 May 2002 at 7:30:35 pm'!
"Change Set:		glorp
Date:			31 May 2002
Author:			Nevin Pratt
First version of a quick and dirty port of glorp to Squeak"!
ProtoObject subclass: #MessageArchiver
    instanceVariableNames: 'myMessage myReceiver '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
Object subclass: #Address
    instanceVariableNames: 'id street number '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Address class
    instanceVariableNames: ''!
Object subclass: #Airline
    instanceVariableNames: 'id name '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Airline class
    instanceVariableNames: ''!
Object subclass: #AirlineMeal
    instanceVariableNames: 'id description ingredients '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
AirlineMeal class
    instanceVariableNames: ''!
Object subclass: #AttributeAccessor
    instanceVariableNames: 'attributeName attributeIndex '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
AttributeAccessor class
    instanceVariableNames: ''!
Object subclass: #BankAccount
    instanceVariableNames: 'id accountNumber accountHolders eventsReceived '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
BankAccount class
    instanceVariableNames: ''!
Object subclass: #BankAccountNumber
    instanceVariableNames: 'bankCode branchNumber accountNumber '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
BankAccountNumber class
    instanceVariableNames: ''!
Object subclass: #BankTransaction
    instanceVariableNames: 'id owner amount serviceCharge '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
BankTransaction class
    instanceVariableNames: ''!
Object subclass: #Cache
    instanceVariableNames: 'items policy mainCache '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!Cache commentStamp: '<historical>' prior: 0!
This is the per-class cache of instances read from the database.
Instance Variables:
    items	<Dictionary from: Object to: Object>	The cached items, keyed by their primary key values
    policy	<CachePolicy>	The settings for this cache.
!
Cache class
    instanceVariableNames: ''!
Object subclass: #CacheManager
    instanceVariableNames: 'subCaches session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!CacheManager commentStamp: '<historical>' prior: 0!
This is the entire cache for a session, consisting of multiple sub-caches, one per class.
Instance Variables:
    session	<Session>	The containing session.
    subCaches	<Dictionary from: Class to: Cache>	The per-class caches.
!
CacheManager class
    instanceVariableNames: ''!
Object subclass: #CachePolicy
    instanceVariableNames: 'size expiryAction '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!CachePolicy commentStamp: '<historical>' prior: 0!
A CachePolicy implements the different possible policies we might use for caching. The superclass implements the trivial policy of keeping all objects forever.
The policy also controls what we store in the cache. In general, it's assumed to be a cache entry of some sort, and the policy is responsible for wrapping and unwrapping objects going to and from the cache. The default policy is that the objects themselves are the cache entry (saving one object per cached object in overhead).
Instance Variables:
    size	<Number>	The minimum cache size we want to use.
    expiryAction <Symbol> What to do when an object has expired. Currently hard-coded as one of #remove, #notify, #refresh, #notifyAndRemove.
!
CachePolicy class
    instanceVariableNames: ''!
Object subclass: #Customer
    instanceVariableNames: 'id name transactions accounts eventsReceived seenPostFetch seenPreWrite seenPostWrite seenExpiry '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Customer class
    instanceVariableNames: ''!
Object subclass: #DatabaseAccessor
    instanceVariableNames: 'connection currentLogin platform logging '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpDatabase'!
DatabaseAccessor class
    instanceVariableNames: ''!
Object subclass: #DatabaseField
    instanceVariableNames: 'table name isPrimaryKey sequencePolicy type fieldSize position '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
DatabaseField class
    instanceVariableNames: ''!
TestResource subclass: #DatabaseLoginResource
    instanceVariableNames: 'accessor login '
    classVariableNames: 'DefaultLogin '
    poolDictionaries: ''
    category: 'GlorpTest'!
DatabaseLoginResource class
    instanceVariableNames: ''!
Object subclass: #DatabasePlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
DatabasePlatform subclass: #AdabasLikePlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
AdabasLikePlatform subclass: #AdabasDPlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
DatabasePlatform class
    instanceVariableNames: ''!
AdabasLikePlatform class
    instanceVariableNames: ''!
AdabasDPlatform class
    instanceVariableNames: ''!
Object subclass: #DatabaseRow
    instanceVariableNames: 'table contents shouldBeWritten owner '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!DatabaseRow commentStamp: '<historical>' prior: 0!
This represents the data to be written out to a row. Database rows are normally stored in a rowmap, keyed according to their table and the object that did the primary writes to them. We expect that that's only one object, although embedded values are an exception to that.
Instance Variables:
table	<DatabaseTable>	The table holding the data
    contents	<IdentityDictionary>	Holds the fields with their values, indirectly through FieldValueWrapper instances.
    shouldBeWritten	<Boolean>	Normally true, but can be set false to suppress writing of a particular row. Used with embedded value mappings, where we create their row, unify it with the parent row, and suppress writing of the original row.
    owner	<Object>	The primary object that wrote into this row, would also be the key into the rowmap.!
DatabaseRow class
    instanceVariableNames: ''!
Object subclass: #DatabaseTable
    instanceVariableNames: 'name creator fields primaryKeyFields foreignKeyConstraints parent '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
DatabaseTable class
    instanceVariableNames: ''!
Object subclass: #Descriptor
    instanceVariableNames: 'describedClass tables multipleTableCriteria mappings system mappedFields cachePolicy '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Descriptor class
    instanceVariableNames: ''!
Object subclass: #DescriptorSystem
    instanceVariableNames: 'descriptors tables session cachePolicy '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
DescriptorSystem class
    instanceVariableNames: ''!
Object subclass: #Dialect
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Extensions'!
Dialect class
    instanceVariableNames: ''!
DatabaseAccessor subclass: #DolphinDatabaseAccessor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpDatabase'!
DolphinDatabaseAccessor class
    instanceVariableNames: ''!
Object subclass: #ElementBuilder
    instanceVariableNames: 'instance requiresPopulating instanceClass key expression query fieldTranslations '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
ElementBuilder class
    instanceVariableNames: ''!
Object subclass: #EmailAddress
    instanceVariableNames: 'id user host '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
EmailAddress class
    instanceVariableNames: ''!
Object subclass: #Encyclopedia
    instanceVariableNames: 'id entries '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Encyclopedia class
    instanceVariableNames: ''!
Object subclass: #EncyclopediaEntry
    instanceVariableNames: 'id name text '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
EncyclopediaEntry class
    instanceVariableNames: ''!
Object subclass: #FakeElementBuilder
    instanceVariableNames: 'value '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
FakeElementBuilder class
    instanceVariableNames: ''!
Object subclass: #FieldUnifier
    instanceVariableNames: 'fields fieldsWithRows objects rows rowMap '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
FieldUnifier class
    instanceVariableNames: ''!
Object subclass: #FieldValueWrapper
    instanceVariableNames: 'contents hasValue containedBy '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
FieldValueWrapper class
    instanceVariableNames: ''!
Object subclass: #Flight
    instanceVariableNames: 'id passengersById passengersByName mealsByType '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Flight class
    instanceVariableNames: ''!
Object subclass: #ForeignKeyConstraint
    instanceVariableNames: 'sourceField targetField '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
ForeignKeyConstraint class
    instanceVariableNames: ''!
DescriptorSystem subclass: #GlorpDemoDescriptorSystem
    instanceVariableNames: ''
    classVariableNames: 'Default '
    poolDictionaries: ''
    category: 'GlorpTest'!
GlorpDemoDescriptorSystem class
    instanceVariableNames: ''!
TestResource subclass: #GlorpDemoTablePopulatorResource
    instanceVariableNames: 'login '
    classVariableNames: 'NeedsSetup '
    poolDictionaries: ''
    category: 'GlorpTest'!
GlorpDemoTablePopulatorResource class
    instanceVariableNames: ''!
DescriptorSystem subclass: #GlorpEncyclopediaDescriptorSystem
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
GlorpEncyclopediaDescriptorSystem class
    instanceVariableNames: ''!
Object subclass: #GlorpExampleSystem
    instanceVariableNames: 'objects '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
GlorpExampleSystem subclass: #GlorpBankExampleSystem
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
GlorpExampleSystem class
    instanceVariableNames: ''!
GlorpBankExampleSystem class
    instanceVariableNames: ''!
Object subclass: #GlorpExpression
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
GlorpExpression subclass: #ConstantExpression
    instanceVariableNames: 'value '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
GlorpExpression subclass: #FieldExpression
    instanceVariableNames: 'field base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
GlorpExpression class
    instanceVariableNames: ''!
ConstantExpression class
    instanceVariableNames: ''!
FieldExpression class
    instanceVariableNames: ''!
Object subclass: #GlorpHelper
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
GlorpHelper class
    instanceVariableNames: ''!
Object subclass: #GlorpMoney
    instanceVariableNames: 'currency amount '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
GlorpMoney class
    instanceVariableNames: ''!
Object subclass: #Login
    instanceVariableNames: 'database username password connectString '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Login class
    instanceVariableNames: ''!
Object subclass: #Mapping
    instanceVariableNames: 'descriptor attributeName attributeAccessor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Mapping subclass: #ConditionalMapping
    instanceVariableNames: 'conditionalField conditionalMethod cases otherwiseCase '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Mapping subclass: #ConstantMapping
    instanceVariableNames: 'constantValue valueIsSession '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!ConstantMapping commentStamp: '<historical>' prior: 0!
Sometimes you just want a constant value to be set, either in the row, the object or both. And sometimes you just want a non-mapping (e.g. with a ConditionalMapping where one
of the conditions means "this isn't mapped"). This mapping represents these situations.
It also handles the special case where it's useful to have access to the session inside a
domain object, by allowing you to map it to an instance variable.
So far only the case of mapping to an inst var is implemented.
Instance Variables:
!
Mapping subclass: #DictionaryMapping
    instanceVariableNames: 'keyMapping valueMapping '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!DictionaryMapping commentStamp: '<historical>' prior: 0!
This allows us to map a dictionary into tables. This breaks down into many cases.
String->Object
Object->Object
with representation either like a 1-many or like a many-many with information in the link table. The general idea is that we represent this as a compound mapping that can describe how the key maps and how the values maps.
Instance Variables:
keyMapping	<ClassOfVariable>	description of variable's function
    valueMapping	<ClassOfVariable>	description of variable's function!
Mapping subclass: #DirectMapping
    instanceVariableNames: 'field '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Mapping class
    instanceVariableNames: ''!
ConditionalMapping class
    instanceVariableNames: ''!
ConstantMapping class
    instanceVariableNames: ''!
DictionaryMapping class
    instanceVariableNames: ''!
DirectMapping class
    instanceVariableNames: ''!
MessageArchiver class
    instanceVariableNames: ''!
GlorpExpression subclass: #ObjectExpression
    instanceVariableNames: 'mappingExpressions requiresDistinct tableAliases fieldAliases '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
ObjectExpression subclass: #BaseExpression
    instanceVariableNames: 'descriptor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
ObjectExpression subclass: #MappingExpression
    instanceVariableNames: 'name base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
ObjectExpression class
    instanceVariableNames: ''!
BaseExpression class
    instanceVariableNames: ''!
MappingExpression class
    instanceVariableNames: ''!
Object subclass: #ObjectTransaction
    instanceVariableNames: 'undoMap '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!ObjectTransaction commentStamp: '<historical>' prior: 0!
An ObjectTransaction knows how to remember the state of objects and revert them back to that state later on. It does this by making a *shallow* copy of the registered objects and everything connected to them, and then putting that into an identity dictionary keyed by the originals.
If you have to undo, you push the state from the shallow copies back into the originals.
Yes, that works, and it's all you have to do. It even handles collections become:ing different sizes.
Instance Variables:
    undoMap	<IdentityDictionary>	 The dictionary of originals->copies.
!
ObjectTransaction class
    instanceVariableNames: ''!
DatabasePlatform subclass: #OraclePlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
OraclePlatform class
    instanceVariableNames: ''!
GlorpExpression subclass: #ParameterExpression
    instanceVariableNames: 'field base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
ParameterExpression class
    instanceVariableNames: ''!
Object subclass: #Passenger
    instanceVariableNames: 'id name frequentFlyerMiles airline '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Passenger class
    instanceVariableNames: ''!
Object subclass: #Person
    instanceVariableNames: 'id name address emailAddresses '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
Person class
    instanceVariableNames: ''!
DatabasePlatform subclass: #PostgreSQLPlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
PostgreSQLPlatform class
    instanceVariableNames: ''!
Object subclass: #PrimaryKeyExpression
    instanceVariableNames: 'sources targets base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
PrimaryKeyExpression class
    instanceVariableNames: ''!
ProtoObject subclass: #Proxy
    instanceVariableNames: 'session query parameters value isInstantiated '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Proxy class
    instanceVariableNames: ''!
Object subclass: #Query
    instanceVariableNames: 'session criteria prepared '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Query subclass: #AbstractReadQuery
    instanceVariableNames: 'resultClass readsOneObject returnProxies shouldRefresh '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Query subclass: #DeleteQuery
    instanceVariableNames: 'objectToDelete '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
Query class
    instanceVariableNames: ''!
AbstractReadQuery class
    instanceVariableNames: ''!
DeleteQuery class
    instanceVariableNames: ''!
AbstractReadQuery subclass: #QueryStub
    instanceVariableNames: 'result '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
QueryStub class
    instanceVariableNames: ''!
AbstractReadQuery subclass: #ReadQuery
    instanceVariableNames: 'absentBlock '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!ReadQuery commentStamp: '<historical>' prior: 0!
This class has not yet been commented.  The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable.  The comment should also explain any unobvious aspects of the implementation.
Instance Variables:
criteria	<ClassOfVariable>	description of variable's function
resultDescription	<ClassOfVariable>	CollectionOfClassOrProjectionOfClass'!
ReadQuery class
    instanceVariableNames: ''!
GlorpExpression subclass: #RelationExpression
    instanceVariableNames: 'relation leftChild rightChild '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
RelationExpression subclass: #CollectionExpression
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
!CollectionExpression commentStamp: '<historical>' prior: 0!
This represents expressions on collection objects taking a block, which at the moment means just anySatisfy:
We treat this as a relation, but with the special properties that when we convert the right hand side into an expression we assume it's a block and give it a base which is the left-hand side. Also, we don't print this relation when printing SQL, we just print the right hand side.!
RelationExpression class
    instanceVariableNames: ''!
CollectionExpression class
    instanceVariableNames: ''!
Mapping subclass: #RelationshipMapping
    instanceVariableNames: 'referenceClass mappingCriteria shouldProxy '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
RelationshipMapping subclass: #ManyToManyMapping
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
RelationshipMapping subclass: #OneToManyMapping
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
RelationshipMapping subclass: #OneToOneMapping
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
OneToOneMapping subclass: #EmbeddedValueOneToOneMapping
    instanceVariableNames: 'fieldTranslation '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!EmbeddedValueOneToOneMapping commentStamp: '<historical>' prior: 0!
This represents a one-to-one mapping in which the referenced object is stored as part of the same table as the containing object.
'!
RelationshipMapping class
    instanceVariableNames: ''!
ManyToManyMapping class
    instanceVariableNames: ''!
OneToManyMapping class
    instanceVariableNames: ''!
OneToOneMapping class
    instanceVariableNames: ''!
EmbeddedValueOneToOneMapping class
    instanceVariableNames: ''!
Object subclass: #RowMap
    instanceVariableNames: 'rowDictionary '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
RowMap class
    instanceVariableNames: ''!
Object subclass: #RowMapKey
    instanceVariableNames: 'key1 key2 '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!RowMapKey commentStamp: '<historical>' prior: 0!
This class serves as a key for a dictionary containing two sub-keys, where we want to be able to look up based on the identity of both sub-keys paired together. This is used primarily for many-to-many mappings indexing into rowmaps, where we want to key the row by the identity of the object that determines it, but there are two of them.
Instance Variables:
key1	<Object>	One sub-key.
key2	<Object>	The other sub-key.'!
RowMapKey class
    instanceVariableNames: ''!
AdabasLikePlatform subclass: #SAPDBPlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
SAPDBPlatform class
    instanceVariableNames: ''!
DatabasePlatform subclass: #SQLServerPlatform
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
SQLServerPlatform class
    instanceVariableNames: ''!
Object subclass: #SequencePolicy
    instanceVariableNames: 'field '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
SequencePolicy subclass: #InMemorySequencePolicy
    instanceVariableNames: 'count '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
SequencePolicy subclass: #NullSequencePolicy
    instanceVariableNames: ''
    classVariableNames: 'Singleton '
    poolDictionaries: ''
    category: 'Glorp'!
SequencePolicy class
    instanceVariableNames: ''!
InMemorySequencePolicy class
    instanceVariableNames: ''!
NullSequencePolicy class
    instanceVariableNames: ''!
SequencePolicy subclass: #SequenceTablePolicy
    instanceVariableNames: 'sequenceTableName '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
SequenceTablePolicy class
    instanceVariableNames: ''!
Object subclass: #ServiceCharge
    instanceVariableNames: 'description amount '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest-Domain Models'!
ServiceCharge class
    instanceVariableNames: ''!
Object subclass: #Session
    instanceVariableNames: 'lastAccess data cache currentUnitOfWork accessor applicationData system '
    classVariableNames: 'Sessions '
    poolDictionaries: ''
    category: 'Glorp'!
!Session commentStamp: '<historical>' prior: 0!
This class has not yet been commented.  The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable.  The comment should also explain any unobvious aspects of the implementation.
Instance Variables:
system	<ClassOfVariable>	description of variable's function
    currentUnitOfWork	<ClassOfVariable>	description of variable's function
    cache	<ClassOfVariable>	description of variable's function
    accessor	<ClassOfVariable>	description of variable's function
    application	<ClassOfVariable>	application-specific data!
Session class
    instanceVariableNames: ''!
TestResource subclass: #SessionResource
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
SessionResource class
    instanceVariableNames: ''!
AbstractReadQuery subclass: #SimpleQuery
    instanceVariableNames: 'fields distinctFields traceNodes builders '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!SimpleQuery commentStamp: '<historical>' prior: 0!
This is a query that is directly executable. A single query might be more than we can do in a single database read, so we might have to break it down into simple queries. But at the moment we just break anything down into an equivalent single query.
Instance Variables:
    builders	<OrderedCollection of: ElementBuilder)>	The builders that will assemble the object from the row that this query returns.
    fields	<OrderedCollection of: DatabaseField>	The fields being selected.
    traceNodes	<Collection of: GlorpExpression>	 These describe the graph of the objects to be read, so we can specify customer, customer address and customer account all in one read.
!
SimpleQuery class
    instanceVariableNames: ''!
DatabaseAccessor subclass: #SqueakDatabaseAccessor
    instanceVariableNames: 'driverSession port isInTransaction '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpDatabase'!
ObjectExpression subclass: #TableExpression
    instanceVariableNames: 'table base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp-Expressions'!
TableExpression class
    instanceVariableNames: ''!
Object subclass: #TableSorter
    instanceVariableNames: 'orderedTables tables visitedTables '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
TableSorter class
    instanceVariableNames: ''!
TestCase subclass: #BasicMappingTest
    instanceVariableNames: 'mapping person '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
BasicMappingTest class
    instanceVariableNames: ''!
TestCase subclass: #CacheTest
    instanceVariableNames: 'cache '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
CacheTest class
    instanceVariableNames: ''!
TestCase subclass: #CommitOrderTest
    instanceVariableNames: 'system t1 t2 t3 t1id t2id t3id '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
CommitOrderTest class
    instanceVariableNames: ''!
TestCase subclass: #ConstantMappingTest
    instanceVariableNames: 'mappingToClass mappingToRow mappingToSession slot '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ConstantMappingTest class
    instanceVariableNames: ''!
TestCase subclass: #DatabaseBasicTest
    instanceVariableNames: 'system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DatabaseBasicTest class
    instanceVariableNames: ''!
TestCase subclass: #DatabaseFieldTest
    instanceVariableNames: 'field negatedField '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DatabaseFieldTest class
    instanceVariableNames: ''!
TestCase subclass: #DatabaseLoginTest
    instanceVariableNames: 'login accessor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DatabaseLoginTest class
    instanceVariableNames: ''!
TestCase subclass: #DatabaseSessionTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DatabaseSessionTest class
    instanceVariableNames: ''!
TestCase subclass: #DeleteQueryTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DeleteQueryTest class
    instanceVariableNames: ''!
TestCase subclass: #DescriptorTest
    instanceVariableNames: 'system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DescriptorTest class
    instanceVariableNames: ''!
TestCase subclass: #DictionaryMappingTest
    instanceVariableNames: 'system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DictionaryMappingTest class
    instanceVariableNames: ''!
TestCase subclass: #DirectMappingTest
    instanceVariableNames: 'system mapping '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
DirectMappingTest class
    instanceVariableNames: ''!
TestCase subclass: #ExpressionBasicPropertiesTest
    instanceVariableNames: 'base '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ExpressionBasicPropertiesTest class
    instanceVariableNames: ''!
TestCase subclass: #ExpressionIterationTest
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ExpressionIterationTest class
    instanceVariableNames: ''!
TestCase subclass: #ExpressionJoiningTest
    instanceVariableNames: 'source target base system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ExpressionJoiningTest class
    instanceVariableNames: ''!
TestCase subclass: #ExpressionTableAliasingTest
    instanceVariableNames: 'exp system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ExpressionTableAliasingTest class
    instanceVariableNames: ''!
TestCase subclass: #ExpressionTest
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ExpressionTest class
    instanceVariableNames: ''!
TestCase subclass: #InsertUpdateTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
InsertUpdateTest class
    instanceVariableNames: ''!
TestCase subclass: #MappingTest
    instanceVariableNames: 'system rowMap '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
MappingTest class
    instanceVariableNames: ''!
TestCase subclass: #MessageCollectorTest
    instanceVariableNames: 'collector '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
MessageCollectorTest class
    instanceVariableNames: ''!
TestCase subclass: #ObjectTransactionTest
    instanceVariableNames: 'transaction objects '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ObjectTransactionTest class
    instanceVariableNames: ''!
TestCase subclass: #PrimaryKeyExpressionTest
    instanceVariableNames: 'expression system compoundExpression '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
PrimaryKeyExpressionTest class
    instanceVariableNames: ''!
TestCase subclass: #ProxyTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ProxyTest class
    instanceVariableNames: ''!
TestCase subclass: #QueryTableAliasingTest
    instanceVariableNames: 'query system expression elementBuilder '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
QueryTableAliasingTest class
    instanceVariableNames: ''!
TestCase subclass: #ReadQueryTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ReadQueryTest class
    instanceVariableNames: ''!
TestCase subclass: #ReadingTest
    instanceVariableNames: 'system session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
ReadingTest class
    instanceVariableNames: ''!
TestCase subclass: #RowMapUnificationTest
    instanceVariableNames: 't1 t2 t3 f1 f2 f3 o1 o2 o3 rowMap '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
RowMapUnificationTest class
    instanceVariableNames: ''!
TestCase subclass: #SQLPrintingTest
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
SQLPrintingTest class
    instanceVariableNames: ''!
TestCase subclass: #SessionTest
    instanceVariableNames: 'session system '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
SessionTest class
    instanceVariableNames: ''!
TestCase subclass: #SimpleQueryTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
SimpleQueryTest class
    instanceVariableNames: ''!
TestCase subclass: #TableTest
    instanceVariableNames: 'system descriptors '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
TableTest class
    instanceVariableNames: ''!
CachePolicy subclass: #TimedExpiryCachePolicy
    instanceVariableNames: 'timeout '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!TimedExpiryCachePolicy commentStamp: '<historical>' prior: 0!
This implements a cache that notes that an object is stale after some amount of time since it has been read.
Instance Variables:
    timeout	<Integer>	The time in seconds until we note an object as needing refreshing.
!
TimedExpiryCachePolicy class
    instanceVariableNames: ''!
CacheTest subclass: #TimedExpiryCacheTest
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
TimedExpiryCacheTest class
    instanceVariableNames: ''!
Object subclass: #Tracing
    instanceVariableNames: 'base allTracings '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!Tracing commentStamp: '<historical>' prior: 0!
A tracing is a collection of expressions representing the graph of other objects which
are to be read at the same time as the root object.
Instance Variables:
base	<Expression>	The base expression representing the root object. Same as the parameter to the query block
    allTracings	<Collection of: Expression>	The expressions representing each of the associated objects. e.g. base accounts, base amount serviceCharge .!
Tracing class
    instanceVariableNames: ''!
TestCase subclass: #TracingTest
    instanceVariableNames: 'tracing '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
TracingTest class
    instanceVariableNames: ''!
Object subclass: #TransformedField
    instanceVariableNames: 'parent transformation stringTransformation '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!TransformedField commentStamp: '<historical>' prior: 0!
This represents a field with a transformation applied to it. This can be used to handle
cases where a foreign key relationship is not based on equality. Specifically, the motivating case is Store's use of (pk * -1) = fk for tw_blob chaining.
Instance Variables:
parent	<DatabaseField>	description of variable's function
    transformation	<Block>	description of variable's function!
TransformedField class
    instanceVariableNames: ''!
Object subclass: #UnitOfWork
    instanceVariableNames: 'session rowMap commitPlan transaction '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Glorp'!
!UnitOfWork commentStamp: '<historical>' prior: 0!
A UnitOfWork keeps track of objects which might potentially be modified and lets you roll them back or commit the changes into the database.
Instance Variables:
    newObjects	<IdentitySet of: Object>	The objects registered with this unit of work. newObjects is probably a bad name for this.
    session	<Session>	The session in which this is all taking place.
    transaction	<ObjectTransaction>	Keeps track of the original object state so that we can revert it.
    rowMap	<RowMap>	A holder for the rows when we are writing out changes.
    commitPlan	<(OrderedCollection of: DatabaseRow)>	The list of rows to be written, in order. Constructed by topological sorting the contents of the row map.
!
UnitOfWork class
    instanceVariableNames: ''!
TestCase subclass: #UnitOfWorkTest
    instanceVariableNames: 'session '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpTest'!
UnitOfWorkTest class
    instanceVariableNames: ''!
DatabaseAccessor subclass: #VA55DatabaseAccessor
    instanceVariableNames: 'isInTransaction '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpDatabase'!
VA55DatabaseAccessor class
    instanceVariableNames: 'databaseErrorSignal '!
DatabaseAccessor subclass: #VWDatabaseAccessor
    instanceVariableNames: 'driverSession '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'GlorpDatabase'!
VWDatabaseAccessor class
    instanceVariableNames: ''!
!MessageArchiver methodsFor: 'expression creation'!
asGlorpExpression
    ^self asGlorpExpressionOn: BaseExpression new! !
!MessageArchiver methodsFor: 'expression creation'!
asGlorpExpressionOn: aBaseExpression 
    myReceiver == nil ifTrue: [^aBaseExpression].
    ^(myReceiver asGlorpExpressionOn: aBaseExpression) get: myMessage selector
    	withArguments: myMessage arguments! !
!MessageArchiver methodsFor: 'doesNotUnderstand'!
= anObject
    "Needed because VA's abtObservableWrapper implements =. Should be portable."
    ^MessageArchiver 
    	receiver: self
    	message: (Message selector: #= arguments: (Array with: anObject)).! !
!MessageArchiver methodsFor: 'doesNotUnderstand'!
basicDoesNotUnderstand: aMessage 
    "Invoke this to avoid infinite recursion in the case of internal errors. We want a dialect-independent way of getting a walkback window, so we'll invoke it against a different object"
(Array with: self) doesNotUnderstand: aMessage.! !
!MessageArchiver methodsFor: 'doesNotUnderstand'!
doesNotUnderstand: aMessage 
    | sel |
    sel := aMessage selector.
    sel == #doesNotUnderstand: ifTrue: [self basicDoesNotUnderstand: aMessage].
    (sel size >= 8 and: [(sel copyFrom: 1 to: 8) = 'perform:']) 
    	ifTrue: 
    		[^self get: aMessage arguments first
    			withArguments: (aMessage arguments copyFrom: 2 to: aMessage arguments size)].
    ^MessageArchiver receiver: self message: aMessage! !
!MessageArchiver methodsFor: 'debugging'!
basicPrintString
^self printString.! !
!MessageArchiver methodsFor: 'debugging'!
class
    ^MessageArchiver! !
!MessageArchiver methodsFor: 'debugging'!
halt
    "Support this so that we can debug inside query blocks. For portability, send it to a different object so that we don't have to care how halt is implemented"
(Array with: self) halt.! !
!MessageArchiver methodsFor: 'debugging'!
inspect
"Not exactly the intended semantics, but should be portable"
    (Array with: self) inspect.! !
!MessageArchiver methodsFor: 'debugging'!
inspectorSize
  ^2! !
!MessageArchiver methodsFor: 'debugging'!
printOn: aStream
aStream nextPutAll: self printString.! !
!MessageArchiver methodsFor: 'debugging'!
printString
"Hard-code this for maximum dialect portability"
    ^'a MessageArchiver'.! !
!MessageArchiver methodsFor: 'expression protocol'!
between: anObject and: anotherObject
^(self > anObject) & (self < anotherObject).! !
!MessageArchiver methodsFor: 'expression protocol'!
get: aSymbol 
    ^MessageArchiver receiver: self
    	message: (Message selector: aSymbol arguments: #())! !
!MessageArchiver methodsFor: 'expression protocol'!
get: aSymbol withArguments: anArray 
    ^MessageArchiver receiver: self
    	message: (Message selector: aSymbol arguments: anArray)! !
!MessageArchiver methodsFor: 'initialize'!
receiver: aMessageCollector message: aMessage
myReceiver := aMessageCollector.
    myMessage := aMessage.! !
!MessageArchiver methodsFor: 'private/accessing'!
privateGlorpMessage
^myMessage! !
!MessageArchiver methodsFor: 'private/accessing'!
privateGlorpReceiver
^myReceiver! !
!Object methodsFor: 'glorp'!
asGlorpExpression
^ConstantExpression for: self.! !
!Object methodsFor: 'glorp'!
asGlorpExpressionOn: anExpression
^self asGlorpExpression.! !
!Object methodsFor: 'glorp'!
glorpIsCollection
^false.! !
!Object methodsFor: 'glorp'!
glorpPostFetch: aSession! !
!Object methodsFor: 'glorp'!
glorpPostWrite: aSession! !
!Object methodsFor: 'glorp'!
glorpPreWrite: aSession! !
!Object methodsFor: 'glorp'!
glorpPrintSQLOn: aStream
self printOn: aStream.! !
!Object methodsFor: 'glorp' stamp: 'nop 5/31/2002 15:14'!
isSymbol
    ^false! !
!Address methodsFor: 'accessing'!
id
    "Private - Answer the value of the receiver's ''id'' instance variable."
^id! !
!Address methodsFor: 'accessing'!
id: anObject
    "Private - Set the value of the receiver's ''id'' instance variable to the argument, anObject."
id := anObject! !
!Address methodsFor: 'accessing'!
number
    "Private - Answer the value of the receiver's ''number'' instance variable."
^number! !
!Address methodsFor: 'accessing'!
number: anObject
    "Private - Set the value of the receiver's ''number'' instance variable to the argument, anObject."
number := anObject! !
!Address methodsFor: 'accessing'!
street
    "Private - Answer the value of the receiver's ''street'' instance variable."
^street! !
!Address methodsFor: 'accessing'!
street: anObject
    "Private - Set the value of the receiver's ''street'' instance variable to the argument, anObject."
street := anObject! !
!Address class methodsFor: 'examples'!
example1
^self new
    	id: 1;
    	street: 'West 47th Ave';
    	number: '2042'.! !
!AttributeAccessor methodsFor: 'accessing'!
attributeName
    "Private - Answer the value of the receiver's ''attributeName'' instance variable."
^attributeName! !
!AttributeAccessor methodsFor: 'accessing'!
attributeName: anObject
    "Private - Set the value of the receiver's ''attributeName'' instance variable to the argument, anObject."
attributeName := anObject! !
!AttributeAccessor methodsFor: 'accessing'!
instVarIndexIn: anObject
attributeIndex isNil ifTrue: [
    	attributeIndex := anObject class allInstVarNames indexOf: attributeName asString].
    ^attributeIndex.! !
!AttributeAccessor methodsFor: 'get/set'!
getValueFrom: anObject
^anObject instVarAt: (self instVarIndexIn: anObject).! !
!AttributeAccessor methodsFor: 'get/set'!
setValueIn: anObject to: aValue
^anObject instVarAt: (self instVarIndexIn: anObject) put: aValue.! !
!AttributeAccessor class methodsFor: 'instance creation'!
newForAttributeNamed: aSymbol
^self new attributeName: aSymbol! !
!BankAccount methodsFor: 'accessing'!
accountHolders
    ^accountHolders.! !
!BankAccount methodsFor: 'accessing'!
accountNumber
    ^accountNumber! !
!BankAccount methodsFor: 'accessing'!
accountNumber: anAccountNumber 
    accountNumber := anAccountNumber! !
!BankAccount methodsFor: 'accessing'!
basicAddHolder: aCustomer
accountHolders add: aCustomer.! !
!BankAccount methodsFor: 'accessing'!
id
    ^id! !
!BankAccount methodsFor: 'accessing'!
id: anObject
    id := anObject! !
!BankAccount methodsFor: 'initialize'!
initialize
accountHolders := OrderedCollection new.! !
!BankAccount methodsFor: 'printing'!
printOn: aStream
super printOn: aStream.
    aStream 
    	nextPutAll: '(id=';
    	print: id;
    	nextPut: $).! !
!BankAccount class methodsFor: 'instance creation'!
new
^super new initialize.! !
!BankAccountNumber methodsFor: 'accessing'!
accountNumber
    ^accountNumber! !
!BankAccountNumber methodsFor: 'accessing'!
accountNumber: anObject
    accountNumber := anObject! !
!BankAccountNumber methodsFor: 'accessing'!
bankCode
    ^bankCode! !
!BankAccountNumber methodsFor: 'accessing'!
bankCode: anObject
    bankCode := anObject! !
!BankAccountNumber methodsFor: 'accessing'!
branchNumber
    ^branchNumber! !
!BankAccountNumber methodsFor: 'accessing'!
branchNumber: anObject
    branchNumber := anObject! !
!BankTransaction methodsFor: 'accessing'!
amount
    ^amount! !
!BankTransaction methodsFor: 'accessing'!
amount: aGlorpMoney 
    amount := aGlorpMoney! !
!BankTransaction methodsFor: 'accessing'!
id
    "Private - Answer the value of the receiver's ''id'' instance variable."
^id! !
!BankTransaction methodsFor: 'accessing'!
id: anObject
    "Private - Set the value of the receiver's ''id'' instance variable to the argument, anObject."
id := anObject! !
!BankTransaction methodsFor: 'accessing'!
owner
    "Private - Answer the value of the receiver's ''owner'' instance variable."
^owner! !
!BankTransaction methodsFor: 'accessing'!
owner: aCustomer 
    owner := aCustomer! !
!BankTransaction methodsFor: 'accessing'!
serviceCharge
    ^serviceCharge! !
!BankTransaction methodsFor: 'accessing'!
serviceCharge: aServiceCharge 
    serviceCharge := aServiceCharge! !
!BankTransaction methodsFor: 'initialize'!
initialize
amount := GlorpMoney forAmount: 0.
    serviceCharge := ServiceCharge default.! !
!BankTransaction class methodsFor: 'examples'!
example1
^self new! !
!BankTransaction class methodsFor: 'examples'!
example2
^self new! !
!BankTransaction class methodsFor: 'instance creation'!
new
^super new initialize.! !
!BlockContext methodsFor: 'glorp' stamp: 'nop 5/29/2002 23:13'!
asGlorpExpression
^self asGlorpExpressionOn: BaseExpression new.! !
!BlockContext methodsFor: 'glorp' stamp: 'nop 5/29/2002 23:13'!
asGlorpExpressionForDescriptor: aDescriptor
| base |
    base := BaseExpression new.
    base descriptor: aDescriptor.
    ^self asGlorpExpressionOn: base.! !
!BlockContext methodsFor: 'glorp' stamp: 'nop 5/29/2002 23:13'!
asGlorpExpressionOn: anExpression 
    ^(self value: MessageArchiver new) asGlorpExpressionOn: anExpression! !
!Cache methodsFor: 'accessing'!
cachePolicy: aCachePolicy
    policy := aCachePolicy.! !
!Cache methodsFor: 'accessing'!
mainCache
    ^mainCache! !
!Cache methodsFor: 'accessing'!
mainCache: aCacheManager
    mainCache := aCacheManager! !
!Cache methodsFor: 'accessing'!
session
    ^mainCache session.! !
!Cache methodsFor: 'initialize'!
initialize
items := Dictionary new: 20.! !
!Cache methodsFor: 'lookup'!
at: key ifAbsent: aBlock 
    | item value |
    item := self basicAt: key ifAbsent: [^aBlock value].
    value := policy contentsOf: item.
    (policy hasExpired: item) 
    	ifTrue: 
    		[policy takeExpiryActionForKey: key withValue: value in: self. 
    		(items includesKey: key) ifFalse: [^aBlock value]].
    ^value.! !
!Cache methodsFor: 'lookup'!
at: key ifAbsentPut: aBlock 
    | item |
    item := self at: key ifAbsent: [nil].
    ^item isNil 
    	ifTrue: [items at: key put: (policy cacheEntryFor: aBlock value)]
    	ifFalse: [item]! !
!Cache methodsFor: 'lookup'!
hasExpired: key
    | item |
    item := self basicAt: key ifAbsent: [^false].
    ^policy hasExpired: item.! !
!Cache methodsFor: 'lookup'!
removeKey: key ifAbsent: aBlock
^items removeKey: key ifAbsent: aBlock.! !
!Cache methodsFor: 'private'!
basicAt: anObject ifAbsent: aBlock
^items at: anObject ifAbsent: aBlock.! !
!Cache class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Cache class methodsFor: 'instance creation'!
newFor: aClass in: aCacheManager 
    | newCache descriptor |
    descriptor := aCacheManager system descriptorFor: aClass.
    newCache := Cache new.
    newCache mainCache: aCacheManager.
    descriptor isNil 
    	ifTrue: [newCache cachePolicy: CachePolicy default]
    	ifFalse: [newCache cachePolicy: descriptor cachePolicy].
    ^newCache.! !
!CacheManager methodsFor: 'accessing'!
session
^session.! !
!CacheManager methodsFor: 'accessing'!
session: aSession 
    session := aSession.! !
!CacheManager methodsFor: 'accessing'!
system
^self session system.! !
!CacheManager methodsFor: 'adding'!
at: aKey insert: anObject
| subCache |
    subCache := self cacheForClass: anObject class.
    subCache at: aKey ifAbsentPut: [anObject].! !
!CacheManager methodsFor: 'initialize/release'!
initialize
subCaches := IdentityDictionary new: 100.! !
!CacheManager methodsFor: 'private/caching'!
cacheFor: anObject
    "Get the cache for a particular object. Since this could conceivably be passed a proxy, check for that. The cache for an uninstantiated proxy is kind of ambiguous, treat it as nil."
    ^anObject class == Proxy
    	ifTrue: [anObject isInstantiated ifTrue: [self cacheFor: anObject getValue] ifFalse: [nil]]
    	ifFalse: [self cacheForClass: anObject class].! !
!CacheManager methodsFor: 'private/caching'!
cacheForClass: aClass
^subCaches at: aClass ifAbsentPut: [Cache newFor: aClass in: self].! !
!CacheManager methodsFor: 'querying'!
hasExpired: anObject
    | key cache |
    key := (session descriptorFor: anObject) primaryKeyFor: anObject.
    cache := self cacheFor: anObject.
    cache isNil ifTrue: [^false].  "We have an uninstantiated proxy."
    ^cache hasExpired: key.! !
!CacheManager methodsFor: 'querying'!
hasObjectExpiredOfClass: aClass withKey: key
    | cache |
    cache := self cacheForClass: aClass.
    ^cache hasExpired: key.! !
!CacheManager methodsFor: 'querying'!
lookupClass: aClass key: aKey
^self lookupClass: aClass key: aKey ifAbsent: [self error: 'cache miss'].! !
!CacheManager methodsFor: 'querying'!
lookupClass: aClass key: aKey ifAbsent: failBlock
^(self cacheForClass: aClass) at: aKey ifAbsent: failBlock.! !
!CacheManager methodsFor: 'querying'!
removeClass: aClass key: aKey
^self removeClass: aClass key: aKey ifAbsent: [self error: 'Object not in cache'].! !
!CacheManager methodsFor: 'querying'!
removeClass: aClass key: aKey ifAbsent: aBlock
^(self cacheForClass: aClass) removeKey: aKey ifAbsent: aBlock.! !
!CacheManager class methodsFor: 'instance creation'!
forSession: aSession 
    ^self new session: aSession.! !
!CacheManager class methodsFor: 'instance creation'!
new
^super new initialize.! !
!CachePolicy methodsFor: 'wrap/unwrap'!
cacheEntryFor: anObject
^anObject.! !
!CachePolicy methodsFor: 'wrap/unwrap'!
contentsOf: aCacheEntry
^aCacheEntry.! !
!CachePolicy methodsFor: 'wrap/unwrap'!
hasExpired: aCacheEntry
^false.! !
!CachePolicy methodsFor: 'initialize'!
initialize
size := 100.
    expiryAction := #remove.! !
!CachePolicy methodsFor: 'accessing'!
expiryAction
    ^expiryAction! !
!CachePolicy methodsFor: 'accessing'!
expiryAction: aSymbol
    "See class comment for possible values"
    expiryAction := aSymbol! !
!CachePolicy methodsFor: 'expiry'!
notifyOfExpiry: anObject in: aCache 
    anObject glorpNoticeOfExpiryIn: aCache session.! !
!CachePolicy methodsFor: 'expiry'!
takeExpiryActionForKey: key withValue: anObject in: aCache
    expiryAction == #refresh
    	ifTrue: [aCache session refreshObject: anObject].
    (#(#notify #notifyAndRemove) includes: expiryAction) ifTrue: [
    	self notifyOfExpiry: anObject in: aCache].
    (#(#remove #notifyAndRemove) includes: expiryAction) ifTrue: [
    	aCache removeKey: key ifAbsent: []].! !
!CachePolicy class methodsFor: 'instance creation'!
default
^self new.! !
!CachePolicy class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Collection methodsFor: 'testing'!
glorpIsCollection
^true.! !
!Collection methodsFor: 'glorp'!
glorpPrintSQLOn: aStream 
    aStream nextPut: $(.
    GlorpHelper 
    	do: [:each | each glorpPrintSQLOn: aStream]
    	for: self
    	separatedBy: [aStream nextPutAll: ', '].
    aStream nextPut: $)! !
!Collection methodsFor: 'glorp'!
glorpRegisterCollectionInternalsIn: anObjectTransaction 
    "Explicitly register any internal structures (e.g. a VW identity dictionary's valueArray) with the transaction. Assume we can safely register everything inside the collection reflectively. The obvious exceptions would be dependents and sortblocks. This is a cheat, and for peculiar cases you'll need to override this in the subclass"
| names |
    names := self class allInstVarNames.
    (1 to: names size) do: 
    		[:index | 
    		(#('dependents' 'sortBlock') includes: (names at: index)) 
    			ifFalse: [anObjectTransaction register: (self instVarAt: index)]]! !
!Array methodsFor: 'accessing'!
atIndex: anInteger
    "For compatibility with Dolphin and VA data base rows."
    ^self at: anInteger.! !
!Customer methodsFor: 'accessing'!
accounts
^accounts.! !
!Customer methodsFor: 'accessing'!
addAccount: aBankAccount
accounts add: aBankAccount.
    aBankAccount basicAddHolder: self.! !
!Customer methodsFor: 'accessing'!
addTransaction: aTransaction
transactions add: aTransaction.
    aTransaction owner: self.! !
!Customer methodsFor: 'accessing'!
id
    "Private - Answer the value of the receiver's ''id'' instance variable."
^id! !
!Customer methodsFor: 'accessing'!
id: anObject
    "Private - Set the value of the receiver's ''id'' instance variable to the argument, anObject."
id := anObject! !
!Customer methodsFor: 'accessing'!
name
    "Private - Answer the value of the receiver's ''name'' instance variable."
^name! !
!Customer methodsFor: 'accessing'!
name: anObject
    "Private - Set the value of the receiver's ''name'' instance variable to the argument, anObject."
name := anObject! !
!Customer methodsFor: 'accessing'!
seenPostFetch
    ^seenPostFetch! !
!Customer methodsFor: 'accessing'!
seenPostWrite
    ^seenPostWrite! !
!Customer methodsFor: 'accessing'!
seenPreWrite
    ^seenPreWrite! !
!Customer methodsFor: 'accessing'!
transactions
    "Private - Answer the value of the receiver's ''transactions'' instance variable."
^transactions! !
!Customer methodsFor: 'accessing'!
transactions: anObject
    "Private - Set the value of the receiver's ''transactions'' instance variable to the argument, anObject."
transactions := anObject! !
!Customer methodsFor: 'glorp/events'!
glorpNoticeOfExpiryIn: aSession
    seenExpiry := true.! !
!Customer methodsFor: 'glorp/events'!
glorpPostFetch: aSession
    seenPostFetch := true! !
!Customer methodsFor: 'glorp/events'!
glorpPostWrite: aSession
    seenPostWrite := true! !
!Customer methodsFor: 'glorp/events'!
glorpPreWrite: aSession
    seenPreWrite := true! !
!Customer methodsFor: 'initialize/release'!
initialize
transactions := OrderedCollection new.
    accounts := OrderedCollection new.! !
!Customer methodsFor: 'As yet unclassified'!
seenExpiry
    ^seenExpiry! !
!Customer class methodsFor: 'examples'!
example1
^self new
    	name: 'Fred Flintstone';
    	addTransaction: BankTransaction example1;
    	addTransaction: BankTransaction example2.! !
!Customer class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DatabaseAccessor methodsFor: 'accessing'!
connection
    ^connection! !
!DatabaseAccessor methodsFor: 'accessing'!
connectionClass
    ^(self connectionClassForLogin: currentLogin)! !
!DatabaseAccessor methodsFor: 'accessing'!
currentLogin
    ^currentLogin! !
!DatabaseAccessor methodsFor: 'accessing'!
currentLogin: aLogin 
    currentLogin := aLogin! !
!DatabaseAccessor methodsFor: 'accessing'!
platform
    ^currentLogin database.! !
!DatabaseAccessor methodsFor: 'initializing'!
initialize! !
!DatabaseAccessor methodsFor: 'executing'!
createTable: aGLORBDatabaseTable ifError: aBlock 
    "This method should be used to create a database table from aTable"
self 
    	doCommand: [self executeSQLString: (self platform createTableStatementStringFor: aGLORBDatabaseTable)]
    	ifError: aBlock! !
!DatabaseAccessor methodsFor: 'executing'!
doCommand: aBlock
^self doCommand: aBlock ifError: [:ex | self halt].! !
!DatabaseAccessor methodsFor: 'executing'!
doCommand: aBlock ifError: errorBlock
^aBlock on: self externalDatabaseErrorSignal do: errorBlock.! !
!DatabaseAccessor methodsFor: 'executing'!
dropConstraint: aConstraint 
    self doCommand: [self executeSQLString: aConstraint dropString]
    	ifError: [:ex | Transcript show: ex messageText]! !
!DatabaseAccessor methodsFor: 'executing'!
dropTable: aTable ifAbsent: aBlock 
    self doCommand: [aTable dropFromAccessor: self]
    	ifError: [:ex | Transcript show: ex messageText]! !
!DatabaseAccessor methodsFor: 'executing'!
dropTableNamed: aString 
    self executeSQLString: 'DROP TABLE ' , aString! !
!DatabaseAccessor methodsFor: 'executing'!
dropTableNamed: aString ifAbsent: aBlock 
    self doCommand: [self executeSQLString: 'DROP TABLE ' , aString]
    	ifError: aBlock! !
!DatabaseAccessor methodsFor: 'executing'!
dropTables: anArray 
"PostgreSQL drops foreign key constraints implicitly."
    anArray do: [:each | each dropForeignKeyConstraintsFromAccessor: self].
    anArray do: [:each | self dropTable: each ifAbsent: [ :ex | Transcript show: ex messageText]]! !
!DatabaseAccessor methodsFor: 'executing'!
externalDatabaseErrorSignal
self subclassResponsibility.! !
!DatabaseAccessor methodsFor: 'logging'!
log: aString
Transcript cr; show: aString! !
!DatabaseAccessor methodsFor: 'logging'!
logError: anErrorObject
self log: anErrorObject printString! !
!DatabaseAccessor methodsFor: 'login'!
login
    
    | warning |
    self loginIfError: [:ex | 
    	warning := 'Unable to log in. Check login information in DatabaseLoginResource class methods'.
    	Transcript show: warning; cr.
    	self showDialog: warning.
    	self halt].! !
!DatabaseAccessor methodsFor: 'login'!
loginIfError: aBlock
self subclassResponsibility.! !
!DatabaseAccessor methodsFor: 'login'!
showDialog: aString
self subclassResponsibility.! !
!DatabaseAccessor class methodsFor: 'instance creation' stamp: 'nop 5/29/2002 15:08'!
classForThisPlatform
    Dialect isVisualWorks
    	ifTrue: [^ Smalltalk at: #VWDatabaseAccessor].
    Dialect isVisualAge
    	ifTrue: [^ Smalltalk at: #VA55DatabaseAccessor].
    Dialect isDolphin
    	ifTrue: [^ Smalltalk at: #DolphinDatabaseAccessor].
    Dialect isSqueak
    	ifTrue: [^ Smalltalk at: #SqueakDatabaseAccessor].
    self error: 'unknown dialect'! !
!DatabaseAccessor class methodsFor: 'instance creation'!
forLogin: aLogin 
    ^self classForThisPlatform new currentLogin: aLogin! !
!DatabaseAccessor class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DatabaseField methodsFor: 'printing'!
asConstraintReferenceString
^table name, ' (', self name, ')'.! !
!DatabaseField methodsFor: 'printing'!
printCreationStringFor: aDatabaseAccessor on: aStream
aStream  nextPutAll: name.
    aStream nextPutAll: ' '.
    aStream nextPutAll: (self typeStringFor: aDatabaseAccessor).
    self isNullable ifFalse: [aStream nextPutAll: ' NOT NULL'].! !
!DatabaseField methodsFor: 'printing'!
printForConstraintNameOn: aStream maxLength: maxLength 
    | constraintName |
    constraintName := table name , '_' , name.
    constraintName size > maxLength 
    	ifTrue: [constraintName := constraintName copyFrom: 1 to: maxLength].
    aStream nextPutAll: constraintName! !
!DatabaseField methodsFor: 'printing'!
printNameOn: aStream withParameters: anArray 
    aStream nextPutAll: self name! !
!DatabaseField methodsFor: 'printing'!
printOn: aStream
    
    super printOn: aStream.
    aStream 
    	nextPutAll: '(';
    	nextPutAll: (table isNil ifTrue: [''] ifFalse: [table name]);
    	nextPutAll: '.';
    	nextPutAll: name;
    	nextPutAll: ')'.! !
!DatabaseField methodsFor: 'printing'!
printQualifiedSQLOn: aStream withParameters: aDictionary 
    aStream nextPutAll: self qualifiedName "self name"! !
!DatabaseField methodsFor: 'printing'!
printSQLOn: aStream withParameters: anArray 
    aStream nextPutAll: self qualifiedName "self name"! !
!DatabaseField methodsFor: 'printing'!
printUnqualifiedSQLOn: aStream withParameters: anArray 
    aStream nextPutAll: self name.! !
!DatabaseField methodsFor: 'printing'!
typeStringFor: aDatabaseAccessor
^aDatabaseAccessor platform typeStringFor: self type ofSize: self fieldSize.! !
!DatabaseField methodsFor: 'configuring'!
beNumeric
type := #number.
    fieldSize := 38.! !
!DatabaseField methodsFor: 'configuring'!
bePrimaryKey
isPrimaryKey := true.
    self table isNil ifFalse: [self table addAsPrimaryKeyField: self].! !
!DatabaseField methodsFor: 'configuring'!
useSequenceTable
sequencePolicy := SequenceTablePolicy default.! !
!DatabaseField methodsFor: 'configuring'!
useSequencingInMemory
    sequencePolicy := InMemorySequencePolicy default.! !
!DatabaseField methodsFor: 'database'!
convertToDatabaseForm: anObject
anObject isSymbol ifTrue: [^anObject asString].
    ^anObject.! !
!DatabaseField methodsFor: 'database'!
transform: anObject
^anObject.! !
!DatabaseField methodsFor: 'accessing'!
fieldSize
    ^fieldSize! !
!DatabaseField methodsFor: 'accessing'!
name
    "Private - Answer the value of the receiver's ''name'' instance variable."
^name! !
!DatabaseField methodsFor: 'accessing'!
name: anObject
    "Private - Set the value of the receiver's ''name'' instance variable to the argument, anObject."
name := anObject! !
!DatabaseField methodsFor: 'accessing'!
position
    ^position! !
!DatabaseField methodsFor: 'accessing'!
position: anObject
    position := anObject! !
!DatabaseField methodsFor: 'accessing'!
table
    "Private - Answer the value of the receiver's ''table'' instance variable."
^table! !
!DatabaseField methodsFor: 'accessing'!
table: anObject
    "Private - Set the value of the receiver's ''table'' instance variable to the argument, anObject."
table := anObject! !
!DatabaseField methodsFor: 'accessing'!
type
^type! !
!DatabaseField methodsFor: 'initializing'!
initialize
isPrimaryKey := false.
    sequencePolicy := NullSequencePolicy default.
    type := #string.
    fieldSize := 255.! !
!DatabaseField methodsFor: 'hacks'!
inverted
^TransformedField new parent: self; transformation: [:each | each * -1].! !
!DatabaseField methodsFor: 'hacks'!
rootField
^self.! !
!DatabaseField methodsFor: 'testing'!
isGenerated
^sequencePolicy ~= NullSequencePolicy default! !
!DatabaseField methodsFor: 'testing'!
isNullable
    
    ^self isPrimaryKey not.! !
!DatabaseField methodsFor: 'testing'!
isPrimaryKey
    "Private - Answer the value of the receiver's ''isPrimaryKey'' instance variable."
^isPrimaryKey! !
!DatabaseField methodsFor: 'querying'!
possibleTypes
^#(string number).! !
!DatabaseField methodsFor: 'querying'!
qualifiedName
^table isNil 
    	ifTrue: [self name]
    	ifFalse: [self table qualifiedName, '.', self name].! !
!DatabaseField methodsFor: 'querying'!
sequencePolicy
^sequencePolicy.! !
!DatabaseField methodsFor: 'converting'!
asGlorpExpression
^ParameterExpression forField: self basedOn: nil.! !
!DatabaseField methodsFor: 'converting'!
asGlorpExpressionOn: anExpression
^ParameterExpression forField: self basedOn: anExpression.! !
!DatabaseField class methodsFor: 'instance creation'!
named: aString
^self new name: aString.! !
!DatabaseField class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DatabaseLoginResource methodsFor: 'accessing'!
accessor
    ^accessor! !
!DatabaseLoginResource methodsFor: 'accessing'!
accessor: anObject
    accessor := anObject! !
!DatabaseLoginResource methodsFor: 'accessing'!
login
    ^login! !
!DatabaseLoginResource methodsFor: 'accessing'!
login: anObject
    login := anObject! !
!DatabaseLoginResource methodsFor: 'initialize/release'!
setUp
    Transcript show: self class name asString, ' setUp'; cr.
    super setUp.
    login := self class defaultLogin.
    accessor := DatabaseAccessor forLogin: login.
    accessor login.! !
!DatabaseLoginResource methodsFor: 'initialize/release'!
tearDown
Transcript show: self class name asString, ' tearDown'; cr.
    accessor notNil ifTrue: [accessor logout].! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultDolphinODBCLogin
    "To set the default database login for Dolphin, execute the following statement."
"DefaultLogin := self defaultDolphinODBCLogin."
^(Login new)
    	database: SQLServerPlatform new;
    	username: 'glorptest';
    	password: 'password';
    	connectString: 'glorptest'! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultLogin
    "Return the default Login."
DefaultLogin isNil ifTrue: [^DefaultLogin := self defaultOracleLiteLogin].
    ^DefaultLogin! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultLogin: aLogin
DefaultLogin := aLogin.! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultMysqlLogin
    "To set the default database login to MySQL, execute the following statement."
    "DefaultLogin := self defaultMysqlLogin."
^(Login new)
    	database: #MySQL;
    	username: 'System';
    	password: 'password';
    	connectString: 'glorp'.! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultOracleLiteLogin
    "To set the default database login to Oracle, execute the following statement."
    "DefaultLogin := self defaultOracleLiteLogin."
^(Login new)
    	database: OraclePlatform new;
    	username: 'System';
    	password: 'password';
    	connectString: 'odbc:polite'! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultOracleLogin
    "To set the default database login to Oracle, execute the following statement."
    "DefaultLogin := self defaultOracleLogin."
^(Login new)
    	database: OraclePlatform new;
    	username: 'System';
    	password: 'manager';
    	connectString: ''! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultPersonalOracleLogin
    "To set the default database login to Oracle, execute the following statement."
    "DefaultLogin := self defaultPersonalOracleLogin."
^(Login new)
    	database: OraclePlatform new;
    	username: 'system';
    	password: 'manager';
    	connectString: ''! !
!DatabaseLoginResource class methodsFor: 'accessing'!
defaultPostgreSQLLogin
    "To set the default database login to PostgreSQL, execute the following statement."
    "DefaultLogin := self defaultPostgreSQLLogin."
^(Login new)
    	database: PostgreSQLPlatform new;
    	username: 'alan';
    	password: '';
    	connectString: 'www.cincomsmalltalk.com:5432_glorptest'.! !
!DatabasePlatform methodsFor: 'constants'!
batchWriteStatementTerminatorString
    "^<String> This statement return the string to be used to devide several statement during batch write ..."
^';'! !
!DatabasePlatform methodsFor: 'constants'!
capitalWritingOfColumnName
    "^<Boolean> This method returns true, if the dbms wants to have column 
    names written in capital letters"
^true! !
!DatabasePlatform methodsFor: 'constants'!
capitalWritingOfCreatorName
    "^<Boolean> This method returns true, if the dbms wants to have column 
    names written in capital letters"
^true! !
!DatabasePlatform methodsFor: 'constants'!
capitalWritingOfDatabaseName
    "^<Boolean>"
^true! !
!DatabasePlatform methodsFor: 'constants'!
capitalWritingOfSQLCommands
    "^<Boolean>"
^true! !
!DatabasePlatform methodsFor: 'constants'!
capitalWritingOfTableName
    "^<Boolean>"
^true! !
!DatabasePlatform methodsFor: 'constants'!
columnNameSeparatorString
    "^<String> This statement return the string to be used to devide several columns ..."
^','! !
!DatabasePlatform methodsFor: 'constants'!
deleteViewWithTableSyntax
^false! !
!DatabasePlatform methodsFor: 'constants'!
hasSubtransaction
    "^<Boolean> This method returns true, if the used dbms is able to execute multiple sql-statements
    transferred via a command line transmitted from client to server - otherwise I return false"
^true! !
!DatabasePlatform methodsFor: 'constants'!
maxLengthOfColumnName
    "^<Integer> I return the max. length of a column name"
^18! !
!DatabasePlatform methodsFor: 'constants'!
maxLengthOfDatabaseName
    "^<Integer>I return the max. length of a database name"
^8! !
!DatabasePlatform methodsFor: 'constants'!
maxLengthOfTableName
    "^<Integer> I return the max. length of a table name"
^18! !
!DatabasePlatform methodsFor: 'constants'!
maxSQLBufferLength
    "^<Integer> I return the maximum length of a sql command stream"
^8192! !
!DatabasePlatform methodsFor: 'constants'!
postfixTableNameBeforeDeleting
^false! !
!DatabasePlatform methodsFor: 'constants'!
prefixQualifierBeforeCreatingAndDeleting
^true! !
!DatabasePlatform methodsFor: 'constants'!
prefixQualifierSeparatorString
    "^<String> This statement return the string to be used to separate the qualifier and the table/column name"
^'.'! !
!DatabasePlatform methodsFor: 'constants'!
prefixTableNameBeforeDeleting
^false! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForBeginTransaction
    "comment"
^'BEGIN'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForCharAttributeType: length
    "^<String>"
^'CHAR(',length asString,')'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForDateAttributeType
    "^<String>"
^'DATE'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForDecimalAttributeType: length post: postLength
    "^<String>"
^'DECIMAL(',length asString,',',postLength asString,')'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForDoubleAttributeType: length
    "^<String>"
^'FLOAT'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForDoubleLongIntegerAttributeType: length
    "^<String>"
^''! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForFloatAttributeType: length
    "^<String>"
^'FLOAT'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForIntegerAttributeType: length
    "^<String>"
^'SMALLINT'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForLongIntegerAttributeType: length
    "^<String>"
^'INTEGER'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForNOTNULLAttributeConstraint
    "^<String>"
^'NOT NULL'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForNOTNULLWithDefaultAttributeConstraint
    "^<String>"
^'NOT NULL WITH DEFAULT'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForNULLAttributeConstraint
    "^<String>"
^'NULL'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForTextAttributeType: length
    "^<String>"
^'LONG'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForTimeAttributeType
    "^<String>"
^'TIME'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForTimestampAttributeType
    "^<String>"
^'TIMESTAMP'! !
!DatabasePlatform methodsFor: 'constants'!
sqlTextForVariableCharAttributeType: length
    "^<String>"
^'VARCHAR(',length asString,')'! !
!DatabasePlatform methodsFor: 'constants'!
sqlWildcardForMultipleCharacters
    "^<String> This method returns the used wildcard string for multiple characters"
    
    ^'%'! !
!DatabasePlatform methodsFor: 'constants'!
sqlWildcardForSingleCharacter
    "^<String> This method returns the used wildcard string for single characters"
    
    ^'_'! !
!DatabasePlatform methodsFor: 'general services'!
predefinedKeywords
    "
    	^<OrderdCollection of: String> This method returns a list of preserved keyword, which should
    	not be used in database-, table or column names or any othe names in the platform system
    "
^OrderedCollection new! !
!DatabasePlatform methodsFor: 'printing'!
typeStringFor: type ofSize: size
type == #string ifTrue: [		^self sqlTextForVariableCharAttributeType: size ].
    type == #number ifTrue: [	^self sqlTextForLongIntegerAttributeType: size ].
"
   type == #fixedString ifTrue:[  ^self sqlTextForCharAttributeType: size ].
   type == #date ifTrue:[  ^self sqlTextForDateAttributeType ].
   type == #time ifTrue:[  ^self sqlTextForTimeAttributeType ].
   type == #timestamp ifTrue:[ ^self sqlTextForTimestampAttributeType ].
   type == #decimal ifTrue:[  ^self sqlTextForDecimalAttributeType: size post: 0  ].
   type == #float ifTrue:[ ^self sqlTextForFloatAttributeType: size  ].
   type == #double ifTrue:[  ^self sqlTextForDoubleAttributeType: size  ].
   type == #8bitInt ifTrue:[^self sqlTextForLongIntegerAttributeType: size  ].
   type == #16bitint ifTrue:[ ^self sqlTextForLongIntegerAttributeType: 8  ].
   type == #32bitint ifTrue:[ ^self sqlTextForLongIntegerAttributeType: 8  ].
   type == #64bitint ifTrue:[ ^self sqlTextForLongIntegerAttributeType: 8  ].
  "
self error: 'invalid field type'.! !
!DatabasePlatform methodsFor: 'testing'!
isODBCPlatform
^false! !
!DatabasePlatform methodsFor: 'testing'!
isOraclePlatform
^false! !
!DatabasePlatform methodsFor: 'testing'!
isPostgreSQLPlatform
^false! !
!DatabasePlatform methodsFor: 'services tables'!
createTableStatementStringFor: aGLORPDatabaseTable 
    "^<String> This method returns a string which can be used to create a database table ..."
| sqlStatementStream tmpString |
    tmpString := 'create table'.
    sqlStatementStream := WriteStream on: String new.
    sqlStatementStream
    	nextPutAll: (self capitalWritingOfSQLCommands 
    				ifTrue: [tmpString asUppercase]
    				ifFalse: [tmpString]);
    	space.
    self printDDLTableNameFor: aGLORPDatabaseTable on: sqlStatementStream.
"Now print the columns specification for each field in the table ..."
    self printColumnsSpecificationFor: aGLORPDatabaseTable
    	on: sqlStatementStream.
    self supportsConstraints 
    	ifTrue: 
    		[aGLORPDatabaseTable hasPrimaryKeyConstraints 
    			ifTrue: 
    				[sqlStatementStream nextPutAll: ', '.
    				self printPrimaryKeyConstraintsOn: sqlStatementStream
    					for: aGLORPDatabaseTable].
    		aGLORPDatabaseTable hasForeignKeyConstraints 
    			ifTrue: 
    				[sqlStatementStream nextPutAll: ', '.
    				self printForeignKeyConstraintsOn: sqlStatementStream
    					for: aGLORPDatabaseTable]].
sqlStatementStream
    	nextPut: $).
    ^sqlStatementStream contents! !
!DatabasePlatform methodsFor: 'services tables'!
dropTableStatementStringFor: aGLORPDatabaseTable 
    "^<String> This method returns a string which can be used to drop a database table ..."
| sqlStatementStream tmpString |
    tmpString := 'drop table'.
    sqlStatementStream := WriteStream on: String new.
    sqlStatementStream
    	nextPutAll: (self capitalWritingOfSQLCommands 
    				ifTrue: [tmpString asUppercase]
    				ifFalse: [tmpString]);
    	space.
    self printDDLTableNameFor: aGLORPDatabaseTable on: sqlStatementStream.
    ^sqlStatementStream contents! !
!DatabasePlatform methodsFor: 'services tables'!
printDDLTableNameFor: aGLORBDatabaseTable on: sqlStatementStream
    "This method just writes the name of a table to a stream"
    
    (aGLORBDatabaseTable creator asString isEmpty not 
    	and: [ self prefixQualifierBeforeCreatingAndDeleting ]) ifTrue:[
    		sqlStatementStream
    			nextPutAll: (self capitalWritingOfCreatorName 
    									ifTrue:[  aGLORBDatabaseTable creator asUppercase ] 
    									ifFalse:[aGLORBDatabaseTable creator ]) ;
    			nextPutAll: self prefixQualifierSeparatorString.
    ].
    sqlStatementStream
    	nextPutAll: (self capitalWritingOfTableName 
    							ifTrue:[ aGLORBDatabaseTable name asUppercase ] 
    							ifFalse:[ aGLORBDatabaseTable name ]).! !
!DatabasePlatform methodsFor: 'services tables'!
printForeignKeyConstraintsOn: sqlStatementStream for: aGLORBDatabaseTable
    "This method print the constraint specification on sqlStatementStream"
| sepFlag |
sepFlag := false.
    aGLORBDatabaseTable foreignKeyConstraints do: [ :eachKeyField |
    	sepFlag ifTrue:[ sqlStatementStream nextPutAll: ',' ].
    	sqlStatementStream nextPutAll: eachKeyField creationString.
    	sepFlag := true
    ].! !
!DatabasePlatform methodsFor: 'services tables'!
printPrimaryKeyConstraintsOn: sqlStatementStream for: aTable 
    "This method print the constraint specification on sqlStatementStream"
| sepFlag |
    aTable primaryKeyFields isEmpty ifTrue: [^self].
    sqlStatementStream
    	nextPutAll: 'CONSTRAINT ';
    	nextPutAll: aTable primaryKeyConstraintName;
    	nextPutAll: ' PRIMARY KEY  ('.
    sepFlag := false.
    aTable primaryKeyFields do: 
    		[:eachPrimaryKeyField | 
    		sepFlag ifTrue: [sqlStatementStream nextPutAll: ','].
    		sqlStatementStream nextPutAll: eachPrimaryKeyField name.
    		sepFlag := true].
    sqlStatementStream nextPut: $).
    sqlStatementStream
    	nextPutAll: ',';
    	cr;
    	nextPutAll: 'CONSTRAINT ';
    	nextPutAll: aTable primaryKeyUniqueConstraintName;
    	nextPutAll: ' UNIQUE  ('.
    sepFlag := false.
    aTable primaryKeyFields do: 
    		[:eachPrimaryKeyField | 
    		sepFlag ifTrue: [sqlStatementStream nextPutAll: ','].
    		sqlStatementStream nextPutAll: eachPrimaryKeyField name.
    		sepFlag := true].
    sqlStatementStream nextPut: $)! !
!DatabasePlatform methodsFor: 'services tables'!
validateTableName: tableNameString
    " <Boolean> I return true, if the choosen tableNameString is valid for the platform"
^( tableNameString size <= self maxLengthOfTableName ) 
    		and: [ (self predefinedKeywords includes: tableNameString asLowercase) not ]! !
!DatabasePlatform methodsFor: 'services columns'!
printColumnsSpecificationFor: aGLORBDatabaseTable on: sqlStatementStream
aGLORBDatabaseTable fields isEmpty not ifTrue:[
    	| sepFlag |
sqlStatementStream
    		space ;
    		nextPut: $(.
sepFlag := false.
       aGLORBDatabaseTable fields
         do: [ :eachGLORBDatabaseField |
sepFlag ifTrue:[ sqlStatementStream nextPutAll: self columnNameSeparatorString ].
    		
    		sqlStatementStream  
    			nextPutAll: (self capitalWritingOfColumnName 
    									ifTrue:[ eachGLORBDatabaseField name asUppercase ] 
    									ifFalse:[ eachGLORBDatabaseField name ]) ;
    			space ;
    			nextPutAll: (self typeStringFor: eachGLORBDatabaseField type ofSize: eachGLORBDatabaseField fieldSize ) ;
    			space  ;
    			nextPutAll: (eachGLORBDatabaseField isNullable 
    									ifTrue:[ 	self sqlTextForNULLAttributeConstraint]
    									ifFalse: [  self sqlTextForNOTNULLAttributeConstraint]).
sepFlag := true.
    	].
]! !
!AdabasLikePlatform methodsFor: 'SQL'!
supportsConstraints
    "^<Boolean> This method returns true, if the database support a contraint concept"
^false! !
!DatabaseRow methodsFor: 'accessing'!
at: aField
^self at: aField ifAbsent: [self error: 'missing field'].! !
!DatabaseRow methodsFor: 'accessing'!
at: aField ifAbsent: absentBlock
^(self wrapperAt: aField ifAbsent: absentBlock) contents.! !
!DatabaseRow methodsFor: 'accessing'!
at: aField put: aValue 
    
    "For generated fields, we expect the real value to be provided later by the database, so don't write a nil value"
| wrapper dbValue |
    dbValue := aField convertToDatabaseForm: aValue.
    aField table == self table ifFalse: [self error: 'Invalid table'].
    wrapper := contents at: aField ifAbsentPut: [FieldValueWrapper new].
    (aValue isNil and: [aField isGenerated]) ifFalse: [wrapper contents: dbValue].
    ^wrapper.! !
!DatabaseRow methodsFor: 'accessing'!
atName: aString put: anObject 
    self at: (table fieldNamed: aString) put: anObject! !
!DatabaseRow methodsFor: 'accessing'!
fields
    ^table fields! !
!DatabaseRow methodsFor: 'accessing'!
owner
^owner.! !
!DatabaseRow methodsFor: 'accessing'!
owner: anObject
owner := anObject.! !
!DatabaseRow methodsFor: 'accessing'!
primaryKey
| |
    self table primaryKeyFields isEmpty ifTrue: [^nil].
    ^self table hasCompositePrimaryKey 
    	ifTrue: [
    		self table primaryKeyFields 
    			collect: [:each | 	self at: each]]
    	ifFalse: [self at: self table primaryKeyFields first].! !
!DatabaseRow methodsFor: 'accessing'!
table
    "Private - Answer the value of the receiver's ''table'' instance variable."
^table! !
!DatabaseRow methodsFor: 'accessing'!
wrapperAt: aField
^self wrapperAt: aField ifAbsent: [self error: 'Field not found'].! !
!DatabaseRow methodsFor: 'accessing'!
wrapperAt: aField ifAbsent: aBlock
^contents at: aField ifAbsent: aBlock.! !
!DatabaseRow methodsFor: 'accessing'!
wrapperAt: aField put: aWrapper
contents at: aField put: aWrapper.
    aWrapper isNowContainedBy: self and: aField.! !
!DatabaseRow methodsFor: 'printing'!
equalityStringForField: aDatabaseField
| stream |
    stream := WriteStream on: (String new: 50).
    self printEqualityStringForField: aDatabaseField on: stream.
    ^stream contents.! !
!DatabaseRow methodsFor: 'printing'!
printEqualityStringForField: aDatabaseField on: aStream 
    "Get around PostgreSQL bug.  Qualified names cannot appear in SET expression."
    aDatabaseField printNameOn: aStream withParameters: #().
    aStream nextPutAll: ' = '.
    self printValueOfField: aDatabaseField on: aStream! !
!DatabaseRow methodsFor: 'printing'!
printFieldValuesOn: aWriteStream 
    GlorpHelper 
    	print: [:each | self sqlFormOfValue: (self at: each)]
    	on: aWriteStream
    	for: self table fields
    	separatedBy: ','.! !
!DatabaseRow methodsFor: 'printing'!
printOn: aStream
super printOn: aStream.
    aStream nextPutAll: '(' , (table name isNil ifTrue: [''] ifFalse: [table name]),  ')'.
    aStream cr.
    contents keysAndValuesDo: [:eachField :eachWrapper |
    	aStream nextPutAll: '    '.
    	eachField printOn: aStream.
    	aStream nextPutAll: '->'.
    	eachWrapper printOn: aStream.
    	aStream cr.].! !
!DatabaseRow methodsFor: 'printing'!
printPrimaryKeyStringOn: aStream 
    
    GlorpHelper
    	do:  [:eachField |
    		self printEqualityStringForField: eachField on: aStream]
    	for: table primaryKeyFields
    	separatedBy: [aStream nextPutAll: ' AND '].! !
!DatabaseRow methodsFor: 'printing'!
printValueOfField: aDatabaseField on: aWriteStream 
    aWriteStream nextPutAll: (self sqlFormOfValue: (self at: aDatabaseField))! !
!DatabaseRow methodsFor: 'printing'!
sqlFormOfValue: anObject 
    "Print a primitive value in the form SQL wants it"
anObject == nil ifTrue: [^'NULL'].
    ^anObject printString! !
!DatabaseRow methodsFor: 'enumerating'!
fieldValuesDo: aBlock
table fields do: [:each |
    	aBlock value: (self at: each)].! !
!DatabaseRow methodsFor: 'enumerating'!
keysAndValuesDo: aBlock
contents keysAndValuesDo: [:eachKey :eachValue |
    	aBlock value: eachKey value: eachValue contents].! !
!DatabaseRow methodsFor: 'querying'!
hasValueFor: aField
^(self wrapperAt: aField ifAbsent: [^false]) hasValue.! !
!DatabaseRow methodsFor: 'querying'!
shouldBeWritten
    ^shouldBeWritten! !
!DatabaseRow methodsFor: 'initializing'!
initialize
contents := IdentityDictionary new.
    shouldBeWritten := true.! !
!DatabaseRow methodsFor: 'sequencing'!
postWriteAssignSequences
self table fields do: [:each |
    	(self hasValueFor: self) ifFalse: [
    		each sequencePolicy postWriteAssignSequenceValueFor: each in: self]].! !
!DatabaseRow methodsFor: 'sequencing'!
preWriteAssignSequences
self table fields do: [:each |
    	(self hasValueFor: each) ifFalse: [
    		each sequencePolicy preWriteAssignSequenceValueFor: each in: self]].! !
!DatabaseRow methodsFor: 'configuring'!
shouldBeWritten: aBoolean 
    shouldBeWritten := aBoolean! !
!DatabaseRow methodsFor: 'configuring'!
table: anObject
    "Private - Set the value of the receiver's ''table'' instance variable to the argument, anObject."
table := anObject! !
!DatabaseRow class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DatabaseRow class methodsFor: 'instance creation'!
newForTable: aTable
^self new table: aTable.! !
!DatabaseRow class methodsFor: 'instance creation'!
newForTable: aTable withOwner: anObject
^self new table: aTable; owner: anObject.! !
!DatabaseTable methodsFor: 'fields'!
addField: aField
fields add: aField.
    aField isPrimaryKey ifTrue: [
    	self addAsPrimaryKeyField: aField].
    aField table: self.
    aField position: fields size.
    ^aField.! !
!DatabaseTable methodsFor: 'fields'!
addForeignKeyFrom: sourceField to: targetField
foreignKeyConstraints add: (ForeignKeyConstraint sourceField:  sourceField targetField: targetField).! !
!DatabaseTable methodsFor: 'fields'!
fieldNamed: aString
^fields detect: [:each | each name = aString] ifNone: [self addField: (DatabaseField named: aString)].! !
!DatabaseTable methodsFor: 'fields'!
newFieldNamed: aString
^self fieldNamed: aString.! !
!DatabaseTable methodsFor: 'create/delete in db'!
creationStringFor: aDatabaseAccessor 
    | creationStream |
    creationStream := WriteStream on: (String new: 1000).
    creationStream
    	nextPutAll: 'CREATE TABLE ';
    	nextPutAll: self name;
    	nextPutAll: ' ( ';
    	cr.
    self printFieldsOn: creationStream for: aDatabaseAccessor.
    aDatabaseAccessor platform supportsConstraints ifTrue: [
    	self hasPrimaryKeyConstraints 
    		ifTrue: [self printDelimiterOn: creationStream].
    	self printPrimaryKeyConstraintsOn: creationStream for: aDatabaseAccessor.
    	self hasForeignKeyConstraints ifTrue: [self printDelimiterOn: creationStream].
    	self printForeignKeyConstraintsOn: creationStream for: aDatabaseAccessor].
    creationStream nextPutAll: ')'.
    ^creationStream contents! !
!DatabaseTable methodsFor: 'create/delete in db'!
dropForeignKeyConstraintsFromAccessor: aDatabaseAccessor 
    self foreignKeyConstraints 
    	do: [:each | aDatabaseAccessor dropConstraint: each]! !
!DatabaseTable methodsFor: 'create/delete in db'!
dropFromAccessor: aDatabaseAccessor 
    self primaryKeyFields isEmpty 
    	ifFalse: 
    		[aDatabaseAccessor doCommand: 
    				[aDatabaseAccessor 
    					executeSQLString: 'ALTER TABLE ' , self name , ' DROP CONSTRAINT ' 
    							, self primaryKeyUniqueConstraintName]
    			ifError: [:ex | Transcript show: ex messageText].
    		aDatabaseAccessor doCommand: 
    				[aDatabaseAccessor 
    					executeSQLString: 'ALTER TABLE ' , self name , ' DROP CONSTRAINT ' 
    							, self primaryKeyConstraintName]
    			ifError: [:ex | Transcript show: ex messageText]].
    aDatabaseAccessor dropTableNamed: self name! !
!DatabaseTable methodsFor: 'create/delete in db'!
primaryKeyConstraintName
^self name, '_PK'.! !
!DatabaseTable methodsFor: 'create/delete in db'!
primaryKeyUniqueConstraintName
^self name, '_UNIQ'.! !
!DatabaseTable methodsFor: 'create/delete in db'!
printDelimiterOn: aStream
    
    aStream
    	nextPut: $,;
    	cr! !
!DatabaseTable methodsFor: 'create/delete in db'!
printFieldsOn: creationStream for: aDatabaseAccessor 
    GlorpHelper 
    	do: [:each | each printCreationStringFor: aDatabaseAccessor on: creationStream]
    	for: fields
    	separatedBy: [self printDelimiterOn: creationStream]! !
!DatabaseTable methodsFor: 'create/delete in db'!
printForeignKeyConstraintsOn: creationStream for: anObject
GlorpHelper 
    	print: [:each | each creationString]
    	on: creationStream
    	for: foreignKeyConstraints
    	separatedBy: ','! !
!DatabaseTable methodsFor: 'create/delete in db'!
printPrimaryKeyConstraintsOn: aStream for: aDatabaseAccessor 
    self primaryKeyFields isEmpty ifTrue: [^self].
    aStream nextPutAll: 'CONSTRAINT '.
    aStream nextPutAll: self primaryKeyConstraintName.
    aStream nextPutAll: ' PRIMARY KEY  ('.
    GlorpHelper 
    	print: [:each | each name]
    	on: aStream
    	for: self primaryKeyFields
    	separatedBy: ','.
    aStream nextPut: $).
aStream
    	nextPutAll: ',';
    	cr.
aStream nextPutAll: 'CONSTRAINT '.
    aStream nextPutAll: self primaryKeyUniqueConstraintName.
    aStream nextPutAll: ' UNIQUE  ('.
    GlorpHelper 
    	print: [:each | each name]
    	on: aStream
    	for: self primaryKeyFields
    	separatedBy: ','.
    aStream nextPut: $)! !
!DatabaseTable methodsFor: 'accessing'!
creator
    "Private - Answer the value of the receiver's ''creator'' instance variable."
^creator! !
!DatabaseTable methodsFor: 'accessing'!
creator: anObject
    "Private - Set the value of the receiver's ''creator'' instance variable to the argument, anObject."
creator := anObject! !
!DatabaseTable methodsFor: 'accessing'!
fields
^fields! !
!DatabaseTable methodsFor: 'accessing'!
foreignKeyConstraints
    "Private - Answer the value of the receiver's ''foreignKeyConstraints'' instance variable."
^foreignKeyConstraints! !
!DatabaseTable methodsFor: 'accessing'!
name
    "Private - Answer the value of the receiver's ''name'' instance variable."
^name! !
!DatabaseTable methodsFor: 'accessing'!
name: anObject
    "Private - Set the value of the receiver's ''name'' instance variable to the argument, anObject."
name := anObject! !
!DatabaseTable methodsFor: 'accessing'!
parent
^parent.! !
!DatabaseTable methodsFor: 'accessing'!
parent: aDatabaseTable
parent := aDatabaseTable.! !
!DatabaseTable methodsFor: 'accessing'!
primaryKeyFields
^primaryKeyFields.! !
!DatabaseTable methodsFor: 'accessing'!
qualifiedName
^self name.! !
!DatabaseTable methodsFor: 'accessing'!
sqlTableName
    "Our name, as appropriate for the list of tables in a SQL statement. Take into account aliasing"
    ^parent isNil 
    	ifTrue: [self name]
    	ifFalse: [parent sqlTableName, ' ', self name].! !
!DatabaseTable methodsFor: 'testing'!
hasCompositePrimaryKey
^primaryKeyFields size > 1.! !
!DatabaseTable methodsFor: 'testing'!
hasConstraints
    ^self hasForeignKeyConstraints or: [self hasPrimaryKeyConstraints]! !
!DatabaseTable methodsFor: 'testing'!
hasForeignKeyConstraints
    ^foreignKeyConstraints isEmpty not! !
!DatabaseTable methodsFor: 'testing'!
hasPrimaryKeyConstraints
    ^self primaryKeyFields isEmpty not.! !
!DatabaseTable methodsFor: 'initialize'!
initialize
creator := ''.
    fields := OrderedCollection new.
    primaryKeyFields := #().
    foreignKeyConstraints := OrderedCollection new: 4.! !
!DatabaseTable methodsFor: 'printing'!
printOn: aStream
super printOn: aStream.
    aStream 
    	nextPutAll: '(';
    	nextPutAll: (name isNil ifTrue: [''] ifFalse: [name]);
    	nextPutAll: ')'.! !
!DatabaseTable methodsFor: 'printing'!
printSQLOn: aWriteStream withParameters: aDictionary
    aWriteStream nextPutAll: self name! !
!DatabaseTable methodsFor: 'printing'!
sqlString
^name.! !
!DatabaseTable methodsFor: 'private/fields'!
addAsPrimaryKeyField: aField
primaryKeyFields := primaryKeyFields, (Array with: aField)! !
!DatabaseTable class methodsFor: 'instance creation'!
named: aString
^self new name: aString.! !
!DatabaseTable class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Date methodsFor: 'printing'!
glorpPrintSQLOn: aStream
    "Print the date in ISO format. 'yyyy-mm-dd'  Don't rely on any dialect-specific formatting or padding mechanisms"
    | monthString dayString |
    aStream 
    	nextPut: $';
    	print: self year;
    	nextPut: $-.
    monthString := self monthIndex printString.
    monthString size = 1 ifTrue: [aStream nextPut: $0 ].
    aStream nextPutAll: monthString.
    aStream nextPut: $-.
    dayString := self dayOfMonth printString.
    dayString size = 1 ifTrue: [aStream nextPut: $0 ].
    aStream nextPutAll: dayString.
    aStream nextPut: $'.! !
!Descriptor methodsFor: 'accessing'!
addMapping: aMapping
mappings add: aMapping.
    aMapping descriptor: self.
    mappedFields := nil.! !
!Descriptor methodsFor: 'accessing'!
addMultipleTableCriteria: anExpression 
    self multipleTableCriteria add: anExpression! !
!Descriptor methodsFor: 'accessing'!
addTable: aDatabaseTable 
    tables add: aDatabaseTable.! !
!Descriptor methodsFor: 'accessing'!
allMappingsForField: aField 
    "Return all of the mappings that use this field"
    ^mappings select: [:each | each mappedFields includes: aField]! !
!Descriptor methodsFor: 'accessing'!
cachePolicy
    cachePolicy isNil ifTrue: [^system cachePolicy].
    ^cachePolicy! !
!Descriptor methodsFor: 'accessing'!
cachePolicy: aCachePolicy
    cachePolicy:= aCachePolicy! !
!Descriptor methodsFor: 'accessing'!
describedClass
    "Private - Answer the value of the receiver's ''describedClass'' instance variable."
^describedClass! !
!Descriptor methodsFor: 'accessing'!
describedClass: anObject
    "Private - Set the value of the receiver's ''describedClass'' instance variable to the argument, anObject."
describedClass := anObject! !
!Descriptor methodsFor: 'accessing'!
directMappingForField: aField 
    "Return a single, direct mapping for this field. There may conceivably be more than one, but they all have to agree, so it shouldn't matter as far as the value. There may also be none."
^mappings 
    	detect: [:each | each isRelationship not and: [each mappedFields includes: aField]]
    	ifNone: [nil]! !
!Descriptor methodsFor: 'accessing'!
fieldsForSelectStatement
    "Return all the fields that are mapped, in the order that they occur in the table, as appropriate for the set of fields being selected"
    | fieldsForSelect fieldSet |
    fieldSet := IdentitySet new: mappings size.
    mappings do: [:each | fieldSet addAll: each fieldsForSelectStatement].
    fieldsForSelect := self mappedFields select: [:each | fieldSet includes: each].
    ^fieldsForSelect.! !
!Descriptor methodsFor: 'accessing'!
initialize
mappings := OrderedCollection new.
    tables := OrderedCollection new: 1.! !
!Descriptor methodsFor: 'accessing'!
mappedFields
    "Return all the fields that are mapped, in the order that they occur in the table."
    mappedFields isNil ifTrue: [
    	| fieldSet |
    	fieldSet := IdentitySet new: mappings size.
    	mappings do: [:each | fieldSet addAll: each mappedFields].
    	mappedFields := OrderedCollection new.
    	tables do: [:each |
    		each fields do: [:eachField | (fieldSet includes: eachField) ifTrue: [mappedFields add: eachField]]]].
    ^mappedFields.! !
!Descriptor methodsFor: 'accessing'!
mappingForAttributeNamed: aSymbol
^mappings detect: [:each | each attributeName == aSymbol] ifNone: [nil]! !
!Descriptor methodsFor: 'accessing'!
multipleTableCriteria
    multipleTableCriteria isNil
    	ifTrue: [multipleTableCriteria := OrderedCollection new: 1].
    ^multipleTableCriteria.! !
!Descriptor methodsFor: 'accessing'!
primaryTable
    ^tables first.! !
!Descriptor methodsFor: 'accessing'!
session
^system session.! !
!Descriptor methodsFor: 'accessing'!
system
    ^system! !
!Descriptor methodsFor: 'accessing'!
system: anObject
    system := anObject! !
!Descriptor methodsFor: 'accessing'!
table
    ^tables first.! !
!Descriptor methodsFor: 'accessing'!
table: aDatabaseTable
tables add: aDatabaseTable.! !
!Descriptor methodsFor: 'accessing'!
tables
    ^tables! !
!Descriptor methodsFor: 'mapping'!
createRowsFor: anObject in: aRowMap
|  |
    anObject class == self describedClass ifFalse: [self error: 'wrong descriptor for this object'].
    mappings do: [:each |
    	each mapFromObject: anObject intoRowsIn: aRowMap].
    self multipleTableCriteria do: [:each |
    	each mapFromSource: anObject andTarget: anObject intoRowsIn: aRowMap].! !
!Descriptor methodsFor: 'mapping'!
mappings
    ^ReadStream on: mappings! !
!Descriptor methodsFor: 'mapping'!
populateObject: anObject fromRow: anArray inBuilder: anElementBuilder 
    "Answer an object using the values for the specified fields."
mappings do: 
    		[:each | 
    		each 
    			mapFromRow: anArray
    			intoObject: anObject
    			inElementBuilder: anElementBuilder]! !
!Descriptor methodsFor: 'mapping'!
primaryKeyExpressionFor: anObject
    | expression |
    anObject class == describedClass ifFalse: [self error: 'Wrong descriptor for this object'].
    expression := nil.
    self primaryKeyMappings do: [:each | 
    	| clause |
    	clause := each expressionFor: anObject.
    	expression := clause exAnd: expression].
    ^expression.! !
!Descriptor methodsFor: 'mapping'!
primaryKeyFor: anObject
    | result |
    anObject class == describedClass ifFalse: [self error: 'Wrong descriptor for this object'].
    result := self primaryKeyMappings collect: [:each | 
    	each getValueFrom: anObject].
    ^result size = 1 ifTrue: [result at: 1] ifFalse: [result].! !
!Descriptor methodsFor: 'mapping'!
primaryKeyMappings
    ^self primaryTable primaryKeyFields 
    	collect: [:each | self directMappingForField: each]! !
!Descriptor methodsFor: 'tracing'!
defaultTracing
    ^Tracing new.! !
!Descriptor methodsFor: 'tracing'!
setupTracing: aTracing
    "Find all the other objects that need to be read when this one is read"
self trace: aTracing context: aTracing base.! !
!Descriptor methodsFor: 'tracing'!
trace: aTracing context: anExpression
    "For each mapping, check if the relationship is involved in the set of things
to be read"
    mappings do: [:each |
    	each trace: aTracing context: anExpression].! !
!Descriptor methodsFor: 'testing'!
mapsPrimaryKeys
| primaryKeyFields  |
    primaryKeyFields := self primaryTable primaryKeyFields.
    primaryKeyFields isEmpty ifTrue: [^false].
    primaryKeyFields do: [:each | (self mappedFields includes: each) ifFalse: [^false]].
    ^true.! !
!Descriptor methodsFor: 'printing'!
printOn: aStream
super printOn: aStream.
    aStream nextPutAll: '('.
    describedClass printOn: aStream.
    aStream nextPutAll: ')'.! !
!Descriptor methodsFor: 'internal'!
readBackNewRowInformationFor: anObject! !
!Descriptor methodsFor: 'internal'!
referencedIndependentObjectsFrom: anObject do: aBlock
mappings do: [:each |
    	(each referencedIndependentObjectsFrom: anObject) do: [:eachReferencedObject |
    		aBlock value: eachReferencedObject]].! !
!Descriptor class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DescriptorSystem methodsFor: 'accessing'!
allClasses
^self allClassNames collect: [:each | Smalltalk at: each].! !
!DescriptorSystem methodsFor: 'accessing'!
allDescriptors
^self allClasses collect: [:each | 
    	self descriptorFor: each].! !
!DescriptorSystem methodsFor: 'accessing'!
allTables
    ^self allTableNames collect: [:each | 
    	self tableNamed: each].! !
!DescriptorSystem methodsFor: 'accessing'!
cachePolicy
    "Return the default cache policy that will be used for descriptors that don't specify their own policy"
    cachePolicy isNil ifTrue: [cachePolicy := CachePolicy new].
    ^cachePolicy.! !
!DescriptorSystem methodsFor: 'accessing'!
cachePolicy: aCachePolicy
    cachePolicy := aCachePolicy.! !
!DescriptorSystem methodsFor: 'accessing'!
defaultTracing
^Tracing new! !
!DescriptorSystem methodsFor: 'accessing'!
session
    ^session! !
!DescriptorSystem methodsFor: 'accessing'!
session: anObject
    session := anObject! !
!DescriptorSystem methodsFor: 'private'!
initialize
descriptors := Dictionary new.
    tables := Dictionary new.! !
!DescriptorSystem methodsFor: 'private'!
newDescriptorFor: aClass
| newDescriptor selector |
    (self allClassNames includes: aClass name) ifFalse: [^nil].
    newDescriptor := Descriptor new.
    newDescriptor system: self.
    newDescriptor describedClass: aClass.
    selector := ('descriptorFor', aClass name, ':') asSymbol.
    self perform:  selector with: newDescriptor.
    ^newDescriptor.! !
!DescriptorSystem methodsFor: 'private'!
newTableNamed: aString
    | newTable str |
    newTable := DatabaseTable new.
    newTable name: aString.
    str := aString copyWithout: $_.
    self perform: ('tableFor', str, ':') asSymbol with: newTable.
    ^newTable.! !
!DescriptorSystem methodsFor: 'api'!
descriptorFor: aClassOrObject
| theClass |
    theClass := aClassOrObject isBehavior 
    			ifTrue: [aClassOrObject]
    			ifFalse: [aClassOrObject class].
    ^descriptors at: theClass ifAbsentPut: [self newDescriptorFor: theClass]! !
!DescriptorSystem methodsFor: 'api'!
existingTableNamed: aString
^tables at: aString ifAbsent: [self error: 'missing table'].! !
!DescriptorSystem methodsFor: 'api'!
hasDescriptorFor: aClassOrObject
^(self descriptorFor: aClassOrObject) notNil.! !
!DescriptorSystem methodsFor: 'api'!
tableNamed: aString
^tables at: aString ifAbsentPut: [self newTableNamed: aString].! !
!DescriptorSystem class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Dialect class methodsFor: 'identifying' stamp: 'nop 5/29/2002 10:36'!
dialectName
    self isVisualWorks
    	ifTrue: [^ 'VisualWorks'].
    self isVisualAge
    	ifTrue: [^ 'VisualAge'].
    self isDolphin
    	ifTrue: [^ 'Dolphin'].
    self isSqueak
    	ifTrue: [^ 'Squeak'].
    self error: 'I don''t know'! !
!Dialect class methodsFor: 'identifying'!
isDolphin
    Smalltalk at: #DolphinSplash ifAbsent: [^false].
    ^true! !
!Dialect class methodsFor: 'identifying' stamp: 'nop 5/29/2002 10:36'!
isSqueak
    Smalltalk
    			at: #SqueakPage
    			ifAbsent: [^ false].
^true! !
!Dialect class methodsFor: 'identifying'!
isVisualAge
    | sys |
    sys := Smalltalk at: #System ifAbsent: [^false].
    (sys respondsTo: #vmType) ifFalse: [^false].
    ^sys vmType = 'ES'! !
!Dialect class methodsFor: 'identifying'!
isVisualWorks
    Smalltalk class selectors do: [ :s | 
    	(s == #versionName and: [ (Smalltalk versionName copyFrom: 1 to: 11) = 'VisualWorks']) 
    	    ifTrue: [^true]].
    ^false! !
!DolphinDatabaseAccessor methodsFor: 'accessing'!
isLoggedIn
^connection notNil.! !
!DolphinDatabaseAccessor methodsFor: 'executing'!
executeSQLString: aString
logging ifTrue: [Transcript show: aString; cr].
    ^connection query: aString! !
!DolphinDatabaseAccessor methodsFor: 'executing'!
externalDatabaseErrorSignal
^Smalltalk at: #DBError! !
!DolphinDatabaseAccessor methodsFor: 'initialize'!
initialize
super initialize.
    logging := true.! !
!DolphinDatabaseAccessor methodsFor: 'login'!
loginIfError: aBlock
self
    	doCommand:
    		[connection := ((Smalltalk at: #DBConnection) new)
    			dsn: currentLogin connectString;
    			uid: currentLogin username;
    			pwd: currentLogin password;
    			connect.]
    	ifError: aBlock! !
!DolphinDatabaseAccessor methodsFor: 'login'!
logout
connection notNil
    	ifTrue:
    		[[connection disconnect.] ensure: [connection := nil]].! !
!DolphinDatabaseAccessor methodsFor: 'login'!
showDialog: aString
(Smalltalk at: #MessageBox) warning: aString.! !
!DolphinDatabaseAccessor methodsFor: 'transactions'!
beginTransaction
connection beginRWTxn.! !
!DolphinDatabaseAccessor methodsFor: 'transactions'!
commitTransaction
logging ifTrue: 
    	[Transcript show: 'Commit Transaction'; cr].
    connection commitTxn.! !
!DolphinDatabaseAccessor methodsFor: 'transactions'!
isInTransaction
^connection isInTransaction! !
!DolphinDatabaseAccessor methodsFor: 'transactions'!
rollbackTransaction
    logging ifTrue: 
    	[Transcript show: 'Rollback Transaction'; cr].
    connection rollbackTxn.! !
!ElementBuilder methodsFor: 'building objects'!
buildObjectFrom: anArray 
    self requiresPopulating 
    	ifTrue: 
    		[self populateInstanceFromRow: anArray inBuilder: self.
    		self registerObjectInUnitOfWork]! !
!ElementBuilder methodsFor: 'building objects'!
buildProxyFrom: anArray 
    | parameters |
    parameters := IdentityDictionary new.
    self descriptor primaryTable primaryKeyFields do: [:eachField |
    	parameters at: eachField put: (self valueOf: eachField in: anArray)].
    instance := (self newProxy) 
    	session: self session; 
    	parameters: parameters.
    ^self! !
!ElementBuilder methodsFor: 'building objects'!
canCache
^self descriptor mapsPrimaryKeys! !
!ElementBuilder methodsFor: 'building objects'!
findInstanceForRow: row useProxy: useProxies 
    self lookupCachedObjectForRow: row.
    instance isNil ifFalse: [
    	requiresPopulating := query shouldRefresh. ^self].
    useProxies 
    	ifTrue: [self buildProxyFrom: row]
    	ifFalse: 
    		[requiresPopulating := true.
    		instance := expression descriptor describedClass basicNew.
    		self canCache ifTrue: [self session cacheAt: key put: instance]]! !
!ElementBuilder methodsFor: 'building objects'!
lookupCachedObjectForRow: row 
    self canCache 
    	ifTrue: 
    		[key := self primaryKeyFromRow: row.
    		instance := self session cacheLookupForClass: expression descriptor describedClass key: key]! !
!ElementBuilder methodsFor: 'building objects'!
newProxy
    "Create a proxy with a primary key query in which the parameters are the primary key fields"
    | whereExpression |
    whereExpression := PrimaryKeyExpression new.
    self descriptor primaryTable primaryKeyFields do: [:eachField | 
    	whereExpression addSource: eachField target: eachField].
    ^Proxy 
    	returningOneOf: query resultClass 
    	where: whereExpression.! !
!ElementBuilder methodsFor: 'building objects'!
populateInstanceFromRow: row inBuilder: anElementBuilder 
    expression descriptor 
    	populateObject: instance
    	fromRow: row
    	inBuilder: anElementBuilder! !
!ElementBuilder methodsFor: 'building objects'!
primaryKeyFromRow: aRow
    
    key := self descriptor table primaryKeyFields collect: [:each |
    	aRow atIndex: (each position)].
    key size = 0 ifTrue: [self error: 'Missing primary key'].
    key size = 1 ifTrue: [^key first].
    ^key.! !
!ElementBuilder methodsFor: 'building objects'!
registerObjectInUnitOfWork
    "If there is a current unit of work, then we must register in it, after population because that way the state is already in place. The nil checks are mostly for safety during unit tests, as those conditions should never occur in real use"
    query isNil ifTrue: [^self].
    query session isNil ifTrue: [^self].
    query session register: instance.! !
!ElementBuilder methodsFor: 'accessing'!
descriptor
    
    ^expression descriptor.! !
!ElementBuilder methodsFor: 'accessing'!
expression
    ^expression! !
!ElementBuilder methodsFor: 'accessing'!
expression: anExpression
    expression := anExpression.! !
!ElementBuilder methodsFor: 'accessing'!
fieldTranslations
    ^fieldTranslations! !
!ElementBuilder methodsFor: 'accessing'!
fieldTranslations: aDictionary 
    fieldTranslations := aDictionary.! !
!ElementBuilder methodsFor: 'accessing'!
instance
    ^instance! !
!ElementBuilder methodsFor: 'accessing'!
instance: anObject
    instance := anObject! !
!ElementBuilder methodsFor: 'accessing'!
instanceClass
    ^instanceClass! !
!ElementBuilder methodsFor: 'accessing'!
instanceClass: anObject
    instanceClass := anObject! !
!ElementBuilder methodsFor: 'accessing'!
query
    ^query! !
!ElementBuilder methodsFor: 'accessing'!
query: aQuery 
    query := aQuery! !
!ElementBuilder methodsFor: 'accessing'!
requiresDistinct
^expression requiresDistinct.! !
!ElementBuilder methodsFor: 'accessing'!
requiresPopulating
    ^requiresPopulating! !
!ElementBuilder methodsFor: 'accessing'!
requiresPopulating: anObject
    requiresPopulating := anObject! !
!ElementBuilder methodsFor: 'accessing'!
session
    ^expression descriptor session.! !
!ElementBuilder methodsFor: 'selecting fields'!
fieldsForSelectStatement
    ^self fieldsFromThePerspectiveOfTheMainSelect: (self fieldsFromMyPerspective).! !
!ElementBuilder methodsFor: 'selecting fields'!
fieldsFromMyPerspective
    ^query returnProxies 
    	ifTrue: [self descriptor table primaryKeyFields]
    	ifFalse: [self descriptor mappedFields]! !
!ElementBuilder methodsFor: 'selecting fields'!
fieldsFromThePerspectiveOfTheMainSelect: aCollection
    ^expression translateFields: aCollection.! !
!ElementBuilder methodsFor: 'initializing'!
initialize
requiresPopulating := false.! !
!ElementBuilder methodsFor: 'translating fields'!
translateFieldPosition: aDatabaseField 
    fieldTranslations isNil ifTrue: [^aDatabaseField position].
    ^fieldTranslations at: aDatabaseField.! !
!ElementBuilder methodsFor: 'translating fields'!
valueOf: aField in: anArray
^anArray atIndex: (self translateFieldPosition: aField rootField).! !
!ElementBuilder methodsFor: 'executing'!
hasFieldTranslations
    ^self fieldTranslations notNil! !
!ElementBuilder class methodsFor: 'instance creation'!
for: anExpression
^self new
    	expression: anExpression.! !
!ElementBuilder class methodsFor: 'instance creation'!
for: anExpression in: aQuery
^self new
    	expression: anExpression;
    	query: aQuery.! !
!ElementBuilder class methodsFor: 'instance creation'!
new
^super new initialize.! !
!EmailAddress methodsFor: 'accessing'!
host
    ^host! !
!EmailAddress methodsFor: 'accessing'!
host: anObject
    host := anObject! !
!EmailAddress methodsFor: 'accessing'!
id
    ^ id! !
!EmailAddress methodsFor: 'accessing'!
user
    ^user! !
!EmailAddress methodsFor: 'accessing'!
user: anObject
    user := anObject! !
!Encyclopedia methodsFor: 'accessories'!
entries
    ^entries.! !
!Encyclopedia methodsFor: 'initialize'!
initialize
entries := Dictionary new.! !
!Encyclopedia class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Encyclopedia class methodsFor: 'examples'!
example1
    | result |
    result := Encyclopedia new.
    result entries at: 'one' put: EncyclopediaEntry example1.
    result entries at: 'two' put: EncyclopediaEntry example2.
    ^result.! !
!EncyclopediaEntry methodsFor: 'accessing'!
id: aSmallInteger 
    id := aSmallInteger.! !
!EncyclopediaEntry methodsFor: 'accessing'!
name: aString 
    name := aString! !
!EncyclopediaEntry methodsFor: 'accessing'!
text: aString 
    text := aString.! !
!EncyclopediaEntry class methodsFor: 'examples'!
example1
    ^self new
    	id: 1;
    	name: 'One';
    	text: 'The first number (not counting zero)'.! !
!EncyclopediaEntry class methodsFor: 'examples'!
example2
    ^self new
    	id: 2;
    	name: 'Two';
    	text: 'The second number (comes after 1)'.! !
!FakeElementBuilder methodsFor: 'accessing'!
value: anObject
    value := anObject.! !
!FakeElementBuilder methodsFor: 'element builder protocol'!
valueOf: aField in: anArray
^value.! !
!FieldUnifier methodsFor: 'unifying'!
calculateRows
rows := OrderedCollection new: fields size.
    fieldsWithRows := OrderedCollection new: fields size.
    fields with: objects do: [:eachField :eachObject |
    	eachObject isNil 
    		ifFalse: [
    			fieldsWithRows add: eachField.
    			rows add: (rowMap findOrAddRowForTable: eachField table withKey: eachObject)]].! !
!FieldUnifier methodsFor: 'unifying'!
findExistingWrappersIfNone: aBlock
| allWrappers |
    allWrappers := IdentitySet new: 5.
    fieldsWithRows with: rows do: [:eachField :eachRow | 
    	| wrapper |
    	wrapper := eachRow wrapperAt: eachField ifAbsent: [nil].
    	wrapper isNil ifFalse: [allWrappers add: wrapper]].
    ^allWrappers isEmpty
    	ifTrue: [aBlock value]
    	ifFalse: [allWrappers asArray].! !
!FieldUnifier methodsFor: 'unifying'!
findWrapperToUseFrom: aWrapperCollection 
    | wrappersWithValues winner |
    wrappersWithValues := aWrapperCollection select: [:each | each hasValue].
    wrappersWithValues size > 1 
    	ifTrue: [self error: 'Conflicting values in rows'].
    winner := wrappersWithValues size = 1 
    			ifTrue: [wrappersWithValues at: 1]
    			ifFalse: [aWrapperCollection first].
    ^winner! !
!FieldUnifier methodsFor: 'unifying'!
unify
    |  wrappers |
    self calculateRows.
    wrappers := self findExistingWrappersIfNone: [Array with: FieldValueWrapper new].
    self unifyWrappers: wrappers.! !
!FieldUnifier methodsFor: 'unifying'!
unifyWrappers: aWrapperCollection 
    | winner allRows allFields |
    winner := self findWrapperToUseFrom: aWrapperCollection.
    allRows := OrderedCollection new.
    allFields := OrderedCollection new.
    aWrapperCollection do: 
    		[:eachWrapper | 
    		eachWrapper containedBy do: 
    				[:eachRowAndField | 
    				allRows add: eachRowAndField first.
    				allFields add: eachRowAndField last]].
    allRows addAll: rows.
    allFields addAll: fieldsWithRows.
    allFields with: allRows
    	do: [:eachField :eachRow | eachRow wrapperAt: eachField put: winner]! !
!FieldUnifier methodsFor: 'accessing'!
fields
    ^fields! !
!FieldUnifier methodsFor: 'accessing'!
fields: anObject
    fields := anObject! !
!FieldUnifier methodsFor: 'accessing'!
objects
    ^objects! !
!FieldUnifier methodsFor: 'accessing'!
objects: anObject
    objects := anObject! !
!FieldUnifier methodsFor: 'accessing'!
rowMap
    ^rowMap! !
!FieldUnifier methodsFor: 'accessing'!
rowMap: anObject
    rowMap := anObject! !
!FieldUnifier class methodsFor: 'instance creation'!
unifyFields: fields correspondingTo: objects in: aRowMap
self new
    	fields: fields;
    	objects: objects;
    	rowMap: aRowMap;
    	unify.! !
!FieldValueWrapper methodsFor: 'public'!
containedBy
^containedBy.! !
!FieldValueWrapper methodsFor: 'public'!
contents
^contents.! !
!FieldValueWrapper methodsFor: 'public'!
contents: anObject
(hasValue and: [contents ~= anObject]) ifTrue: [self error: 'Inconsistent values in field'].
    contents := anObject.
    hasValue := true.! !
!FieldValueWrapper methodsFor: 'public'!
hasValue
^hasValue.! !
!FieldValueWrapper methodsFor: 'public'!
initialize
hasValue := false.
    containedBy := OrderedCollection new: 5.! !
!FieldValueWrapper methodsFor: 'public'!
printOn: aStream
aStream 
    	nextPutAll: '<<'.
    self hasValue ifTrue: [aStream print: contents].
    aStream
    	nextPutAll: '>>'.! !
!FieldValueWrapper methodsFor: 'containing'!
isNowContainedBy: aRow and: aField
| existingEntry |
    existingEntry := containedBy detect: [:each | each first == aRow and: [each last == aField]] ifNone: [nil].
    existingEntry notNil ifTrue: [^self].
    containedBy add: (Array with: aRow with: aField).! !
!FieldValueWrapper class methodsFor: 'public'!
new
^super new initialize.! !
!ForeignKeyConstraint methodsFor: 'printing'!
creationString
    
    ^'CONSTRAINT ', self name, ' FOREIGN KEY (', sourceField name, ') REFERENCES ', targetField asConstraintReferenceString.! !
!ForeignKeyConstraint methodsFor: 'printing'!
dropString
    
    ^'ALTER TABLE ', sourceField table sqlString, ' DROP CONSTRAINT ', self name.! !
!ForeignKeyConstraint methodsFor: 'printing'!
name
    | stream |
    stream := WriteStream on: (String new: 100).
    sourceField printForConstraintNameOn: stream maxLength: 11.
    stream nextPutAll: '_TO_'.
    targetField printForConstraintNameOn: stream maxLength: 11.
    stream nextPutAll: '_REF'.
    ^stream contents! !
!ForeignKeyConstraint methodsFor: 'accessing'!
sourceField
    ^sourceField! !
!ForeignKeyConstraint methodsFor: 'accessing'!
sourceField: aDatabaseField 
    sourceField := aDatabaseField! !
!ForeignKeyConstraint methodsFor: 'accessing'!
targetField
    ^targetField! !
!ForeignKeyConstraint methodsFor: 'accessing'!
targetField: aDatabaseField 
    targetField := aDatabaseField! !
!ForeignKeyConstraint methodsFor: 'initializing'!
sourceField: aDatabaseField targetField: anotherDatabaseField
sourceField := aDatabaseField.
    targetField := anotherDatabaseField.! !
!ForeignKeyConstraint class methodsFor: 'instance creation'!
sourceField: aDatabaseField targetField: anotherDatabaseField
^self new
    	sourceField: aDatabaseField
    	targetField: anotherDatabaseField.! !
!GlorpDemoDescriptorSystem methodsFor: 'other'!
allClassNames
^#(Person Address Customer BankTransaction BankAccount GlorpMoney ServiceCharge BankAccountNumber EmailAddress Passenger Airline).! !
!GlorpDemoDescriptorSystem methodsFor: 'other'!
allTableNames
^#('GR_ADDRESS' 'PERSON' 'GR_CUSTOMER' 'BANK_TRANS' 'BANK_ACCT' 'CUSTOMER_ACCT_LINK' 'EMAIL_ADDRESS' 'STUFF' 'PASSENGER' 'AIRLINE' 'FREQUENT_FLYER').! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleAccountRow1
| accountTable row |
    accountTable := self tableNamed: 'BANK_ACCT'.
    row := DatabaseRow newForTable: accountTable.
    row at: (accountTable fieldNamed: 'ID') put: 9874.
    row at: (accountTable fieldNamed: 'BANK_CODE') put: 1.
    row at: (accountTable fieldNamed: 'BRANCH_NO') put: 2.
    row at: (accountTable fieldNamed: 'ACCT_NO') put: 3.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleAccountRow2
| accountTable row |
    accountTable := self tableNamed: 'BANK_ACCT'.
    row := DatabaseRow newForTable: accountTable.
    row at: (accountTable fieldNamed: 'ID') put: 6.
    row at: (accountTable fieldNamed: 'BANK_CODE') put: 2.
    row at: (accountTable fieldNamed: 'BRANCH_NO') put: 3.
    row at: (accountTable fieldNamed: 'ACCT_NO') put: 4.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleAddressRow
    | addressTable row |
    addressTable := self  tableNamed: 'GR_ADDRESS'.
    row := DatabaseRow newForTable: addressTable.
    row at: (addressTable fieldNamed: 'ID') put: 123.
    row at: (addressTable fieldNamed: 'STREET') put: 'Paseo Montril'.
    row at: (addressTable fieldNamed: 'HOUSE_NUM') put: '10185'.
    ^row! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleBankTransactionRow
    | table row |
    table := self tableNamed: 'BANK_TRANS'.
    row := DatabaseRow newForTable: table.
row atName: 'ID' put: 1.
    row atName: 'OWNER_ID' put: nil.
    row atName: 'AMT_CURR' put: 'CDN'.
    row atName: 'AMT_AMT' put: 7.
    row atName: 'SRVC_DESC' put: 'additional overcharge'.
    row atName: 'SRVC_AMT_CURR' put: 'USD'.
    row atName: 'SRVC_AMT_AMT' put: 2.
^row! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleCALinkRow1
| linkTable row |
    linkTable := self tableNamed: 'CUSTOMER_ACCT_LINK'.
    row := DatabaseRow newForTable: linkTable.
    row at: (linkTable fieldNamed: 'ACCT_ID') put: 9874.
    row at: (linkTable fieldNamed: 'CUSTOMER_ID') put: 27.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleCALinkRow2
| linkTable row |
    linkTable := self tableNamed: 'CUSTOMER_ACCT_LINK'.
    row := DatabaseRow newForTable: linkTable.
    row at: (linkTable fieldNamed: 'ACCT_ID') put: 6.
    row at: (linkTable fieldNamed: 'CUSTOMER_ID') put: 27.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleCustomerRow1
| customerTable row |
    customerTable := self tableNamed: 'GR_CUSTOMER'.
    row := DatabaseRow newForTable: customerTable.
    row at: (customerTable fieldNamed: 'ID') put: 27.
    row at: (customerTable fieldNamed: 'NAME') put: 'aCustomer'.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleEmailAddressRow1
| personTable row |
    personTable := self tableNamed: 'EMAIL_ADDRESS'.
    row := DatabaseRow newForTable: personTable.
    row at: (personTable fieldNamed: 'ID') put: 42.
    row at: (personTable fieldNamed: 'USER_NAME') put: 'alan'.
    row at: (personTable fieldNamed: 'HOST_NAME') put: 'objectpeople.com'.
    row at: (personTable fieldNamed: 'PERSON_ID') put: 3.
^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleEmailAddressRow2
| personTable row |
    personTable := self tableNamed: 'EMAIL_ADDRESS'.
    row := DatabaseRow newForTable: personTable.
    row at: (personTable fieldNamed: 'ID') put: 54321.
    row at: (personTable fieldNamed: 'USER_NAME') put: 'johnson'.
    row at: (personTable fieldNamed: 'HOST_NAME') put: 'cs.uiuc.edu'.
    row at: (personTable fieldNamed: 'PERSON_ID') put: 3.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleFrequentFlyerRow
    | ffTable row |
    ffTable := self tableNamed: 'FREQUENT_FLYER'.
    row := DatabaseRow newForTable: ffTable.
    row at: (ffTable fieldNamed: 'ID') put: 1.
    row at: (ffTable fieldNamed: 'POINTS') put: 10000.
    row at: (ffTable fieldNamed: 'AIRLINE_ID') put: nil.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
exampleModifiedAddressRow
    | addressTable row |
    addressTable := self  tableNamed: 'GR_ADDRESS'.
    row := DatabaseRow newForTable: addressTable.
    row at: (addressTable fieldNamed: 'ID') put: 123.
    row at: (addressTable fieldNamed: 'STREET') put: 'Something Else'.
    row at: (addressTable fieldNamed: 'HOUSE_NUM') put: '10185'.
    ^row! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
examplePassengerRow
    | passengerTable row |
    passengerTable := self tableNamed: 'PASSENGER'.
    row := DatabaseRow newForTable: passengerTable.
    row at: (passengerTable fieldNamed: 'ID') put: 1.
    row at: (passengerTable fieldNamed: 'NAME') put: 'Some Passenger'.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
examplePersonRow1
| personTable row |
    personTable := self tableNamed: 'PERSON'.
    row := DatabaseRow newForTable: personTable.
    row at: (personTable fieldNamed: 'ID') put: 3.
    row at: (personTable fieldNamed: 'NAME') put: 'aPerson'.
    row at: (personTable fieldNamed: 'ADDRESS_ID') put: 123.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'examples'!
examplePersonRow2
| personTable row |
    personTable := self tableNamed: 'PERSON'.
    row := DatabaseRow newForTable: personTable.
    row at: (personTable fieldNamed: 'ID') put: 4.
    row at: (personTable fieldNamed: 'NAME') put: 'aPerson'.
    row at: (personTable fieldNamed: 'ADDRESS_ID') put: nil.
    ^row.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForBANKACCT: aTable
(aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'BANK_CODE'.
    aTable newFieldNamed: 'BRANCH_NO'.
    aTable newFieldNamed: 'ACCT_NO'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForBANKTRANS: aTable 
    | ownerId |
    (aTable newFieldNamed: 'ID')
    	beNumeric;
    	bePrimaryKey;
    	useSequencingInMemory.
    ownerId := (aTable newFieldNamed: 'OWNER_ID') beNumeric.
    aTable addForeignKeyFrom: ownerId
    	to: ((self tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID').
    aTable newFieldNamed: 'AMT_CURR'.
    aTable newFieldNamed: 'AMT_AMT'.
    aTable newFieldNamed: 'SRVC_DESC'.
    aTable newFieldNamed: 'SRVC_AMT_CURR'.
    aTable newFieldNamed: 'SRVC_AMT_AMT'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForCUSTOMERACCTLINK: aTable
| customerId accountId |
    customerId := (aTable newFieldNamed: 'CUSTOMER_ID') beNumeric.
    aTable addForeignKeyFrom: customerId to: ((self tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID').
    accountId := (aTable newFieldNamed: 'ACCT_ID') beNumeric.
    aTable addForeignKeyFrom: accountId to: ((self tableNamed: 'BANK_ACCT') fieldNamed: 'ID').! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForEMAILADDRESS: aTable
| personId |
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'USER_NAME'.
    aTable newFieldNamed: 'HOST_NAME'.
    personId := (aTable newFieldNamed: 'PERSON_ID') beNumeric.
    aTable addForeignKeyFrom: personId to: ((self tableNamed: 'PERSON') fieldNamed: 'ID').! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForGRADDRESS: aTable
(aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'STREET'.
    aTable newFieldNamed: 'HOUSE_NUM'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForGRCUSTOMER: aTable 
    (aTable newFieldNamed: 'ID')
    	beNumeric;
    	bePrimaryKey;
    	useSequencingInMemory.
    aTable newFieldNamed: 'NAME'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForMONEYIMAGINARYTABLE: aTable
    | |
    aTable newFieldNamed: 'CURRENCY'.
    (aTable newFieldNamed: 'AMOUNT') beNumeric.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForPERSON: aTable
    | addrId|
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'NAME'.
    addrId := (aTable newFieldNamed: 'ADDRESS_ID') beNumeric.
    aTable addForeignKeyFrom: addrId to: ((self tableNamed: 'GR_ADDRESS') fieldNamed: 'ID').! !
!GlorpDemoDescriptorSystem methodsFor: 'tables'!
tableForSTUFF: aTable 
    | |
    (aTable newFieldNamed: 'ID')
    	beNumeric;
    	bePrimaryKey.
    aTable newFieldNamed: 'THING'.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForAddress: aDescriptor
| table |
    table := self tableNamed: 'GR_ADDRESS'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #id to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: (	
    	DirectMapping from: #street to: (table fieldNamed: 'STREET')).
    aDescriptor addMapping: (	
    	DirectMapping from: #number to: (table fieldNamed: 'HOUSE_NUM')).
    ^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForBankAccount: aDescriptor
| table |
    table := self tableNamed: 'BANK_ACCT'.
    aDescriptor table: table.
    aDescriptor addMapping: (DirectMapping from: #id
    			to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: ((ManyToManyMapping new)
    			attributeName: #accountHolders;
    			referenceClass: Customer;
    			mappingCriteria: (PrimaryKeyExpression 
    						from: (table fieldNamed: 'ID')
    						to: ((self tableNamed: 'CUSTOMER_ACCT_LINK') fieldNamed: 'ACCT_ID'))).
    aDescriptor addMapping: ((EmbeddedValueOneToOneMapping new)
    			attributeName: #accountNumber;
    			referenceClass: BankAccountNumber).
    ^aDescriptor! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForBankAccountNumber: aDescriptor
| table |
    table := self tableNamed: 'BANK_ACCT'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #bankCode to: (table fieldNamed: 'BANK_CODE')).
    aDescriptor addMapping: (	
    	DirectMapping from: #branchNumber to: (table fieldNamed: 'BRANCH_NO')).
    aDescriptor addMapping: (	
    	DirectMapping from: #accountNumber to: (table fieldNamed: 'ACCT_NO')).
    ^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForBankTransaction: aDescriptor
    | table | 
    table := self tableNamed: 'BANK_TRANS'.
    aDescriptor table: table.
    aDescriptor addMapping: (DirectMapping from: #id
    			to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: ((OneToOneMapping new)
    			attributeName: #owner;
    			referenceClass: Customer;
    			mappingCriteria: (PrimaryKeyExpression 
    						from: (table fieldNamed: 'OWNER_ID')
    						to: ((self tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID'))).
    aDescriptor addMapping: ((EmbeddedValueOneToOneMapping new)
    			attributeName: #amount;
    			referenceClass: GlorpMoney;
    			fieldTranslation: ((PrimaryKeyExpression new)
    						addSource: (table fieldNamed: 'AMT_AMT')
    							target: ((self tableNamed: 'MONEY_IMAGINARY_TABLE') fieldNamed: 'AMOUNT');
    						addSource: (table fieldNamed: 'AMT_CURR')
    							target: ((self tableNamed: 'MONEY_IMAGINARY_TABLE') fieldNamed: 'CURRENCY');
    						yourself)).
    aDescriptor addMapping: ((EmbeddedValueOneToOneMapping new)
    			attributeName: #serviceCharge;
    			referenceClass: ServiceCharge).
    ^aDescriptor! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForCustomer: aDescriptor
| table |
    table := self tableNamed: 'GR_CUSTOMER'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #id to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: (	
    	DirectMapping from: #name to: (table fieldNamed: 'NAME')).
    aDescriptor addMapping: (	
    	OneToManyMapping new
    		attributeName: #transactions;
    		referenceClass: BankTransaction;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (table fieldNamed: 'ID')
    			to: ((self tableNamed: 'BANK_TRANS') fieldNamed: 'OWNER_ID'))).
    aDescriptor addMapping: (	
    	ManyToManyMapping new
    		attributeName: #accounts;
    		referenceClass: BankAccount;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (table fieldNamed: 'ID')
    			to: ((self tableNamed: 'CUSTOMER_ACCT_LINK') fieldNamed: 'CUSTOMER_ID'))).
^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForEmailAddress: aDescriptor
| table |
    table := self tableNamed: 'EMAIL_ADDRESS'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #id to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: (	
    	DirectMapping from: #user to: (table fieldNamed: 'USER_NAME')).
    aDescriptor addMapping: (	
    	DirectMapping from: #host to: (table fieldNamed: 'HOST_NAME')).
    ^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForGlorpMoney: aDescriptor
| table |
    table := self tableNamed: 'MONEY_IMAGINARY_TABLE'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #currency to: (table fieldNamed: 'CURRENCY')).
    aDescriptor addMapping: (	
    	DirectMapping from: #amount to: (table fieldNamed: 'AMOUNT')).
    ^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForPerson: aDescriptor
| table |
    table := self tableNamed: 'PERSON'.
    aDescriptor table: table.
    aDescriptor addMapping: (	
    	DirectMapping from: #id to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: (	
    	DirectMapping from: #name to: (table fieldNamed: 'NAME')).
    aDescriptor addMapping: (	 
    	OneToOneMapping new
    		attributeName: #address;
    		referenceClass: Address;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (table fieldNamed: 'ADDRESS_ID')
    			to: ((self tableNamed: 'GR_ADDRESS') fieldNamed: 'ID'))).
    aDescriptor addMapping: (
    	OneToManyMapping new
    		attributeName: #emailAddresses;
    		referenceClass: EmailAddress;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (table fieldNamed: 'ID')
    			to: ((self tableNamed: 'EMAIL_ADDRESS') fieldNamed: 'PERSON_ID'))).
    ^aDescriptor.! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/bank'!
descriptorForServiceCharge: aDescriptor 
    
    | table |
    table := self tableNamed: 'BANK_TRANS'.
    aDescriptor table: table.
    aDescriptor addMapping: (DirectMapping from: #description
    			to: (table fieldNamed: 'SRVC_DESC')).
    aDescriptor addMapping: ((EmbeddedValueOneToOneMapping new)
    			attributeName: #amount;
    			referenceClass: GlorpMoney;
    			fieldTranslation: ((PrimaryKeyExpression new)
    						addSource: (table fieldNamed: 'SRVC_AMT_AMT')
    							target: ((self tableNamed: 'MONEY_IMAGINARY_TABLE') fieldNamed: 'AMOUNT');
    						addSource: (table fieldNamed: 'SRVC_AMT_CURR')
    							target: ((self tableNamed: 'MONEY_IMAGINARY_TABLE') fieldNamed: 'CURRENCY');
    						yourself)).
    ^aDescriptor! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/airline'!
descriptorForAirline: aDescriptor 
    | table |
    table := self tableNamed: 'AIRLINE'.
    aDescriptor table: (self tableNamed: 'AIRLINE').
    aDescriptor addMapping: (DirectMapping from: #id to: (table fieldNamed: 'ID')).
    aDescriptor addMapping: (DirectMapping from: #name to: (table fieldNamed: 'NAME')).
    ^aDescriptor! !
!GlorpDemoDescriptorSystem methodsFor: 'descriptors/airline'!
descriptorForPassenger: aDescriptor 
    | passTable ffTable |
    passTable := self tableNamed: 'PASSENGER'.
    ffTable := self tableNamed: 'FREQUENT_FLYER'.
    aDescriptor table: passTable.
    aDescriptor addTable: ffTable.
    aDescriptor addMultipleTableCriteria: (	
    	PrimaryKeyExpression 
    		from: (passTable fieldNamed: 'ID')
    		to: (ffTable fieldNamed: 'ID')).
    aDescriptor addMapping: (DirectMapping from: #id to: (passTable fieldNamed: 'ID')).
    aDescriptor addMapping: (DirectMapping from: #name to: (passTable fieldNamed: 'NAME')).
    aDescriptor addMapping: (DirectMapping from: #frequentFlyerMiles to: (ffTable fieldNamed: 'POINTS')).
    aDescriptor addMapping: (	
    	OneToOneMapping new
    		attributeName: #airline;
    		referenceClass: Airline;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (ffTable fieldNamed: 'AIRLINE_ID')
    			to: ((self tableNamed: 'AIRLINE') fieldNamed: 'ID'))).
^aDescriptor! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForAIRLINE: aTable
    | |
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'NAME'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForAIRLINEMEAL: aTable
    | |
    (aTable newFieldNamed: 'ID') beNumeric.
    (aTable fieldNamed: 'DESCR').
    (aTable fieldNamed: 'FLIGHT_ID') beNumeric.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForFLIGHT: aTable
    | |
    aTable name: 'FLIGHT'.
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'FLIGHT_NUM'.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForFLIGHTPASS: aTable
    | |
    aTable name: 'FLIGHT_PASS'.
    (aTable newFieldNamed: 'FLIGHT_ID') beNumeric.
    (aTable fieldNamed: 'PASS_ID') beNumeric.
    (aTable fieldNamed: 'AIRLINE_ID') beNumeric.! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForFREQUENTFLYER: aTable 
    | airlineId |
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    (aTable newFieldNamed: 'POINTS') beNumeric.
    airlineId := (aTable newFieldNamed: 'AIRLINE_ID') beNumeric.
    aTable addForeignKeyFrom: airlineId to: ((self tableNamed: 'AIRLINE') fieldNamed: 'ID').! !
!GlorpDemoDescriptorSystem methodsFor: 'tables/airline'!
tableForPASSENGER: aTable
    | |
    (aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'NAME'.! !
!GlorpDemoDescriptorSystem class methodsFor: 'accessing'!
default
    Default isNil ifTrue: [Default := self new].
    ^Default! !
!GlorpDemoTablePopulatorResource methodsFor: 'setup'!
populateStuffTable
login accessor executeSQLString: 'INSERT INTO STUFF VALUES (12,''abc'')'.
    login accessor executeSQLString: 'INSERT INTO STUFF VALUES (13, ''hey nonny nonny'')'.
    login accessor executeSQLString: 'INSERT INTO STUFF VALUES (42, ''yabba dabba doo'')'.
    login accessor executeSQLString: 'INSERT INTO STUFF VALUES (9625, ''and the band played Waltzing Matilda'')'.
    login accessor executeSQLString: 'INSERT INTO STUFF VALUES (113141, ''Smalltalk'')'.! !
!GlorpDemoTablePopulatorResource methodsFor: 'setup'!
setUp
    | system | 
    super setUp.
    login := DatabaseLoginResource current.
    system := GlorpDemoDescriptorSystem new.
    self class needsSetup ifFalse: [^self].
    login accessor dropTables: system allTables.
    system allTables do: 
    		[:each | 
    		login accessor createTable: each
    			ifError: 
    				[:ex | 
    				Transcript
    					show: ex description;
    					cr]].
    self populateStuffTable.
    self class needsSetup: false! !
!GlorpDemoTablePopulatorResource class methodsFor: 'setup'!
invalidateSetup
    "GlorpDemoTablePopulatorResource invalidateSetup"
NeedsSetup := true! !
!GlorpDemoTablePopulatorResource class methodsFor: 'setup'!
needsSetup
    NeedsSetup isNil ifTrue: [NeedsSetup := true].
    ^NeedsSetup! !
!GlorpDemoTablePopulatorResource class methodsFor: 'setup'!
needsSetup: aBoolean
NeedsSetup := aBoolean.! !
!GlorpDemoTablePopulatorResource class methodsFor: 'setup'!
resources
^Array with: DatabaseLoginResource.! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'other'!
allClassNames
^#(Encyclopedia EncyclopediaEntry).! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'other'!
allTableNames
^#('ENCYC' 'ENCYC_ENTRY').! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'descriptors'!
descriptorForEncyclopedia: aDescriptor 
    | table keyMapping valueMapping entryTable |
    table := self tableNamed: 'ENCYC'.
    entryTable := self tableNamed: 'ENCYC_ENTRY'.
    aDescriptor table: table.
keyMapping := DirectMapping new field: (entryTable fieldNamed: 'NAME').
    valueMapping := OneToManyMapping new
    		referenceClass: EncyclopediaEntry;
    		mappingCriteria: (PrimaryKeyExpression 
    			from: (table fieldNamed: 'ID')
    			to: (entryTable fieldNamed: 'OWNER_ID')).
    aDescriptor addMapping: (DictionaryMapping 
    	attributeName: #entries
    	keyMapping: keyMapping
    	valueMapping: valueMapping).
^aDescriptor! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'descriptors'!
descriptorForEncyclopediaEntry: aDescriptor 
    | entryTable |
    entryTable := self tableNamed: 'ENCYC_ENTRY'.
    aDescriptor table: entryTable.
    aDescriptor addMapping: (DirectMapping from: #id to: (entryTable fieldNamed: 'ID')).
    aDescriptor addMapping: (DirectMapping from: #name to: (entryTable fieldNamed: 'NAME')).
    aDescriptor addMapping: (DirectMapping from: #text to: (entryTable fieldNamed: 'ENTRY_TEXT')).
^aDescriptor.! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'tables'!
tableForENCYC: aTable
(aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.! !
!GlorpEncyclopediaDescriptorSystem methodsFor: 'tables'!
tableForENCYCENTRY: aTable
(aTable newFieldNamed: 'ID') beNumeric; bePrimaryKey.
    aTable newFieldNamed: 'NAME'.
    aTable newFieldNamed: 'ENTRY_TEXT'.! !
!GlorpExampleSystem methodsFor: 'initialize'!
initialize
objects := Dictionary new.! !
!GlorpExampleSystem methodsFor: 'misc'!
lookupObject: aNumber ofClass: aClass ifAbsentPut: absentBlock
^(objects at: aClass ifAbsentPut: [Dictionary new]) at: aNumber ifAbsentPut: absentBlock.! !
!GlorpExampleSystem methodsFor: 'api'!
objectNumber: aNumber ofClass: aClass
| symbol instance|
    instance := self lookupObject: aNumber ofClass: aClass ifAbsentPut: [aClass new].
    symbol := ('example', aClass name, 'Number', aNumber printString, ':') asSymbol.
    self perform: symbol with: instance.
    ^instance.! !
!GlorpBankExampleSystem methodsFor: 'misc'!
allClasses
^#(Customer Account BankTransaction) collect: [:each | Smalltalk at: each].! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleAddressNumber1: anAddress
    anAddress id: 12.
    anAddress street: 'Paseo Montril'.
    anAddress number: '10185'.! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankAccountNumber1: anAccount
anAccount id: 1.
    anAccount accountNumber: (self objectNumber: 1 ofClass: BankAccountNumber).! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankAccountNumber2: anAccount
anAccount id: 2.
    anAccount accountNumber: (self objectNumber: 2 ofClass: BankAccountNumber).! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankAccountNumberNumber1: aBankAccountNumber
aBankAccountNumber bankCode: '004'.
    aBankAccountNumber branchNumber: '0342'.
    aBankAccountNumber accountNumber: '12345'.! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankAccountNumberNumber2: aBankAccountNumber
aBankAccountNumber bankCode: '004'.
    aBankAccountNumber branchNumber: '0342'.
    aBankAccountNumber accountNumber: '01010'.! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankTransactionNumber1: aTrans
"Nothing to initialize"! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleBankTransactionNumber2: aTrans
"Nothing to initialize"! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleCustomerNumber1: aCustomer
aCustomer id: 1.
    aCustomer name: 'Fred Flintstone'.
    aCustomer addTransaction: (self objectNumber: 1 ofClass: BankTransaction).
    aCustomer addTransaction: (self objectNumber: 2 ofClass: BankTransaction).
    aCustomer addAccount: (self objectNumber: 1 ofClass: BankAccount).
    aCustomer addAccount: (self objectNumber: 2 ofClass: BankAccount).! !
!GlorpBankExampleSystem methodsFor: 'examples'!
exampleEmailAddressNumber1: anEmailAddress 
    anEmailAddress id: 2.
    anEmailAddress user: 'foo'.
    anEmailAddress host: 'bar.com'! !
!GlorpBankExampleSystem methodsFor: 'examples'!
examplePersonNumber1: aPerson 
    aPerson id: 1.
    aPerson name: 'Barney Rubble'.
    aPerson address: (self objectNumber: 1 ofClass: Address).	
    aPerson emailAddress: (self objectNumber: 1 ofClass: EmailAddress).! !
!GlorpBankExampleSystem class methodsFor: 'instance creation'!
new
^super new initialize! !
!GlorpExpression methodsFor: 'preparing'!
additionalExpressions
^#().! !
!GlorpExpression methodsFor: 'preparing'!
additionalExpressionsIn: aQuery 
    "Return the collection of additional expressions (representing joins) that this expression tree requires"
^self 
    	inject: OrderedCollection new 
    	into: [:sum :each | 
    		sum addAll: each additionalExpressions.
    		sum].! !
!GlorpExpression methodsFor: 'preparing'!
allTables
^self inject: Set new into: [:sum :each | 
    	sum addAll: each tables. sum].! !
!GlorpExpression methodsFor: 'preparing'!
allTablesToPrint
^self inject: Set new into: [:sum :each | 
    	sum addAll: each tablesToPrint. sum].! !
!GlorpExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
self subclassResponsibility.! !
!GlorpExpression methodsFor: 'preparing'!
assignTableAliasesStartingAt: anInteger
^anInteger.! !
!GlorpExpression methodsFor: 'preparing'!
prepareIn: aQuery 
    | newExpression |
    newExpression := self.
    (self additionalExpressionsIn: aQuery) 
    	do: [:each | newExpression := newExpression exAnd: each].
    ^newExpression! !
!GlorpExpression methodsFor: 'preparing'!
tables
^#().! !
!GlorpExpression methodsFor: 'preparing'!
tablesToPrint
^#().! !
!GlorpExpression methodsFor: 'api'!
asGlorpExpression
^self.! !
!GlorpExpression methodsFor: 'api'!
base
self subclassResponsibility.! !
!GlorpExpression methodsFor: 'api'!
equals: anExpression
^RelationExpression named: #= basedOn: self withArguments: (Array with: anExpression).! !
!GlorpExpression methodsFor: 'api'!
exAnd: anExpression
anExpression isNil ifTrue: [^self].
    ^RelationExpression named: #AND basedOn: self withArguments: (Array with: anExpression).! !
!GlorpExpression methodsFor: 'api'!
get: aSymbol withArguments: anArray
self subclassResponsibility.! !
!GlorpExpression methodsFor: 'converting'!
asGlorpExpressionForDescriptor: aDescriptor
self ultimateBaseExpression descriptor: aDescriptor.! !
!GlorpExpression methodsFor: 'accessing'!
hasDescriptor
^false.! !
!GlorpExpression methodsFor: 'accessing'!
printsTable
^false.! !
!GlorpExpression methodsFor: 'accessing'!
valueIn: aDictionary
    "Return the value associated with this expression given the parameters in aDictionary. Only meaningful for ParameterExpressions"
^self.! !
!GlorpExpression methodsFor: 'initialize'!
initialize! !
!GlorpExpression methodsFor: 'iterating'!
collect: aBlock
| newCollection |
    newCollection := OrderedCollection new.
    self do: [:each | newCollection add: (aBlock value: each)].
    ^newCollection.! !
!GlorpExpression methodsFor: 'iterating'!
do: aBlock
    "Iterate over the expression tree"
self do: aBlock skipping: IdentitySet new.! !
!GlorpExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
    "Iterate over the expression tree. Keep track of who has already been visited, so we don't get trapped in cycles or visit nodes twice."
(aSet includes: self) ifTrue: [^self].
    aSet add: self.
    aBlock value: self.! !
!GlorpExpression methodsFor: 'iterating'!
inject: anObject into: aBlock
| sum |
    sum := anObject.
    self do: [:each | sum := aBlock value: sum value: each].
    ^sum! !
!GlorpExpression methodsFor: 'printing'!
className
^self class name.! !
!GlorpExpression methodsFor: 'printing'!
displayString
| stream |
    stream := String new writeStream.
    self printOnlySelfOn: stream.
    ^stream contents.! !
!GlorpExpression methodsFor: 'printing'!
printOn: aStream 
    self printTreeOn: aStream! !
!GlorpExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
    self subclassResponsibility.! !
!GlorpExpression methodsFor: 'printing'!
printTreeOn: aStream
self subclassResponsibility.! !
!GlorpExpression methodsFor: 'inspecting'!
inspectorHierarchies
    | hierarchy |
    hierarchy := ((Smalltalk at: #Tools ifAbsent: [^#()])
    	at: #Trippy ifAbsent: [^#()])
    	at: #Hierarchy ifAbsent: [^#()].
    ^Array with: (hierarchy
    		id: #expression
    		label: 'Expression Tree'
    		parentBlock: [:each | nil]
    		childrenBlock: [:each | each inspectorChildren])! !
!ConstantExpression methodsFor: 'accessing'!
value
    ^value! !
!ConstantExpression methodsFor: 'accessing'!
value: anObject
    value := anObject! !
!ConstantExpression methodsFor: 'accessing'!
valueIn: aDictionary
    ^value! !
!ConstantExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
^self.! !
!ConstantExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
aStream print: value! !
!ConstantExpression methodsFor: 'printing'!
printTreeOn: aStream 
    aStream print: value! !
!ConstantExpression methodsFor: 'printing SQL'!
printSQLOn: aStream withParameters: aDictionary
    self value glorpPrintSQLOn: aStream.! !
!FieldExpression methodsFor: 'initializing'!
field: aField base: anObjectExpression
field := aField.
    base := anObjectExpression.! !
!FieldExpression methodsFor: 'printing SQL'!
printSQLOn: aStream withParameters: aDictionary
    self field printSQLOn: aStream withParameters:aDictionary.! !
!FieldExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
    | newTarget |
    newTarget := (target tables includes: field table) 
    	ifTrue: [target]
    	ifFalse: [base asExpressionJoiningSource: source toTarget: target].
    ^newTarget getField: field.! !
!FieldExpression methodsFor: 'preparing'!
tables
^base tables.! !
!FieldExpression methodsFor: 'preparing'!
tablesToPrint
^#().! !
!FieldExpression methodsFor: 'navigating'!
ultimateBaseExpression
    ^base ultimateBaseExpression.! !
!FieldExpression methodsFor: 'accessing'!
base
^base.! !
!FieldExpression methodsFor: 'accessing'!
field
    ^base translateField: field! !
!FieldExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
    "Iterate over the expression tree"
(aSet includes: self) ifTrue: [^self].
    aSet add: self.
    base do: aBlock skipping: aSet.
    aBlock value: self.! !
!FieldExpression methodsFor: 'printing'!
printOnlySelfOn: aStream 
    base printsTable
    	ifTrue: [field printUnqualifiedSQLOn: aStream withParameters: #()]
    	ifFalse: [field printSQLOn: aStream withParameters: #()]! !
!FieldExpression methodsFor: 'printing'!
printTreeOn: aStream 
    base printOn: aStream.
    aStream nextPut: $..
    base printsTable 
    	ifTrue: [field printUnqualifiedSQLOn: aStream withParameters: #()]
    	ifFalse: [field printSQLOn: aStream withParameters: #()]! !
!FieldExpression methodsFor: 'api'!
get: aSymbol withArguments: anArray
^anArray isEmpty 
    	ifTrue: [self error: 'Field expressions do not have attributes']
    	ifFalse: [RelationExpression named: aSymbol basedOn: self withArguments: anArray].! !
!GlorpExpression class methodsFor: 'instance creation'!
new
^super new initialize.! !
!ConstantExpression class methodsFor: 'instance creation'!
for: anObject
^self new value: anObject.! !
!FieldExpression class methodsFor: 'instance creation'!
forField: aField basedOn: anObjectExpression
^self new field: aField base: anObjectExpression; yourself! !
!GlorpHelper class methodsFor: 'helpers'!
do: aBlock for: aCollection separatedBy: separatorBlock
| array |
    array := aCollection asArray.
    1 to: array size do: [:i |
    	| each |
    	each := array at: i.
    	aBlock value: each.
    	i = array size ifFalse: [
    		separatorBlock value]].! !
!GlorpHelper class methodsFor: 'helpers'!
print: printBlock on: stream for: aCollection separatedBy: separatorString
| array |
    array := aCollection asArray.
    1 to: array size do: [:index |
    	stream nextPutAll: (printBlock value: (array at: index)).
    	index == array size ifFalse: [
    		stream nextPutAll: separatorString]].
    ^stream contents.! !
!GlorpHelper class methodsFor: 'helpers'!
separate: aCollection by: aOneArgumentBlock
^aCollection inject: Dictionary new into: [:dict :each |
    	| val |
    	val := aOneArgumentBlock value: each.
    	(dict at: val ifAbsentPut: [OrderedCollection new]) add: each].! !
!GlorpMoney methodsFor: 'accessing'!
amount
    ^amount! !
!GlorpMoney methodsFor: 'accessing'!
amount: anObject
    amount := anObject! !
!GlorpMoney methodsFor: 'accessing'!
currency
    ^currency! !
!GlorpMoney methodsFor: 'accessing'!
currency: anObject
    currency := anObject! !
!GlorpMoney class methodsFor: 'instance creation'!
currency: aSymbol amount: aNumber
^self new
    	currency: aSymbol;
    	amount: aNumber.! !
!GlorpMoney class methodsFor: 'instance creation'!
defaultCurrency
^#CDN.! !
!GlorpMoney class methodsFor: 'instance creation'!
forAmount: anAmount
^self currency: self defaultCurrency amount: anAmount.! !
!Login methodsFor: 'accessing'!
connectString
    ^connectString! !
!Login methodsFor: 'accessing'!
connectString: aString 
    connectString := aString! !
!Login methodsFor: 'accessing'!
database
    ^database! !
!Login methodsFor: 'accessing'!
database: aSymbol 
    database := aSymbol! !
!Login methodsFor: 'accessing'!
password
    ^password! !
!Login methodsFor: 'accessing'!
password: aString 
    password := aString! !
!Login methodsFor: 'accessing'!
username
    ^username! !
!Login methodsFor: 'accessing'!
username: aString 
    username := aString! !
!Login methodsFor: 'printing'!
printOn: aStream
aStream nextPutAll: 'a Login('.
    database printOn: aStream.
    aStream nextPutAll: ', '.
    username printOn: aStream.
    aStream nextPutAll: ', '.
    password printOn: aStream.
    aStream nextPutAll: ', '.
    connectString printOn: aStream.
    aStream nextPutAll: ')'.! !
!Mapping methodsFor: 'accessing'!
allTables
self subclassResponsibility.! !
!Mapping methodsFor: 'accessing'!
attributeName
    "Private - Answer the value of the receiver's ''attributeName'' instance variable."
^attributeName! !
!Mapping methodsFor: 'accessing'!
attributeName: anObject
    "Private - Set the value of the receiver's ''attributeName'' instance variable to the argument, anObject."
attributeName := anObject.
    self initializeAccessor.! !
!Mapping methodsFor: 'accessing'!
descriptor
    "Private - Answer the value of the receiver's ''descriptor'' instance variable."
^descriptor! !
!Mapping methodsFor: 'accessing'!
descriptor: anObject
    "Private - Set the value of the receiver's ''descriptor'' instance variable to the argument, anObject."
descriptor := anObject! !
!Mapping methodsFor: 'accessing'!
fieldsForSelectStatement
    "Return a collection of fields that this mapping will read from a row"
^self mappedFields! !
!Mapping methodsFor: 'accessing'!
initializeAccessor
attributeAccessor := AttributeAccessor newForAttributeNamed: attributeName.! !
!Mapping methodsFor: 'accessing'!
mappedFields
    "Return a collection of fields that this mapping will write into any of the containing object's rows"
^Array with: self field.! !
!Mapping methodsFor: 'accessing'!
session
    
    ^self descriptor session.! !
!Mapping methodsFor: 'accessing'!
system
    
    ^self descriptor system.! !
!Mapping methodsFor: 'public'!
getValueFrom: anObject
^attributeAccessor getValueFrom: anObject.! !
!Mapping methodsFor: 'public'!
printOn: aStream
super printOn: aStream.
    aStream 
    	nextPutAll: '(';
    	nextPutAll: (attributeName isNil ifTrue: [''] ifFalse: [attributeName]) ;
    	nextPutAll: ')'.! !
!Mapping methodsFor: 'public'!
setValueIn: anObject to: aValue
attributeAccessor setValueIn: anObject to: aValue.! !
!Mapping methodsFor: 'testing'!
controlsTables
    "Return true if this type of mapping 'owns' the tables it's associated with, and expression nodes using this mapping should alias those tables where necessary"
self subclassResponsibility! !
!Mapping methodsFor: 'testing'!
includesSubFieldsInSelectStatement
    ^false! !
!Mapping methodsFor: 'testing'!
isIndependentRelationship
    "True when the mapping associates different tables."
^self subclassResponsibility! !
!Mapping methodsFor: 'testing'!
isOneToOne
^false! !
!Mapping methodsFor: 'testing'!
isRelationship
    "True when the mapping associates different classes."
^self subclassResponsibility! !
!Mapping methodsFor: 'preparing'!
joinExpressionFor: anExpression
^nil.! !
!Mapping methodsFor: 'mapping'!
expressionFor: anObject
    "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"
self subclassResponsibility.! !
!Mapping methodsFor: 'mapping'!
mapFromObject: anObject intoRowsIn: aRowMap
self subclassResponsibility.! !
!Mapping methodsFor: 'mapping'!
mapFromRow: valueCollection intoObject: anObject inElementBuilder: anObject1 
    self subclassResponsibility! !
!Mapping methodsFor: 'mapping'!
referencedIndependentObjectsFrom: anObject
self subclassResponsibility.! !
!Mapping methodsFor: 'mapping'!
trace: aTracing context: anExpression
self subclassResponsibility.! !
!Mapping methodsFor: 'initialize/release'!
initialize! !
!ConditionalMapping methodsFor: 'mapping'!
applicableMappingFor: anArray in: anElementBuilder 
    | rowValue |
    rowValue := anElementBuilder valueOf: conditionalField in: anArray.
    cases do: [:each | (self descriptor system perform: each key with: rowValue)
    		ifTrue: [^each value]].
    ^otherwiseCase! !
!ConditionalMapping methodsFor: 'mapping'!
mapFromRow: valueCollection intoObject: anObject inElementBuilder: anElementBuilder 
    (self applicableMappingFor: valueCollection in: anElementBuilder)
    	mapFromRow: valueCollection
    	intoObject: anObject
    	inElementBuilder: anElementBuilder! !
!ConditionalMapping methodsFor: 'accessing'!
conditionalField: aField
conditionalField := aField.! !
!ConditionalMapping methodsFor: 'accessing'!
conditionalMethod: aSymbol
conditionalMethod := aSymbol.! !
!ConditionalMapping methodsFor: 'accessing'!
descriptor: aDescriptor
super descriptor: aDescriptor.
    cases do: [:each | each value descriptor: aDescriptor].
    otherwiseCase descriptor: aDescriptor.! !
!ConditionalMapping methodsFor: 'accessing'!
mappedFields
| all |
    all := OrderedCollection new.
    all add: conditionalField.
    cases do: [:each |
    	all addAll: each value mappedFields].
    ^all.! !
!ConditionalMapping methodsFor: 'conditions'!
if: conditionSelector then: aMapping
cases add: (Association key: conditionSelector value: aMapping).! !
!ConditionalMapping methodsFor: 'conditions'!
otherwise: aMapping
otherwiseCase := aMapping.! !
!ConditionalMapping methodsFor: 'conditions'!
trace: aTracing context: anExpression
    "To make a join, we need to look at all of our possible cases"
cases do: [:each |
    	each value trace: aTracing context: anExpression].! !
!ConditionalMapping methodsFor: 'testing'!
controlsTables
    self error: 'What should we do here?'! !
!ConditionalMapping methodsFor: 'testing'!
isRelationship
self error: 'What should we do here?'.! !
!ConditionalMapping methodsFor: 'initialize/release'!
initialize
    
    super initialize.
    cases := OrderedCollection new.! !
!ConstantMapping methodsFor: 'accessing'!
constantValue
    ^constantValue.! !
!ConstantMapping methodsFor: 'accessing'!
constantValue: anObject
constantValue := anObject.! !
!ConstantMapping methodsFor: 'accessing'!
constantValueIn: aSession
^valueIsSession
    	ifTrue: [aSession]
    	ifFalse: [constantValue].! !
!ConstantMapping methodsFor: 'accessing'!
constantValueIsSession
valueIsSession := true.! !
!ConstantMapping methodsFor: 'accessing'!
initializeAccessor
attributeName == nil 
    	ifFalse: [super initializeAccessor].! !
!ConstantMapping methodsFor: 'accessing'!
mappedFields
    "Return a collection of fields that this mapping will write into any of the containing object's rows"
^#().! !
!ConstantMapping methodsFor: 'mapping'!
mapFromObject: anObject intoRowsIn: aRowMap! !
!ConstantMapping methodsFor: 'mapping'!
mapFromRow: valueCollection intoObject: anObject inElementBuilder: anElementBuilder 
    | value |
    value := anElementBuilder isNil
    			ifTrue: [constantValue]
    			ifFalse: [self constantValueIn: anElementBuilder session].
    self setValueIn: anObject to: value! !
!ConstantMapping methodsFor: 'mapping'!
referencedIndependentObjectsFrom: anObject
^#().! !
!ConstantMapping methodsFor: 'mapping'!
trace: aTracing context: anExpression
^self.! !
!ConstantMapping methodsFor: 'testing'!
controlsTables
    "Return true if this type of method 'owns' the tables it's associated with, and expression nodes using this mapping should alias those tables where necessary"
^false! !
!ConstantMapping methodsFor: 'api'!
getValueFrom: anObject
^constantValue.! !
!ConstantMapping methodsFor: 'initialize/release'!
initialize
super initialize.
    valueIsSession := false.! !
!DictionaryMapping methodsFor: 'accessing'!
keyMapping: aMapping 
    keyMapping := aMapping.! !
!DictionaryMapping methodsFor: 'accessing'!
valueMapping: aMapping 
    valueMapping := aMapping.! !
!DirectMapping methodsFor: 'accessing'!
field
    "Private - Answer the value of the receiver's ''field'' instance variable."
^field! !
!DirectMapping methodsFor: 'accessing'!
field: anObject
    "Private - Set the value of the receiver's ''field'' instance variable to the argument, anObject."
field := anObject! !
!DirectMapping methodsFor: 'testing'!
controlsTables
    "Return true if this type of method 'owns' the tables it's associated with, and expression nodes using this mapping should alias those tables where necessary"
^false! !
!DirectMapping methodsFor: 'testing'!
isIndependentRelationship
    "True when the mapping associates different tables."
^false! !
!DirectMapping methodsFor: 'testing'!
isRelationship
    "True when the mapping associates different classes."
^false! !
!DirectMapping methodsFor: 'enumerating'!
referencedIndependentObjectsFrom: anObject
^#().! !
!DirectMapping methodsFor: 'mapping'!
convertValueToDatabaseForm: aValue
aValue isSymbol ifTrue: [^aValue asString].
    ^aValue.! !
!DirectMapping methodsFor: 'mapping'!
expressionFor: anObject
    "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 := attributeAccessor getValueFrom: anObject. 
    ^(BaseExpression new getField: field) get: #= withArguments: (Array with: value).! !
!DirectMapping methodsFor: 'mapping'!
mapFromObject: anObject intoRowsIn: aRowMap
| value row |
    value := attributeAccessor getValueFrom: anObject.
    row := aRowMap findOrAddRowForTable: self field table withKey: anObject.
    row at: field put: value.! !
!DirectMapping methodsFor: 'mapping'!
mapFromRow: anArray intoObject: anObject inElementBuilder: anElementBuilder 
    self setValueIn: anObject to: (anElementBuilder valueOf: field in: anArray).! !
!DirectMapping methodsFor: 'mapping'!
trace: aTracing 
    ^self.! !
!DirectMapping methodsFor: 'mapping'!
trace: aTracing context: anExpression
    ^self.! !
!Mapping class methodsFor: 'instance creation'!
new
^super new initialize.! !
!DictionaryMapping class methodsFor: 'instance creation'!
attributeName: aSymbol keyMapping: keyMapping valueMapping: valueMapping
^self new
    	attributeName: aSymbol;
    	keyMapping: keyMapping;
    	valueMapping: valueMapping.! !
!DirectMapping class methodsFor: 'instance creation'!
from: attributeName to: field
^self new
    	attributeName: attributeName;
    	field: field.! !
!MessageArchiver class methodsFor: 'instance creation'!
receiver: aMessageCollector message: aMessage
^self new
    	receiver: aMessageCollector
    	message: aMessage.! !
!ObjectExpression methodsFor: 'api'!
get: aSymbol 
    "Return the mapping expression corresponding to the named attribute"
| reallyASymbol |
    reallyASymbol := aSymbol asSymbol.
    ^mappingExpressions at: reallyASymbol
    	ifAbsentPut: [MappingExpression named: reallyASymbol basedOn: self]! !
!ObjectExpression methodsFor: 'api'!
get: aSymbol withArguments: anArray
    "Return the mapping expression corresponding to the named attribute"
^anArray isEmpty 
    	ifTrue: [self get: aSymbol]
    	ifFalse: [RelationExpression named: aSymbol basedOn: self withArguments: anArray].! !
!ObjectExpression methodsFor: 'api'!
getField: aField
    
    ^mappingExpressions at: aField ifAbsentPut: [self newFieldExpressionFor: aField].! !
!ObjectExpression methodsFor: 'api'!
getTable: aTable
    aTable isString ifTrue: [self error: 'This method takes a table object'].
    ^mappingExpressions at: aTable ifAbsentPut: [TableExpression forTable: aTable basedOn: self].! !
!ObjectExpression methodsFor: 'fields'!
aliasTable: aDatabaseTable to: aString 
    | newTable |
    newTable := aDatabaseTable copy.
    newTable name: aString.
    newTable parent: aDatabaseTable.
    self tableAliases at: aDatabaseTable put: newTable! !
!ObjectExpression methodsFor: 'fields'!
aliasedTableFor: aDatabaseTable 
    tableAliases isNil ifTrue: [^aDatabaseTable].
    ^tableAliases at: aDatabaseTable.! !
!ObjectExpression methodsFor: 'fields'!
controlsTables
self subclassResponsibility.! !
!ObjectExpression methodsFor: 'fields'!
newFieldExpressionFor: aField
^FieldExpression forField: aField basedOn: self! !
!ObjectExpression methodsFor: 'fields'!
translateField: aDatabaseField 
    | newTable |
    newTable := self aliasedTableFor: aDatabaseField table.
    newTable == aDatabaseField table ifTrue: [^aDatabaseField].
    ^self fieldAliases 
    	at: aDatabaseField
    	ifAbsentPut: 
    		[| newField |
    		newField := aDatabaseField copy.
    		newField table: newTable]! !
!ObjectExpression methodsFor: 'fields'!
translateFields: anOrderedCollection 
    ^anOrderedCollection collect: [:each | self translateField: each]! !
!ObjectExpression methodsFor: 'accessing'!
fieldAliases
fieldAliases isNil ifTrue: [fieldAliases := IdentityDictionary new].
    ^fieldAliases.! !
!ObjectExpression methodsFor: 'accessing'!
requiresDistinct
    ^requiresDistinct! !
!ObjectExpression methodsFor: 'accessing'!
requiresDistinct: aBoolean 
    requiresDistinct := aBoolean! !
!ObjectExpression methodsFor: 'accessing'!
tableAliases
    tableAliases isNil ifTrue: [
    	tableAliases := IdentityDictionary new: 3].
    ^tableAliases! !
!ObjectExpression methodsFor: 'initialize'!
initialize
super initialize.
    mappingExpressions := IdentityDictionary new.
    requiresDistinct := false.! !
!ObjectExpression methodsFor: 'tests'!
hasTableAliases
    ^tableAliases notNil! !
!ObjectExpression methodsFor: 'preparing'!
assignTableAliasesStartingAt: anInteger 
    | tableNumber |
    self controlsTables ifFalse: [^anInteger].
    tableNumber := anInteger.
    self tables do: [:each |
    	self aliasTable: each to: 't', tableNumber printString.
    	tableNumber := tableNumber + 1].
    ^tableNumber! !
!ObjectExpression methodsFor: 'printing'!
printTableAliasesOn: aStream 
    self hasTableAliases 
    	ifTrue: 
    		[aStream nextPutAll: ' '.
    		tableAliases keysAndValuesDo: [:eachKey :eachValue | 
    			aStream nextPutAll: eachKey name, '->', eachValue name , ' ']]! !
!ObjectExpression methodsFor: 'private/accessing'!
removeMappingExpression: anExpression
    "Private. Normally you would never do this, but in the case of an anySatisfy: or allSatisfy: we want to have each of them as distinct joins, so we will remove the entry from the mappingExpression of the base, making sure that relationship will not be used for anything else. Since any/allSatisfy: is the only valid use of a collection relationship, we don't have to worry about whether it was used for something else earlier."
mappingExpressions removeKey: anExpression name.! !
!BaseExpression methodsFor: 'api'!
base
^nil.! !
!BaseExpression methodsFor: 'api'!
getParameter: aDatabaseField 
    ^ParameterExpression forField: aDatabaseField basedOn: self.! !
!BaseExpression methodsFor: 'accessing'!
descriptor
^descriptor! !
!BaseExpression methodsFor: 'accessing'!
descriptor: aDescriptor
    descriptor := aDescriptor! !
!BaseExpression methodsFor: 'accessing'!
hasDescriptor
^descriptor notNil.! !
!BaseExpression methodsFor: 'accessing'!
system
    ^descriptor system.! !
!BaseExpression methodsFor: 'accessing'!
targetDescriptor
    self halt! !
!BaseExpression methodsFor: 'navigating'!
ultimateBaseExpression
^self! !
!BaseExpression methodsFor: 'printing'!
className
^'Base'.! !
!BaseExpression methodsFor: 'printing'!
printOn: aStream 
    aStream
    	nextPutAll: self className;
    	nextPut: $(.
    self printTreeOn: aStream.
    aStream nextPut: $)! !
!BaseExpression methodsFor: 'printing'!
printOnlySelfOn: aStream 
    descriptor isNil ifTrue: [aStream nextPutAll: 'Empty Base'. ^self].
    aStream print: descriptor describedClass.
    self printTableAliasesOn: aStream! !
!BaseExpression methodsFor: 'printing'!
printTreeOn: aStream 
    aStream 
    	print: (descriptor isNil ifTrue: [nil] ifFalse: [descriptor describedClass])! !
!BaseExpression methodsFor: 'preparing'!
additionalExpressions
^descriptor multipleTableCriteria 
    	collect: [:each | each asExpressionJoiningSource: self toTarget: self]! !
!BaseExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
^source.! !
!BaseExpression methodsFor: 'preparing'!
controlsTables
^true.! !
!BaseExpression methodsFor: 'preparing'!
fieldsForSelectStatement
    ^descriptor mappedFields.! !
!BaseExpression methodsFor: 'preparing'!
rebuildOn: aBaseExpression 
    ^aBaseExpression.! !
!BaseExpression methodsFor: 'preparing'!
tables
^descriptor tables.! !
!BaseExpression methodsFor: 'preparing'!
tablesToPrint
    "We derive the base's tables from the fields that are being selected, so don't add them here."
    ^#().! !
!MappingExpression methodsFor: 'api'!
base
^base.! !
!MappingExpression methodsFor: 'api'!
get: aSymbol withArguments: anArray
^aSymbol == #anySatisfy:
    	ifTrue: [
    		self base requiresDistinct: true.
    		self base removeMappingExpression: self.
    		CollectionExpression 
    			named: aSymbol 
    			basedOn: self 
    			withArguments: anArray]
    	ifFalse: [super get: aSymbol withArguments: anArray].! !
!MappingExpression methodsFor: 'accessing'!
descriptor
    ^self system descriptorFor: self mapping referenceClass.! !
!MappingExpression methodsFor: 'accessing'!
field
^base translateField: self mapping field.! !
!MappingExpression methodsFor: 'accessing'!
hasDescriptor
    "Does the object that we describe have its own descriptor"
    ^self mapping isRelationship! !
!MappingExpression methodsFor: 'accessing'!
name
^name.! !
!MappingExpression methodsFor: 'accessing'!
sourceDescriptor
    ^base descriptor.! !
!MappingExpression methodsFor: 'accessing'!
system
    ^base system.! !
!MappingExpression methodsFor: 'accessing'!
tables
| set |
    self controlsTables ifFalse: [^#()].
    set := self descriptor tables asSet.
    ^set.! !
!MappingExpression methodsFor: 'printing SQL'!
printSQLOn: aStream withParameters: aDictionary 
    self field printSQLOn: aStream withParameters:aDictionary.! !
!MappingExpression methodsFor: 'navigating'!
ultimateBaseExpression
^base ultimateBaseExpression.! !
!MappingExpression methodsFor: 'preparing'!
additionalExpressions
    | exp |
    exp := self mapping joinExpressionFor: self.
    ^exp isNil ifTrue: [#()] ifFalse: [Array with: exp].! !
!MappingExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
| newBase |
    newBase := base asExpressionJoiningSource: source toTarget: target.
    ^self class named: name basedOn: newBase.! !
!MappingExpression methodsFor: 'preparing'!
fieldsForSelectStatement
    
    ^self mapping fieldsForSelectStatement.! !
!MappingExpression methodsFor: 'preparing'!
rebuildOn: aBaseExpression 
    ^(base rebuildOn: aBaseExpression) get: name.! !
!MappingExpression methodsFor: 'preparing'!
tablesToPrint
self hasDescriptor ifFalse: [^#()].
    ^self tables collect: [:each |
    	self aliasedTableFor: each].! !
!MappingExpression methodsFor: 'preparing'!
translateFields: anOrderedCollection 
    "Ugh. Unify these mechnisms"
    ^super translateFields: (self mapping translateFields: anOrderedCollection).! !
!MappingExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
    "Iterate over the expression tree"
(aSet includes: self) ifTrue: [^self].
    aSet add: self.
    base do: aBlock skipping: aSet.
    aBlock value: self.! !
!MappingExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
aStream nextPutAll: name.
    self printTableAliasesOn: aStream.! !
!MappingExpression methodsFor: 'printing'!
printTreeOn: aStream 
    aStream
    	print: base;
    	nextPut: $.;
    	nextPutAll: name! !
!MappingExpression methodsFor: 'fields'!
aliasedTableFor: aDatabaseTable 
    ^self controlsTables 
    	ifTrue: [super aliasedTableFor: aDatabaseTable]
    	ifFalse: [base aliasedTableFor: aDatabaseTable]! !
!MappingExpression methodsFor: 'fields'!
controlsTables
    | mapping |
    mapping := self mapping.
    mapping isNil ifTrue: [^false].
    ^mapping controlsTables! !
!MappingExpression methodsFor: 'internal'!
mapping
    | descriptor |
    descriptor := self sourceDescriptor.
    descriptor isNil ifTrue: [^nil].
    ^descriptor mappingForAttributeNamed: name.! !
!MappingExpression methodsFor: 'private/initialization'!
named: aSymbol basedOn: anExpression
name := aSymbol.
    base := anExpression.! !
!MappingExpression class methodsFor: 'instance creation'!
named: aSymbol basedOn: anExpression
^self new
    	named: aSymbol
    	basedOn: anExpression.! !
!ObjectTransaction methodsFor: 'begin/commit/abort'!
abort
    undoMap keysAndValuesDo: [:original :copy | self restoreStateOf: original toThatOf: copy]! !
!ObjectTransaction methodsFor: 'begin/commit/abort'!
begin
    self initializeUndoMap! !
!ObjectTransaction methodsFor: 'begin/commit/abort'!
commit
    self initializeUndoMap! !
!ObjectTransaction methodsFor: 'initializing'!
initialize
    self initializeUndoMap! !
!ObjectTransaction methodsFor: 'initializing'!
initializeUndoMap
undoMap := IdentityDictionary new.! !
!ObjectTransaction methodsFor: 'private/registering'!
instanceVariablesOf: anObject do: aBlock
(1 to: anObject class instSize) do: [:index | aBlock value: (anObject instVarAt: index)].
    (1 to: anObject basicSize) do: [:index | aBlock value: (anObject basicAt: index)]! !
!ObjectTransaction methodsFor: 'private/registering'!
shallowCopyOf: anObject ifNotNeeded: aBlock
| copy |
    copy := anObject shallowCopy.
    ^copy == anObject 
    	ifTrue: [aBlock value]
    	ifFalse: [copy]! !
!ObjectTransaction methodsFor: 'private/restoring'!
isShapeOf: original differentThanThatOf: copy
^original class ~~ copy class or: [original basicSize ~= copy basicSize]! !
!ObjectTransaction methodsFor: 'private/restoring'!
restoreIndexedInstanceVariablesOf: original toThoseOf: copy
1 to: copy basicSize do: [:index |
    	original basicAt: index put: (copy basicAt: index)]! !
!ObjectTransaction methodsFor: 'private/restoring'!
restoreNamedInstanceVariablesOf: original toThoseOf: copy
1 to: copy class instSize do: [:index |
    	original instVarAt: index put: (copy instVarAt: index)]! !
!ObjectTransaction methodsFor: 'private/restoring'!
restoreShapeOf: original toThatOf: copy
| newOriginal |
    (copy class isBits or: [copy class isVariable])
    	ifTrue: [newOriginal := copy class basicNew: copy basicSize]
    	ifFalse: [newOriginal := copy class basicNew].
    original become: newOriginal.! !
!ObjectTransaction methodsFor: 'private/restoring'!
restoreStateOf: original toThatOf: copy
(self isShapeOf: original differentThanThatOf: copy) 
    	ifTrue: [self restoreShapeOf: original toThatOf: copy].
    self restoreNamedInstanceVariablesOf: original toThoseOf: copy.
    self restoreIndexedInstanceVariablesOf: original toThoseOf: copy! !
!ObjectTransaction methodsFor: 'registering'!
isRegistered: anObject 
    "Note: We can never have a situation where a proxy is registered but its contents aren't, so we don't have to worry about that ambiguous case."
    | realObject |
    realObject := self realObjectFor: anObject.
    realObject isNil ifTrue: [^false].
    ^undoMap includesKey: realObject.! !
!ObjectTransaction methodsFor: 'registering'!
realObjectFor: anObject 
    "If this is a proxy, return the contents (if available). Otherwise, return the object itself."
    ^anObject class == Proxy 
    	ifTrue: [anObject isInstantiated ifTrue: [anObject getValue] ifFalse: [nil]]
    	ifFalse: [anObject]! !
!ObjectTransaction methodsFor: 'registering'!
register: anObject 
    "Make anObject be a member of the current transaction. Return the object if registered, or nil otherwise"
| copy realObject |
    (self requiresRegistrationFor: anObject) ifFalse: [^nil].
    realObject := self realObjectFor: anObject.
    copy := self shallowCopyOf: realObject ifNotNeeded: [^nil].
    undoMap at: realObject put: copy.
    self registerTransientInternalsOfCollection: realObject.
    ^realObject! !
!ObjectTransaction methodsFor: 'registering'!
registerTransientInternalsOfCollection: aCollection
"If this is a collection, then we may need to register any internal structures it has, e.g. an internal array. This is implementation dependent for the collection. We will also explicitly exclude strings"
aCollection glorpIsCollection ifFalse: [^self].
    aCollection isString ifTrue: [^self].
    aCollection glorpRegisterCollectionInternalsIn: self.! !
!ObjectTransaction methodsFor: 'registering'!
registeredObjectsDo: aBlock
    "Iterate over all our objects. Note that this will include objects without descriptors"
    undoMap keysDo: aBlock.! !
!ObjectTransaction methodsFor: 'registering'!
requiresRegistrationFor: anObject
| realObject |
    realObject := self realObjectFor: anObject.
    realObject isNil ifTrue: [^false].
    ^(self isRegistered: realObject) not.! !
!ObjectTransaction class methodsFor: 'instance creation'!
new
    ^super new initialize! !
!OraclePlatform methodsFor: 'table creation'!
printNumericFieldOfSize: anInteger on: aStream
aStream 
    	nextPutAll: 'number('.
    anInteger printOn: aStream.
    aStream nextPutAll: ')'.! !
!OraclePlatform methodsFor: 'table creation'!
printStringFieldOfSize: anInteger on: aStream
aStream 
    	nextPutAll: 'varchar2('.
    anInteger printOn: aStream.
    aStream nextPutAll: ')'.! !
!OraclePlatform methodsFor: 'SQL'!
isOraclePlatform
^true! !
!OraclePlatform methodsFor: 'SQL'!
sqlTextForVariableCharAttributeType: length
    "^<String>"
^'VARCHAR2(',length asString,')'! !
!OraclePlatform methodsFor: 'SQL'!
supportsConstraints
^true.! !
!OraclePlatform methodsFor: 'SQL'!
typeStringFor: type ofSize: size
type == #string ifTrue: [^'varchar2(', size printString, ')'].
    type == #number ifTrue: [^'number(', size printString, ')'].
    self error: 'invalid field type'.! !
!PGAsciiRow methodsFor: 'as yet unclassified' stamp: 'nop 5/31/2002 18:04'!
description
    ^ description! !
!PGColumnDescription methodsFor: 'as yet unclassified' stamp: 'nop 5/31/2002 18:10'!
isNumber
    ^ typeOid = 23! !
!PGConnection methodsFor: 'events' stamp: 'nop 5/31/2002 15:11'!
execute: queryString 
    | pkt |
    resultSet errorResponse: nil.
    resultSet rowDescription: nil.
    resultSet rows reset.
    (pkt _ self receivePacket) eventName = #ReadyForQuery
    	ifFalse: [self error: 'Failed to receive ReadyForQuery packet'].
    self sendQuery: queryString.
    pkt _ self receivePacket.
    pkt eventName = #ErrorResponse
    	ifTrue: [resultSet errorResponse: pkt.
    			Transcript show: pkt value;
    			 cr]
    	ifFalse: [pkt eventName = #CompletedResponse
    			ifFalse: [pkt eventName = #CursorResponse
    					ifTrue: [pkt _ self receivePacket.
    						pkt eventName = #RowDescription
    							ifTrue: [resultSet rowDescription: pkt.
    								[(pkt _ self receivePacket) eventName = #CompletedResponse]
    									whileFalse: [resultSet rows add: pkt]]
    							ifFalse: [pkt eventName = #CompletedResponse
    									ifFalse: [self error: 'Failed to receive RowDescription packet']]]]].
    ^ resultSet! !
!ParameterExpression methodsFor: 'accessing'!
base
^base! !
!ParameterExpression methodsFor: 'accessing'!
field
    ^field! !
!ParameterExpression methodsFor: 'navigating'!
ultimateBaseExpression
    ^base ultimateBaseExpression.! !
!ParameterExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
(aSet includes: self) ifTrue: [^self].
    aSet add: self.
    base do: aBlock skipping: aSet.
    aBlock value: self.! !
!ParameterExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
^source getField: field.! !
!ParameterExpression methodsFor: 'printing'!
printOn: aStream 
    aStream nextPutAll: 'Parameter('.
    self printTreeOn: aStream.
    aStream nextPut: $)! !
!ParameterExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
field printSQLOn: aStream withParameters: #()! !
!ParameterExpression methodsFor: 'printing'!
printSQLOn: aStream withParameters: aDictionary
    (self valueIn: aDictionary) glorpPrintSQLOn: aStream.! !
!ParameterExpression methodsFor: 'printing'!
printTreeOn: aStream 
    field printSQLOn: aStream withParameters: #()! !
!ParameterExpression methodsFor: 'printing'!
valueIn: aDictionary 
    ^aDictionary at: field! !
!ParameterExpression methodsFor: 'initialize/release'!
field: aDatabaseField base: aBaseExpression 
    field := aDatabaseField.
    base := aBaseExpression! !
!ParameterExpression class methodsFor: 'instance creation'!
forField: aField basedOn: anObjectExpression
^self new field: aField base: anObjectExpression; yourself! !
!Passenger methodsFor: 'accessing'!
frequentFlyerPoints
    ^frequentFlyerMiles.! !
!Passenger methodsFor: 'accessing'!
frequentFlyerPoints: aSmallInteger 
    frequentFlyerMiles := aSmallInteger.! !
!Passenger methodsFor: 'accessing'!
id
    ^id! !
!Passenger methodsFor: 'accessing'!
id: aSmallInteger 
    id := aSmallInteger.! !
!Passenger methodsFor: 'accessing'!
name
    ^name.! !
!Passenger methodsFor: 'accessing'!
name: aString 
    name := aString.! !
!Passenger class methodsFor: 'examples'!
example1
^self new
    	id: 1;
    	name: 'Some Passenger';
    	frequentFlyerPoints: 10000.! !
!Person methodsFor: 'accessing'!
address
    "Private - Answer the value of the receiver's ''address'' instance variable."
^address! !
!Person methodsFor: 'accessing'!
address: anObject
    "Private - Set the value of the receiver's ''address'' instance variable to the argument, anObject."
address := anObject! !
!Person methodsFor: 'accessing'!
emailAddresses
    ^emailAddresses! !
!Person methodsFor: 'accessing'!
id
    "Private - Answer the value of the receiver's ''id'' instance variable."
^id! !
!Person methodsFor: 'accessing'!
id: anObject
    "Private - Set the value of the receiver's ''id'' instance variable to the argument, anObject."
id := anObject! !
!Person methodsFor: 'accessing'!
name
    "Private - Answer the value of the receiver's ''name'' instance variable."
^name! !
!Person methodsFor: 'accessing'!
name: anObject
    "Private - Set the value of the receiver's ''name'' instance variable to the argument, anObject."
name := anObject! !
!Person class methodsFor: 'example1'!
example1
^self new
    	id: 1;
    	name: 'Zaphod Beeblebrox';
    	address: Address example1.! !
!PositionableStream methodsFor: 'positioning' stamp: 'nop 5/31/2002 18:36'!
skipToAll: aCollection
    ^self match: aCollection! !
!PostgreSQLPlatform methodsFor: 'SQL'!
isPostgreSQLPlatform
^true! !
!PostgreSQLPlatform methodsFor: 'SQL'!
supportsConstraints
^false.! !
!PostgreSQLPlatform methodsFor: 'SQL'!
typeStringFor: type ofSize: size
type ==#number ifTrue: [^'integer'].
    type == #string ifTrue: [^'varchar(', size printString, ')'].
    self error: 'invalid field type'.! !
!PrimaryKeyExpression methodsFor: 'accessing'!
allSourceFields
^sources! !
!PrimaryKeyExpression methodsFor: 'accessing'!
allTables
^(targets collect: [:each | each table]) asSet.! !
!PrimaryKeyExpression methodsFor: 'accessing'!
hasDescriptor
^false.! !
!PrimaryKeyExpression methodsFor: 'accessing'!
numberOfParameters
    ^sources size! !
!PrimaryKeyExpression methodsFor: 'accessing'!
targetKeys
^targets.! !
!PrimaryKeyExpression methodsFor: 'accessing'!
ultimateBaseExpression
^base.! !
!PrimaryKeyExpression methodsFor: 'converting'!
asExpression
    "Convert this to a 'normal' expression representing the same information"
| main clause |
    main := nil.
    sources with: targets do: [:eachSource :eachTarget |
    	| srcExp targetExp |
    	srcExp := base getParameter: eachSource.
    	targetExp := (base getTable: eachTarget table) getField: eachTarget.
    	"Reversing the order is important because the source is the parameter, and sql won't accept '27 = FOO' "
    	clause := targetExp equals: srcExp.
    	main := main == nil 
    		ifTrue: [clause]
    		ifFalse: [main exAnd: clause]].
    ^main.! !
!PrimaryKeyExpression methodsFor: 'converting'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
| sourceFieldExpression targetFieldExpression completeExpression |
    completeExpression := nil.
    sources with: targets
    	do: 	[:sourceField :targetField | 
    		sourceFieldExpression := source getField: sourceField.
    		targetFieldExpression := target getField: targetField.
    		completeExpression := (sourceFieldExpression equals: targetFieldExpression)
    					exAnd: completeExpression].
    ^completeExpression! !
!PrimaryKeyExpression methodsFor: 'iterating'!
fieldsDo: aBlock
sources with: targets do: aBlock.! !
!PrimaryKeyExpression methodsFor: 'printing'!
printOn: aStream
sources with: targets do: [:source :target |
    	aStream nextPut: $(.
    	source printSQLOn: aStream withParameters: #().
    	aStream nextPutAll: ' = '.
    	target printSQLOn: aStream withParameters: #().
    	aStream nextPutAll: ') ']! !
!PrimaryKeyExpression methodsFor: 'printing'!
printSQLOn: aStream withParameters: aDictionary 
    1 to: sources size
    	do: 
    		[:i | 
    		| eachTarget eachSource sourceValue |
    		eachTarget := targets at: i.
    		eachSource := sources at: i.
    		eachTarget printSQLOn: aStream withParameters: aDictionary.
    		sourceValue := aDictionary at: eachSource.
    		sourceValue isNil 
    			ifTrue: [aStream nextPutAll: ' IS NULL ']
    			ifFalse: 
    				[aStream nextPutAll: ' = '.
    				(eachSource transform: sourceValue) printOn: aStream].
    		i = targets size ifFalse: [aStream nextPutAll: ' AND ']]! !
!PrimaryKeyExpression methodsFor: 'preparing'!
additionalExpressions
    ^#()! !
!PrimaryKeyExpression methodsFor: 'preparing'!
additionalExpressionsIn: aQuery 
    ^#()! !
!PrimaryKeyExpression methodsFor: 'preparing'!
allTablesToPrint
^targets inject: Set new into: [:sum :each | 
    	sum add: each table. sum].! !
!PrimaryKeyExpression methodsFor: 'preparing'!
prepareIn: anObject 
    "Do nothing."
^self asExpression prepareIn: anObject.! !
!PrimaryKeyExpression methodsFor: 'preparing'!
sourceForTarget: aField
| index |
    index := targets indexOf: aField.
    index = 0 ifTrue: [^nil].
    ^sources at: index.! !
!PrimaryKeyExpression methodsFor: 'testing'!
isPrimaryKeyExpression
    ^true.! !
!PrimaryKeyExpression methodsFor: 'initialize'!
initialize
sources := OrderedCollection new: 2.
    targets := OrderedCollection new: 2.
    base := BaseExpression new.! !
!PrimaryKeyExpression methodsFor: 'api'!
addSource: aField target: anotherField
sources add: aField.
    targets add: anotherField.! !
!PrimaryKeyExpression methodsFor: 'api'!
asGlorpExpression
^self.! !
!PrimaryKeyExpression methodsFor: 'api'!
asGlorpExpressionForDescriptor: aDescriptor
base descriptor: aDescriptor.! !
!PrimaryKeyExpression methodsFor: 'api'!
mapFromSource: sourceObject andTarget: targetObject intoRowsIn: aRowMap
sources with: targets
    	do: [:eachSourceField :eachTargetField | 
    		FieldUnifier
    			unifyFields: (Array with: eachSourceField with: eachTargetField)
    			correspondingTo: (Array with: sourceObject with: targetObject)
    			in: aRowMap]! !
!PrimaryKeyExpression class methodsFor: 'instance creation'!
from: aField to: anotherField
^self new
    	addSource: aField target: anotherField.! !
!PrimaryKeyExpression class methodsFor: 'instance creation'!
from: from1Field to: to1Field
from: from2Field to: to2Field
^self new
    	addSource: from1Field target: to1Field;
    	addSource: from2Field target: to2Field.! !
!PrimaryKeyExpression class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Proxy methodsFor: 'api'!
getValue
isInstantiated ifTrue: [^value].
    value := query executeWithParameters: parameters in: session.
    isInstantiated := true.
    ^value.! !
!Proxy methodsFor: 'initialize'!
doesNotUnderstand: aMessage
^self getValue perform: aMessage selector withArguments: aMessage arguments.! !
!Proxy methodsFor: 'initialize'!
initialize
isInstantiated := false.! !
!Proxy methodsFor: 'testing'!
isInstantiated
    ^isInstantiated.! !
!Proxy methodsFor: 'accessing'!
class
^Proxy.! !
!Proxy methodsFor: 'accessing'!
parameters
    ^parameters! !
!Proxy methodsFor: 'accessing'!
parameters: aDictionary
    parameters := aDictionary.! !
!Proxy methodsFor: 'accessing'!
query
    ^query! !
!Proxy methodsFor: 'accessing'!
query: aQuery 
    query := aQuery! !
!Proxy methodsFor: 'accessing'!
session
    ^session! !
!Proxy methodsFor: 'accessing'!
session: aSession 
    session := aSession! !
!Proxy methodsFor: 'notification'!
glorpPostFetch: aSession! !
!Proxy class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Proxy class methodsFor: 'instance creation'!
returningManyOf: aClass where: aBlock
    
    ^self new query: (Query returningManyOf: aClass where: aBlock).! !
!Proxy class methodsFor: 'instance creation'!
returningOneOf: aClass where: aBlock
    
    ^self new query: (Query returningOneOf: aClass where: aBlock).! !
!Query methodsFor: 'executing'!
executeIn: aSession
^self executeWithParameters:#() in: aSession.! !
!Query methodsFor: 'sql generation'!
printTablesOn: stream 
    GlorpHelper 
    	print: [:table | table sqlTableName]
    	on: stream
    	for: self tablesToPrint
    	separatedBy: ', '! !
!Query methodsFor: 'accessing'!
session
    ^session! !
!Query methodsFor: 'accessing'!
session: aSession 
    session := aSession! !
!Query methodsFor: 'initialize'!
initialize
prepared := false.! !
!AbstractReadQuery methodsFor: 'accessing'!
criteria
    ^criteria! !
!AbstractReadQuery methodsFor: 'accessing'!
readsOneObject: aBoolean 
    readsOneObject := aBoolean! !
!AbstractReadQuery methodsFor: 'accessing'!
resultClass
    ^resultClass! !
!AbstractReadQuery methodsFor: 'accessing'!
returnProxies
    ^returnProxies! !
!AbstractReadQuery methodsFor: 'accessing'!
returnProxies: aBoolean
    returnProxies := aBoolean! !
!AbstractReadQuery methodsFor: 'accessing'!
shouldRefresh
    ^shouldRefresh! !
!AbstractReadQuery methodsFor: 'accessing'!
shouldRefresh: aBoolean
    shouldRefresh := aBoolean! !
!AbstractReadQuery methodsFor: 'executing'!
setUpCriteria
    criteria := criteria asGlorpExpressionForDescriptor: (session descriptorFor: resultClass)! !
!AbstractReadQuery methodsFor: 'initialize/release'!
initResultClass: aClass criteria: theCriteria singleObject: aBoolean 
    resultClass := aClass.
    criteria := theCriteria asGlorpExpression.
    readsOneObject := aBoolean.! !
!AbstractReadQuery methodsFor: 'initialize/release'!
initialize
    
    super initialize.
    returnProxies := false.
    shouldRefresh := false.! !
!DeleteQuery methodsFor: 'executing'!
executeWithParameters: parameterDictionary in: aSession 
    | |
    session := aSession.
    self prepare.
    session accessor executeSQLString: (self sqlWith: parameterDictionary).
    session cacheRemoveObject: objectToDelete.! !
!DeleteQuery methodsFor: 'sql generation'!
sqlWith: aDictionary 
    "This is likely to break horribly if there is more than one table involved. If that happens, do I have to split this up into multiple deletes?"
| string stream |
    self prepare.
    stream := WriteStream on: (String new: 100).
    stream nextPutAll: 'DELETE FROM '.
    self printTablesOn: stream.
    stream nextPutAll: ' WHERE '.
    criteria printSQLOn: stream withParameters: aDictionary.
    string := stream contents.
    ^string! !
!DeleteQuery methodsFor: 'sql generation'!
tablesToPrint
    ^criteria ultimateBaseExpression tables.! !
!DeleteQuery methodsFor: 'preparing'!
prepare
    prepared ifTrue: [^self].
    self setUpCriteria. "In case it hasn't already been done"
    criteria := criteria prepareIn: self.
    prepared := true.! !
!DeleteQuery methodsFor: 'preparing'!
setUpCriteria
    criteria := self descriptor primaryKeyExpressionFor: objectToDelete.
    criteria := criteria asGlorpExpressionForDescriptor: (session descriptorFor: objectToDelete)! !
!DeleteQuery methodsFor: 'accessing'!
descriptor
    ^session descriptorFor: objectToDelete.! !
!DeleteQuery methodsFor: 'accessing'!
objectToDelete: anObject
    objectToDelete := anObject.! !
!Query class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Query class methodsFor: 'instance creation'!
returningManyOf: aClass where: criteria
    "Backward-compatibility, since we changed the class name."
    ^ReadQuery returningManyOf: aClass where: criteria.! !
!Query class methodsFor: 'instance creation'!
returningOneOf: aClass where: criteria
    "Backward-compatibility, since we changed the class name."
    ^ReadQuery returningOneOf: aClass where: criteria.! !
!AbstractReadQuery class methodsFor: 'instance creation'!
returningManyOf: aClass where: criteria
^self new
    	initResultClass: aClass criteria: criteria singleObject: false.! !
!AbstractReadQuery class methodsFor: 'instance creation'!
returningOneOf: aClass where: criteria
^self new
    	initResultClass: aClass criteria: criteria singleObject: true.! !
!DeleteQuery class methodsFor: 'instance creation'!
for: anObject
    ^self new objectToDelete: anObject.! !
!QueryStub methodsFor: 'accessing'!
result
    ^result! !
!QueryStub methodsFor: 'accessing'!
result: anObject
    result := anObject! !
!QueryStub methodsFor: 'executing'!
executeWithParameters: parameterArray in: aSession
aSession register: result.
    ^result.! !
!ReadQuery methodsFor: 'printing'!
printWhereClauseOn: aStream withParameters: anArray 
    criteria printSQLOn: aStream withParameters: anArray! !
!ReadQuery methodsFor: 'accessing'!
absentBlock
absentBlock == nil ifTrue: [^[nil]].
    ^absentBlock.! !
!ReadQuery methodsFor: 'accessing'!
defaultTracing
    ^self descriptor defaultTracing.! !
!ReadQuery methodsFor: 'accessing'!
descriptor
    ^session descriptorFor: resultClass.! !
!ReadQuery methodsFor: 'executing'!
executeWithParameters: parameterDictionary in: aSession 
    | cacheHit |
    session := aSession.
    self setUpCriteria.
    cacheHit := self checkCacheWithParameters: parameterDictionary.
    cacheHit isNil ifFalse: [^cacheHit].
    ^self 
    	readFromDatabaseWithParameters: parameterDictionary
    	tracing: self defaultTracing
    	inSession: aSession! !
!ReadQuery methodsFor: 'executing'!
readFromDatabaseForTraceNodes: aCollection withParameters: aDictionary
    | simpleQuery |
    simpleQuery := self asSimpleQueryForTraceNodes: aCollection.
    ^simpleQuery readFromDatabaseWithParameters: aDictionary! !
!ReadQuery methodsFor: 'executing'!
readFromDatabaseWithParameters: aDictionary tracing: aTracing inSession: anObject 
    | traceNodeSets result |
    self setupTracing: aTracing.
    traceNodeSets := aTracing traceNodeSets.
    result := self readFromDatabaseForTraceNodes: traceNodeSets first
    			withParameters: aDictionary.
    readsOneObject ifTrue: [^result isEmpty ifTrue: [self absentBlock value] ifFalse: [result first]].
    2 to: traceNodeSets size
    	do: 
    		[:i | 
    		self readFromDatabaseForTraceNodes: (traceNodeSets at: i)
    			withParameters: aDictionary].
    ^result! !
!ReadQuery methodsFor: 'caching'!
checkCacheWithParameters: aCollection 
    "We can only check the cache on parameterized queries, and even then it doesn't work for composite keys. Needs work"
    | primaryKey |
    readsOneObject ifFalse: [^nil].
    self shouldRefresh ifTrue: [^nil].
    primaryKey := self primaryKeyWithParameters: aCollection.
    primaryKey isNil ifTrue: [^nil].
    ^session 
    	cacheAt: primaryKey
    	forClass: resultClass
    	ifNone: [nil]! !
!ReadQuery methodsFor: 'caching'!
primaryKeyWithParameters: aCollection 
    
    aCollection isEmpty ifTrue: [^nil].
    "Return any element. Clearly broken for composite keys"
    aCollection do: [:each | ^each].! !
!ReadQuery methodsFor: 'tracing'!
setupTracing: aTracing 
    self descriptor setupTracing: aTracing! !
!ReadQuery methodsFor: 'converting'!
asSimpleQueryForTraceNodes: anArray
| newQuery |
    newQuery := SimpleQuery new
    	initResultClass: resultClass criteria: criteria singleObject: readsOneObject.
    newQuery session: session.
    newQuery returnProxies: self returnProxies.
    newQuery shouldRefresh: self shouldRefresh.
    newQuery setUpCriteria.
    newQuery traceNodes: anArray.
    ^newQuery.! !
!ReadStream methodsFor: 'Not categorized'!
collect: aBlock 
    | newStream |
    newStream := WriteStream on: collection species new.
    [self atEnd] whileFalse: [newStream nextPut: (aBlock value: self next)].
    ^newStream contents! !
!RelationExpression methodsFor: 'accessing'!
leftChild
    ^leftChild! !
!RelationExpression methodsFor: 'accessing'!
leftChild: anExpression 
    leftChild := anExpression! !
!RelationExpression methodsFor: 'accessing'!
relation
^relation.! !
!RelationExpression methodsFor: 'accessing'!
relation: aSymbol
relation := aSymbol.! !
!RelationExpression methodsFor: 'accessing'!
rightChild
    ^rightChild! !
!RelationExpression methodsFor: 'accessing'!
rightChild: anExpression
    rightChild := anExpression! !
!RelationExpression methodsFor: 'navigating'!
ultimateBaseExpression
^leftChild ultimateBaseExpression.! !
!RelationExpression methodsFor: 'preparing'!
additionalExpressions
^#().! !
!RelationExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
| left right |
    left := leftChild asExpressionJoiningSource: source toTarget: target.
    right := rightChild asExpressionJoiningSource: source toTarget: target.
    ^self class new 
    	relation: relation;
    	leftChild: left;
    	rightChild: right.! !
!RelationExpression methodsFor: 'api'!
get: aSymbol withArguments: anArray
    "Return the mapping expression corresponding to the named attribute"
^anArray isEmpty 
    	ifTrue: [self error: 'Only binary relationships supported right now']
    	ifFalse: [RelationExpression named: aSymbol basedOn: self withArguments: anArray].! !
!RelationExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
    
    (aSet includes: self) ifTrue: [^self].
    aSet add: self.
    leftChild do: aBlock skipping: aSet.
    rightChild do: aBlock skipping: aSet.
    aBlock value: self.! !
!RelationExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
aStream nextPutAll: relation.! !
!RelationExpression methodsFor: 'printing'!
printTreeOn: aStream 
    aStream
    	print: leftChild;
    	space;
    	nextPutAll: relation;
    	space;
    	print: rightChild! !
!RelationExpression methodsFor: 'testing'!
isPrimaryKeyExpression
    ^false.! !
!RelationExpression methodsFor: 'private/initializing'!
named: aSymbol basedOn: anExpression withArguments: anArray
relation := self operationFor: aSymbol.
    leftChild := anExpression.
    rightChild := anArray first asGlorpExpressionOn: anExpression ultimateBaseExpression.! !
!RelationExpression methodsFor: 'private/initializing'!
operationFor: aSymbol
    "Simple translation of operators"
aSymbol == #exAnd: ifTrue: [^#AND].
    aSymbol == #& ifTrue: [^#AND].
    aSymbol == #exOr: ifTrue: [^#OR].
    aSymbol == #| ifTrue: [^#OR].
    aSymbol == #~= ifTrue: [^#<>].
     aSymbol == #like: ifTrue: [^#LIKE].
     aSymbol == #in: ifTrue: [^#IN].
    ^aSymbol.! !
!RelationExpression methodsFor: 'printing SQL'!
printSQLOn: aStream withParameters: aDictionary 
    leftChild printSQLOn: aStream withParameters: aDictionary.
    (rightChild valueIn: aDictionary) isNil ifTrue: [^self printWithNullOn: aStream].
    aStream
    	space;
    	nextPutAll: self relation;
    	space.
    rightChild printSQLOn: aStream withParameters: aDictionary.! !
!RelationExpression methodsFor: 'printing SQL'!
printWithNullOn: aStream
    aStream nextPutAll: ' IS '.
    self relation = #<> ifTrue: [
    	aStream nextPutAll: 'NOT '].
    aStream nextPutAll: 'NULL'.! !
!CollectionExpression methodsFor: 'printing SQL'!
printSQLOn: aStream withParameters: aDictionary 
    "Don't print the left child or ourselves, just the expression that is the right side.
e.g. aPerson addresses anySatisfy: [:each | each city='Ottawa'] prints as
where (address.city = 'Ottawa')
The relation 'aPerson addresses' will ensure that the join gets printed"
    rightChild printSQLOn: aStream withParameters: aDictionary.! !
!CollectionExpression methodsFor: 'private/initializing'!
named: aSymbol basedOn: anExpression withArguments: anArray
    "We know that our argument is a block and it operates on the elements of the receiver, i.e. the left child"
relation := aSymbol.
    leftChild := anExpression.
    rightChild := anArray first asGlorpExpressionOn: leftChild.! !
!RelationExpression class methodsFor: 'instance creation'!
named: aSymbol basedOn: anExpression withArguments: anArray
^self new
    	named: aSymbol
    	basedOn: anExpression
    	withArguments: anArray.! !
!RelationshipMapping methodsFor: 'accessing'!
allTables
mappingCriteria isNil ifTrue: [^#()].
    ^mappingCriteria allTables.! !
!RelationshipMapping methodsFor: 'accessing'!
mappedFields
    "Return a collection of fields that this mapping will write into any of the containing object's rows"
^self mappingCriteria allSourceFields.! !
!RelationshipMapping methodsFor: 'accessing'!
mappingCriteria
    "Private - Answer the value of the receiver's ''mappingCriteria'' instance variable."
^mappingCriteria! !
!RelationshipMapping methodsFor: 'accessing'!
mappingCriteria: anObject
    "Private - Set the value of the receiver's ''mappingCriteria'' instance variable to the argument, anObject."
mappingCriteria := anObject! !
!RelationshipMapping methodsFor: 'accessing'!
referenceClass
    "Private - Answer the value of the receiver's ''referenceClass'' instance variable."
^referenceClass! !
!RelationshipMapping methodsFor: 'accessing'!
referenceClass: anObject
    "Private - Set the value of the receiver's ''referenceClass'' instance variable to the argument, anObject."
referenceClass := anObject! !
!RelationshipMapping methodsFor: 'accessing'!
referenceDescriptor
^self system descriptorFor: self referenceClass.! !
!RelationshipMapping methodsFor: 'accessing'!
shouldProxy
^shouldProxy.! !
!RelationshipMapping methodsFor: 'accessing'!
shouldProxy: aBoolean
shouldProxy := aBoolean.! !
!RelationshipMapping methodsFor: 'testing'!
controlsTables
    "Return true if this type of method 'owns' the tables it's associated with, and expression nodes using this mapping should alias those tables where necessary"
^true! !
!RelationshipMapping methodsFor: 'testing'!
isIndependentRelationship
    "True when the mapping associates different tables."
^true! !
!RelationshipMapping methodsFor: 'testing'!
isRelationship
    "True when the mapping associates different classes."
^true! !
!RelationshipMapping methodsFor: 'initializing'!
initialize
super initialize.
    shouldProxy := true.! !
!RelationshipMapping methodsFor: 'mapping'!
extendedMappingCriteria
^mappingCriteria.! !
!RelationshipMapping methodsFor: 'mapping'!
isValidTarget: anObject
^anObject class == Proxy
    	ifTrue: [anObject isInstantiated]
    	ifFalse: [anObject notNil].! !
!RelationshipMapping methodsFor: 'mapping'!
mapFromObject: anObject intoRowsIn: aRowMap 
    
    | target |
    target := self getValueFrom: anObject.
    (self isValidTarget: target)
    	ifTrue: [self mapFromObject: anObject toTarget: target puttingRowsIn: aRowMap].! !
!RelationshipMapping methodsFor: 'mapping'!
mapFromRow: anArray intoObject: anObject inElementBuilder: anElementBuilder 
    | parameters |
    parameters := IdentityDictionary new.
    mappingCriteria fieldsDo: [:eachSource :eachTarget | 
    	parameters 
    		at: eachSource
    		put: (anElementBuilder valueOf: eachSource in: anArray)].
    self setValueIn: anObject
    	to: (self shouldProxy 
    			ifTrue: 
    				[(self newProxy)
    					session: descriptor session;
    					parameters: parameters]
    			ifFalse: [self query executeWithParameters: parameters in: descriptor session])! !
!RelationshipMapping methodsFor: 'mapping'!
query
self subclassResponsibility.! !
!RelationshipMapping methodsFor: 'api'!
referencedIndependentObjectsFrom: anObject
^self getValueFrom: anObject.! !
!RelationshipMapping methodsFor: 'processing'!
trace: aTracing context: anExpression
    "Currently we don't trace relationships across tables, so all we do here
is accumulate the list of embedded mappings"
    | newContext |
    (aTracing tracesThrough: self) ifFalse: [^self].
    newContext := anExpression get: attributeName.
    aTracing addTracing: newContext.
    self referenceDescriptor trace: aTracing context: newContext.! !
!RelationshipMapping methodsFor: 'preparing'!
joinExpressionFor: targetExpression
    "We're looking for the object represented by this mapping, and we know the object represented by its source. Use our mapping criteria to construct a join that traverses that instance of this relationship"
| sourceExpression |
    sourceExpression := targetExpression base.
    ^self extendedMappingCriteria asExpressionJoiningSource: sourceExpression toTarget: targetExpression.! !
!RelationshipMapping methodsFor: 'proxies'!
newProxy
| proxy |
    proxy := Proxy new.
    proxy query: (self query).
    ^proxy.! !
!ManyToManyMapping methodsFor: 'mapping'!
extendedMappingCriteria
    "In order to do a many-to-many read we need more information than just the write, we need to know 
    the relationship to the other table. Construct that based on the table information"
| generalMappingCriteria base |
    generalMappingCriteria := mappingCriteria asExpression.
    base := generalMappingCriteria ultimateBaseExpression.
    ^generalMappingCriteria exAnd: 
    	(self expressionFromLinkToReferenceTableWithBase: base) .! !
!ManyToManyMapping methodsFor: 'mapping'!
mapFromObject: anObject toTarget: aCollection puttingRowsIn: aRowMap
aCollection do: [:each | 
    	(self isValidTarget: each) ifTrue: [
    		| rowMapKey |
    		rowMapKey := (RowMapKey new)
    					key1: anObject;
    					key2: each.
    		mappingCriteria 
    			mapFromSource: anObject
    			andTarget: rowMapKey
    			intoRowsIn: aRowMap]]! !
!ManyToManyMapping methodsFor: 'mapping'!
query
    ^ReadQuery returningManyOf: referenceClass
    	where: self extendedMappingCriteria! !
!ManyToManyMapping methodsFor: 'private/expressions'!
expressionFromLinkToReferenceTable
    | referenceKeys linkTable constraints referenceTables expression |
    referenceKeys := mappingCriteria targetKeys asOrderedCollection.
    linkTable := referenceKeys first table.
    "Find all the foreign keys in the link table that aren't the ones from our source to the link, assuming that they will all be from the link to the target"
    constraints := linkTable foreignKeyConstraints reject: [:each | 
    	(referenceKeys includes: each sourceField)].
"Validate that we can handle this case"
    referenceTables := (constraints collect: [:each | each targetField table]) asSet.
    referenceTables size = 1 ifFalse: [self error: 'Cannot handle this general a case'].
expression := PrimaryKeyExpression new.
    constraints do: [:each |
    	expression
    		addSource: each sourceField
    		target: each targetField].
    ^expression asExpression.! !
!ManyToManyMapping methodsFor: 'private/expressions'!
expressionFromLinkToReferenceTableWithBase: base
    | referenceKeys linkTable constraints referenceTables expression |
    referenceKeys := mappingCriteria targetKeys asOrderedCollection.
    linkTable := referenceKeys first table.
    "Find all the foreign keys in the link table that aren't the ones from our source to the link, assuming that they will all be from the link to the target"
    constraints := linkTable foreignKeyConstraints reject: [:each | 
    	(referenceKeys includes: each sourceField)].
"Validate that we can handle this case"
    referenceTables := (constraints collect: [:each | each targetField table]) asSet.
    referenceTables size > 1 ifTrue: [self error: 'Cannot handle this general a case'].
    referenceTables size = 0 ifTrue: [self error: 'No tables found. Did you set up foreign key references in the table definitions?'].
expression := nil.
    constraints do: [:each | |src target |
    	src := (base getTable: each sourceField table) getField: each sourceField.
    	target := (base getTable: each targetField table) getField: each targetField.
    	expression := expression isNil 
    		ifTrue: [src equals: target]
    		ifFalse: [expression exAnd: (src equals: target)]].
    ^expression.! !
!ManyToManyMapping methodsFor: 'api'!
referencedIndependentObjectsFrom: anObject
| collection includingTheCollectionItself |
    collection := super referencedIndependentObjectsFrom: anObject.
    includingTheCollectionItself := OrderedCollection new: (collection size + 1).
    includingTheCollectionItself addAll: collection.
    includingTheCollectionItself add: collection.
    ^includingTheCollectionItself.! !
!OneToManyMapping methodsFor: 'mapping'!
mapFromObject: anObject toTarget: aCollection puttingRowsIn: aRowMap 
    aCollection do: [:each | 
    	(self isValidTarget: each) ifTrue: [
    		mappingCriteria 
    			mapFromSource: anObject
    			andTarget: each
    			intoRowsIn: aRowMap]].! !
!OneToManyMapping methodsFor: 'mapping'!
query
    ^ReadQuery returningManyOf: referenceClass where: mappingCriteria! !
!OneToManyMapping methodsFor: 'api'!
referencedIndependentObjectsFrom: anObject
| collection includingTheCollectionItself |
    collection := super referencedIndependentObjectsFrom: anObject.
    includingTheCollectionItself := OrderedCollection new: (collection size + 1).
    includingTheCollectionItself addAll: collection.
    includingTheCollectionItself add: collection.
    ^includingTheCollectionItself.! !
!OneToOneMapping methodsFor: 'testing'!
isOneToOne
^true! !
!OneToOneMapping methodsFor: 'mapping'!
mapFromObject: anObject toTarget: target puttingRowsIn: aRowMap
mappingCriteria 
    	mapFromSource: anObject
    	andTarget: target
    	intoRowsIn: aRowMap! !
!OneToOneMapping methodsFor: 'mapping'!
query
    ^ReadQuery returningOneOf: referenceClass where: mappingCriteria! !
!OneToOneMapping methodsFor: 'mapping'!
referencedIndependentObjectsFrom: anObject
^Array with: (self getValueFrom: anObject).! !
!EmbeddedValueOneToOneMapping methodsFor: 'transformations'!
defaultTransformationExpressionFor: aDescriptor 
    "If there's no transformation, get all the mapped fields from the other descriptor and construct a transformation of each onto itself. This lets us unify the fields in my row with the fields in its row"
| fields transform |
    fields := IdentitySet new.
    aDescriptor mappings do: [:each | fields addAll: each mappedFields].
    transform := PrimaryKeyExpression new.
    fields do: [:each | transform addSource: each target: each].
    ^transform! !
!EmbeddedValueOneToOneMapping methodsFor: 'transformations'!
hasTransformation
^false.! !
!EmbeddedValueOneToOneMapping methodsFor: 'transformations'!
transformationExpression
^self hasFieldTranslation
    	ifTrue: [fieldTranslation]
    	ifFalse: [self defaultTransformationExpressionFor: (self referenceDescriptor)].! !
!EmbeddedValueOneToOneMapping methodsFor: 'internal'!
fieldsForSelectStatement
    "Return a collection of fields that this mapping will read from a row"
    "Return nothing, because our sub-objects will take care of adding their own fields, translated correctly through us."
    ^#().! !
!EmbeddedValueOneToOneMapping methodsFor: 'internal'!
mappedFields
    "Return a collection of fields that this mapping will write into any of the containing object's rows"
fieldTranslation isNil ifFalse: [^fieldTranslation allSourceFields].
    ^self referenceDescriptor mappedFields.! !
!EmbeddedValueOneToOneMapping methodsFor: 'accessing'!
fieldTranslation
    ^fieldTranslation! !
!EmbeddedValueOneToOneMapping methodsFor: 'accessing'!
fieldTranslation: aPrimaryKeyExpression 
    fieldTranslation := aPrimaryKeyExpression! !
!EmbeddedValueOneToOneMapping methodsFor: 'accessing'!
hasFieldTranslation
^fieldTranslation notNil.! !
!EmbeddedValueOneToOneMapping methodsFor: 'testing'!
controlsTables
    "Return true if this type of method 'owns' the tables it's associated with, and expression nodes using this mapping should alias those tables where necessary"
^false! !
!EmbeddedValueOneToOneMapping methodsFor: 'testing'!
isIndependentRelationship
    "True when the mapping associates different tables."
^false! !
!EmbeddedValueOneToOneMapping methodsFor: 'testing'!
shouldProxy
^false.! !
!EmbeddedValueOneToOneMapping methodsFor: 'mapping'!
mapFromObject: anObject toTarget: target puttingRowsIn: aRowMap
self transformationExpression 
    	mapFromSource: anObject
    	andTarget: target
    	intoRowsIn: aRowMap.
(aRowMap rowsForKey: target) do: [:each | each shouldBeWritten: false]! !
!EmbeddedValueOneToOneMapping methodsFor: 'mapping'!
mapFromRow: valueCollection intoObject: anObject inElementBuilder: anElementBuilder
| myTraceNode myBuilder |
    "If the object already has a value in my slot, then this it got a cache hit, the embedded value was carried along for the ride, and we don't need to assign anything"
    (self getValueFrom: anObject) isNil ifFalse: [^self].
"Otherwise, we need to look up the trace node that corresponds to this mapping, and get its instance"
    myTraceNode := anElementBuilder expression get: attributeName.
    myBuilder := anElementBuilder query elementBuilderFor: myTraceNode.
    self setValueIn: anObject to: myBuilder instance.! !
!EmbeddedValueOneToOneMapping methodsFor: 'mapping'!
translateFields: anOrderedCollection 
    fieldTranslation isNil ifTrue: [^anOrderedCollection].
    ^anOrderedCollection collect: [:each |
    	fieldTranslation sourceForTarget: each].! !
!EmbeddedValueOneToOneMapping methodsFor: 'preparing'!
joinExpressionFor: targetExpression
    "We're looking for the object represented by this mapping, and we know the object represented by its source. Use our mapping criteria to construct a join that traverses that instance of this relationship.
    Embedded values never induce a join."
^nil.! !
!RowMap methodsFor: 'lookup'!
findOrAddRowForTable: aTable withKey: aKey 
    | submap |
    submap := self subMapForTable: aTable withKey: aKey.
    ^submap at: aKey ifAbsentPut: [DatabaseRow newForTable: aTable withOwner: aKey]! !
!RowMap methodsFor: 'lookup'!
includesRowForTable: aTable withKey: aKey
(self subMapForTable: aTable ifAbsent: [^false]) at: aKey ifAbsent: [^false].
    ^true.! !
!RowMap methodsFor: 'lookup'!
rowForTable: aTable withKey: aKey 
    ^(self subMapForTable: aTable) at: aKey! !
!RowMap methodsFor: 'iterating'!
keysAndValuesDo: aBlock 
    self tables do: [:each | 
    	(self subMapForTable: each) keysAndValuesDo: aBlock].! !
!RowMap methodsFor: 'iterating'!
rowsDo: aBlock 
    self tables do: [:each | self rowsForTable: each do: aBlock]! !
!RowMap methodsFor: 'iterating'!
rowsForTable: aTable do: aBlock 
    ^(self subMapForTable: aTable) do: aBlock! !
!RowMap methodsFor: 'counting'!
numberOfEntries
    ^rowDictionary inject: 0 into: [:sum :each | sum + each size]! !
!RowMap methodsFor: 'counting'!
numberOfEntriesForTable: aTable
^(self subMapForTable: aTable) size.! !
!RowMap methodsFor: 'private/mapping'!
dictionaryClassRequiredForKeysOfType: aClass
^aClass == RowMapKey
    	ifTrue: [Dictionary]
    	ifFalse: [IdentityDictionary].! !
!RowMap methodsFor: 'private/mapping'!
rowsForKey: aKey 
    "Return a collection of all rows for any table which are keyed by aKey"
| rowsForKey |
    rowsForKey := OrderedCollection new: 5.
    rowDictionary do: 
    		[:each | 
    		| row |
    		row := each at: aKey ifAbsent: [nil].
    		row isNil ifFalse: [rowsForKey add: row]].
    ^rowsForKey.! !
!RowMap methodsFor: 'private/mapping'!
subMapForTable: aTable
    
    ^self subMapForTable: aTable withKey: nil.! !
!RowMap methodsFor: 'private/mapping'!
subMapForTable: aTable ifAbsent: aBlock 
    ^rowDictionary at: aTable ifAbsent: aBlock! !
!RowMap methodsFor: 'private/mapping'!
subMapForTable: aTable withKey: anObject 
    ^rowDictionary at: aTable
    	ifAbsentPut: [(self dictionaryClassRequiredForKeysOfType: anObject class) new]! !
!RowMap methodsFor: 'private/mapping'!
tables
^rowDictionary keys.! !
!RowMap methodsFor: 'initialize/release'!
initialize
    rowDictionary := IdentityDictionary new! !
!RowMap class methodsFor: 'instance creation'!
new
^super new initialize.! !
!RowMapKey methodsFor: 'comparing'!
= aRowMapKey
aRowMapKey class == self class ifFalse: [^false].
    ^(key1 == aRowMapKey key1 and: [key2 == aRowMapKey key2]) or: [
    	key2 == aRowMapKey key1 and: [key1 == aRowMapKey key2]].! !
!RowMapKey methodsFor: 'comparing'!
hash
^key1 identityHash bitXor: key2 identityHash.! !
!RowMapKey methodsFor: 'accessing'!
key1
    ^key1! !
!RowMapKey methodsFor: 'accessing'!
key1: anObject
    key1 := anObject! !
!RowMapKey methodsFor: 'accessing'!
key2
    ^key2! !
!RowMapKey methodsFor: 'accessing'!
key2: anObject
    key2 := anObject! !
!SQLServerPlatform methodsFor: 'SQL'!
isODBCPlatform
^true! !
!SQLServerPlatform methodsFor: 'SQL'!
supportsConstraints
^true! !
!SQLServerPlatform methodsFor: 'SQL'!
typeStringFor: type ofSize: size
type == #number ifTrue: [^'integer'].
    type == #string ifTrue: [^'varchar(', size printString, ')'].
    self error: 'invalid field type'.! !
!SequencePolicy methodsFor: 'accessing'!
field
    "Private - Answer the value of the receiver's ''field'' instance variable."
^field! !
!SequencePolicy methodsFor: 'accessing'!
field: anObject
    "Private - Set the value of the receiver's ''field'' instance variable to the argument, anObject."
field := anObject! !
!SequencePolicy methodsFor: 'initialize/release'!
initialize! !
!SequencePolicy methodsFor: 'sequencing'!
postWriteAssignSequenceValueFor: aField in: aRow
self subclassResponsibility.! !
!SequencePolicy methodsFor: 'sequencing'!
preWriteAssignSequenceValueFor: aField in: aRow
self subclassResponsibility.! !
!InMemorySequencePolicy methodsFor: 'initialize/release'!
initialize
super initialize.
    count := 0.! !
!InMemorySequencePolicy methodsFor: 'sequencing'!
postWriteAssignSequenceValueFor: aField in: aRow! !
!InMemorySequencePolicy methodsFor: 'sequencing'!
preWriteAssignSequenceValueFor: aField in: aRow
aRow at: aField put: (count := count + 1).! !
!NullSequencePolicy methodsFor: 'sequencing'!
postWriteAssignSequenceValueFor: aField in: aRow! !
!NullSequencePolicy methodsFor: 'sequencing'!
preWriteAssignSequenceValueFor: aField in: aRow! !
!SequencePolicy class methodsFor: 'instance creation'!
new
^super new initialize.! !
!InMemorySequencePolicy class methodsFor: 'defaults'!
default
^self new.! !
!NullSequencePolicy class methodsFor: 'defaults'!
default
^self new.! !
!NullSequencePolicy class methodsFor: 'instance creation'!
new
Singleton isNil ifTrue: [Singleton := self basicNew].
    ^Singleton.! !
!SequenceTablePolicy methodsFor: 'accessing'!
sequenceTableName
    "Private - Answer the value of the receiver's ''sequenceTableName'' instance variable."
^sequenceTableName! !
!SequenceTablePolicy methodsFor: 'accessing'!
sequenceTableName: anObject
    "Private - Set the value of the receiver's ''sequenceTableName'' instance variable to the argument, anObject."
sequenceTableName := anObject! !
!SequenceTablePolicy class methodsFor: 'defaults'!
default
^self new sequenceTableName: 'SEQUENCE'.! !
!ServiceCharge methodsFor: 'accessing'!
amount
    ^amount! !
!ServiceCharge methodsFor: 'accessing'!
amount: anObject
    amount := anObject! !
!ServiceCharge methodsFor: 'accessing'!
description
    ^description! !
!ServiceCharge methodsFor: 'accessing'!
description: anObject
    description := anObject! !
!ServiceCharge methodsFor: 'initialize'!
initialize! !
!ServiceCharge class methodsFor: 'instance creation'!
default
^self new
    	amount: (GlorpMoney forAmount: 3);
    	description: 'additional overcharge'.! !
!ServiceCharge class methodsFor: 'instance creation'!
new
^super new initialize.! !
!Session methodsFor: 'initialize'!
initialize
self initializeCache.! !
!Session methodsFor: 'initialize'!
initializeCache
cache := CacheManager forSession: self.! !
!Session methodsFor: 'initialize'!
reset
self initializeCache.
    currentUnitOfWork := nil.! !
!Session methodsFor: 'accessing'!
accessor
    ^accessor! !
!Session methodsFor: 'accessing'!
accessor: aDatabaseAccessor 
    accessor := aDatabaseAccessor! !
!Session methodsFor: 'accessing'!
applicationData
    ^applicationData! !
!Session methodsFor: 'accessing'!
applicationData: anObject	
    applicationData := anObject! !
!Session methodsFor: 'accessing'!
system
    ^system! !
!Session methodsFor: 'caching'!
cacheAt: aKey  forClass: aClass ifNone: failureBlock
^cache lookupClass: aClass key: aKey ifAbsent: failureBlock.! !
!Session methodsFor: 'caching'!
cacheAt: keyObject put: valueObject 
    ^cache at: keyObject insert: valueObject! !
!Session methodsFor: 'caching'!
cacheContainsObjectForRow: aDatabaseRow
    ^(self cacheLookupObjectForRow: aDatabaseRow) notNil.! !
!Session methodsFor: 'caching'!
cacheLookupForClass: aClass key: aKey 
    ^self 
    	cacheAt: aKey
    	forClass: aClass
    	ifNone: [nil]! !
!Session methodsFor: 'caching'!
cacheLookupObjectForRow: aDatabaseRow
    ^self 
    	cacheLookupForClass: aDatabaseRow owner class
    	key: aDatabaseRow primaryKey! !
!Session methodsFor: 'caching'!
cacheRemoveObject: anObject
    | key |
    key := (self descriptorFor: anObject) primaryKeyFor: anObject.
    cache removeClass: anObject class key: key.! !
!Session methodsFor: 'copying'!
copy
^self shallowCopy postCopy.! !
!Session methodsFor: 'copying'!
postCopy
super postCopy.
    self initializeCache.
    currentUnitOfWork := nil.! !
!Session methodsFor: 'api'!
descriptorFor: aClass
^system descriptorFor: aClass.! !
!Session methodsFor: 'api'!
hasDescriptorFor: aClass
^system hasDescriptorFor: aClass.! !
!Session methodsFor: 'api'!
isRegistered: anObject
currentUnitOfWork isNil ifTrue: [^false].
    ^currentUnitOfWork isRegistered: anObject.! !
!Session methodsFor: 'api'!
register: anObject
currentUnitOfWork isNil ifTrue: [^self].
    currentUnitOfWork register: anObject.! !
!Session methodsFor: 'api'!
system: aSystem 
    aSystem session: self.
    system := aSystem! !
!Session methodsFor: 'queries'!
delete: anObject
^self execute: (DeleteQuery for: anObject).! !
!Session methodsFor: 'queries'!
execute: aQuery
^aQuery executeIn: self.! !
!Session methodsFor: 'queries'!
readManyOf: aClass where: aBlock
^self execute: (ReadQuery returningManyOf: aClass where: aBlock).! !
!Session methodsFor: 'queries'!
readOneOf: aClass where: aBlock
^self execute: (ReadQuery returningOneOf: aClass where: aBlock).! !
!Session methodsFor: 'read/write'!
writeRow: aDatabaseRow 
    aDatabaseRow shouldBeWritten ifFalse: [^self].
    aDatabaseRow preWriteAssignSequences.
    accessor executeSQLString: (self sqlStringFor: aDatabaseRow). 
    aDatabaseRow postWriteAssignSequences! !
!Session methodsFor: 'events'!
sendPostFetchEventTo: anObject
    anObject glorpPostFetch: self.! !
!Session methodsFor: 'events'!
sendPostWriteEventTo: anObject
    anObject glorpPostWrite: self.! !
!Session methodsFor: 'events'!
sendPreWriteEventTo: anObject
    anObject glorpPreWrite: self.! !
!Session methodsFor: 'api/transactions'!
beginTransaction
    accessor beginTransaction.! !
!Session methodsFor: 'api/transactions'!
beginUnitOfWork
self hasUnitOfWork ifTrue: [self error: 'Cannot nest units of work yet'].
    currentUnitOfWork := UnitOfWork new.
    currentUnitOfWork session: self.! !
!Session methodsFor: 'api/transactions'!
commitTransaction
    accessor commitTransaction! !
!Session methodsFor: 'api/transactions'!
commitUnitOfWork
currentUnitOfWork commit.
    currentUnitOfWork := nil.! !
!Session methodsFor: 'api/transactions'!
hasUnitOfWork
^currentUnitOfWork notNil.! !
!Session methodsFor: 'api/transactions'!
rollbackTransaction
    accessor rollbackTransaction.! !
!Session methodsFor: 'api/transactions'!
rollbackUnitOfWork
currentUnitOfWork abort.
    currentUnitOfWork := nil.! !
!Session methodsFor: 'internal/writing'!
createRowsFor: anObject in: rowMap
(self descriptorFor: anObject class) createRowsFor: anObject in: rowMap.! !
!Session methodsFor: 'internal/writing'!
shouldInsert: aDatabaseRow 
    ^(self cacheContainsObjectForRow: aDatabaseRow) not.! !
!Session methodsFor: 'internal/writing'!
sqlInsertStringFor: aDatabaseRow 
    | stream |
    stream := WriteStream on: (String new: 100).
    stream nextPutAll: 'INSERT INTO '.
    aDatabaseRow table printSQLOn: stream withParameters: #().
    stream nextPutAll: ' VALUES ('.
    aDatabaseRow printFieldValuesOn: stream.
    stream nextPutAll: ')'.
    ^stream contents! !
!Session methodsFor: 'internal/writing'!
sqlStringFor: aDatabaseRow 
    
    ^(self shouldInsert: aDatabaseRow)
    	ifTrue: [self  sqlInsertStringFor: aDatabaseRow]
    	ifFalse: [self sqlUpdateStringFor: aDatabaseRow].! !
!Session methodsFor: 'internal/writing'!
sqlUpdateStringFor: aDatabaseRow 
    | stream |
    stream := WriteStream on: (String new: 100).
    stream nextPutAll: 'UPDATE '.
    aDatabaseRow table printSQLOn: stream withParameters: #().
    stream nextPutAll: ' SET '.
    GlorpHelper 
    	print: [:eachField | aDatabaseRow equalityStringForField: eachField]
    	on: stream
    	for: aDatabaseRow fields
    	separatedBy: ', '.
    stream nextPutAll: ' WHERE '.
    aDatabaseRow printPrimaryKeyStringOn: stream.
    ^stream contents! !
!Session methodsFor: 'internal/writing'!
tablesInCommitOrder
^(TableSorter for: system allTables) sort.! !
!Session methodsFor: 'private'!
privateGetCache
^cache.! !
!Session methodsFor: 'private'!
privateGetCurrentUnitOfWork
^currentUnitOfWork.! !
!Session methodsFor: 'As yet unclassified'!
hasExpired: anObject 
    ^cache hasExpired: anObject.! !
!Session methodsFor: 'As yet unclassified'!
hasObjectExpiredOfClass: aClass withKey: key
    ^cache hasObjectExpiredOfClass: aClass withKey: key.! !
!Session class methodsFor: 'instance creation'!
forSystem: aSystem 
    ^self new system: aSystem! !
!Session class methodsFor: 'instance creation'!
new
^super new initialize.! !
!SessionResource methodsFor: 'accessing'!
newSession
self setUp.
    ^self session.! !
!SessionResource methodsFor: 'accessing'!
session
^session.! !
!SessionResource methodsFor: 'setup'!
setUp
| login |
    super setUp.
    login := DatabaseLoginResource current.
    GlorpDemoTablePopulatorResource current.
    session := Session new.
    session system: GlorpDemoDescriptorSystem new.
    session accessor: login accessor.! !
!SessionResource class methodsFor: 'resources'!
resources
^Array with: DatabaseLoginResource with: GlorpDemoTablePopulatorResource.! !
!SimpleQuery methodsFor: 'accessing'!
builders
^builders.! !
!SimpleQuery methodsFor: 'accessing'!
criteria: anExpression
    criteria := anExpression! !
!SimpleQuery methodsFor: 'accessing'!
elementBuilderFor: anExpression 
    ^builders detect: [:each | each expression == anExpression] ifNone: [nil].! !
!SimpleQuery methodsFor: 'accessing'!
fields
    ^fields! !
!SimpleQuery methodsFor: 'accessing'!
resultClass: aClass 
    resultClass := aClass.! !
!SimpleQuery methodsFor: 'accessing'!
traceNodes
    ^traceNodes! !
!SimpleQuery methodsFor: 'accessing'!
traceNodes: aCollection
    traceNodes := aCollection collect: [:each | self traceExpressionInContextFor: each].
    builders := traceNodes collect: [:each | ElementBuilder for: each in: self].! !
!SimpleQuery methodsFor: 'sql generation'!
printSelectFields: aCollection on: stream 
    GlorpHelper 
    	print: [:field | field qualifiedName]
    	on: stream
    	for: aCollection
    	separatedBy: ', '! !
!SimpleQuery methodsFor: 'sql generation'!
printSelectFieldsOn: stream 
    distinctFields isNil 
    	ifTrue: [self printSelectFields: fields on: stream]
    	ifFalse: 
    		[stream nextPutAll: 'DISTINCT '.
    		self printSelectFields: distinctFields on: stream.
    		distinctFields size = fields size ifFalse: [stream nextPutAll: ', '].
    		self 
    			printSelectFields: (fields copyFrom: distinctFields size + 1 to: fields size)
    			on: stream]! !
!SimpleQuery methodsFor: 'sql generation'!
sqlWith: aDictionary 
    | string stream |
    self prepare.
    stream := WriteStream on: (String new: 100).
    stream nextPutAll: 'SELECT '.
    self printSelectFieldsOn: stream.
    stream
    	cr;
    	nextPutAll: ' FROM '.
    self printTablesOn: stream.
    stream
    	cr;
    	nextPutAll: ' WHERE '.
    criteria printSQLOn: stream withParameters: aDictionary.
    string := stream contents.
    ^string! !
!SimpleQuery methodsFor: 'sql generation'!
tablesToPrint
    | allTables |
    allTables := (fields collect: [:each | each table]) asSet.
    allTables addAll: criteria allTablesToPrint.
    ^allTables.! !
!SimpleQuery methodsFor: 'fields'!
addDistinctField: aField
distinctFields isNil ifTrue: [distinctFields := OrderedCollection new].
    distinctFields add: aField.! !
!SimpleQuery methodsFor: 'fields'!
addFields: aliasedFields returningTranslationForFields: originalFields distinct: isDistinct 
    "The query has computed a set of fields the way the mappings see them, which are then transformed to account for field aliasing in embedded mappings. Add those to our collection, and set up the translation which knows which fields are at which index in the resulting row. If necessary, note that those fields are selected as distinct"
| translation |
    translation := IdentityDictionary new.
    aliasedFields with: originalFields
    	do: 
    		[:aliased :original | 
    		| position |
    		position := fields indexOf: aliased.
    		position = 0 
    			ifTrue: 
    				[fields add: aliased.
    				position := fields size.
    				isDistinct ifTrue: [self addDistinctField: aliased]].
    		translation at: original put: position].
    ^translation! !
!SimpleQuery methodsFor: 'executing'!
buildObjectsFrom: anArray 
    builders do: [:each | each findInstanceForRow: anArray useProxy: self returnProxies].
    builders do: [:each | each buildObjectFrom: anArray].
    ^builders first instance! !
!SimpleQuery methodsFor: 'executing'!
computeFields
    builders 
    	do: [:each | each hasFieldTranslations ifFalse: [self computeFieldsFor: each]]! !
!SimpleQuery methodsFor: 'executing'!
computeFieldsFor: anElementBuilder 
    | translatedFields |
    translatedFields := self 
    	addFields: anElementBuilder fieldsForSelectStatement
    	returningTranslationForFields: anElementBuilder fieldsFromMyPerspective
    	distinct: anElementBuilder requiresDistinct.
    anElementBuilder fieldTranslations: translatedFields.! !
!SimpleQuery methodsFor: 'executing'!
readFromDatabaseWithParameters: aDictionary 
    | rows objects |
    rows := session accessor executeSQLString: (self sqlWith: aDictionary).
    objects := rows collect: [:each | self buildObjectsFrom: each].
    objects do: [:each | session sendPostFetchEventTo: each].
    ^objects! !
!SimpleQuery methodsFor: 'preparing'!
assignTableAliases
    | tableNumber |
    criteria isPrimaryKeyExpression ifTrue: [^self].
    tableNumber := 1.
    criteria do: [:each |
    	tableNumber := each assignTableAliasesStartingAt: tableNumber].! !
!SimpleQuery methodsFor: 'preparing'!
prepare
    prepared ifTrue: [^self].
    self setUpCriteria. "In case it hasn't already been done"
    criteria := criteria prepareIn: self.
    self assignTableAliases.
    self computeFields.
    prepared := true.! !
!SimpleQuery methodsFor: 'preparing'!
traceExpressionInContextFor: anExpression 
    
    ^anExpression rebuildOn: criteria ultimateBaseExpression.! !
!SimpleQuery methodsFor: 'initialize'!
initResultClass: aClass criteria: theCriteria singleObject: aBoolean 
    super 
    	initResultClass: aClass
    	criteria: theCriteria
    	singleObject: aBoolean.
    prepared := false.
    fields := OrderedCollection new.! !
!SqueakDatabaseAccessor methodsFor: 'transactions' stamp: 'nop 5/29/2002 23:36'!
beginTransaction
    logging
    	ifTrue: [Transcript show: 'Begin Transaction';
    			 cr].
    isInTransaction _ true.
    connection execute: 'BEGIN TRANSACTION'! !
!SqueakDatabaseAccessor methodsFor: 'transactions' stamp: 'nop 5/29/2002 23:36'!
commitTransaction
    logging
    	ifTrue: [Transcript show: 'Commit Transaction';
    			 cr].
    isInTransaction := false.
    connection execute: 'COMMIT TRANSACTION'.! !
!SqueakDatabaseAccessor methodsFor: 'transactions' stamp: 'nop 5/29/2002 23:37'!
isInTransaction
    ^ isInTransaction! !
!SqueakDatabaseAccessor methodsFor: 'transactions' stamp: 'nop 5/29/2002 23:36'!
rollbackTransaction
    logging
    	ifTrue: [Transcript show: 'Rollback Transaction';
    			 cr].
    isInTransaction := false.
    connection execute: 'ROLLBACK TRANSACTION'! !
!SqueakDatabaseAccessor methodsFor: 'executing'!
disconnect
^connection disconnect! !
!SqueakDatabaseAccessor methodsFor: 'executing' stamp: 'nop 5/31/2002 18:16'!
executeSQLString: aString 
    | resultSet rowCollection |
    logging
    	ifTrue: [Transcript show: aString;
    			 cr].
    resultSet _ connection execute: aString.
    resultSet errorResponse notNil
    	ifTrue: [self externalDatabaseErrorSignal signal: resultSet errorResponse value].
    rowCollection _ OrderedCollection new.
    resultSet rows
    	do: [:ea | 
    		| columns data descr | 
    		columns _ OrderedCollection new.
    		data _ ea data.
    		descr _ ea description columnDescriptions.
    		1
    			to: data size
    			do: [:idx | (descr at: idx) isNumber
    					ifTrue: [|nbr |
    							nbr := data at: idx.
    							(nbr respondsTo: #asNumber) ifTrue: [nbr := nbr asNumber].
    							columns add: nbr]
    					ifFalse: [columns
    							add: (data at: idx)]].
    		rowCollection add: columns asArray].
    ^ rowCollection asArray! !
!SqueakDatabaseAccessor methodsFor: 'executing' stamp: 'nop 5/29/2002 15:50'!
externalDatabaseErrorSignal
    ^ Error! !
!SqueakDatabaseAccessor methodsFor: 'login' stamp: 'nop 5/29/2002 18:40'!
connectionArgs
    currentLogin isNil
    	ifTrue: [^ PGConnectionArgs
    	hostname: 'localhost'
    	portno: port
    	databaseName: 'squeakdb'
    	userName: 'bern'
    	password: 'bern'].
    ^ PGConnectionArgs
    	hostname: (currentLogin connectString copyUpTo: $_)
    	portno: port
    	databaseName: (currentLogin connectString copyAfter: $_)
    	userName: currentLogin username
    	password: currentLogin password! !
!SqueakDatabaseAccessor methodsFor: 'login' stamp: 'nop 5/29/2002 15:19'!
connectionClassForLogin: aLogin 
    aLogin database class == PostgreSQLPlatform
    	ifTrue: [^ Smalltalk at: #PGConnection].
    self error: 'Unknown database: ' , aLogin database! !
!SqueakDatabaseAccessor methodsFor: 'login'!
isLoggedIn
connection isNil ifTrue: [^false].
    ^connection isConnected! !
!SqueakDatabaseAccessor methodsFor: 'login' stamp: 'nop 5/29/2002 18:40'!
loginIfError: aBlock 
    logging
    	ifTrue: [Transcript show: 'Login';
    			 cr].
    connection _ self connectionClass new.
    self
    	doCommand: [connection startup: self connectionArgs]
    	ifError: aBlock.
    logging
    	ifTrue: [Transcript show: 'Login finished';
    			 cr]! !
!SqueakDatabaseAccessor methodsFor: 'login' stamp: 'nop 5/29/2002 17:11'!
logout
    self isLoggedIn
    	ifFalse: [^ self].
    logging
    	ifTrue: [Transcript show: 'Logout';
    			 cr].
    self
    	doCommand: [connection terminate].
    logging
    	ifTrue: [Transcript show: 'Logout finished';
    			 cr]! !
!SqueakDatabaseAccessor methodsFor: 'login' stamp: 'nop 5/29/2002 18:32'!
port: aPort 
    aPort isInteger ifTrue: [
    port _ aPort].
    ^port! !
!SqueakDatabaseAccessor methodsFor: 'login'!
showDialog: aString
(Smalltalk at: #Dialog) warn: aString.! !
!SqueakDatabaseAccessor methodsFor: 'initialize' stamp: 'nop 5/29/2002 23:35'!
initialize
    super initialize.
    logging _ true.
    port _ 5432.
    isInTransaction := false.! !
!String methodsFor: 'glorp'!
glorpPrintSQLOn: aStream
self printOn: aStream.! !
!Symbol methodsFor: 'glorp'!
asGlorpExpression
    "In theory we can have parameters that aren't field references, but have to be supplied when executing, and these can't be used in a join. These aren't used yet"
    ^ParameterExpression for: self.! !
!Symbol methodsFor: 'glorp' stamp: 'nop 5/31/2002 15:15'!
isSymbol
    ^true! !
!TableExpression methodsFor: 'accessing'!
base
^base.! !
!TableExpression methodsFor: 'accessing'!
printsTable
^true.! !
!TableExpression methodsFor: 'accessing'!
table
^table.! !
!TableExpression methodsFor: 'accessing'!
ultimateBaseExpression
    ^base ultimateBaseExpression.! !
!TableExpression methodsFor: 'preparing'!
aliasedTableFor: aDatabaseTable 
    ^self controlsTables 
    	ifTrue: [super aliasedTableFor: aDatabaseTable]
    	ifFalse: [base aliasedTableFor: aDatabaseTable]! !
!TableExpression methodsFor: 'preparing'!
asExpressionJoiningSource: source toTarget: target
    "Create a general expression which represents this relationship where the values of the targets (which are normally parameters) are supplied out of the context provided by 'target' and the source fields are referencing things out of the context of source. Produces something suitable for ANDing into an expression when doing a join
   Example: If we had CUSTOMER.ADDRESS_ID = ADDRESS.ID as a parameter, and we want to AND this into an expression [:customer | customer address street = 'Main'] then we have customer as a base, and we get 
    (customer.ADDRESS.STREET = 'Main') AND (customer.CUSTOMER.ADDRESS_ID = customer.ADDRESS.ID)
    The primary key expression for the relationship has been translated into field references into the customer and address tables in a particular context."
^target getTable: table.! !
!TableExpression methodsFor: 'preparing'!
controlsTables
    "We can end up with a table expression built on top of a base that has the same table. If so, we don't count as controlling that table"
base isNil ifTrue: [^true].
    base hasDescriptor ifFalse: [^true].
    ^(base descriptor tables includes: table) not.! !
!TableExpression methodsFor: 'preparing'!
tables
^Array with: table.! !
!TableExpression methodsFor: 'preparing'!
tablesToPrint
self controlsTables ifFalse: [^#()].
    ^Array with: (self aliasedTableFor: table).! !
!TableExpression methodsFor: 'iterating'!
do: aBlock skipping: aSet
    "Iterate over the expression tree"
(aSet includes: self) ifTrue: [^self].
    aSet add: self.
    base do: aBlock skipping: aSet.
    aBlock value: self.! !
!TableExpression methodsFor: 'printing'!
printOnlySelfOn: aStream
table printSQLOn: aStream withParameters: #().
    self printTableAliasesOn: aStream.! !
!TableExpression methodsFor: 'printing'!
printTreeOn: aStream 
    base printOn: aStream.
    aStream nextPut: $..
    table printSQLOn: aStream withParameters: #()! !
!TableExpression methodsFor: 'initialize/release'!
table: aDatabaseTable base: aBaseExpression
table := aDatabaseTable.
    base := aBaseExpression.! !
!TableExpression class methodsFor: 'instance creation'!
forTable: aDatabaseTable basedOn: aBaseExpression
^self new table: aDatabaseTable base: aBaseExpression; yourself! !
!TableSorter methodsFor: 'accessing'!
addTable: aTable 
    tables add: aTable! !
!TableSorter methodsFor: 'accessing'!
hasBeenVisited: aTable
^visitedTables includes: aTable.! !
!TableSorter methodsFor: 'accessing'!
markVisited: aTable
visitedTables add: aTable.! !
!TableSorter methodsFor: 'initializing'!
initialize
    tables := OrderedCollection new: 100.
    visitedTables := IdentitySet new: 100.! !
!TableSorter methodsFor: 'sorting'!
sort
    orderedTables := OrderedCollection new: tables size.
    tables do: [:each | self visit: each].
    ^orderedTables! !
!TableSorter methodsFor: 'sorting'!
visit: aTable 
    "The essential bit of topological sort. Visit each node in post-order, traversing dependencies, based on foreign key constraints to database-generated fields. "
(self hasBeenVisited: aTable) ifTrue: [^self].
    self markVisited: aTable.
    self visitDependentTablesFor: aTable.
    orderedTables add: aTable! !
!TableSorter methodsFor: 'sorting'!
visitDependentTablesFor: aTable 
    aTable foreignKeyConstraints do: [:eachConstraint | 
    	| fieldFromOtherTable |
    	fieldFromOtherTable := eachConstraint targetField.
    	fieldFromOtherTable isGenerated 
    		ifTrue: [self visit: fieldFromOtherTable table]]! !
!TableSorter class methodsFor: 'instance creation'!
for: tables
| sorter |
    sorter := self new.
    tables do: [:each |
    	sorter addTable: each].
    ^sorter.! !
!TableSorter class methodsFor: 'instance creation'!
new
^super new initialize.! !
!TestCase methodsFor: 'Accessing'!
unfinished
"indicates an unfinished test"! !
!BasicMappingTest methodsFor: 'tests'!
testGet
    
    self assert: (mapping getValueFrom: person) = 1! !
!BasicMappingTest methodsFor: 'tests'!
testSet
    
    mapping setValueIn: person to: 2.
    self assert: person id = 2.
    self assert: (mapping getValueFrom: person) = 2.! !
!BasicMappingTest methodsFor: 'support'!
setUp
super setUp.
    mapping := DirectMapping new.
    mapping attributeName: #id.
    person := Person example1.! !
!CacheTest methodsFor: 'support'!
setUp
| session |
    super setUp.
    session := Session forSystem: GlorpDemoDescriptorSystem new.
    cache := session privateGetCache.! !
!CacheTest methodsFor: 'tests'!
testDuplicates 
    | c1 c2 |
    c1 := Customer example1.
    c2 := Customer example1.
    cache at: 3 insert: c1.
    cache at: 3 insert: c2.
    self assert: (cache lookupClass: Customer key: 3) = c1.! !
!CacheTest methodsFor: 'tests'!
testDuplicatesDifferentClasses
| cust trans |
    cust := Customer example1.
    trans := BankTransaction example1.
    cache at: 3 insert: cust.
    cache at: 3 insert: trans.
    self assert: (cache lookupClass: Customer key: 3) = cust.
    self assert: (cache lookupClass: BankTransaction key: 3) = trans.! !
!CacheTest methodsFor: 'tests'!
testInsert
    | customer |
    customer := Customer example1.
    cache at: 3 insert: customer.
    self assert: (cache lookupClass: Customer key: 3) == customer! !
!CommitOrderTest methodsFor: 'tests'!
testCommitOrder
| sorter |
    sorter := TableSorter for: (Array with: (system tableNamed: 'BANK_TRANS') with: (system tableNamed: 'GR_CUSTOMER')).
    self assert: sorter sort first name = 'GR_CUSTOMER'.! !
!CommitOrderTest methodsFor: 'tests'!
testCommitOrder2
    "Test for a cycle between t1 and t2 with t3 also pointing to both. Order of t1, t2 is indeterminate, but t3 should be last"
| t2fk t3fk t3fk2 sorter t1fk |
    t1id useSequencingInMemory.
    t2id useSequencingInMemory.
t1fk := t1 newFieldNamed: 'T2_ID'.
    t1 addForeignKeyFrom: t1fk to: (t2id).
    t2fk := t2 newFieldNamed: 'T1_ID'.
    t2 addForeignKeyFrom: t2fk to: (t1id).
t3 := DatabaseTable new name: 'T3'.
    t3fk := t3 newFieldNamed: 'T2_ID'.
    t3 addForeignKeyFrom: t3fk to: (t2id).
    t3fk2 := t3 newFieldNamed: 'T1_ID'.
    t3 addForeignKeyFrom: t3fk2 to: (t1id).
sorter := TableSorter for: (Array with: t3 with: t2 with: t1).
    self assert: sorter sort last name = 'T3'.! !
!CommitOrderTest methodsFor: 'tests'!
testCommitOrderNonSequencedFieldsDontCount
"Test for a cycle between t1 and t2 with t3 also pointing to both, but with nothing sequenced. Order should be completely indeterminate. We rely on the topological sort being predictable and depending on the insert order so that if we feed objects with no dependencies in in different orders we should get different results."
| t1fk t2fk t3fk t3fk2 sorter sorter2 |
    t1fk := t1 newFieldNamed: 'T2_ID'.
    t1 addForeignKeyFrom: t1fk to: (t2id).
    t2fk := t2 newFieldNamed: 'T1_ID'.
    t2 addForeignKeyFrom: t2fk to: (t1id).
t3 := DatabaseTable new name: 'T3'.
    t3fk := t3 newFieldNamed: 'T2_ID'.
    t3 addForeignKeyFrom: t3fk to: (t2id).
    t3fk2 := t3 newFieldNamed: 'T1_ID'.
    t3 addForeignKeyFrom: t3fk2 to: (t1id).
sorter := TableSorter for: (Array with: t3 with: t2 with: t1).
    sorter2 := TableSorter for: (Array with: t1 with: t2 with: t3).
    self assert: sorter sort first ~= sorter2 sort first.! !
!CommitOrderTest methodsFor: 'support'!
setUp
super setUp.
    system := GlorpDemoDescriptorSystem new.
    t1 := DatabaseTable new name: 'T1'.
    t1id := (t1 newFieldNamed: 'ID') bePrimaryKey.
    t2 := DatabaseTable new name: 'T2'.
    t2id := (t2 newFieldNamed: 'ID') bePrimaryKey.
t3 := DatabaseTable new name: 'T3'.
    t3id := (t3 newFieldNamed: 'ID') bePrimaryKey.! !
!ConstantMappingTest methodsFor: 'support'!
setUp
    super setUp.
    mappingToClass := ConstantMapping new
    	attributeName: #slot;
    	constantValue: 34.
    mappingToRow := ConstantMapping new.
    mappingToSession := ConstantMapping new! !
!ConstantMappingTest methodsFor: 'tests'!
testConstantInClass
slot := nil.
    mappingToClass mapFromRow: nil intoObject: self inElementBuilder: nil.
    self assert: slot = 34.! !
!ConstantMappingTest methodsFor: 'tests'!
testConstantInClassDoesNotWriteToRow
"Would raise an exception if it tried to write into nil"
    mappingToClass mapFromObject: self intoRowsIn: nil.! !
!ConstantMappingTest methodsFor: 'tests'!
testGetValue
slot := nil.
    self assert: (mappingToClass getValueFrom: self) = 34.! !
!ConstantMappingTest methodsFor: 'tests'!
testSessionValue
    mappingToClass constantValueIsSession.
    self assert: (mappingToClass constantValueIn: 38)== 38.! !
!DatabaseBasicTest methodsFor: 'accessing'!
accessor
    ^self databaseLoginResource accessor! !
!DatabaseBasicTest methodsFor: 'support'!
databaseLoginResource
    ^DatabaseLoginResource current.! !
!DatabaseBasicTest methodsFor: 'support'!
setUp
super setUp.
    system := GlorpDemoDescriptorSystem new.! !
!DatabaseBasicTest methodsFor: 'tests'!
testBeginTransactionWithCommit
    self assert: self accessor isInTransaction not.
    self accessor beginTransaction.
    self assert: self accessor isInTransaction.
    self accessor commitTransaction.
    self assert: self accessor isInTransaction not! !
!DatabaseBasicTest methodsFor: 'tests'!
testBeginTransactionWithRollback
    self assert: self accessor isInTransaction not.
    self accessor beginTransaction.
    self assert: self accessor isInTransaction.
    self accessor rollbackTransaction.
    self assert: self accessor isInTransaction not! !
!DatabaseBasicTest methodsFor: 'tests'!
testCreateTable
    | selectResult |
    
    [self accessor 
    	executeSQLString: 'CREATE TABLE GLORP_TEST_CREATE (ID varchar(4))'.
    selectResult := self accessor 
    			executeSQLString: 'SELECT * FROM GLORP_TEST_CREATE'.
    self assert: selectResult isEmpty] 
    		ensure: 
    			[self accessor dropTableNamed: 'GLORP_TEST_CREATE'
    				ifAbsent: [:ex | self assert: false]]! !
!DatabaseBasicTest methodsFor: 'tests'!
testDropMissingTable
    | absentFlag |
    absentFlag := false.
    self accessor 
    	dropTableNamed: 'GLORP_TEST_DROP' 
    	ifAbsent: [:ex  | absentFlag := true. ex sunitExitWith: nil].
    self assert: absentFlag! !
!DatabaseBasicTest methodsFor: 'tests'!
testReadEmpty
    | results |
    results := self accessor
    			executeSQLString: 'SELECT * FROM PERSON'.
    self assert: results size = 0! !
!DatabaseBasicTest methodsFor: 'tests'!
testReadStatement
    | results |
    results := self accessor
    			executeSQLString: 'SELECT * FROM STUFF ORDER BY ID'.
    self assert: results size = 5.
    self assert: results first size = 2.
    self assert: results first last =  'abc'! !
!DatabaseBasicTest class methodsFor: 'resources'!
resources
    ^Array with: DatabaseLoginResource with: GlorpDemoTablePopulatorResource.! !
!DatabaseFieldTest methodsFor: 'support'!
setUp
| table |
    super setUp.
    table := DatabaseTable new name: 'T'.
    field := (table newFieldNamed: 'TEST') beNumeric.
    negatedField := TransformedField new 
    	parent: field; 
    	transformation: [:each | each * -1];
    	stringTransformation: [:each | (each , ' * -1')].! !
!DatabaseFieldTest methodsFor: 'tests'!
testInvert
    | newField |
    newField := field inverted.
    self assert: newField class == TransformedField.
    self assert: newField parent == field! !
!DatabaseFieldTest methodsFor: 'tests'!
testPrint
| stream |
    stream := String new writeStream.
    negatedField printSQLOn: stream withParameters: #().
    self assert: stream contents = 'T.TEST * -1'.! !
!DatabaseFieldTest methodsFor: 'tests'!
testTransformation
self assert: (field convertToDatabaseForm: 'abc') = 'abc'.
    self assert: (field convertToDatabaseForm: #abc) = 'abc'.
    self assert: (field convertToDatabaseForm: -3) = -3.
    self assert: (negatedField convertToDatabaseForm: -3) = 3.! !
!DatabaseLoginTest methodsFor: 'accessing'!
accessor
^accessor.! !
!DatabaseLoginTest methodsFor: 'support'!
setUp
    super setUp.
    login := DatabaseLoginResource defaultLogin.
    accessor := DatabaseAccessor forLogin: login.! !
!DatabaseLoginTest methodsFor: 'tests'!
testLogin
    self assert: self accessor isLoggedIn not.
    self accessor login.
    self assert: self accessor isLoggedIn.
    self accessor logout.
    self assert: self accessor isLoggedIn not! !
!DatabaseLoginTest methodsFor: 'tests'!
testUnsuccessfulLogin
| anotherAccessor invalidLogin |
    invalidLogin := DatabaseLoginResource defaultLogin copy.
    invalidLogin
    	password: 'you will never ever guess this password';
    	username: 'not a valid user name'.
    anotherAccessor := DatabaseAccessor forLogin: invalidLogin.
self assert: anotherAccessor isLoggedIn not.
    anotherAccessor loginIfError: [:ex | ].
    Dialect isVisualAge ifFalse: [ "The isLoggedIn is unreliable under VA, can return false positive"
    	self assert: anotherAccessor isLoggedIn not].
    anotherAccessor logout.! !
!DatabaseLoginTest class methodsFor: 'resources'!
resources
^Array with: DatabaseLoginResource.! !
!DatabaseSessionTest methodsFor: 'support'!
setUp
super setUp.
    session := SessionResource current newSession.! !
!DatabaseSessionTest methodsFor: 'tests'!
testWriteRow
    | rowToWrite fields rowReadFromDatabase |
    rowToWrite := session system examplePersonRow2.
    
    [session beginTransaction.
    session writeRow: rowToWrite.
    rowReadFromDatabase := (session accessor
    			executeSQLString: 'SELECT * FROM ' , rowToWrite table name) first.
    fields := rowToWrite table fields.
    (1 to: fields size) with: fields
    	do: [:index :field | self assert: (rowReadFromDatabase atIndex: index) = (rowToWrite at: field)]] 
    		ensure: [session rollbackTransaction]! !
!DatabaseSessionTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!DeleteQueryTest methodsFor: 'support'!
setUp
session := SessionResource current newSession.! !
!DeleteQueryTest methodsFor: 'support'!
tearDown
session := nil.! !
!DeleteQueryTest methodsFor: 'tests'!
testExecute
    | customer query result |	
    [session beginTransaction.
    session accessor executeSQLString: 'INSERT INTO GR_CUSTOMER VALUES (1,''Fred Flintstone'')'.
    customer := session execute: (ReadQuery returningOneOf: Customer where: [:each | each id = 1]).
    self assert: (session cacheLookupForClass: Customer key: 1) == customer.
    query := DeleteQuery for: customer.
    session execute: query.
    result := session accessor executeSQLString: 'SELECT * FROM GR_CUSTOMER WHERE ID=1'.
    self assert: result isEmpty.
    self assert: (session cacheLookupForClass: Customer key: 1) isNil]
    	ensure: [session rollbackTransaction]! !
!DeleteQueryTest methodsFor: 'tests'!
testSQL
    | customer query sql |
    customer := Customer new.
    customer id: 12.
    query := DeleteQuery for: customer.
    query session: session.
    query prepare.
    sql := query sqlWith: Dictionary new.
    self assert: sql asLowercase = 'delete from gr_customer where gr_customer.id = 12'.! !
!DescriptorTest methodsFor: 'support'!
setUp
system := GlorpDemoDescriptorSystem new.! !
!DescriptorTest methodsFor: 'tests'!
errorSignal
Dialect isVisualAge ifTrue: [^(Smalltalk at: #SystemExceptions) at: 'ExAll'].
    ^Error.! !
!DescriptorTest methodsFor: 'tests'!
testAllMappingsForField
    | descriptor mappings |
    descriptor := system descriptorFor: Customer.
    mappings := descriptor 
    			allMappingsForField: ((system tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID').
    self assert: mappings first attributeName = #id! !
!DescriptorTest methodsFor: 'tests'!
testMappedFields
| descriptor |
    descriptor := system descriptorFor: BankTransaction.
    self assert: (descriptor mappedFields) = (descriptor table fields).
    self assert: (descriptor fieldsForSelectStatement) = (descriptor table fields copyFrom: 1 to: 2).! !
!DescriptorTest methodsFor: 'tests'!
testMappingForField
    | descriptor mapping |
    descriptor := system descriptorFor: Customer.
    mapping := descriptor 
    			directMappingForField: ((system tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID').
    self assert: mapping attributeName = #id! !
!DescriptorTest methodsFor: 'tests'!
testPrimaryKeyExpressionFor
| descriptor trans exp |
    descriptor := system descriptorFor: BankTransaction.
    trans := BankTransaction new.
    trans id: 42.
    exp := descriptor primaryKeyExpressionFor: trans.
    self assert: exp relation = #=.
    self assert: exp rightChild value = 42.! !
!DescriptorTest methodsFor: 'tests'!
testPrimaryKeyExpressionForFailing
| descriptor trans |
    descriptor := system descriptorFor: BankTransaction.
    trans := Customer new.
    self should: [descriptor primaryKeyExpressionFor: trans] raise: self errorSignal.! !
!DescriptorTest methodsFor: 'tests'!
testPrimaryKeyExpressionForWithCompositeKey
self unfinished.! !
!DictionaryMappingTest methodsFor: 'support'!
setUp
system := GlorpEncyclopediaDescriptorSystem new.! !
!DictionaryMappingTest methodsFor: 'tests'!
testCasesToWrite
"How des a dictionary mapping relate to 1:many vs many:many.
    dictionary of strings to strings
    dictionary of strings to objects
    dictionary of objects to objects
    keys always have to be related to values somehow, because I can't extract the association otherwise. Both might also be associated to source.
    You should be able to use the topological sort to determine the create/delete order of tables as well"! !
!DictionaryMappingTest methodsFor: 'tests'!
testStringToObject
| encyclopedia rowMap entryTable entries |
    encyclopedia := Encyclopedia example1.
    entries := encyclopedia entries asOrderedCollection.
    entryTable := system tableNamed: 'ENCYCENTRY'.
    rowMap := RowMap new.
"	(system descriptorFor: Encyclopedia) createRowsFor: encyclopedia in: rowMap.
self assert: (rowMap includesRowForTable: entryTable withKey: entries first).
    self assert: rowMap size = 3."
"So what happens here. We need to know how the rows for the associations get created. Do we treat the associations as objects (risking loss of identity issues in some dictionary implementations), create composite keys similar to many-many, or what?"! !
!DirectMappingTest methodsFor: 'support'!
setUp
system := GlorpDemoDescriptorSystem new.
    mapping := DirectMapping from: #id to: ((system tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID')! !
!DirectMappingTest methodsFor: 'tests'!
testExpressionFor
    | cust exp |
    cust := Customer new.
    cust id: 12.
    exp := mapping expressionFor: cust.
    self assert: exp rightChild class == ConstantExpression.
    self assert: exp rightChild value = 12.
    self assert: exp relation = #=.
    self assert: exp leftChild class == FieldExpression.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForBase
| exp |
    self assert: base hasDescriptor.
    exp := [:a | a ] asGlorpExpressionOn: base.
    self assert: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForDirect
| exp |
    exp := [:a | a id ] asGlorpExpressionOn: base.
    self deny: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForOneToMany
| exp |
    exp := [:a | a emailAddresses ] asGlorpExpressionOn: base.
    self assert: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForOneToOne
| exp |
    exp := [:a | a address ] asGlorpExpressionOn: base.
    self assert: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForPrimaryKeyExpression
| exp |
    exp := PrimaryKeyExpression new.
    self deny: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForRelation
| exp |
    exp := [:a | a = 3] asGlorpExpressionOn: base.
    self deny: exp hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForTwoLevelDirect
| exp |
    exp := [:a | a address street] asGlorpExpressionOn: base.
    self deny: exp hasDescriptor.
    self assert: exp base hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'tests'!
testHasDescriptorForUninitializedBase
self deny: BaseExpression new hasDescriptor.! !
!ExpressionBasicPropertiesTest methodsFor: 'support'!
setUp
base := BaseExpression new descriptor: (GlorpDemoDescriptorSystem new descriptorFor: Person).! !
!ExpressionIterationTest methodsFor: 'tests'!
helpTestSingleNodeDo: exp 
    self assert: (exp collect: [:each | each]) = (OrderedCollection with: exp)! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoBase
    self helpTestSingleNodeDo:BaseExpression new! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoCollection
| exp l r |
    exp := CollectionExpression new.
    l := BaseExpression new.
    r := BaseExpression new.
    exp leftChild: l; rightChild: r.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: l with: r with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoConstant
    self helpTestSingleNodeDo: ConstantExpression new! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoField
| exp |
    exp := FieldExpression new.
    exp field: nil base: BaseExpression new.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: exp base with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoMapping
| exp |
    exp := MappingExpression new.
    exp named: 'foo' basedOn: BaseExpression new.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: exp base with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoParameter
| exp |
    exp := ParameterExpression new.
    exp field: nil base: BaseExpression new.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: exp base with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoRelation
| exp l r |
    exp := RelationExpression new.
    l := BaseExpression new.
    r := BaseExpression new.
    exp leftChild: l; rightChild: r.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: l with: r with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoTable
| exp |
    exp := TableExpression new.
    exp table: nil base: BaseExpression new.
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: exp base with: exp)).! !
!ExpressionIterationTest methodsFor: 'tests'!
testDoWithCommonBase
| exp l r base |
    exp := RelationExpression new.
    base := BaseExpression new.
    l := MappingExpression new.
    l named: nil basedOn: base.
    r := MappingExpression new.
    r named: nil basedOn: base.
    exp leftChild: l; rightChild: r.	
    self assert: ((exp collect: [:each | each]) = (OrderedCollection with: base with: l with: r with: exp)).! !
!ExpressionJoiningTest methodsFor: 'tests'!
join: exp 
    ^exp asExpressionJoiningSource: source toTarget: target! !
!ExpressionJoiningTest methodsFor: 'tests'!
resultOfJoiningFieldFor: aTable toExpressionBuiltOn: anotherTable
    | exp table |
    base descriptor: (system descriptorFor: Customer).
    exp := FieldExpression forField: (aTable fieldNamed: 'ID')
    			basedOn: BaseExpression new.
    table := base getTable: anotherTable.
^exp asExpressionJoiningSource: base toTarget: table.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testBase
    | result |
    result := self join: base. 
    self assert: result == source.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testConstant
    | exp |
    exp := ConstantExpression for: 42.
    self assert: (self join: exp) == exp! !
!ExpressionJoiningTest methodsFor: 'tests'!
testField
    | exp  result |
    exp := FieldExpression forField: (DatabaseField named: 'test')
    			basedOn: base.
    result := self join: exp.
    self assert: result base == source.
    self assert: result field == exp field! !
!ExpressionJoiningTest methodsFor: 'tests'!
testFieldBuiltOnDifferentTable
    | result custTable |
    custTable := system tableNamed: 'GR_CUSTOMER'.
    result := self 
    	resultOfJoiningFieldFor: custTable
    	toExpressionBuiltOn: custTable.
    self assert: result base == (base getTable: custTable).
    self assert: result field == ((system tableNamed: 'GR_CUSTOMER') fieldNamed: 'ID').! !
!ExpressionJoiningTest methodsFor: 'tests'!
testFieldBuiltOnSameTable
    | exp result base2 table custTable |
    system := GlorpDemoDescriptorSystem new.
    custTable := system tableNamed: 'GR_CUSTOMER'.
    base2 := BaseExpression new.
    base2 descriptor: (system descriptorFor: Customer).
    table := base2 getTable: custTable.
    exp := FieldExpression forField: (custTable fieldNamed: 'ID')
    			basedOn: base.
    result := exp asExpressionJoiningSource: base2 toTarget: table.
    self assert: result base == table.
    self assert: result field == exp field.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testMapping
    | result exp |
    exp := base get: #foo.
    result := self join: exp. 
    self assert: result base == source.
    self assert: result name = #foo.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testParameter
    | result exp table field |
    table := DatabaseTable named: 'T'.	
    field := DatabaseField named: 'F'.
    table addField: field.
    exp := base getParameter: field.
    result := self join: exp.
    self assert: result base == source.
    self assert: result class == FieldExpression.
    self assert: result field == field.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testRelation
    | result exp |
    exp := [:a | a foo = 3] asGlorpExpressionOn: base.
    result := self join: exp.
self assert: result class == RelationExpression.
    self assert: result rightChild == exp rightChild.
    self assert: result leftChild base == source.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testRelation2
    | result exp field | 
    field := DatabaseField named: 'fred'.
    exp := [:a | a foo = field] asGlorpExpressionOn: base.
    result := self join: exp. 
    self assert: result class == RelationExpression.
    self assert: result rightChild class == FieldExpression.
    self assert: result rightChild field == field.
    self assert: result leftChild base == source.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testSelfJoinWithPrimaryKeyExpression
| pkExpression |
    pkExpression := PrimaryKeyExpression 
    	from: (system tableNamed: 'GR_CUSTOMER')
    	to: (system tableNamed: 'GR_CUSTOMER').
    self unfinished.! !
!ExpressionJoiningTest methodsFor: 'tests'!
testTable
    | result exp table |
    table := DatabaseTable named: 'T'.
    exp := base getTable: table.
    result := self join: exp. 
    self assert: result base == target.
    self assert: result table == table.! !
!ExpressionJoiningTest methodsFor: 'support'!
setUp
source := BaseExpression new.
    target := source get: #relation.
    base := BaseExpression new.
    system := GlorpDemoDescriptorSystem new.! !
!ExpressionJoiningTest methodsFor: 'support'!
tearDown
source := nil.
    target := nil.
    base := nil.
    system := nil.! !
!ExpressionTableAliasingTest methodsFor: 'tests'!
helpTestBasicAliasing: aTable 
    self deny: exp hasTableAliases.
    exp assignTableAliasesStartingAt: 1.
    self assert: exp hasTableAliases.
    self assert: exp tableAliases size = 1.
    self 
    	assert: (exp tableAliases at: aTable) name 
    			= 't1'! !
!ExpressionTableAliasingTest methodsFor: 'tests'!
testBase
    exp := BaseExpression new.
    exp descriptor: (system descriptorFor: Customer).
    self helpTestBasicAliasing: (system tableNamed: 'GR_CUSTOMER').! !
!ExpressionTableAliasingTest methodsFor: 'tests'!
testMapping
    | base |
    base := BaseExpression new.
    base descriptor: (system descriptorFor: Customer).
    exp := base get: 'transactions'.
    self helpTestBasicAliasing: (system tableNamed: 'BANK_TRANS').! !
!ExpressionTableAliasingTest methodsFor: 'tests'!
testTable
    | base transTable |
    base := BaseExpression new.
    base descriptor: (system descriptorFor: Customer).
    transTable := system tableNamed: 'BANK_TRANS'.
    exp := base getTable: transTable.
    self helpTestBasicAliasing: transTable! !
!ExpressionTableAliasingTest methodsFor: 'tests'!
testTableSameAsBase
    | base custTable |
    base := BaseExpression new.
    base descriptor: (system descriptorFor: Customer).
    custTable := system tableNamed: 'GR_CUSTOMER'.
    exp := base getTable: custTable.
    self deny: exp hasTableAliases.
    exp assignTableAliasesStartingAt: 1.
    base assignTableAliasesStartingAt: 42.
    self deny: exp hasTableAliases.
    self assert: (exp aliasedTableFor: custTable) name = 't42'! !
!ExpressionTableAliasingTest methodsFor: 'support'!
setUp
system := GlorpDemoDescriptorSystem new.! !
!ExpressionTest methodsFor: 'support'!
assertIdentityOf: aBlock and: anotherBlock
    
    | base |
    base := BaseExpression new.
    self assert: (aBlock asGlorpExpressionOn: base) == (anotherBlock asGlorpExpressionOn: base)! !
!ExpressionTest methodsFor: 'support'!
denyIdentityOf: aBlock and: anotherBlock
| base |
    base := BaseExpression new.
    self deny: (aBlock asGlorpExpressionOn: base) == (anotherBlock asGlorpExpressionOn: base)! !
!ExpressionTest methodsFor: 'tests'!
testAndOperation
    | expression fred base |
    fred := 'Fred'.
    base := BaseExpression new.
    expression := [:a | (a firstName = fred) & (a firstName ~= fred)] asGlorpExpressionOn: base.
    self assert: expression class == RelationExpression.
    self assert: expression relation = #AND.! !
!ExpressionTest methodsFor: 'tests'!
testAndOperation2
    | expression fred base |
    fred := 'Fred'.
    base := BaseExpression new.
    expression := [:a | (a firstName = fred) exAnd: (a firstName ~= fred)] asGlorpExpressionOn: base.
    self assert: expression class == RelationExpression.
    self assert: expression relation = #AND.! !
!ExpressionTest methodsFor: 'tests'!
testAnySatisfy
| expression |
    expression := [:a | a items anySatisfy: [:each | each id = 7]] asGlorpExpression.
    self assert: expression class == CollectionExpression.
    self assert: expression leftChild == expression rightChild leftChild base.! !
!ExpressionTest methodsFor: 'tests'!
testAnySatisfyPrint
| expression system stream |
    system :=  GlorpDemoDescriptorSystem new.
    expression := [:cust | cust transactions anySatisfy: [:each | each id = 7]]
    	asGlorpExpressionForDescriptor: (system descriptorFor: Customer).
    stream := WriteStream on: (String new: 100).
    expression printSQLOn: stream withParameters: Dictionary new.
    self assert: stream contents = 'BANK_TRANS.ID = 7'.! !
!ExpressionTest methodsFor: 'tests'!
testBetweenAnd
    | expression base |
    base := BaseExpression new.
    expression := [:a | a between: 3 and: 4] asGlorpExpressionOn: base.
    self assert: expression class == RelationExpression.
    self assert: expression relation = #AND.
    self assert: expression leftChild relation == #>.
    self assert: expression leftChild rightChild value == 3.
    self assert: expression rightChild relation == #<.
    self assert: expression rightChild rightChild value == 4.! !
!ExpressionTest methodsFor: 'tests'!
testEqualityOperation
    | expression fred base |
    fred := 'Fred'.
    base := BaseExpression new.
    expression := [:a | a firstName = fred] asGlorpExpressionOn: base.
    self assert: expression leftChild == (base get: #firstName).
    self assert: expression rightChild class == ConstantExpression.
    self assert: expression rightChild value == fred.
    self assert: expression relation == #=! !
!ExpressionTest methodsFor: 'tests'!
testFindingMapping
| base baseDescriptor system|
    system := GlorpDemoDescriptorSystem new.
    baseDescriptor := system descriptorFor: BankTransaction.
    base := BaseExpression new descriptor: baseDescriptor.
    self assert: (base get: #serviceCharge) mapping == (baseDescriptor mappingForAttributeNamed: #serviceCharge).
    self assert: (base get: #serviceCharge) sourceDescriptor == (system descriptorFor: BankTransaction).
    self assert: (base get: #serviceCharge) descriptor == (system descriptorFor: ServiceCharge).! !
!ExpressionTest methodsFor: 'tests'!
testIsNullPrint
| expression system stream |
    system :=  GlorpDemoDescriptorSystem new.
    expression := [:cust | cust id = nil]
    	asGlorpExpressionForDescriptor: (system descriptorFor: Customer).
    stream := WriteStream on: (String new: 100).
    expression printSQLOn: stream withParameters: Dictionary new.
    self assert: stream contents = 'GR_CUSTOMER.ID IS NULL'.! !
!ExpressionTest methodsFor: 'tests'!
testJoinOperation
    | userExpression base expression addressTable personTable system query field1 field2 |
    system := GlorpDemoDescriptorSystem new.
    addressTable := system tableNamed: 'GR_ADDRESS'.
    personTable := system tableNamed: 'PERSON'.
    base := BaseExpression new.
    base descriptor: (system descriptorFor: Person).
    userExpression := [:aPerson | aPerson address number = 12] 
    			asGlorpExpressionOn: base.
    query := SimpleQuery returningOneOf: Person where: userExpression.
    query traceNodes: #().
    query session: (Session new system: system).
    self assert: (userExpression additionalExpressionsIn: query) size = 1.
    query prepare.
    expression := query criteria.
    self
    	assert: expression ultimateBaseExpression == base;
    	assert: expression relation == #AND;
    	assert: expression leftChild == userExpression;
    	assert: expression rightChild relation == #=.
    field1 :=  expression rightChild leftChild field.
    self assert: field1 table parent == personTable.
    self assert: field1 name = 'ADDRESS_ID'.
    field2 := expression rightChild rightChild field.
    self assert: field2 table parent == addressTable.
    self assert: field2 name = 'ID'.! !
!ExpressionTest methodsFor: 'tests'!
testMappingBase
| base |
    base := BaseExpression new.
    self assert: (base get: #someAttribute) base == base! !
!ExpressionTest methodsFor: 'tests'!
testMappingExpressionIdentity
self assertIdentityOf: [:a | a someAttribute] and: [:a | a someAttribute].! !
!ExpressionTest methodsFor: 'tests'!
testMappingExpressionIdentity2
self assertIdentityOf: [:a | a perform: #someAttribute] and: [:a | a someAttribute].! !
!ExpressionTest methodsFor: 'tests'!
testMappingExpressionIdentity3
self assertIdentityOf: [:a | a get: #someAttribute] and: [:a | a someAttribute].! !
!ExpressionTest methodsFor: 'tests'!
testMappingExpressionIdentity4
self denyIdentityOf: [:a | a get: #someAttribute] and: [:a | a someOtherAttribute].! !
!ExpressionTest methodsFor: 'tests'!
testNotNullPrint
| expression system stream |
    system :=  GlorpDemoDescriptorSystem new.
    expression := [:cust | cust id ~= nil]
    	asGlorpExpressionForDescriptor: (system descriptorFor: Customer).
    stream := WriteStream on: (String new: 100).
    expression printSQLOn: stream withParameters: Dictionary new.
    self assert: stream contents = 'GR_CUSTOMER.ID IS NOT NULL'.! !
!ExpressionTest methodsFor: 'tests'!
testOrOperation
    | expression fred base |
    fred := 'Fred'.
    base := BaseExpression new.
    expression := [:a | (a firstName = fred) | (a firstName ~= fred)] asGlorpExpressionOn: base.
    self assert: expression class == RelationExpression.
    self assert: expression relation = #OR.! !
!ExpressionTest methodsFor: 'tests'!
testOrOperation2
    | expression fred base |
    fred := 'Fred'.
    base := BaseExpression new.
    expression := [:a | (a firstName = fred) exOr: (a firstName ~= fred)] asGlorpExpressionOn: base.
    self assert: expression class == RelationExpression.
    self assert: expression relation = #OR.! !
!ExpressionTest methodsFor: 'tests'!
testTwoLevelMappingExpressionIdentity
self assertIdentityOf: [:a | a someAttribute someAttribute] and: [:a | a someAttribute someAttribute].
    self denyIdentityOf: [:a | a someAttribute someAttribute] and: [:a | a someAttribute].! !
!InsertUpdateTest methodsFor: 'support'!
rowFor: anObject
| rowMap rows |
    rowMap := RowMap new.
    session createRowsFor: anObject in: rowMap.
    rows := rowMap rowsForKey: anObject.
    self assert: rows size = 1.
    ^rows first.! !
!InsertUpdateTest methodsFor: 'support'!
setUp
    super setUp.
    session := SessionResource current newSession.! !
!InsertUpdateTest methodsFor: 'tests'!
testFunctionalInsertUpdateForInsert
| testObject |
    [session beginTransaction.
    session beginUnitOfWork.
    testObject := Customer example1.
    testObject id: 876.
    session register: testObject.
    session commitUnitOfWork.
    self assert: (testObject seenPreWrite = true).
    self assert: (testObject seenPostWrite = true).
session beginUnitOfWork.
    session register: testObject.
    testObject name: 'Change of name'.
    session commitUnitOfWork]
    	ensure: [session rollbackTransaction]! !
!InsertUpdateTest methodsFor: 'tests'!
testRowOwnership
| aCustomer rowMap |
    aCustomer := Customer new.
    rowMap := RowMap new.
    (session descriptorFor: Customer) createRowsFor: aCustomer in: rowMap.
    rowMap rowsDo: [:each | 
    	self assert: each owner = aCustomer].! !
!InsertUpdateTest methodsFor: 'tests'!
testShouldInsertForInsert
| testObject row |
    testObject := Customer example1.
    testObject id: 876.
    row :=self rowFor: testObject.
    self assert: (session shouldInsert: row).! !
!InsertUpdateTest methodsFor: 'tests'!
testShouldInsertForUpdate
| testObject row |
    session beginUnitOfWork.
    testObject := Customer example1.
    testObject id: 876.
    session cacheAt: 876 put: testObject.
    row :=self rowFor: testObject.
    self deny: (session shouldInsert: row).! !
!InsertUpdateTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!MappingTest methodsFor: 'tests'!
helperForMergedOneToOneReversingWriteOrder: aBoolean 
    | account accountTable row |
    account := GlorpBankExampleSystem new objectNumber: 1 ofClass: BankAccount.
    accountTable := system tableNamed: 'BANK_ACCT'.
    aBoolean 
    	ifTrue: 
    		[self write: account.
    		self write: account accountNumber]
    	ifFalse: 
    		[self write: account accountNumber.
    		self write: account].
    self assert: (rowMap includesRowForTable: accountTable withKey: account).
    self assert: (rowMap includesRowForTable: accountTable
    			withKey: account accountNumber).
    row := self rowFor: account.
    self assert: (row at: (accountTable fieldNamed: 'ID')) = account id.
    (Array with: row with: (self rowFor: account accountNumber)) do: 
    		[:each | 
    		self assert: (each at: (accountTable fieldNamed: 'BANK_CODE')) 
    					= account accountNumber bankCode.
    		self assert: (each at: (accountTable fieldNamed: 'BRANCH_NO')) 
    					= account accountNumber branchNumber.
    		self assert: (each at: (accountTable fieldNamed: 'ACCT_NO')) 
    					= account accountNumber accountNumber].
    self assert: (rowMap numberOfEntriesForTable: accountTable) = 2! !
!MappingTest methodsFor: 'tests'!
helperForNestedMergedOneToOneReversingWriteOrder: aBoolean 
    | trans transTable moneyTable row fieldNames fieldValues |
    trans := GlorpBankExampleSystem new objectNumber: 1
    			ofClass: BankTransaction.
    transTable := system tableNamed: 'BANK_TRANS'.
    moneyTable := system tableNamed: 'MONEY_IMAGINARY_TABLE'.
    aBoolean 
    	ifTrue: 
    		[self write: trans.
    		self write: trans amount.
    		self write: trans serviceCharge.
    		self write: trans serviceCharge amount]
    	ifFalse: 
    		[self write: trans serviceCharge amount.
    		self write: trans serviceCharge.
    		self write: trans amount.
    		self write: trans].
    self 
    	assert: (rowMap rowForTable: transTable withKey: trans) shouldBeWritten.
    self 
    	assert: (rowMap rowForTable: transTable withKey: trans serviceCharge) 
    			shouldBeWritten not.
    self 
    	assert: (rowMap rowForTable: moneyTable withKey: trans amount) 
    			shouldBeWritten not.
    self 
    	assert: (rowMap rowForTable: moneyTable withKey: trans serviceCharge amount) 
    			shouldBeWritten not.
    row := self rowFor: trans.
    self assert: (row at: (transTable fieldNamed: 'ID')) = trans id.
    fieldNames := #('AMT_CURR' 'AMT_AMT' 'SRVC_DESC' 'SRVC_AMT_CURR' 'SRVC_AMT_AMT').
    fieldValues := (Array 
    			with: trans amount currency asString
    			with: trans amount amount
    			with: trans serviceCharge description) 
    				, (Array with: trans serviceCharge amount currency asString
    						with: trans serviceCharge amount amount).
    fieldNames with: fieldValues
    	do: [:fieldName :value | self assert: (row at: (transTable fieldNamed: fieldName)) = value].
    self assert: (rowMap numberOfEntriesForTable: transTable) = 2.
    self assert: (rowMap numberOfEntriesForTable: moneyTable) = 2! !
!MappingTest methodsFor: 'tests'!
testManyToMany
| customer customerTable accountTable linkTable linkRow |
    customer := GlorpBankExampleSystem new objectNumber: 1 ofClass: Customer.
    rowMap := RowMap new.
    customerTable := system tableNamed: 'GR_CUSTOMER'.
    accountTable := system tableNamed: 'BANK_ACCT'.
    linkTable := system tableNamed: 'CUSTOMER_ACCT_LINK'.
self write: customer.
    customer accounts do: [:each | 
    	self write: each].
self assert: (rowMap includesRowForTable: customerTable withKey: customer).
    customer accounts do: [:each |
    	self assert: (rowMap includesRowForTable: accountTable withKey: each).
    	self assert: (rowMap includesRowForTable: linkTable withKey: (RowMapKey new key1: customer; key2: each))].
customer accounts do: [:each | | rowMapKey |
    	self assert: ((self rowFor: each) at: (accountTable fieldNamed: 'ID')) = each id.
    	rowMapKey := RowMapKey new key1: customer; key2: each.
    	linkRow := rowMap rowForTable: linkTable withKey: rowMapKey.
    	self assert: (linkRow at: (linkTable fieldNamed: 'ACCT_ID')) = each id.
    	self assert: (linkRow at: (linkTable fieldNamed: 'CUSTOMER_ID')) = customer id.
    	].
    self assert: ((self rowFor: customer) at: (customerTable fieldNamed: 'ID')) = customer id.
    self assert: ((rowMap numberOfEntriesForTable: linkTable) = 2).
    self assert: ((rowMap numberOfEntriesForTable: customerTable) = 1).! !
!MappingTest methodsFor: 'tests'!
testMergedOneToOne
    self helperForMergedOneToOneReversingWriteOrder: false! !
!MappingTest methodsFor: 'tests'!
testMergedOneToOneReversingWrites
    self helperForMergedOneToOneReversingWriteOrder: true! !
!MappingTest methodsFor: 'tests'!
testMissingDescriptor
    self assert: (system descriptorFor: nil) isNil.
    self assert: (system descriptorFor: UndefinedObject) isNil.
    self assert: (system descriptorFor: 3) isNil! !
!MappingTest methodsFor: 'tests'!
testMultipleTableCreation
    
    | descriptor table passenger table2 row1 row2 |
    descriptor := system descriptorFor: Passenger.
    passenger := Passenger example1.
    rowMap := RowMap new.
    table := system existingTableNamed: 'PASSENGER'.
    table2 := system existingTableNamed: 'FREQUENT_FLYER'.
    descriptor createRowsFor: passenger in: rowMap.
    self assert: (rowMap includesRowForTable: table withKey: passenger).
    self assert: (rowMap includesRowForTable: table2 withKey: passenger).
    row1 := rowMap rowForTable: table withKey: passenger.
    self assert: (row1 at: (table fieldNamed: 'ID'))
    		= passenger id.
    self assert: (row1 at: (table fieldNamed: 'NAME'))
    		= passenger name.
    row2 := rowMap rowForTable: table2 withKey: passenger.
    self assert: (row2 at: (table2 fieldNamed: 'ID'))
    		= passenger id.
    self assert: (row2 at: (table2 fieldNamed: 'POINTS')) = passenger frequentFlyerPoints.
    self assert: rowMap numberOfEntries = 2! !
!MappingTest methodsFor: 'tests'!
testNestedMergedOneToOne
    self helperForNestedMergedOneToOneReversingWriteOrder: false! !
!MappingTest methodsFor: 'tests'!
testNestedMergedOneToOneReversingWriteOrder
    self helperForNestedMergedOneToOneReversingWriteOrder: true.! !
!MappingTest methodsFor: 'tests'!
testNilOneToOne
    
    | person  personTable addressTable |
    person := Person example1.
    person address: nil.
    self write: person.
    self write: person address.
    personTable := system existingTableNamed: 'PERSON'.
    addressTable := system existingTableNamed: 'GR_ADDRESS'.
self assert: (rowMap includesRowForTable: personTable withKey: person).
    self deny: (rowMap includesRowForTable: addressTable withKey: person address).
self assert: rowMap numberOfEntries = 1.! !
!MappingTest methodsFor: 'tests'!
testOneToMany
| customer customerTable transactionTable |
    customer := Customer example1.
    rowMap := RowMap new.
    customerTable := system tableNamed: 'GR_CUSTOMER'.
    transactionTable := system tableNamed: 'BANK_TRANS'.
    self write: customer.
    customer transactions do: [:each |
    	self write: each].
self assert: (rowMap includesRowForTable: customerTable withKey: customer).
    customer transactions do: [:each |
    	self assert: (rowMap includesRowForTable: transactionTable withKey: each)].
customer transactions do: [:each |
    	self assert: ((self rowFor: each) at: (transactionTable fieldNamed: 'OWNER_ID')) = customer id].
    self assert: ((self rowFor: customer) at: (customerTable fieldNamed: 'ID')) = customer id.! !
!MappingTest methodsFor: 'tests'!
testOneToOne
    
    | person  personTable addressTable |
    person := Person example1.
    self write: person.
    self write: person address.
    personTable := system existingTableNamed: 'PERSON'.
    addressTable := system existingTableNamed: 'GR_ADDRESS'.
self assert: (rowMap includesRowForTable: personTable withKey: person).
    self assert: (rowMap includesRowForTable: addressTable withKey: person address).
self assert: ((self rowFor: person address) at: (addressTable fieldNamed: 'ID')) = person address id.
    self assert: ((self rowFor: person) at: (personTable fieldNamed: 'ADDRESS_ID')) = person address id.
    self assert: rowMap numberOfEntries = 2.! !
!MappingTest methodsFor: 'tests'!
testOneToOneWithProxy
| person  personTable addressTable proxy stub |
    person := Person example1.
    proxy := Proxy new.
    proxy session: Session new.
    stub := QueryStub returningOneOf: Address where: [:address | address id = 1].
    stub result: person address.
    proxy query: stub.
    person address: proxy.
    self deny: person address isInstantiated.
self write: person.
personTable := system existingTableNamed: 'PERSON'.
    addressTable := system existingTableNamed: 'GR_ADDRESS'.
self assert: (rowMap includesRowForTable: personTable withKey: person).
    self deny: (rowMap includesRowForTable: addressTable withKey: person address).
self deny: ((self rowFor: person) hasValueFor: (personTable fieldNamed: 'ADDRESS_ID')).
    self assert: rowMap numberOfEntries = 1.! !
!MappingTest methodsFor: 'tests'!
testRowCreation
| descriptor person row table  |
    descriptor := system descriptorFor: Person.
    person := Person example1.
    rowMap := RowMap new.
    table := system existingTableNamed: 'PERSON'.
    descriptor createRowsFor: person in: rowMap.
    self assert: (rowMap includesRowForTable: table withKey: person).
    row := rowMap rowForTable: table withKey: person.
    self assert: (row at: (table fieldNamed: 'ID')) = person id.
    self assert: (row at: (table fieldNamed: 'NAME')) = person name.
    self assert: rowMap numberOfEntries = 2.! !
!MappingTest methodsFor: 'support'!
rowFor: anObject
    | descriptor |
    descriptor := system descriptorFor: anObject.
    descriptor isNil ifTrue: [^nil].
^rowMap rowForTable: descriptor table withKey: anObject.! !
!MappingTest methodsFor: 'support'!
setUp
    super setUp.
    system := GlorpDemoDescriptorSystem new.
    rowMap := RowMap new.! !
!MappingTest methodsFor: 'support'!
write: anObject
| descriptor |
    descriptor := system descriptorFor: anObject. 
    descriptor isNil ifTrue: [^self].
    descriptor createRowsFor: anObject in: rowMap.! !
!MessageCollectorTest methodsFor: 'support'!
setUp
    super setUp.
    collector := MessageArchiver new! !
!MessageCollectorTest methodsFor: 'tests'!
dNUException
    ^Dialect isVisualAge 
    	ifTrue: [(Smalltalk at: #SystemExceptions) at: 'ExAll']
    	ifFalse: [MessageNotUnderstood].! !
!MessageCollectorTest methodsFor: 'tests'!
testExpressionCreation
    | exp |
    exp := collector foo asGlorpExpression.
    self assert: exp name == #foo.
    self assert: exp base class == BaseExpression! !
!MessageCollectorTest methodsFor: 'tests'!
testMessageCollectorDNU
    | message caught |
    message := Message selector: #foo arguments: #().
    caught := false.
    [collector basicDoesNotUnderstand: message] on: self dNUException
    	do: [:signal | caught := true. signal sunitExitWith: nil].
    self assert: caught! !
!MessageCollectorTest methodsFor: 'tests'!
testMessageIntercept
| foo |
    foo := collector foo.
    self assert: foo privateGlorpMessage selector == #foo.
    self assert: foo privateGlorpReceiver == collector.! !
!ObjectTransactionTest methodsFor: 'support'!
setUp
transaction := ObjectTransaction new! !
!ObjectTransactionTest methodsFor: 'tests'!
testArray
    | object |
    object := #(1 2 3 4 5) copy.
    transaction begin.
    transaction register: object.
    object
    	at: 1 put: #one;
    	at: 2 put: object.
    transaction abort.
    self
    	assert: (object at: 1) == 1;
    	assert: (object at: 2) == 2! !
!ObjectTransactionTest methodsFor: 'tests'!
testBecome
    | object |
    object := 'hello'.
    transaction begin.
    transaction register: object.
    object become: Set new.
    transaction abort.
    self 
    	assert: object class == '' class;
    	assert: object = 'hello'.! !
!ObjectTransactionTest methodsFor: 'tests'!
testCommit
    | array |
    array := #(1 2 3 4 5) copy.
    transaction begin.
    transaction register: array.
    array
    	at: 1 put: #one;
    	at: 2 put: array.
    transaction commit.
    self
    	assert: (array at: 1) == #one;
    	assert: (array at: 2) == array! !
!ObjectTransactionTest methodsFor: 'tests'!
testHashedCollection
    | object originalMembers |
    object := Set new.
    originalMembers := #(one two three 'four' 5 'vi' (1 2 3 4 5 6 7)) collect: [:each | each copy].
    object addAll: originalMembers.
    transaction begin.
    transaction register: object.
    object remove: #one; remove: (originalMembers at: 4).
    object add: 1.
    originalMembers last at: 7 put: 'seven'.
    transaction abort.
    self
    	assert: object size = originalMembers size;
    	assert: (object includes: originalMembers first);
    	assert: (object includes: (originalMembers at: 4));
    	assert: object size = (object rehash; size).
    originalMembers do: [:each | self assert: (object includes: each)]! !
!ObjectTransactionTest methodsFor: 'tests'!
testString
    | object |
    object := 'Hello, World!!' copy.
    transaction begin.
    transaction register: object.
    object
    	at: 1 put: $h;
    	at: 2 put: $E.
    transaction abort.
    self
    	assert: object first  == $H;
    	assert: (object at: 2) == $e! !
!PrimaryKeyExpressionTest methodsFor: 'support'!
setUp
system := GlorpDemoDescriptorSystem new.
    expression := PrimaryKeyExpression 
    	from: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID')
    	to: ((system tableNamed: 'CUSTOMER_ACCT_LINK') fieldNamed: 'ACCT_ID').
compoundExpression := PrimaryKeyExpression
    	from: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID')
    	to: ((system tableNamed: 'PERSON') fieldNamed: 'NAME').
    compoundExpression
    	addSource: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'BANK_CODE')
    	target: ((system tableNamed: 'PERSON') fieldNamed: 'ADDRESS_ID').! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testAsExpressionCompound
    
    | e personTable accountTable |
    personTable := system tableNamed: 'PERSON'.
    accountTable := system tableNamed: 'BANK_ACCT'.
e := compoundExpression asExpression.
    self assert: (e isKindOf: RelationExpression).
    self assert: e relation == #AND.
    self assert: (e leftChild isKindOf: RelationExpression).
    self assert: (e leftChild relation == #=).
    self assert: (e leftChild leftChild isKindOf: FieldExpression).
    self assert: e leftChild leftChild field == (personTable fieldNamed: 'NAME').
    self assert: (e leftChild rightChild isKindOf: ParameterExpression).
    self assert: e leftChild rightChild field == (accountTable fieldNamed: 'ID').
self assert: (e rightChild isKindOf: RelationExpression).
    self assert: (e rightChild relation == #=).
    self assert: (e rightChild leftChild isKindOf: FieldExpression).
    self assert: e rightChild leftChild field == (personTable fieldNamed: 'ADDRESS_ID').
    self assert: (e rightChild rightChild isKindOf: ParameterExpression).
    self assert: e rightChild rightChild field = (accountTable fieldNamed: 'BANK_CODE').! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testAsExpressionSingle
    
    | e field param |
    e := expression asExpression.
    self assert: (e isKindOf: RelationExpression).
    self assert: e relation == #=.
    field := e leftChild.
    self assert: (field isKindOf: FieldExpression).
    self assert: field field == ((system tableNamed: 'CUSTOMER_ACCT_LINK') fieldNamed: 'ACCT_ID').
    param := e rightChild.
    self assert: (param isKindOf: ParameterExpression).
    self assert: param field == ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID').! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testCompoundSQLPrinting
    | stream params|
    stream := WriteStream on: (String new: 100).
    params := Dictionary new.
    params at: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID') put: 1.
    params at: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'BANK_CODE') put: 3.
    compoundExpression printSQLOn: stream withParameters: params.
    self assert: stream contents = 'PERSON.NAME = 1 AND PERSON.ADDRESS_ID = 3'.! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testCreation
self assert: expression allSourceFields size = 1.
    self assert: expression allSourceFields first == ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID').! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testParameterCount
self assert: expression numberOfParameters = 1.
    self assert: compoundExpression numberOfParameters = 2.! !
!PrimaryKeyExpressionTest methodsFor: 'tests'!
testSQLPrinting
    | stream params |
    stream := WriteStream on: (String new: 100).
    params := Dictionary new.
    params at: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'ID') put: 'abc'.
    expression printSQLOn: stream withParameters: params.
    self assert: stream contents = 'CUSTOMER_ACCT_LINK.ACCT_ID = ''abc'''! !
!ProxyTest methodsFor: 'tests'!
testCreation
| proxy |
    proxy := Proxy new.
    self deny: proxy isInstantiated.! !
!ProxyTest methodsFor: 'tests'!
testInstantiationFromStub
| proxy stub |
proxy := Proxy new.
    proxy session: session.
    stub := QueryStub returningOneOf: Address where: [:address | address id = 1].
    stub result: 42.
    proxy query: stub.
    proxy parameters: #().
self assert: (proxy getValue notNil).
    self assert: proxy getValue = 42.
    self assert: proxy isInstantiated.! !
!ProxyTest methodsFor: 'support'!
setUp
session := SessionResource current newSession.! !
!ProxyTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!QueryTableAliasingTest methodsFor: 'tests'!
testAliasWithEmbeddedMapping
self unfinished.! !
!QueryTableAliasingTest methodsFor: 'tests'!
testBuildingObject
| customer |
    elementBuilder instance: Customer new.
    elementBuilder requiresPopulating: true.
    elementBuilder buildObjectFrom: #(12 'Name').
    customer := elementBuilder instance.
    self assert: customer class == Customer.
    self assert: customer id = 12.
    self assert: customer name = 'Name'.! !
!QueryTableAliasingTest methodsFor: 'tests'!
testElementBuilderFields
    elementBuilder fieldsForSelectStatement 
    	do: [:each | self assert: each table name = 't1']! !
!QueryTableAliasingTest methodsFor: 'tests'!
testExpressionTableAlias
    | fields |
    fields := expression translateFields: expression descriptor mappedFields.
    fields do: [:each | self assert: each table name = 't1']! !
!QueryTableAliasingTest methodsFor: 'tests'!
testQueryPrintingFields
    | stream |
    query 
    	initResultClass: Customer
    	criteria: expression
    	singleObject: true.
    query traceNodes: expression.
    query computeFields.
    stream := String new writeStream.
    query printSelectFieldsOn: stream.
    self assert: stream contents = 't1.ID, t1.NAME'! !
!QueryTableAliasingTest methodsFor: 'tests'!
testQueryPrintingSimpleWhereClause
    | string |
    string := self helpTestPrintingWhereClause: ((expression get: #name) get: #= withArguments: #('Fred')).
    self assert: string = 't1.NAME = ''Fred'''! !
!QueryTableAliasingTest methodsFor: 'tests'!
testQueryPrintingTables
    | stream string |
    query 
    	initResultClass: Customer
    	criteria: expression
    	singleObject: true.
    query traceNodes: expression.
    query computeFields.
    stream := String new writeStream.
    query printTablesOn: stream.
    string := stream contents.
    self assert: string = 'GR_CUSTOMER t1'! !
!QueryTableAliasingTest methodsFor: 'support'!
helpTestPrintingWhereClause: anExpression
    | stream |
    query 
    	initResultClass: Customer
    	criteria: expression
    	singleObject: true.
    query traceNodes: expression.
    query computeFields.
    stream := String new writeStream.
    anExpression	
    	printSQLOn: stream
    	withParameters: Dictionary new.
    ^stream contents.! !
!QueryTableAliasingTest methodsFor: 'support'!
setUp
    query := SimpleQuery new.
    expression := BaseExpression new.
    system := GlorpDemoDescriptorSystem new.
    expression descriptor: (system descriptorFor: Customer).
    elementBuilder := ElementBuilder for: expression in: query.
    expression aliasTable: (system tableNamed: 'GR_CUSTOMER') to: 't1'! !
!ReadQueryTest methodsFor: 'support'!
setUp
session := SessionResource current newSession.! !
!ReadQueryTest methodsFor: 'tests'!
testCriteriaSetup
    | query |
    query := ReadQuery returningOneOf: Address where: [:each | each id = 12].
    query session: session.
    query setUpCriteria.
    self assert: query criteria class == RelationExpression.
    self assert: query criteria ultimateBaseExpression descriptor 
    			== (session descriptorFor: Address)! !
!ReadQueryTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!ReadingTest methodsFor: 'tests'!
helperForTestReadEmbeddedOneToOne
    | transRow query result |
    
    [session beginTransaction.
    transRow := session system exampleBankTransactionRow.
    session writeRow: transRow.
    query := ReadQuery returningOneOf: BankTransaction
    			where: [:each | each id = 1].
    result := query executeIn: session] 
    		ensure: [session rollbackTransaction].
    self assert: result serviceCharge notNil.
    self assert: result serviceCharge description = 'additional overcharge'.
    self assert: result amount currency = 'CDN'.
    self assert: result amount amount = '7'.
    self assert: result serviceCharge amount currency = 'USD'.
    self assert: result serviceCharge amount amount = '2'.
    ^result.! !
!ReadingTest methodsFor: 'tests'!
readPersonWithAddressForExpression: aBlock 
    | object query results personRow addressRow |
    
    [session beginTransaction.
    addressRow := session system exampleAddressRow.
    session writeRow: addressRow.
    personRow := session system examplePersonRow1.
    session writeRow: personRow.
    query := ReadQuery returningManyOf: Person where: aBlock.
    results := query executeIn: session.
    self assert: results size = 1.
    object := results first.
    self assert: object class = Person.
    self assert: object id = 3.
    self assert: object name = 'aPerson'.
    self assert: object address class == Proxy.
    self assert: object address getValue id = 123.
    self assert: object address getValue class == Address] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testBuildBankTransactionAndDependentsFromRow
    | transactionDescriptor object row moneyDescriptor money1 table translations |
    transactionDescriptor := system descriptorFor: BankTransaction.
    object := BankTransaction new.
    row := #(99 nil 'CDN' 98 'service charge' 'USD' 97).
    transactionDescriptor 
    	populateObject: object
    	fromRow: row
    	inBuilder: ElementBuilder new.
    self assert: object id = 99.
    moneyDescriptor := system descriptorFor: GlorpMoney.
    money1 := GlorpMoney new.
    table := system tableNamed: 'MONEY_IMAGINARY_TABLE'.
    translations := IdentityDictionary new.
    translations at: (table fieldNamed: 'CURRENCY') put: 3.
    translations at: (table fieldNamed: 'AMOUNT') put: 4.
    moneyDescriptor 
    	populateObject: money1
    	fromRow: row
    	inBuilder: (ElementBuilder new fieldTranslations: translations).
    self assert: money1 amount = 98.
    self assert: money1 currency = 'CDN'! !
!ReadingTest methodsFor: 'tests'!
testBuildPersonFromRow
    | descriptor object address |
    address := Address new.
    session cacheAt: 127 put: address.
    descriptor := system descriptorFor: Person.
    system tableNamed: 'PERSON'.
    object := Person new.
    descriptor 
    	populateObject: object
    	fromRow: #(456 'Ralph' 127)
    	inBuilder: ElementBuilder new.
    self assert: object class = Person.
    self assert: object id = 456.
    self assert: object name = 'Ralph'.
    self assert: object address getValue == address! !
!ReadingTest methodsFor: 'tests'!
testNonRefreshAddress
    "Test that if we don't set the refresh flag on the query we don't re-read the data"
    | query rowToWrite address modifiedRow |
    
    [session beginTransaction.
    rowToWrite := session system exampleAddressRow.
    session writeRow: rowToWrite.
    address := session readOneOf: Address
    			where: [:each | each id = 123].
    modifiedRow := session system exampleModifiedAddressRow.
    modifiedRow owner: address. "Otherwise it thinks it's an insert"
    session writeRow: modifiedRow.
    query := Query returningOneOf: Address where: [:each | each id = 123].
    query executeIn: session.
    self assert: address street = 'Paseo Montril'.] 
    		ensure: [session rollbackTransaction].! !
!ReadingTest methodsFor: 'tests'!
testReadAccountsWithMultipleAnySatisfy
    | query result |
    
    [| block |
    session beginTransaction.
    self writeCustomer1Rows.
    block := 
    		[:account | 
    		(account accountHolders anySatisfy: [:each | each id = 24]) 
    			| (account accountHolders anySatisfy: [:each | each id = 27])].
    query := ReadQuery returningManyOf: BankAccount where: block.
    result := session execute: query.
    self assert: result size = 2] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadAddress
    | object query results rowToWrite |
    
    [session beginTransaction.
    rowToWrite := session system exampleAddressRow.
    session writeRow: rowToWrite.
    query := ReadQuery returningManyOf: Address
    			where: [:address | address id = 123].
    results := query executeIn: session] 
    		ensure: [session rollbackTransaction].
    self assert: results size = 1.
    object := results first.
    self assert: object class = Address.
    self assert: object id = 123.
    self assert: object street = 'Paseo Montril'.
    self assert: object number = '10185'! !
!ReadingTest methodsFor: 'tests'!
testReadAddressProxy
    | object query results rowToWrite proxy |
[session beginTransaction.
    	rowToWrite := session system exampleAddressRow.
    	session writeRow: rowToWrite.
    	query := (Query
    		returningManyOf: Address
    		where: ([:address | address id = 123]) ) returnProxies: true.
    	results := query executeIn: session.
    	self assert: (results size = 1).
    	proxy := results first.
    	object := proxy getValue]
    ensure: [session rollbackTransaction].
self assert: (proxy class = Proxy).
    self assert: (object class = Address).
    self assert: (object id = 123).
    self assert: (object street = 'Paseo Montril').
    self assert: (object number = '10185').! !
!ReadingTest methodsFor: 'tests'!
testReadAddressProxyAlreadyInMemory
    "Check that if the object is already in memory we don't create a proxy for it, just return the instance"
    | object query results rowToWrite |
[session beginTransaction.
    	rowToWrite := session system exampleAddressRow.
    	session writeRow: rowToWrite.
    	session readOneOf: Address where: [:address | address id = 123].
    	query := (Query
    		returningManyOf: Address
    		where: ([:address | address id = 123]) ) returnProxies: true.
    	results := query executeIn: session.
    	self assert: (results size = 1).
    	object := results first]
    ensure: [session rollbackTransaction].
self assert: (object class = Address).
    self assert: (object id = 123).
    self assert: (object street = 'Paseo Montril').
    self assert: (object number = '10185').! !
!ReadingTest methodsFor: 'tests'!
testReadCustomerWithAccounts
    | query id1 id2 result accounts backRef1 backRef2 accountIds |
    
    [session beginTransaction.
    accountIds := self writeCustomer1Rows.
    id1 := accountIds at: 1.
    id2 := accountIds at: 2.
    query := ReadQuery returningOneOf: Customer
    			where: [:person | person id = 27].
    result := session execute: query.
    self assert: result seenPostFetch = true.
    accounts := result accounts getValue.
    self assert: accounts size = 2.
    self assert: (accounts first id = id1 or: [accounts last id = id1]).
    self assert: (accounts first id = id2 or: [accounts last id = id2]).
    self assert: accounts first id ~= accounts last id.
    backRef1 := accounts first accountHolders getValue.
    self assert: backRef1 size = 1.
    self assert: backRef1 first = result.
    backRef2 := accounts first accountHolders getValue.
    self assert: backRef2 size = 1.
    self assert: backRef2 first = result] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadCustomerWithAnySatisfy
    | query result accounts |
    
    [session beginTransaction.
    self writeCustomer1Rows.
    query := ReadQuery returningManyOf: Customer
    			where: 
    				[:person | 
    				person accounts anySatisfy: [:each | each accountNumber branchNumber > 0]].
    result := session execute: query.
    self assert: result size = 1.
    accounts := result first accounts getValue.
    self assert: accounts size = 2.
    query := ReadQuery returningManyOf: Customer
    			where: 
    				[:person | 
    				person accounts anySatisfy: [:each | each accountNumber branchNumber = 2]].
    result := session execute: query.
    self assert: result size = 1.
    accounts := result first accounts getValue.
    self assert: accounts size = 2] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadCustomerWithMultipleAnySatisfy
    | query result |
    
    [| block |
    session beginTransaction.
    self writeCustomer1Rows.
    block := 
    		[:person | 
    		(person accounts anySatisfy: [:each | each accountNumber branchNumber = 2]) 
    			& (person accounts 
    					anySatisfy: [:each | each accountNumber branchNumber = 3])].
    query := ReadQuery returningManyOf: Customer where: block.
    result := session execute: query.
    self assert: result size = 1] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadEmbeddedOneToOne
self helperForTestReadEmbeddedOneToOne.! !
!ReadingTest methodsFor: 'tests'!
testReadPassenger
    | passengerRow1 passengerRow2 query result |
    
    [session beginTransaction.
    passengerRow1 := session system examplePassengerRow.
    session writeRow: passengerRow1.
    passengerRow2 := session system exampleFrequentFlyerRow.
    session writeRow: passengerRow2.
    query := ReadQuery returningOneOf: Passenger
    			where: [:passenger | passenger id = 1].
    result := query executeIn: session.
    self assert: result id = 1.
    self assert: result name = 'Some Passenger'.
    self assert: result frequentFlyerPoints = 10000] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadPersonWithAddress
    self readPersonWithAddressForExpression: [:pers | pers id = 3]! !
!ReadingTest methodsFor: 'tests'!
testReadPersonWithEmailAddresses
    | query personRow addressRow emailAddress1Row emailAddress2Row id1 id2 result emailAddresses |
    
    [session beginTransaction.
    addressRow := session system exampleAddressRow.
    session writeRow: addressRow.
    personRow := session system examplePersonRow1.
    session writeRow: personRow.
    emailAddress1Row := session system exampleEmailAddressRow1.
    emailAddress2Row := session system exampleEmailAddressRow2.
    id1 := emailAddress1Row at: (emailAddress1Row table fieldNamed: 'ID').
    id2 := emailAddress2Row at: (emailAddress2Row table fieldNamed: 'ID').
    session writeRow: emailAddress1Row.
    session writeRow: emailAddress2Row.
    query := ReadQuery returningOneOf: Person where: [:person | person id = 3].
    result := query executeIn: session.
    emailAddresses := result emailAddresses getValue.
    self assert: emailAddresses size = 2.
    self 
    	assert: (emailAddresses first id = id1 or: [emailAddresses last id = id1]).
    self 
    	assert: (emailAddresses first id = id2 or: [emailAddresses last id = id2]).
    self assert: emailAddresses first id ~= emailAddresses last id] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testReadPersonWithJoinToAddress
    self 
    	readPersonWithAddressForExpression: [:person | person address street = 'Paseo Montril']! !
!ReadingTest methodsFor: 'tests'!
testReadWithCacheHits
    | query addressRow result1 result2 |
    
    [session beginTransaction.
    addressRow := session system exampleAddressRow.
    session writeRow: addressRow.
    query := ReadQuery returningOneOf: Address
    			where: [:address | address id = 123].
    result1 := query executeIn: session.
    result2 := query executeIn: session.
    self assert: result1 == result2] 
    		ensure: [session rollbackTransaction]! !
!ReadingTest methodsFor: 'tests'!
testRefreshAddress
    "Check that we refresh correctly when the refresh flag is set"
    | query rowToWrite address modifiedRow |
    
    [session beginTransaction.
    rowToWrite := session system exampleAddressRow.
    session writeRow: rowToWrite.
    address := session readOneOf: Address
    			where: [:each | each id = 123].
    modifiedRow := session system exampleModifiedAddressRow.
    modifiedRow owner: address. "Otherwise it thinks it's an insert"
    session writeRow: modifiedRow.
    query := Query returningOneOf: Address where: [:each | each id = 123].
    query shouldRefresh: true.
    query executeIn: session.
    self assert: address street = 'Something Else'.] 
    		ensure: [session rollbackTransaction].! !
!ReadingTest methodsFor: 'tests'!
testRegisteringWithEmbeddedMapping
| bankTrans |
    session beginUnitOfWork.
    bankTrans := self helperForTestReadEmbeddedOneToOne.
    self assert: (session isRegistered: bankTrans).
    self assert: (session isRegistered: bankTrans serviceCharge).
    self assert: (session isRegistered: bankTrans serviceCharge amount).! !
!ReadingTest methodsFor: 'tests'!
writeCustomer1Rows
    | id1 id2 customerRow accountRow1 accountRow2 linkRow1 linkRow2 |
customerRow := session system exampleCustomerRow1.
    accountRow1 := session system exampleAccountRow1. 
    accountRow2 := session system exampleAccountRow2.
    linkRow1 := session system exampleCALinkRow1.
    linkRow2 := session system exampleCALinkRow2.
    session writeRow: customerRow.
    session writeRow: accountRow1.
    session writeRow: accountRow2.
    session writeRow: linkRow1.
    session writeRow: linkRow2.
id1 := accountRow1 at: (accountRow1 table fieldNamed: 'ID').
    id2 := accountRow2 at: (accountRow2 table fieldNamed: 'ID').
    ^Array with: id1 with: id2.! !
!ReadingTest methodsFor: 'support'!
setUp
    super setUp.
    session := SessionResource current newSession.
    system := session system.! !
!ReadingTest methodsFor: 'accessing'!
session
    ^session.! !
!ReadingTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!RowMapUnificationTest methodsFor: 'support'!
setUp
super setUp.
    t1 := DatabaseTable named: 'T1'.
    t2 := DatabaseTable named: 'T2'.
    t3 := DatabaseTable named: 'T3'.
    f1 := t1 newFieldNamed: 'f1'.
    f2 := t2 newFieldNamed: 'f2'.
    f3 := t3 newFieldNamed: 'f3'.
    rowMap := RowMap new.
    o1 := 'one'.
    o2 := 'two'.
    o3 := 'three'.! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationDifferentRows
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f3 with: f2)
    	correspondingTo: (Array with: o3 with: o2)
    	in: rowMap.
    (rowMap rowForTable: t1 withKey: o1) at: f1 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42.
    self assert: ((rowMap rowForTable: t3 withKey: o3) at: f3) = 42.! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationDifferentRows2
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f2 with: f3)
    	correspondingTo: (Array with: o2 with: o3)
    	in: rowMap.
    (rowMap rowForTable: t1 withKey: o1) at: f1 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42.
    self assert: ((rowMap rowForTable: t3 withKey: o3) at: f3) = 42.! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationDifferentRows3
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f2 with: f3)
    	correspondingTo: (Array with: o2 with: o3)
    	in: rowMap.
    (rowMap rowForTable: t3 withKey: o3) at: f3 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42.
    self assert: ((rowMap rowForTable: t3 withKey: o3) at: f3) = 42.! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationDifferentRows4
| t4 f4 o4 |
    t4 := DatabaseTable named: 'T4'.
    f4 := t4 newFieldNamed: 'f4'.
    o4 := 'four'.
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f3 with: f4)
    	correspondingTo: (Array with: o3 with: o4)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f2 with: f3)
    	correspondingTo: (Array with: o2 with: o3)
    	in: rowMap.
    (rowMap rowForTable: t1 withKey: o1) at: f1 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42.
    self assert: ((rowMap rowForTable: t3 withKey: o3) at: f3) = 42.
    self assert: ((rowMap rowForTable: t4 withKey: o4) at: f4) = 42.! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationSameRow
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    (rowMap rowForTable: t1 withKey: o1) at: f1 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42! !
!RowMapUnificationTest methodsFor: 'tests'!
testDoubleRowUnificationSameRow2
FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f2 with: f1)
    	correspondingTo: (Array with: o2 with: o1)
    	in: rowMap.
    (rowMap rowForTable: t1 withKey: o1) at: f1 put: 42.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 42.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 42! !
!RowMapUnificationTest methodsFor: 'tests'!
testIteration
| rows r1 r2 r3 count |
    r1 := rowMap findOrAddRowForTable: t1 withKey: o1.
    r2 := rowMap findOrAddRowForTable: t1 withKey: o2.
    r3 := rowMap findOrAddRowForTable: t2 withKey: o2.
    rows := IdentitySet new.
    count := 0.
    rowMap rowsDo: [:each | 
    	count := count + 1.
    	rows add: each].
    self assert: count = 3.
    self assert: (rows includes: r1).
    self assert: (rows includes: r3).
    self assert: (rows includes: r2).! !
!RowMapUnificationTest methodsFor: 'tests'!
testStoreThenUnify
(rowMap findOrAddRowForTable: t1 withKey: o1) at: f1 put: 12.
    FieldUnifier 
    	unifyFields: (Array with: f2 with: f3)
    	correspondingTo: (Array with: o2 with: o3)
    	in: rowMap.
    FieldUnifier 
    	unifyFields: (Array with: f1 with: f2)
    	correspondingTo: (Array with: o1 with: o2)
    	in: rowMap.
    self assert: ((rowMap rowForTable: t1 withKey: o1) at: f1) = 12.
    self assert: ((rowMap rowForTable: t2 withKey: o2) at: f2) = 12.
    self assert: ((rowMap rowForTable: t3 withKey: o3) at: f3) = 12.! !
!RowMapUnificationTest methodsFor: 'tests'!
testStoreWithRowMapKey
| a b key1 key2 key3 table r1 r2 r3 |
    a := Object new.
    b := Object new.
    key1 := RowMapKey new key1: a; key2: b.
    key2 := RowMapKey new key1: a; key2: b.
    key3 := RowMapKey new key1: b; key2: a.
    table := DatabaseTable new.
r1 := rowMap findOrAddRowForTable: table withKey: key1.
    r2 := rowMap findOrAddRowForTable: table withKey: key2.
    r3 := rowMap findOrAddRowForTable: table withKey: key3.
self assert: r1 == r2.
    self assert: r2 == r3.
    self assert: r1 owner == key1.! !
!SQLPrintingTest methodsFor: 'tests'!
testDatePrinting
    | date stream |
    date := Date newDay: 14 month: #Nov year: 1997.
    stream := WriteStream on: String new.
    date glorpPrintSQLOn: stream.
    self assert: stream contents = '''1997-11-14'''.
date := Date newDay: 2 month: #May year: 2002.
    stream := WriteStream on: String new.
    date glorpPrintSQLOn: stream.
    self assert: stream contents = '''2002-05-02'''.! !
!SessionTest methodsFor: 'support'!
addCustomerToCache
    | customer |
    customer := Customer example1.
    customer id: 3.
    session cacheAt: 3 put: customer.
    ^customer! !
!SessionTest methodsFor: 'support'!
setUp
    system := GlorpDemoDescriptorSystem new.
    session := Session new.
    session system: system! !
!SessionTest methodsFor: 'tests'!
testAddingDescriptors
self assert: session system == system.
    self assert: system session == session.
    (session descriptorFor: Address) session == session.! !
!SessionTest methodsFor: 'tests'!
testExecuteQuery
    | q result |
    q := QueryStub new result: 3.
    result := session execute: q.
    self assert: result = 3! !
!SessionTest methodsFor: 'tests'!
testHasExpired1
    | customer |
    customer := self addCustomerToCache.
    self deny: (session hasExpired: customer)! !
!SessionTest methodsFor: 'tests'!
testHasExpired2
    | customer |
    (session system descriptorFor: Customer) 
    	cachePolicy: (TimedExpiryCachePolicy new timeout: 0).
    customer := self addCustomerToCache.
    self assert: (session hasExpired: customer)! !
!SessionTest methodsFor: 'tests'!
testHasObjectOfClassExpired1
self addCustomerToCache.
    self deny: (session hasObjectExpiredOfClass: Customer withKey: 3).! !
!SessionTest methodsFor: 'tests'!
testHasObjectOfClassExpired2
(session system descriptorFor: Customer) 
    	cachePolicy: (TimedExpiryCachePolicy new timeout: 0).
    self addCustomerToCache.
    self assert: (session hasObjectExpiredOfClass: Customer withKey: 3).! !
!SimpleQueryTest methodsFor: 'tests'!
testComputingFieldsForDirectMappings
| query table tracing |
    query := SimpleQuery returningOneOf: Address where: [:each | each id = 1].
    query session: session.
    query setUpCriteria.
    tracing := Tracing new.
    query traceNodes: (tracing traceNodeSets first).
    query computeFields.
    
    table := session system tableNamed: 'GR_ADDRESS'.
    self assert: (query fields = table fields).! !
!SimpleQueryTest methodsFor: 'tests'!
testComputingFieldsForReferenceMappings
| query table tracing |
    query := SimpleQuery returningOneOf: Person where: [:each | each id = 1].
    query session: session.
    query setUpCriteria.
    tracing := Tracing new.
    query traceNodes: (tracing traceNodeSets first).
    query computeFields.
    
    table := session system tableNamed: 'PERSON'.
    self assert: (query fields = table fields).! !
!SimpleQueryTest methodsFor: 'tests'!
testDescriptorAssignmentToCriteria
| query |
    query := SimpleQuery returningOneOf: Address where: [:each | each id = 1].
    query session: session.
    query setUpCriteria.
    self assert: query criteria ultimateBaseExpression descriptor == (session descriptorFor: Address).! !
!SimpleQueryTest methodsFor: 'tests'!
testFieldAliasingForEmbeddedMappings
| query table tracing |
    query := SimpleQuery returningOneOf: BankTransaction where: [:each | each id = 1].
    query session: session.
    query setUpCriteria.
    tracing := Tracing new.
    (session descriptorFor: BankTransaction)  setupTracing: tracing.
    query traceNodes: (tracing traceNodeSets first).
    query computeFields.
    table := session system tableNamed: 'BANK_TRANS'.
    self assert: (query fields = table fields).
    self assert: (query builders first translateFieldPosition: (table fieldNamed: 'ID')) = 1.
    self assert: (query builders first translateFieldPosition: (table fieldNamed: 'OWNER_ID')) = 2.! !
!SimpleQueryTest methodsFor: 'tests'!
testPrimaryKeyExpressionWithMultipleTables
| query sql tracing sqlStream result |
    query := SimpleQuery returningOneOf: Passenger where: [:each | each id = 1].
    query session: session.
    query setUpCriteria.
    tracing := Tracing new.
    (session descriptorFor: Passenger)  setupTracing: tracing.
    query traceNodes: (tracing traceNodeSets first).
    query prepare.
sql := query sqlWith: (Dictionary new).
    sqlStream := ReadStream on: sql asLowercase.
    sqlStream skipToAll: 'where '.
    Dialect isVisualWorks ifTrue: [sqlStream skip: 'where ' size]. "<Grumble grumble> stupid incompatibilities"
    result := sqlStream upToEnd.
    self assert: result = 't1.id = 1 and t1.id = t2.id'.! !
!SimpleQueryTest methodsFor: 'support'!
setUp
session := SessionResource current newSession.! !
!SimpleQueryTest methodsFor: 'support'!
tearDown
session := nil.! !
!SimpleQueryTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!TableTest methodsFor: 'support'!
setUp
    super setUp.
    system := GlorpDemoDescriptorSystem new.
    descriptors := system allDescriptors.! !
!TableTest methodsFor: 'tests'!
testBasicSequencing
    | row |
    row := DatabaseRow newForTable: (system existingTableNamed: 'BANK_TRANS').
    row preWriteAssignSequences.
    row postWriteAssignSequences.
    self assert: (row at: ((system existingTableNamed: 'BANK_TRANS') fieldNamed: 'ID')) = 1.! !
!TableTest methodsFor: 'tests'!
testCircularFieldRefs
| field table1 table2 |
    table1 := DatabaseTable named: 'BAR'.
    field := table1 newFieldNamed: 'FOO'.
    table2 := DatabaseTable named: 'BLETCH'.
    table1 addForeignKeyFrom: field to: (table2 fieldNamed: 'FLIRP').
    self assert: (table2 fieldNamed: 'FLIRP') = table1 foreignKeyConstraints first targetField.! !
!TableTest methodsFor: 'tests'!
testConstraintCreation
| constraint |
    constraint := ForeignKeyConstraint 
    	sourceField: ((system tableNamed: 'BANK_ACCT') fieldNamed: 'BANK_CODE')
    	targetField: ((system tableNamed: 'PERSON') fieldNamed: 'ID').
    self assert: constraint creationString = 
    	 'CONSTRAINT BANK_ACCT_B_TO_PERSON_ID_REF FOREIGN KEY (BANK_CODE) REFERENCES PERSON (ID)'.
    self assert: constraint dropString = 
    	 'ALTER TABLE BANK_ACCT DROP CONSTRAINT BANK_ACCT_B_TO_PERSON_ID_REF'.! !
!TableTest methodsFor: 'tests'!
testFieldTable
| field table |
    field := DatabaseField named: 'FOO'.
    table := DatabaseTable named: 'BAR'.
    table addField: field.
    self assert: (table fieldNamed: 'FOO') = field.! !
!TableTest methodsFor: 'tests'!
testPrimaryKeyFields
| pkFields table |
    table := system tableNamed: 'BANK_TRANS'.
    pkFields := table primaryKeyFields.
    self assert: pkFields size = 1.
    self assert: (pkFields at: 1) == (table fieldNamed: 'ID').! !
!TableTest methodsFor: 'tests'!
testPrimaryKeyFields2
| table field |
    table := DatabaseTable new.
    field := DatabaseField new name: 'FRED'; bePrimaryKey.
    table addField: field.
    self assert: table primaryKeyFields size = 1.
    self assert: (table primaryKeyFields at: 1) == field.! !
!TableTest methodsFor: 'tests'!
testPrimaryKeyFieldsNoPK
| pkFields table |
    table := system tableNamed: 'CUSTOMER_ACCT_LINK'.
    pkFields := table primaryKeyFields.
    self assert: pkFields size = 0.! !
!TableTest methodsFor: 'tests'!
testPrintingWithParent
| t t1 |
    t := system tableNamed: 'GR_CUSTOMER'.
    t1 := t copy.
    t1 parent: t.
    t1 name: 'foo'.
    self assert: t1 sqlTableName = 'GR_CUSTOMER foo'.! !
!TableTest methodsFor: 'tests'!
testPrintingWithoutParent
| t t1 |
    t := system tableNamed: 'GR_CUSTOMER'.
    self assert: t sqlTableName = 'GR_CUSTOMER'.! !
!TableTest methodsFor: 'tests'!
testRowCreation
| row |
    row := system examplePersonRow1.
    self assert: (row at: (row table fieldNamed: 'ID')) = 3.! !
!TableTest methodsFor: 'tests'!
testTwoSequences
    | row1 row2 bankTable idField |
    bankTable := system existingTableNamed: 'BANK_TRANS'.
    row1 := DatabaseRow newForTable: bankTable.
    row2 := DatabaseRow newForTable: bankTable.
    row1 preWriteAssignSequences.
    row1 postWriteAssignSequences.
    row2 preWriteAssignSequences.
    row2 postWriteAssignSequences.
    idField := bankTable fieldNamed: 'ID'.
    self assert: (row1 at: idField) = 1.
    self assert: (row2 at: idField) = 2.! !
!TestPGConnection methodsFor: 'private' stamp: 'nop 5/31/2002 18:52'!
defaultConnectionArgs
    ^ PGConnectionArgs
    	hostname: 'localhost'
    	portno: 5432
    	databaseName: 'squeakdb'
    	userName: 'bern'
    	password: 'bern'! !
!TestRunner methodsFor: 'initialize' stamp: 'nop 5/31/2002 14:06'!
gatherTestNames
    | theNames |
    theNames _ (TestCase allSubclasses
    			collect: [:each | each name]) asSortedCollection.
    theNames
    	remove: #TestViaMethodCall
    	ifAbsent: [^ theNames].
    TestViaMethodCall addClassesTo: theNames.
    ^ theNames! !
!TimedExpiryCachePolicy methodsFor: 'wrap/unwrap'!
cacheEntryFor: anObject
^Array with: Time totalSeconds with: anObject.! !
!TimedExpiryCachePolicy methodsFor: 'wrap/unwrap'!
contentsOf: aCacheEntry
^aCacheEntry at: 2.! !
!TimedExpiryCachePolicy methodsFor: 'wrap/unwrap'!
hasExpired: aCacheEntry
^(Time totalSeconds - (aCacheEntry at: 1)) >= timeout.! !
!TimedExpiryCachePolicy methodsFor: 'accessing'!
timeout
    ^timeout! !
!TimedExpiryCachePolicy methodsFor: 'accessing'!
timeout: anInteger
    timeout := anInteger! !
!TimedExpiryCachePolicy methodsFor: 'initialize'!
initialize
super initialize.
    timeout := 300.! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUp
    super setUp.
    self setUpExpiryWithRealDelay.! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpExpiryWithRealDelay
    (cache session descriptorFor: Customer) cachePolicy: (TimedExpiryCachePolicy new timeout: 1).
    (cache session descriptorFor: BankTransaction) cachePolicy: (TimedExpiryCachePolicy new timeout: 1).! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpExpiryWithZeroDelay
    (cache session descriptorFor: Customer) cachePolicy: (TimedExpiryCachePolicy new timeout: 0).
    (cache session descriptorFor: BankTransaction) cachePolicy: (TimedExpiryCachePolicy new timeout: 0).! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpForExpiryActionOf: aSymbol
    (cache session descriptorFor: Customer) cachePolicy expiryAction: aSymbol.
    (cache session descriptorFor: BankTransaction) cachePolicy expiryAction: aSymbol.! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpForNotify
    self setUpForExpiryActionOf: #notify.! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpForNotifyAndRemove
    self setUpForExpiryActionOf: #notifyAndRemove.! !
!TimedExpiryCacheTest methodsFor: 'support'!
setUpForRefresh
    self setUpForExpiryActionOf: #refresh.! !
!TimedExpiryCacheTest methodsFor: 'tests'!
testExpiryReturningNilWithRealDelay
    "test that objects expire with a non-zero delay time."
    | customer customer2 |
    customer := Customer example1.
    cache at: 3 insert: customer.
    self deny: (cache lookupClass: Customer key: 3 ifAbsent: [nil]) == nil.
    (Delay forSeconds: 2) wait.
    self assert: (cache lookupClass: Customer key: 3 ifAbsent: [nil]) == nil.
    customer2 := Customer new.
    cache at: 3 insert: customer2.
    self assert: (cache lookupClass: Customer key: 3 ifAbsent: [nil]) == customer2.! !
!TimedExpiryCacheTest methodsFor: 'tests'!
testNotify
    | customer |
    self setUpExpiryWithZeroDelay.
    self setUpForNotify.
    customer := Customer example1.
    cache at: 3 insert: customer.
    self deny: (cache lookupClass: Customer key: 3 ifAbsent: [nil]) == nil.
    self assert: customer seenExpiry = true.! !
!TimedExpiryCacheTest methodsFor: 'tests'!
testNotifyAndRemove
    | customer |
    self setUpExpiryWithZeroDelay.
    self setUpForNotifyAndRemove.
    customer := Customer example1.
    cache at: 3 insert: customer.
    self assert: (cache lookupClass: Customer key: 3 ifAbsent: [nil]) == nil.
    self assert: customer seenExpiry = true.! !
!Tracing methodsFor: 'accessing'!
addTracing: anExpression
(allTracings includes: anExpression) ifFalse: [
    	allTracings add: anExpression].! !
!Tracing methodsFor: 'accessing'!
base
    ^base! !
!Tracing methodsFor: 'accessing'!
base: anExpression 
    base := anExpression! !
!Tracing methodsFor: 'initialize'!
initialize
base := BaseExpression new.
    allTracings := OrderedCollection new.
    allTracings add: base.! !
!Tracing methodsFor: 'querying'!
traceNodeSets
    ^Array with: allTracings.! !
!Tracing methodsFor: 'querying'!
tracesThrough: aMapping
^aMapping isIndependentRelationship not.! !
!Tracing class methodsFor: 'instance creation'!
new
^super new initialize.! !
!TracingTest methodsFor: 'support'!
setUp
tracing := Tracing new.! !
!TracingTest methodsFor: 'tests'!
testAddDuplicateTracings
| all |
    tracing addTracing: (tracing base get: #foo).
    tracing addTracing: (tracing base get: #foo).
    self assert: tracing traceNodeSets size = 1.
    all := tracing traceNodeSets first.
    self assert: all size = 2.
    self assert: all first == tracing base.! !
!TracingTest methodsFor: 'tests'!
testAddRecursiveTracings
| all |
    tracing addTracing: (tracing base get: #foo).
    tracing addTracing: ((tracing base get: #foo) get: #bar).
    self assert: tracing traceNodeSets size = 1.
    all := tracing traceNodeSets first.
    self assert: all size = 3.
    self assert: all first == tracing base.
    self assert: all last base == (all at: 2).! !
!TracingTest methodsFor: 'tests'!
testAddTracing
| onlyNodeSet |
    tracing addTracing: (tracing base get: #foo).
    self assert: tracing traceNodeSets size = 1.
    onlyNodeSet := tracing traceNodeSets first.
    self assert: onlyNodeSet size = 2.
    self assert: onlyNodeSet first == tracing base.
    self assert: onlyNodeSet last == (tracing base get: #foo).! !
!TracingTest methodsFor: 'tests'!
testAddTwoTracings
tracing addTracing: (tracing base get: #foo).
    tracing addTracing: (tracing base get: #bar).
    self assert: tracing traceNodeSets size = 1.
    self assert: tracing traceNodeSets first size = 3.
    self assert: tracing traceNodeSets first first == tracing base.! !
!TransformedField methodsFor: 'database'!
convertToDatabaseForm: anObject
^parent convertToDatabaseForm: (self transform: anObject).! !
!TransformedField methodsFor: 'database'!
transform: anObject
^transformation value: anObject! !
!TransformedField methodsFor: 'accessing'!
parent
    ^parent.! !
!TransformedField methodsFor: 'accessing'!
parent: aDatabaseField 
    parent := aDatabaseField.! !
!TransformedField methodsFor: 'accessing'!
rootField
^parent rootField.! !
!TransformedField methodsFor: 'accessing'!
stringTransformation: aBlockClosure 
    stringTransformation := aBlockClosure.! !
!TransformedField methodsFor: 'accessing'!
transformation: aBlock
    transformation := aBlock.! !
!TransformedField methodsFor: 'printing'!
printSQLOn: aWriteStream withParameters: anArray 
    | newStream |
    newStream := String new writeStream.
    parent printSQLOn: newStream withParameters: anArray.
    aWriteStream nextPutAll: (stringTransformation value: newStream contents)! !
!UnitOfWork methodsFor: 'begin/commit/abort'!
abort
    self reinitialize.! !
!UnitOfWork methodsFor: 'begin/commit/abort'!
begin
    self reinitialize.! !
!UnitOfWork methodsFor: 'begin/commit/abort'!
commit
"First, look for new objects reachable from currently registered objects"
    self registeredObjectsDo: [:eachObject |
    	self registerTransitiveClosureFrom: eachObject].
self registeredObjectsDo: [:eachObject |
    	session createRowsFor: eachObject in: rowMap].
    self buildCommitPlan.
    self registeredObjectsDo: [:eachObject |
    	session sendPreWriteEventTo: eachObject].
    self writeRows.
    self registeredObjectsDo: [:eachObject |
    	session sendPostWriteEventTo: eachObject].
    self updateSessionCache.! !
!UnitOfWork methodsFor: 'begin/commit/abort'!
rollback
    self abort.! !
!UnitOfWork methodsFor: 'initializing'!
initialize
transaction := ObjectTransaction new.
    self reinitialize! !
!UnitOfWork methodsFor: 'initializing'!
reinitialize
rowMap := RowMap new.
    transaction abort.! !
!UnitOfWork methodsFor: 'enumerating'!
registeredObjectsDo: aBlock
transaction registeredObjectsDo: [:each |
    	(session hasDescriptorFor: each) ifTrue: [
    		aBlock value: each]].! !
!UnitOfWork methodsFor: 'enumerating'!
rowsForTable: aTable do: aBlock
rowMap rowsForTable: aTable do: aBlock.! !
!UnitOfWork methodsFor: 'accessing'!
session
    "Private - Answer the value of the receiver's ''session'' instance variable."
^session! !
!UnitOfWork methodsFor: 'accessing'!
session: anObject
    "Private - Set the value of the receiver's ''session'' instance variable to the argument, anObject."
session := anObject! !
!UnitOfWork methodsFor: 'private/mapping'!
addObject: eachObject toCacheKeyedBy: key 
    
    self session cacheAt: key put: eachObject.! !
!UnitOfWork methodsFor: 'private/mapping'!
addToCommitPlan: aRow
    
    commitPlan add: aRow.! !
!UnitOfWork methodsFor: 'private/mapping'!
buildCommitPlan
    
    commitPlan := OrderedCollection new.
    session tablesInCommitOrder do: [:eachTable  |
    	self rowsForTable: eachTable do: [:eachRow |
    		self addToCommitPlan: eachRow]].! !
!UnitOfWork methodsFor: 'private/mapping'!
readBackNewRowInformation
self registeredObjectsDo: [:each |
    	(session descriptorFor: each class) readBackNewRowInformationFor: each].! !
!UnitOfWork methodsFor: 'private/mapping'!
registerTransitiveClosureFrom: anObject
| descriptor |
    descriptor := session descriptorFor: anObject class.
    descriptor isNil ifTrue: [^self].
    descriptor referencedIndependentObjectsFrom: anObject do: [:each |
    	self register: each].! !
!UnitOfWork methodsFor: 'private/mapping'!
updateSessionCache
    rowMap
    	keysAndValuesDo: [:eachObject :eachRow | 
    		eachRow shouldBeWritten ifTrue: [
    			self updateSessionCacheFor: eachObject withRow: eachRow]]! !
!UnitOfWork methodsFor: 'private/mapping'!
updateSessionCacheFor: anObject withRow: aRow 
    | key existingObject |
    key := aRow primaryKey.
    existingObject := session cacheLookupForClass: anObject class key: key.
    existingObject isNil ifTrue: [self addObject: anObject toCacheKeyedBy: key]! !
!UnitOfWork methodsFor: 'private/mapping'!
writeRows
commitPlan do: [:eachRow |
    	session writeRow: eachRow].
    self readBackNewRowInformation.! !
!UnitOfWork methodsFor: 'registering'!
isRegistered: anObject
^transaction isRegistered: anObject.! !
!UnitOfWork methodsFor: 'registering'!
register: anObject
| realObject |
    realObject := transaction register: anObject.
    self registerTransitiveClosureFrom: realObject.! !
!UnitOfWork methodsFor: 'private'!
privateGetTransaction
^transaction.! !
!UnitOfWork class methodsFor: 'instance creation'!
new
^super new initialize.! !
!UnitOfWorkTest methodsFor: 'support'!
exampleCustomerProxy
    | p |
    p := Proxy new.
    p session: session.
    p query: (QueryStub returningOneOf: Customer where: [:a | a id = 3]).
    p query result: (Customer new id: 3).
    ^p! !
!UnitOfWorkTest methodsFor: 'support'!
exampleTransactionWithCustomerProxy
    | transaction |
    transaction := BankTransaction example1.
    transaction owner: self exampleCustomerProxy.
    ^transaction! !
!UnitOfWorkTest methodsFor: 'support'!
setUp
    super setUp.
    session := SessionResource current newSession.! !
!UnitOfWorkTest methodsFor: 'tests'!
testAutomaticRegistrationOnRead
    | p c |
    p := self exampleCustomerProxy.
    c := p getValue.
    session beginUnitOfWork.
    session register: p.
    self assert: (session isRegistered: p).
    self assert: (session isRegistered: c).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction isRegistered: p).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction isRegistered: c).! !
!UnitOfWorkTest methodsFor: 'tests'!
testCommitOrderAtSessionLevel
| tables | 
    tables := session tablesInCommitOrder.
    tables first name = 'CUSTOMER'.
    self unfinished.! !
!UnitOfWorkTest methodsFor: 'tests'!
testPostRegister
    | c1 t1 t2 |
    c1 := Customer example1.
    [session beginTransaction.
    session beginUnitOfWork.
    t1 := BankTransaction new.
    t2 := BankTransaction new.
    c1 addTransaction: t1.
    c1 addTransaction: t2.
    session register: c1.
    self assert: (session isRegistered: c1).
    self assert: (session isRegistered: t1).
    self assert: (session isRegistered: t2).
    session commitUnitOfWork]
    	ensure: [session rollbackTransaction].
    "Need some assertions on what was written"
    self unfinished.! !
!UnitOfWorkTest methodsFor: 'tests'!
testPreRegister
    
    | c1 t1 t2 trans |
    c1 := Customer example1.
    [session beginTransaction.
    session beginUnitOfWork.
    session register: c1.
    t1 := BankTransaction new.
    t2 := BankTransaction new.
    c1 addTransaction: t1.
    c1 addTransaction: t2.
    trans := session privateGetCurrentUnitOfWork privateGetTransaction.
    session commitUnitOfWork.
    self assert: (trans isRegistered: c1).
    self assert: (trans isRegistered: t1).
    self assert: (trans isRegistered: t2).]
    	ensure: [session rollbackTransaction].
    "Need some assertions on what got written"
    self unfinished.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterInstantiatedProxy
    | p c |
    p := self exampleCustomerProxy.
    c := p getValue.
    session beginUnitOfWork.
    session register: p.
    self assert: (session isRegistered: p).
    self assert: (session isRegistered: c).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction isRegistered: p).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction isRegistered: c).! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterObjectWithInstantiatedProxy
    | transaction customer |
    transaction := self exampleTransactionWithCustomerProxy.
    customer := transaction owner getValue.
    session beginUnitOfWork.
    session register: transaction.
    self assert: (session isRegistered: transaction).
    self assert: (session isRegistered: customer).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: transaction).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: customer).
    self assert: transaction owner isInstantiated.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterObjectWithProxy
    | transaction |
    transaction := self exampleTransactionWithCustomerProxy.
    session beginUnitOfWork.
    session register: transaction.
    self assert: (session isRegistered: transaction).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: transaction).
    self deny: transaction owner isInstantiated.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterObjectWithProxyThenInstantiate
    | transaction customer |
    transaction := self exampleTransactionWithCustomerProxy.
    session beginUnitOfWork.
    session register: transaction.
    customer := transaction owner getValue.
    session register: transaction.
    self assert: (session isRegistered: transaction).
    self assert: (session isRegistered: customer).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: transaction).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: customer).
    self assert: transaction owner isInstantiated! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterObjectWithProxyThenInstantiateAndReregister
    | transaction customer |
    transaction := self exampleTransactionWithCustomerProxy.
    session beginUnitOfWork.
    session register: transaction.
    customer := transaction owner getValue.
    session register: transaction.
    self assert: (session isRegistered: transaction).
    self assert: (session isRegistered: customer).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: transaction).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: customer).
    self assert: transaction owner isInstantiated! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterProxy
    | p |
    p := self exampleCustomerProxy.
    session beginUnitOfWork.
    session register: p.
    self deny: (session isRegistered: p).
    self deny: (session privateGetCurrentUnitOfWork privateGetTransaction isRegistered: p).
    self deny: p isInstantiated.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRegisterProxyThenInstantiateAndReregister
    | p c |
    p := self exampleCustomerProxy.
    session beginUnitOfWork.
    session register: p.
    c := p getValue.
    session register: p.
    self assert: (session isRegistered: p).
    self assert: (session isRegistered: c).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: p).
    self assert: (session privateGetCurrentUnitOfWork privateGetTransaction 
    			isRegistered: c)! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToManyAfterAdd
    | customer t1 t2 transList amount |
    customer := Customer example1.
    t1 := customer transactions first.
    t2 := customer transactions last.
    transList := customer transactions.
    amount := t1 amount.
    session beginUnitOfWork.
    session register: customer.
    20 timesRepeat: [customer addTransaction: (BankTransaction new)].
    customer transactions first amount: 65543.
    session rollbackUnitOfWork.
    self assert: customer transactions == transList.
    self assert: customer transactions size = 2.
    self assert: customer transactions first == t1.
    self assert: customer transactions last == t2.
    self assert: t1 amount == amount.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToManyAfterReplace
    | customer t1 t2 transList |
    customer := Customer example1.
    t1 := customer transactions first.
    t2 := customer transactions last.
    transList := customer transactions.
    session beginUnitOfWork.
    session register: customer.
    customer transactions: OrderedCollection new.
    session rollbackUnitOfWork.
    self assert: customer transactions == transList.
    self assert: customer transactions size = 2.
    self assert: customer transactions first == t1.
    self assert: customer transactions last == t2.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToManyProxy
    | customer t1 t2 transList |
    customer := Customer example1.
    t1 := customer transactions first.
    t2 := customer transactions last.
    transList := customer transactions.
    session beginUnitOfWork.
    session register: customer.
    customer transactions: OrderedCollection new.
    session rollbackUnitOfWork.
    self assert: customer transactions == transList.
    self assert: customer transactions size = 2.
    self assert: customer transactions first == t1.
    self assert: customer transactions last == t2.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToManyWithList
    "Check that dependents aren't being registered for the collection"
    | customer marker |
    "Lists only exist in VW"
    Dialect isVisualWorks ifFalse: [^self].
    marker := Object new.
    customer := Customer example1.
    customer transactions: (customer transactions asList).
    customer transactions addDependent: marker.
    session beginUnitOfWork.
    session register: customer.
    20 timesRepeat: [customer addTransaction: (BankTransaction new)].
    session rollbackUnitOfWork.
    self assert: customer transactions class == List.
    self assert: customer transactions size = 2.
    self should: [customer transactions privateAt: 3] raise: Object subscriptOutOfBoundsSignal.
    self assert: (customer transactions dependents includes: marker).
    self deny: (session isRegistered: marker).! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToOne
    | transaction customer |
    transaction := BankTransaction new.
    customer := Customer new.
    transaction owner: customer.
    session beginUnitOfWork.
    session register: transaction.
    transaction owner: Customer new.
    session rollbackUnitOfWork.
    self assert: transaction owner == customer.! !
!UnitOfWorkTest methodsFor: 'tests'!
testRollbackOneToOneWithProxy
    | transaction customerProxy |
    transaction := self exampleTransactionWithCustomerProxy.
    customerProxy := transaction owner.
    session beginUnitOfWork.
    session register: transaction.
    transaction owner: Customer new.
    session rollbackUnitOfWork.
    self assert: transaction owner == customerProxy! !
!UnitOfWorkTest class methodsFor: 'resources'!
resources
^Array with: SessionResource.! !
!VA55DatabaseAccessor methodsFor: 'executing'!
executeSQLString: aString 
    "^<(OrderedCollection of: ??) | self> This method executes a general SQL command against the connection"
| resultTable rowCollection |
    self log: aString.
    rowCollection := OrderedCollection new.
"Changed to get all sql commands to the database via this method"
    (aString copyFrom: 1 to: (6 min: aString size)) asUppercase = 'SELECT' 
    	ifFalse: [
    		connection 
    			executeSQLStatement: aString
    			ifError: [:err|self externalDatabaseErrorSignal signalWith: err]
    	]
    	ifTrue: 
    		[
    		resultTable := connection 
    							resultTableFromQuerySpec: ((Smalltalk at: #AbtQuerySpec) new statement: aString)
    							ifError: [:err |self externalDatabaseErrorSignal signalWith: err].
    		resultTable isAbtError 
    			ifFalse: [
    				rowCollection := OrderedCollection new.
    				resultTable do: 
    						[:eachRow | 
    						eachRow isAbtError 
    							ifTrue: [self externalDatabaseErrorSignal signalWith: eachRow]
    							ifFalse: [rowCollection addLast: OrderedCollection new. 
    								(eachRow columnValuesDo: [:eachValue| rowCollection last addLast: eachValue])]]]].
"	self log: 'Done with executeSQLString.'."
    ^rowCollection! !
!VA55DatabaseAccessor methodsFor: 'executing'!
externalDatabaseErrorSignal
^self class externalDatabaseErrorSignal.! !
!VA55DatabaseAccessor methodsFor: 'development'!
todo: aString
^self! !
!VA55DatabaseAccessor methodsFor: 'initialize'!
initialize
    super initialize.
    isInTransaction := false.! !
!VA55DatabaseAccessor methodsFor: 'login'!
connectionClassForLogin: aLogin 
    aLogin database isOraclePlatform 
    	ifTrue: [^Smalltalk at: #AbtOracle8DatabaseManager].
    aLogin database isODBCPlatform 
    	ifTrue: [^Smalltalk at: #AbtOdbcDatabaseManager].
    aLogin database isPostgreSQLPlatform 
    	ifTrue: [self error: 'PostgreSQL is not yet supported under VA'].
    self error: 'Unknown database platform' , aLogin database printString! !
!VA55DatabaseAccessor methodsFor: 'login'!
isLoggedIn
^connection notNil! !
!VA55DatabaseAccessor methodsFor: 'login'!
logStream
    ^Transcript! !
!VA55DatabaseAccessor methodsFor: 'login'!
loginIfError: aBlock 
    "
    	This method creates a NEW database connection.
    "
| dbMgrClass anAbtDatabaseLogonSpec anAbtDatabaseConnectionSpec aliasNameString baseAliasName |
    self log: 'Login'.
    aliasNameString := baseAliasName := currentLogin connectString.
"
    	We try to generate a unique alias name to get a new connection and to 
    	prevent the normal VAST behaviour to reuse a connection
    "
    
    [((Smalltalk at: #AbtDbmSystem) 
    	activeDatabaseConnectionWithAlias: aliasNameString) notNil] 
    		whileTrue: 
    			[aliasNameString := baseAliasName , Time millisecondClockValue printString].
"
    	Get the native VA class responsible for doing the work against the
    	three special connections available in VA
    "
    dbMgrClass := self connectionClass.
"
    	Get the logon specification for the database ... do not use
    	any server information
    "
    anAbtDatabaseLogonSpec := (Smalltalk at: #AbtDatabaseLogonSpec) 
    			id: currentLogin username
    			password: currentLogin password
    			server: nil.
"	
    	Get the specification for the connection ... 
   "
    anAbtDatabaseConnectionSpec := (Smalltalk at: #AbtDatabaseConnectionSpec) 
    			forDbmClass: dbMgrClass
    			dataSourceName: currentLogin connectString.
    connection := anAbtDatabaseConnectionSpec 
    			connectUsingAlias: aliasNameString
    			logonSpec: anAbtDatabaseLogonSpec
    			ifError: 
    				[:error | 
    				"throw away the connection ..."
connection := nil.
    				aBlock value: error]! !
!VA55DatabaseAccessor methodsFor: 'login'!
logout
    self isLoggedIn ifFalse: [^self].
    self log: 'Logout'.
    [connection disconnectIfError: [:ex | self logError: ex]]
    	ensure:	[connection := nil].
    self log: 'Logout finished'! !
!VA55DatabaseAccessor methodsFor: 'login'!
showDialog: aString
(Smalltalk at: #CwMessagePrompter) warn: aString.! !
!VA55DatabaseAccessor methodsFor: 'transactions'!
beginTransaction
    self log: 'Begin Transaction'.
    isInTransaction := true.
    self connection beginUnitOfWork.! !
!VA55DatabaseAccessor methodsFor: 'transactions'!
commitTransaction
    self log: 'Commit Transaction'.
    isInTransaction := false.
    self connection commitUnitOfWorkIfError: 
    		[:err |
    		self log: 'Commit Transaction failed.'. 
    		self connection autoCommit: true.
    		self todo: 'Need to handle this error somehow....'.
    		"errorBlock value: err"].! !
!VA55DatabaseAccessor methodsFor: 'transactions'!
isInTransaction
    ^isInTransaction! !
!VA55DatabaseAccessor methodsFor: 'transactions'!
rollbackTransaction
    self log: 'Rollback Transaction'.
    isInTransaction := false.
    self connection rollbackUnitOfWork.! !
!VA55DatabaseAccessor class methodsFor: 'accessing'!
externalDatabaseErrorSignal
databaseErrorSignal isNil ifTrue: [self initializeDatabaseErrorSignal ].
    ^databaseErrorSignal! !
!VA55DatabaseAccessor class methodsFor: 'initialization'!
initializeDatabaseErrorSignal
databaseErrorSignal := ((Smalltalk at: #SystemExceptions) at: 'ExError') newChild.
    databaseErrorSignal markReadOnly: false;
    	description: 'Database error';
    	resumable: false;
    	defaultHandler: nil;
    	markReadOnly: true! !
!VWDatabaseAccessor methodsFor: 'accessing'!
driverSession
driverSession isNil
    	ifTrue: [
    		driverSession := connection getSession.
    		(driverSession respondsTo: #maxLongBytes:) ifTrue: [
    			driverSession maxLongBytes: 32767]].  "Why does this not default larger for Oracle?"
    ^driverSession.! !
!VWDatabaseAccessor methodsFor: 'executing'!
disconnect
^connection disconnect! !
!VWDatabaseAccessor methodsFor: 'executing'!
executeSQLString: aString 
    | answerStream |
    logging 
    	ifTrue: 
    		[Transcript
    			show: aString;
    			cr].
    self driverSession prepare: aString.
    self driverSession execute.
    answerStream := driverSession answer.
    answerStream == #noAnswerStream ifTrue: [^#()].
    answerStream == #noMoreAnswers ifTrue: [^#()].
    ^answerStream upToEnd! !
!VWDatabaseAccessor methodsFor: 'executing'!
externalDatabaseErrorSignal
^connection class externalDatabaseErrorSignal.! !
!VWDatabaseAccessor methodsFor: 'initialize'!
initialize
super initialize.
    logging := true.! !
!VWDatabaseAccessor methodsFor: 'login'!
connectionClassForLogin: aLogin 
    aLogin database class == OraclePlatform ifTrue: [^'OracleConnection' asQualifiedReference value].
    aLogin database class == #MySQL ifTrue: [^'JdmMysqlConnection' asQualifiedReference value].
    aLogin database class == PostgreSQLPlatform 
    	ifTrue: [^'PostgreSQLEXDIConnection' asQualifiedReference value].
    aLogin database class == SQLServerPlatform
    	ifTrue: [^'ODBCConnection' asQualifiedReference value].
    self error: 'Unknown database: ' , aLogin database! !
!VWDatabaseAccessor methodsFor: 'login'!
isLoggedIn
connection isNil ifTrue: [^false].
    ^connection isConnected! !
!VWDatabaseAccessor methodsFor: 'login'!
loginIfError: aBlock 
    logging 	ifTrue: [Transcript show: 'Login'; cr].
    connection := self connectionClass new.
    connection username: currentLogin username.
    connection environment: currentLogin connectString.
    self doCommand: [connection connect: currentLogin password] ifError: aBlock.
    logging 
    	ifTrue: 
    		[Transcript
    			show: 'Login finished';
    			cr]! !
!VWDatabaseAccessor methodsFor: 'login'!
logout
self isLoggedIn ifFalse: [^self].
    logging 	ifTrue: [Transcript show: 'Logout'; cr].
    self doCommand: [connection disconnect.].	
    logging 	ifTrue: [Transcript show: 'Logout finished'; cr].! !
!VWDatabaseAccessor methodsFor: 'login'!
showDialog: aString
(Smalltalk at: #Dialog) warn: aString.! !
!VWDatabaseAccessor methodsFor: 'transactions'!
beginTransaction
    logging ifTrue: 
    	[Transcript show: 'Begin Transaction'; cr].
    connection begin.! !
!VWDatabaseAccessor methodsFor: 'transactions'!
commitTransaction
logging ifTrue: 
    	[Transcript show: 'Commit Transaction'; cr].
    connection commit.! !
!VWDatabaseAccessor methodsFor: 'transactions'!
isInTransaction
^connection inTransactionMode! !
!VWDatabaseAccessor methodsFor: 'transactions'!
rollbackTransaction
    logging ifTrue: 
    	[Transcript show: 'Rollback Transaction'; cr].
    connection rollback.! !
Object subclass: #Session
    instanceVariableNames: 'system currentUnitOfWork cache accessor applicationData '
    classVariableNames: 'Sessions '
    poolDictionaries: ''
    category: 'Glorp'!
"Postscript:
First version of a quick and dirty port of glorp to Squeak"
!