Glorp port changeset and documentationNevin Pratt nevin at smalltalkpro.comSat Jun 1 01:59:39 UTC 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
-------------- next part --------------
A non-text attachment was scrubbed...
Name: GlorpPort.doc
Type: application/octet-stream
Size: 30720 bytes
Desc: not available
Url : http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20020531/3902ff9c/GlorpPort.obj
-------------- next part --------------
'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"
!
More information about the Squeak-dev mailing list |