Squeak-dev June 2002

squeak-dev@lists.squeakfoundation.org

173 participants
382 discussions

Squeak glorp port and documentation
by Nevin Pratt 01 Jun '02

01 Jun '02

Guys, I didn't realize that the changeset was so large that I had attached to the last message I sent out on this. It might not make it past your mail server (it was about 300k). I'm really sorry about that. This message shows what I should have done to start with. Sorry. Nevin ********************** 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. I have a MickeySoft Word document ('GlorpPort.doc') that contains my "diary" of what I did. I hope you find it entertaining :-) I also have the 'glorp.cs' changeset with the code. The "diary" can be found at: http://home.earthlink.net/~nevinpratt/GlorpPort.doc The Squeak changeset can be found at: http://home.earthlink.net/~nevinpratt/glorp.cs 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

1 0

Glorp port changeset and documentation
by Nevin Pratt 01 Jun '02

01 Jun '02

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

1 0

Jump to page: