"Copyright (C) Masashi Umezawa all rights reserved" "I MAKE NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY OF THIS CLASS,EITHER EXPRESS OR IMPLIED, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT. I SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY USING AS A RESULT OF USING, MODIFYING OR DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES." "You need VisualWorks 2.5.* and Objectivity/DB Smalltalk Interface" Object subclass: #StorageManager instanceVariableNames: 'sessionMgr sessionManagerClass sessionMode ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! StorageManager comment: 'ABSTRACT StorageManager My subclasss should treat storaging matters.. Application programmers should use my subclass. They do not have to care about session managemant much because I will manage it using sesiion manager. Instance Variables: sessionManagerClass sessionMgr '! !StorageManager methodsFor: 'initialize'! initialize self prepareInitialize. self setSessonMode. self makeSessionManager. self startSessionManager. self setDomains. self closeInitialize.! ! !StorageManager methodsFor: 'private-initialize'! closeInitialize ^self subclassResponsibility! makeSessionManager self sessionManagerClass notNil ifTrue: [self sessionMode == #single ifTrue: [sessionMgr := self sessionManagerClass default]. self sessionMode == #multi ifTrue: [sessionMgr := self sessionManagerClass default]]! prepareInitialize ^self subclassResponsibility! setSessonMode self sessionMode: #single.! startSessionManager ^self subclassResponsibility! ! !StorageManager methodsFor: 'operation'! add: anObject ^self subclassResponsibility! find: anObject ^self subclassResponsibility! put: anObject ^self subclassResponsibility! remove: anObject ^self subclassResponsibility! ! !StorageManager methodsFor: 'accessing'! sessionManagerClass ^sessionManagerClass! sessionManagerClass: aClass sessionManagerClass := aClass! sessionMgr ^sessionMgr! sessionMgr: anObject sessionMgr := anObject! sessionMode ^sessionMode! sessionMode: anObject sessionMode := anObject! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! StorageManager class instanceVariableNames: ''! !StorageManager class methodsFor: 'instance creation'! new ^super new initialize! ! Object subclass: #OoDomainModelContainer instanceVariableNames: 'container dictionary ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! OoDomainModelContainer comment: 'OoDomainModelContainer Instance Variables: container description of container dictionary description of dictionary '! !OoDomainModelContainer methodsFor: 'accessing-dictionary'! at: aKey ^self dictionary at: aKey! at: aKey ifAbsent: aBlock ^self dictionary at: aKey ifAbsent: aBlock! at: aKey put: anObject self container ooUpdate. self dictionary at: aKey put: anObject. self container cluster: anObject. ^anObject! do: aBlock ^self dictionary keysAndValuesDo: [:key :value | aBlock value: value]! keys ^self dictionary keys! removeKey: aKey ^self dictionary removeKey: aKey! removeKey: aKey ifAbsent: aBlock ^self dictionary removeKey: aKey ifAbsent: aBlock! values ^self dictionary values! ! !OoDomainModelContainer methodsFor: 'accessing-generic'! container ^container! container: anOoContainer container := anOoContainer! dictionary ^dictionary! dictionary: anOoDictionary dictionary := anOoDictionary! ! !OoDomainModelContainer methodsFor: 'putting'! put: anOoDomainModel anOoDomainModel putObjyOn: self! ! !OoDomainModelContainer methodsFor: 'removing'! remove: anOoDomainModel anOoDomainModel removeObjyOn: self! ! !OoDomainModelContainer methodsFor: 'changing-mode'! beUpdateMode ^self container ooUpdate! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OoDomainModelContainer class instanceVariableNames: 'growth hash pages '! !OoDomainModelContainer class methodsFor: 'instance creation'! new ^self shouldNotImplement! new: anOoDB ^self new: anOoDB mode: OoSession oocRead.! new: anOoDB mode: aMode | inst cont dict contName dictName | inst := self basicNew. contName := self containerName. dictName := self dictionaryName. (anOoDB hasContainer: contName) ifTrue: [cont := anOoDB openContainer: contName mode: aMode. dict := anOoDB roots at: dictName] ifFalse: [cont := self containerClass new: anOoDB name: contName pages: self pages growth: self growth hash: self hashValue. dict := self dictionaryClass new. anOoDB roots at: dictName put: dict. cont cluster: dict]. inst container: cont. inst dictionary: dict. ^inst! new: anOoDB mode: aMode contName: aContName dictName: aDictName | inst cont dict contName dictName | inst := self basicNew. contName := aContName. dictName := aDictName. (anOoDB hasContainer: contName) ifTrue: [cont := anOoDB openContainer: contName mode: aMode. dict := anOoDB roots at: dictName] ifFalse: [cont := self containerClass new: anOoDB name: contName pages: self pages growth: self growth hash: self hashValue. dict := self dictionaryClass new. anOoDB roots at: dictName put: dict. cont cluster: dict]. inst container: cont. inst dictionary: dict. ^inst! ! !OoDomainModelContainer class methodsFor: 'constants'! containerClass "default-You can also use OoContObj(C++ container)" ^OoContainer! containerName "override-This method returns String( container name )" ^self subclassResponsibility! dictionaryClass "default-You can also use OoMap" ^OoDictionary! dictionaryName "override-This method returns String( named root dictionary name )" ^self subclassResponsibility! growth ^10! hashValue ^11! pages ^10! ! StorageManager subclass: #ObjyStorageManager instanceVariableNames: 'database databaseName contDict ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! ObjyStorageManager comment: 'ABSTRACT ObjyStorageManager The comment should state the purpose of the class and also explain any unobvious aspects of the implementation. '! !ObjyStorageManager methodsFor: 'initialize'! closeInitialize self sessionMgr commitBeginMROW! setDomains self database: (self sessionMgr startDB: self databaseName). self setContainers: self database.! startSessionManager self sessionMgr startUp! ! !ObjyStorageManager methodsFor: 'accessing'! database ^database! database: anObject database := anObject! databaseName ^databaseName! databaseName: aString databaseName := aString! sessionManagerClass ^ObjySessionManager! ! !ObjyStorageManager methodsFor: 'private'! prepareInitialize self class ooFdBoot isEmpty ifFalse: [self sessionManagerClass bootLocation: self class ooFdBoot].! setContainers: database ^self subclassResponsibility! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ObjyStorageManager class instanceVariableNames: 'OoFdBoot '! !ObjyStorageManager class methodsFor: 'accessing'! ooFdBoot ^OoFdBoot! ooFdBoot: aString OoFdBoot := aString! ! Object subclass: #OoDomainModel instanceVariableNames: 'key ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! OoDomainModel comment: 'ABSTRACT OoDomainModel I am a base class for domain model which shoud be stored in Objy/ST. Instance Variables: key User defined ID '! !OoDomainModel methodsFor: 'intialize-release'! initialize "override--default use hash value as Key" key := self hash! ! !OoDomainModel methodsFor: 'database-key'! key "note--default use hash value as Key" ^key! key: aKey key := aKey! ! !OoDomainModel methodsFor: 'putting'! putObjyOn: anOoDomainModelContainer ^anOoDomainModelContainer at: self key put: self! ! !OoDomainModel methodsFor: 'removing'! removeObjyOn: anOoDomainModelContainer ^anOoDomainModelContainer removeKey: self key! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OoDomainModel class instanceVariableNames: ''! !OoDomainModel class methodsFor: 'instance creation'! new ^super new initialize! ! StorageManager subclass: #LensStorageManager instanceVariableNames: 'dataModelOwner username passwd ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! LensStorageManager comment: 'ABSTRACT LensStorageManager Instance Variables: dataModelOwner any object which returns anLensDataModel passwd passwd username username '! !LensStorageManager methodsFor: 'initialize'! makeSessionManager super makeSessionManager. (self dataModelOwner isNil or: [self username isNil or: [self passwd isNil]]) ifFalse: [sessionMgr dataModel: self dataModelOwner dataModel. (sessionMgr session) username: self username; password: self passwd]! startSessionManager self sessionMgr connect! ! !LensStorageManager methodsFor: 'accessing'! dataModelOwner ^dataModelOwner! dataModelOwner: anObject dataModelOwner := anObject! passwd ^passwd! passwd: anObject passwd := anObject! sessionManagerClass ^LensSessionManager! username ^username! username: anObject username := anObject! ! Object subclass: #DatabaseSessionManager instanceVariableNames: 'session ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! DatabaseSessionManager comment: 'ABSTRACT DatabaseSessionManager I manage database sessions. Subclasses must implement the following messages: session management abortTransaction beginTransaction commitTransaction inTransaction Instance Variables: session instance of any session implementing class '! !DatabaseSessionManager methodsFor: 'initialize-release'! initialize session := nil.! release self abortTransaction! ! !DatabaseSessionManager methodsFor: 'accessing'! session ^session! ! !DatabaseSessionManager methodsFor: 'session management'! abortTransaction self subclassResponsibility! beginTransaction self subclassResponsibility! commitTransaction self subclassResponsibility! inTransaction self subclassResponsibility! ! !DatabaseSessionManager methodsFor: 'updating'! update: anAspect with: arguments from: anObject anAspect == #returnFromSnapshot ifTrue:[ self initialize]. anAspect == #aboutToSnapshot ifTrue: [self release].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DatabaseSessionManager class instanceVariableNames: 'Default '! !DatabaseSessionManager class methodsFor: 'instance creation'! default ^Default isNil ifTrue: [self initialize. Default := self basicNew initialize. ObjectMemory addDependent: Default] ifFalse: [Default inTransaction ifFalse: [Default initialize]. Default]! new ^super new initialize! ! !DatabaseSessionManager class methodsFor: 'class-initialization'! initialize "self initialize"! release "self release" Default release. ObjectMemory removeDependent: Default. Default := nil! ! DatabaseSessionManager subclass: #ObjySessionManager instanceVariableNames: 'database ' classVariableNames: 'Encoding ' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! ObjySessionManager comment: 'ObjySessionManager Instance Variables: database Objectivity Database Class Variables: Encoding specifies Encoding Type ( not used in this version) '! !ObjySessionManager methodsFor: 'initialize-release'! initialize session := OoSession new.! ! !ObjySessionManager methodsFor: 'accessing'! database ^database! ! !ObjySessionManager methodsFor: 'session managemant'! abortTransaction ^session abortTransaction! beginTransaction ^session beginTransaction! beginTransactionMROW ^session beginTransactionMROW! commitTransaction ^session commitTransaction! inTransaction ^session inTransaction! openSession ^self openSession: self class bootLocation! openSession: aBootFilePath ^self session open: aBootFilePath! ! !ObjySessionManager methodsFor: 'session actions'! abortBegin self abortTransaction. self beginTransaction.! abortBeginMROW self abortTransaction. self beginTransactionMROW.! abortDown self abortTransaction.! commitBegin self commitTransaction. self beginTransaction.! commitBeginMROW self commitTransaction. self beginTransactionMROW.! commitDown self commitTransaction.! startUp self openSession. self beginTransaction.! startUpMROW self openSession. self beginTransactionMROW.! ! !ObjySessionManager methodsFor: 'db managemant'! deleteDB database notNil ifTrue:[ database delete.].! newDB: aString ^database := self session newDB: aString.! openDB: aString ^database := session openDB: aString.! openDBRead: aString ^database := session openDB: aString mode: OoSession oocRead.! openDBUpdate: aString ^database := session openDB: aString mode: OoSession oocUpdate.! startDB: aString self inTransaction ifFalse: [self beginTransaction]. (session hasDB: aString) ifTrue: [database := self openDB: aString] ifFalse: [database := self newDB: aString]. ^database! ! !ObjySessionManager methodsFor: 'container managemant'! newContainer: name (self inTransaction and: [database notNil]) ifTrue: [^database newContainer: name]! newCPPContainer: name (self inTransaction and: [database notNil]) ifTrue: [^database newCPPContainer: name]! openContainer: name (self inTransaction and: [database notNil]) ifTrue: [^database openContainer: name]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ObjySessionManager class instanceVariableNames: 'OoFdBoot '! !ObjySessionManager class methodsFor: 'class-initialization'! initialize "ObjyManager initialize" Encoding := Locale current defaultStreamEncoder streamEncodingType. OoFdBoot := Filename defaultDirectory asString.! ! !ObjySessionManager class methodsFor: 'accessing'! bootLocation ^OoFdBoot! bootLocation: aString OoFdBoot := aString! encoding ^Encoding! encoding: anEncodingSymbol Encoding := anEncodingSymbol! ! !ObjySessionManager class methodsFor: 'examples'! example1 "ObjySessionManager example1" ObjySessionManager encoding: #ShiftJIS. ObjySessionManager bootLocation: 'F:\users\umezawa\objyST\Test'! ! DatabaseSessionManager subclass: #LensSessionManager instanceVariableNames: 'dataModel ' classVariableNames: '' poolDictionaries: '' category: 'DBSessionManagement-OGIS'! LensSessionManager comment: 'LensSessionManager Instance Variables: dataModel '! !LensSessionManager methodsFor: 'initialize-release'! initialize session := self dataModel isNil ifTrue: [nil] ifFalse: [self dataModel session]! ! !LensSessionManager methodsFor: 'accessing'! dataModel ^dataModel! dataModel: aDataModel dataModel := aDataModel! ! !LensSessionManager methodsFor: 'session management'! abortTransaction ^session rollback! beginTransaction ^session begin! commitTransaction ^session commit! inTransaction ^session isInTransaction! ! !LensSessionManager methodsFor: 'connection actions'! connect ^session connect! connect: aPassword ^session connect: aPassword! disconnect ^session disconnect! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! LensSessionManager class instanceVariableNames: ''! !LensSessionManager class methodsFor: 'instance creation'! on: aDataModel ^self basicNew dataModel: aDataModel; initialize! ! DatabaseSessionManager initialize! ObjySessionManager initialize!