Menu
▾
▴
[Jcframework-commits] dotnet CInjectedObject.vb,NONE,1.1 CInjectedObjects.vb,NONE,1.1 AToMSFramework.vbproj,1.17,1.18 CCacheEntry.vb,1.17,1.18 CClassMap.vb,1.31,1.32 CPersistenceBroker.vb,1.63,1.64 CPersistentObject.vb,1.41,1.42 IPersistentObject.vb,1.2,1.3 modPersistenceBrokerSingleton.vb,1.8,1.9
|
From: Richard B. <rb...@us...> - 2004-10-14 05:25:11
|
Update of /cvsroot/jcframework/dotnet In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21824 Modified Files: AToMSFramework.vbproj CCacheEntry.vb CClassMap.vb CPersistenceBroker.vb CPersistentObject.vb IPersistentObject.vb modPersistenceBrokerSingleton.vb Added Files: CInjectedObject.vb CInjectedObjects.vb Log Message: Allow the persistence of objects without having to inherit from CPeristentObject. At this stage only basic save and retrieve for a single object is working. Index: AToMSFramework.vbproj =================================================================== RCS file: /cvsroot/jcframework/dotnet/AToMSFramework.vbproj,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- AToMSFramework.vbproj 13 Oct 2004 01:36:34 -0000 1.17 +++ AToMSFramework.vbproj 14 Oct 2004 05:25:02 -0000 1.18 @@ -184,6 +184,16 @@ BuildAction = "Compile" /> <File + RelPath = "CInjectedObject.vb" + SubType = "Code" + BuildAction = "Compile" + /> + <File + RelPath = "CInjectedObjects.vb" + SubType = "Code" + BuildAction = "Compile" + /> + <File RelPath = "CJoin.vb" SubType = "Code" BuildAction = "Compile" Index: CPersistenceBroker.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistenceBroker.vb,v retrieving revision 1.63 retrieving revision 1.64 diff -u -d -r1.63 -r1.64 --- CPersistenceBroker.vb 13 Oct 2004 05:19:01 -0000 1.63 +++ CPersistenceBroker.vb 14 Oct 2004 05:25:02 -0000 1.64 @@ -35,6 +35,7 @@ Private m_cache As CCacheCollection 'object collection cache - stores persistent objects Private m_useCache As Boolean Private m_loaded As Boolean + Private m_injectedObjects As New CInjectedObjects Public Event LoginDetailsNeeded(ByVal sender As Object, ByRef User As String, ByRef Password As String) @@ -155,12 +156,12 @@ ''' [rbanks] 16/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function retrieveObject(ByRef obj As CPersistentObject, ByVal useFind As Boolean, ByVal useCache As Boolean) As Boolean + Public Function retrieveObject(ByRef obj As IPersistableObject, ByVal useFind As Boolean, ByVal useCache As Boolean) As Boolean SyncLock GetType(CPersistenceBroker) Dim cm As CClassMap Dim conn As _CConnection Dim x As RetrieveException - cm = obj.getClassMap(obj) + cm = obj.getClassMap conn = cm.RelationalDatabase.getConnection(Nothing) conn.AutoCommit = False Try @@ -247,8 +248,8 @@ ''' [rbanks] 16/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Private Function retrievePrivateObject(ByRef obj As CPersistentObject, ByVal conn As _CConnection, ByVal useFind As Boolean, ByVal useCache As Boolean) As Boolean - Dim tmpObj As CPersistentObject + Private Function retrievePrivateObject(ByRef obj As IPersistableObject, ByVal conn As _CConnection, ByVal useFind As Boolean, ByVal useCache As Boolean) As Boolean + Dim tmpObj As IPersistableObject Dim cm As CClassMap Dim t As Type Dim resetLoadingFlag As Boolean @@ -266,7 +267,7 @@ Dim isfirst As Boolean = True Dim am As CAttributeMap - cm = obj.getClassMap(obj) + cm = obj.getClassMap Debug.WriteLine("retrievePrivateObject: " & cm.Name) @@ -280,8 +281,8 @@ End If End If If Not tmpObj Is Nothing Then - t = tmpObj.GetType - If t Is obj.GetType Or t.IsSubclassOf(obj.GetType) Then + t = tmpObj.GetObjectType + If t Is obj.GetObjectType Or t.IsSubclassOf(obj.GetObjectType) Then Debug.WriteLine("retrievePrivateObject: retreived from cache") obj = tmpObj Return True @@ -297,30 +298,6 @@ End If obj.IsLoading = True - 'Dim al As New ArrayList - 'cm2 = cm - 'Do - ' If useFind Then - ' For i = 1 To cm2.getFindSize - ' am = cm2.FindAttributeMaps(i) - ' al.Add(cm2.RelationalDatabase.getValueFor(obj.getValueByAttribute(am.Name))) - ' Next i - ' cm2 = cm2.SuperClass - ' Else - ' For i = 1 To cm2.getKeySize - ' am = cm2.getKeyAttributeMap(i) - ' al.Add(cm2.RelationalDatabase.getValueFor(obj.getValueByAttribute(am.Name))) - ' Next i - ' cm2 = Nothing - ' End If - 'Loop While Not cm2 Is Nothing - 'Dim statement As CSqlStatement - 'If useFind Then - ' statement = cm.getSQLFind(Me, al) - 'Else - ' statement = cm.getSQLRetrieve(Me, al) - 'End If - Dim statement As CSqlStatement If useFind Then statement = cm.getSQLFind(Me, Nothing) @@ -363,10 +340,10 @@ Return False End If - Dim targetobj, anObjPers As CPersistentObject + Dim targetobj, anObjPers As IPersistableObject Dim gotValue As Boolean Dim j As Integer - Dim col As CPersistentCollection + Dim col As IList 'Retrieve superclass details first classMapCount = 1 @@ -430,7 +407,7 @@ If Not gotValue Then 'Check whether the object is of child type If udamap.ForClass.ChildrenMaps.Count > 0 Then - targetobj = Me.createTargetObjectForMultipleInheritance(udamap.ForClass, obj.GetType, obj.GetType.Namespace, rs.ResultSet.Tables(0).Rows(i), joins, conn) + targetobj = Me.createTargetObjectForMultipleInheritance(udamap.ForClass, obj.GetObjectType, obj.GetObjectType.Namespace, rs.ResultSet.Tables(0).Rows(i), joins, conn) 'update classMapCount with the child count number classMapCount += Me.getChildCountForMultipleInheritance(udamap.ForClass) classMapCount -= 1 'This is because we added one in the beginning of the for loop @@ -482,7 +459,7 @@ 'Check whether the object is of child type If udamap.ForClass.ChildrenMaps.Count > 0 Then - targetobj = Me.createTargetObjectForMultipleInheritance(udamap.ForClass, obj.GetType, obj.GetType.Namespace, rs.ResultSet.Tables(0).Rows(i), joins, conn) + targetobj = Me.createTargetObjectForMultipleInheritance(udamap.ForClass, obj.GetObjectType, obj.GetObjectType.Namespace, rs.ResultSet.Tables(0).Rows(i), joins, conn) 'update classMapCount with the child count number classMapCount += Me.getChildCountForMultipleInheritance(udamap.ForClass) classMapCount -= 1 'This is because we added one in the beginning of the for loop @@ -708,11 +685,11 @@ ''' [rbanks] 16/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub saveObject(ByRef obj As CPersistentObject) + Public Sub saveObject(ByRef obj As IPersistableObject) SyncLock GetType(CPersistenceBroker) Dim conn As _CConnection Dim cm As CClassMap - cm = obj.getClassMap(obj) + cm = obj.getClassMap conn = cm.RelationalDatabase.getConnection(Nothing) Try conn.startTransaction() @@ -748,13 +725,13 @@ ''' [rbanks] 16/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Private Sub savePrivateObject(ByRef obj As CPersistentObject, ByVal conn As _CConnection) + Private Sub savePrivateObject(ByRef obj As IPersistableObject, ByVal conn As _CConnection) Dim j, i, k As Integer Dim clMap As CClassMap Dim m As Short Dim udaMap As CUDAMap - Dim Value As CPersistentObject - Dim col As CPersistentCollection + Dim Value As IPersistableObject + Dim col As IList Dim SharedClassMapStack As New Stack Dim cm As CClassMap Dim tmpStatement As CSqlStatement @@ -764,7 +741,7 @@ Dim statement As CSqlStatement Dim rs As CResultset - clMap = obj.getClassMap(obj) + clMap = obj.getClassMap cm = clMap 'Clear dirty flag so that recursion in the class structure doesn't cause an infinite loop obj.IsDirty = False @@ -2113,12 +2090,12 @@ ''' [danmayer] 19/05/2004 Created ''' </history> ''' ----------------------------------------------------------------------------- - Function getObjectsToSave(ByVal obj As CPersistentObject, ByVal includeBaseObject As Boolean, ByVal checkAssociationsRecursivly As Boolean) As Queue + Function getObjectsToSave(ByVal obj As IPersistableObject, ByVal includeBaseObject As Boolean, ByVal checkAssociationsRecursivly As Boolean) As Queue Dim cm As CClassMap Dim de As DictionaryEntry Dim udamap As CUDAMap - Dim value, o As CPersistentObject - Dim col As CPersistentCollection + Dim value, o As IPersistableObject + Dim col As IList 'Dim stack As New Stack Dim queue As New Queue Dim i, k As Integer @@ -2127,7 +2104,9 @@ If Not checkAssociationsRecursivly Then If Not obj.IsDirty Then Return queue 'Do not save if nothing changed If obj.IsProxy Then Return queue 'Do not save if object is proxied - If Not obj.IsValid Then Return queue 'Do not save if object is not valid + If TypeOf (obj) Is CPersistentObject Then + If Not CType(obj, CPersistentObject).IsValid Then Return queue 'Do not save if object is not valid + End If If obj.isReadOnly Then Return queue End If @@ -2135,16 +2114,23 @@ Return queue End If If includeBaseObject Then - obj.IsDirty = False 'Added to queue so clear dirty flag + obj.IsDirty = False 'Added to queue so clear dirty flag queue.Enqueue(obj) End If Else 'Determine if the object needs saving 'But, countinue to determine if the object's associations need saving If includeBaseObject AndAlso _ - (obj.IsDirty AndAlso Not obj.IsProxy AndAlso obj.IsValid AndAlso Not obj.isReadOnly AndAlso Not obj.isModifyOnly) Then - obj.IsDirty = False 'Added to queue so clear dirty flag - queue.Enqueue(obj) + (obj.IsDirty AndAlso Not obj.IsProxy AndAlso Not obj.isReadOnly AndAlso Not obj.isModifyOnly) Then + If TypeOf (obj) Is CPersistentObject Then + If Not CType(obj, CPersistentObject).IsValid Then 'Do not save if object is not valid + obj.IsDirty = False 'Added to queue so clear dirty flag + queue.Enqueue(obj) + End If + Else + obj.IsDirty = False + queue.Enqueue(obj) + End If End If End If @@ -2211,20 +2197,11 @@ If Not cm.SuperClass Is Nothing Then value = obj.getObjectByClassMap(cm.SuperClass) queue.Enqueue(value) - value.IsDirty = False 'Added to queue so clear dirty flag + value.IsDirty = False 'Added to queue so clear dirty flag For Each o In getObjectsToSave(value, False, checkAssociationsRecursivly) queue.Enqueue(o) Next End If - 'cm = cm.SuperClass - 'While Not cm Is Nothing - ' value = obj.getObjectByClassMap(cm) - ' Stack.Push(value) - ' For Each o In getObjectsToSave(value, False) - ' Stack.Push(o) - ' Next - ' cm = cm.SuperClass - 'End While Else If Not cm.SuperClass Is Nothing Then value = obj.getObjectByClassMap(cm.SuperClass) @@ -2233,14 +2210,6 @@ queue.Enqueue(o) Next End If - 'cm = cm.SuperClass - 'While Not cm Is Nothing - ' value = obj.getObjectByClassMap(cm) - ' For Each o In getObjectsToSave(value, False) - ' Stack.Push(o) - ' Next - ' cm = cm.SuperClass - 'End While End If Return queue End Function @@ -2343,4 +2312,85 @@ m_cache.Clear() End Sub + Public Sub GetObject(ByVal obj As Object) + Dim injObj As CInjectedObject + injObj = New CInjectedObject(obj) + If m_injectedObjects.Exists(obj) Then + Return + Else + retrieveObject(injObj, False, True) + End If + End Sub + + Public Sub FindObject(ByVal obj As Object) + Dim injObj As CInjectedObject + injObj = New CInjectedObject(obj) + If m_injectedObjects.Exists(obj) Then + Return + Else + retrieveObject(injObj, True, True) + m_injectedObjects.Add(injObj) + End If + End Sub + + Public Function getInjectedObject(ByVal obj As Object) As CInjectedObject + Return m_injectedObjects.Find(obj) + End Function + + Public Sub StartTracking(ByVal obj As Object) + Dim injObj As CInjectedObject + injObj = New CInjectedObject(obj) + m_injectedObjects.Add(injObj) + End Sub + + Public Function GetCurrentState(ByVal obj As Object) As CInjectedObject.State + Dim injObj As CInjectedObject + injObj = m_injectedObjects.Find(obj) + If Not injObj Is Nothing Then + Return injObj.CurrentState + Else + Return CInjectedObject.State.NotLoaded + End If + End Function + + Public Sub MarkForDeletion(ByVal obj As Object) + + End Sub + + Public Sub PersistChanges(ByVal obj As Object) + PersistChanges(obj, True) + End Sub + + Public Sub PersistChanges(ByVal obj As Object, ByVal checkAssociationsRecursively As Boolean) + Dim value As IPersistableObject + Dim queue As Queue + + Dim injObj As CInjectedObject + injObj = m_injectedObjects.Find(obj) + If injObj Is Nothing Then + injObj = New CInjectedObject(obj) + End If + + queue = getObjectsToSave(injObj, True, checkAssociationsRecursively) + + 'All objects to be saved must be saved in a single transaction. + If queue.Count > 0 Then + startTransaction() + Do While queue.Count > 0 + value = queue.Dequeue() + Try + saveObject(value) + Catch ex As Exception + 'After an error remove the cached object so that the next retrieve + ' will refresh the cache with the item from the database + deleteCachedObject(value) + 'Abort the transaction and throw an error + rollback() + Throw New SaveException(ex.Message, ex) + End Try + value.IsDirty = False + Loop + commit() + End If + End Sub End Class \ No newline at end of file Index: IPersistentObject.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/IPersistentObject.vb,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- IPersistentObject.vb 13 Oct 2004 05:19:01 -0000 1.2 +++ IPersistentObject.vb 14 Oct 2004 05:25:02 -0000 1.3 @@ -1,4 +1,4 @@ -Public Interface IPersistentObject +Public Interface IPersistableObject Property Persistent() As Boolean Property IsProxy() As Boolean Property IsDirty() As Boolean @@ -7,10 +7,33 @@ Property GUIDValue() As String Property CreatedDate() As Date Property ModifiedDate() As Date + Property OriginalModifiedDate() As Date Property AssociationsLoaded() As Boolean Property IsLoading() As Boolean ReadOnly Property isReadOnly() As Boolean ReadOnly Property isModifyOnly() As Boolean + Property OriginalCacheKey() As CCacheKey + + Function getClassMap() As CClassMap + Function getFieldLengthByName(ByVal x As String) As Integer + Function getFieldTypeByName(ByVal x As String) As Type + + Function getCollectionByAttribute(ByVal pName As String) As IList + Function getObjectByAttribute(ByVal pName As String) As IPersistableObject + Function getValueByAttribute(ByVal pName As String) As Object + Sub setAttributeValue(ByVal pName As String, ByRef Value As Object) + + Function GetObjectType() As Type + Function Equals(ByVal obj As IPersistableObject) As Boolean + Function Copy() As IPersistableObject + Sub ReplaceWith(ByVal obj As IPersistableObject) + Sub ResetOriginalDates() + Function getObjectByClassMap(ByVal classMap As CClassMap) As IPersistableObject + +End Interface + +Public Interface IPersistentObject + Inherits IPersistableObject Function Retrieve() As Boolean Function Retrieve(ByRef obj As CPersistentObject) As Boolean @@ -30,16 +53,10 @@ Sub Delete(ByVal obj As CPersistentObject, ByVal deleteSuperClass As Boolean) Sub DeleteAll() - Function Copy() As CPersistentObject Function IsValid() As Boolean Function IsReferenced() As Boolean Function getNewObject() As CPersistentObject - Function getClassMap() As CClassMap - Function getFieldLengthByName(ByVal x As String) As Integer - Function getFieldTypeByName(ByVal x As String) As Type - - Function Equals(ByVal obj As CPersistentObject) As Boolean Event MarkedAsDirty As EventHandler Event LoadStarted As EventHandler Index: CClassMap.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CClassMap.vb,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- CClassMap.vb 6 Oct 2004 23:42:23 -0000 1.31 +++ CClassMap.vb 14 Oct 2004 05:25:02 -0000 1.32 @@ -745,7 +745,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getDeleteSqlFor(ByVal obj As CPersistentObject) As CSqlStatement + Public Function getDeleteSqlFor(ByVal obj As IPersistableObject) As CSqlStatement If Not m_deleteStatement Is Nothing Then m_deleteStatement = Nothing End If @@ -989,7 +989,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getSelectSqlFor(ByVal obj As CPersistentObject) As CSqlStatement + Public Function getSelectSqlFor(ByVal obj As IPersistableObject) As CSqlStatement Return getSelectSqlFor(obj, False) End Function @@ -1005,7 +1005,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getSelectSqlFor(ByVal obj As CPersistentObject, ByVal useFind As Boolean) As CSqlStatement + Public Function getSelectSqlFor(ByVal obj As IPersistableObject, ByVal useFind As Boolean) As CSqlStatement If Not m_selectStatement Is Nothing Then m_selectStatement = Nothing End If @@ -1089,7 +1089,7 @@ ''' [rbanks] 23/01/2004 Adjusted to use SQL parameters ''' </history> '''----------------------------------------------------------------------------- - Public Function getInsertSqlFor(ByVal obj As CPersistentObject) As CSqlStatement + Public Function getInsertSqlFor(ByVal obj As IPersistableObject) As CSqlStatement ' ' Identity columns with null values should not be included in the insert statement. ' The database will populate them during the insert. @@ -1203,7 +1203,7 @@ ''' [rbanks] 23/01/2004 Adjusted to use SQL parameters ''' </history> '''----------------------------------------------------------------------------- - Public Function getUpdateSqlFor(ByVal obj As CPersistentObject) As CSqlStatement + Public Function getUpdateSqlFor(ByVal obj As IPersistableObject) As CSqlStatement If Not m_updateStatement Is Nothing Then m_updateStatement = Nothing End If @@ -1323,7 +1323,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub retrieveObject(ByRef obj As CPersistentObject, ByVal rs As CResultset) + Public Sub retrieveObject(ByRef obj As IPersistableObject, ByVal rs As CResultset) Dim tm As CTableMap Dim ClassMap As CClassMap ClassMap = Me @@ -1355,7 +1355,7 @@ ''' </history> '''----------------------------------------------------------------------------- - Public Sub retrieveObject(ByRef cm As CClassMap, ByRef obj As CPersistentObject, ByVal rs As CResultset, ByVal pAlias As String) + Public Sub retrieveObject(ByRef cm As CClassMap, ByRef obj As IPersistableObject, ByVal rs As CResultset, ByVal pAlias As String) Dim i As Short Dim AttrMap As CAttributeMap Dim val As Object @@ -1403,7 +1403,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub retrieveObject(ByRef obj As CPersistentObject, ByVal rw As DataRow) + Public Sub retrieveObject(ByRef obj As IPersistableObject, ByVal rw As DataRow) Dim tm As CTableMap Dim ClassMap As CClassMap ClassMap = Me @@ -1434,7 +1434,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub retrieveObject(ByRef ClassMap As CClassMap, ByRef obj As CPersistentObject, ByVal rw As DataRow, ByVal pAlias As String) + Public Sub retrieveObject(ByRef ClassMap As CClassMap, ByRef obj As IPersistableObject, ByVal rw As DataRow, ByVal pAlias As String) Dim tmpObj As Object If obj Is Nothing Then Throw New RetrieveException("Source object not instantiated yet") @@ -1523,13 +1523,15 @@ End If Next i ClassMap = ClassMap.SuperClass + If Not IsDBNull(tmpObj) And Not tmpObj Is Nothing Then + obj.Persistent = True + End If Loop While Not ClassMap Is Nothing - obj.Persistent = True obj.IsProxy = True obj.IsDirty = False End Sub - Public Sub retrieveKeys(ByRef ClassMap As CClassMap, ByRef obj As CPersistentObject, ByVal rw As DataRow, ByVal pAlias As String) + Public Sub retrieveKeys(ByRef ClassMap As CClassMap, ByRef obj As IPersistableObject, ByVal rw As DataRow, ByVal pAlias As String) Dim tmpObj As Object If obj Is Nothing Then Throw New RetrieveException("Source object has not been instantiated yet") @@ -1968,7 +1970,7 @@ End Get End Property - Public Function CreateObjectInstance() As CPersistentObject + Public Function CreateObjectInstance() As IPersistableObject If AssemblyPath <> String.Empty Then 'For late loading assemblies Dim objHdl As ObjectHandle @@ -1977,7 +1979,7 @@ Else objHdl = Activator.CreateInstanceFrom(AssemblyPath, ClassNameSpace & "." & Name) End If - Return CType(objHdl.Unwrap(), CPersistentObject) + Return CType(objHdl.Unwrap(), IPersistableObject) Else Dim t As Type Dim asmArray As [Assembly]() = AppDomain.CurrentDomain.GetAssemblies --- NEW FILE: CInjectedObjects.vb --- Public Class CInjectedObjectKey Inherits CCacheKey Public Sub New(ByVal obj As CInjectedObject) MyBase.new() populateWith(obj) End Sub End Class Public Class CInjectedObjects Inherits System.Collections.Hashtable Public Overloads Sub Add(ByVal obj As CInjectedObject) Dim injKey As CInjectedObjectKey If obj.ReferencedObject Is Nothing Then Exit Sub End If injKey = New CInjectedObjectKey(obj) 'If Not injKey.hasLegitValues Then ' Exit Sub 'End If If injKey.hasLegitValues AndAlso Not (MyBase.Item(injKey) Is Nothing) Then 'Replace values if possible, otherwise delete and add new Debug.WriteLine("Object: " & obj.GetObjectType.ToString & " is already tracked with key(s):" & vbCrLf & injKey.ToString) Else Debug.WriteLine("Started Tracking " & obj.GetObjectType.ToString & " with keys:" & vbCrLf & injKey.ToString) 'If obj.getClassMap.RelationalDatabase.getConnection(Nothing).Started Then ' obj.CurrentState = CInjectedObject.State.Loaded 'End If MyBase.Add(injKey, obj) End If End Sub Public Overloads Function Exists(ByVal obj As Object) As Boolean Dim injObj As CInjectedObject injObj = New CInjectedObject(obj) Return Exists(injObj, False) End Function Public Overloads Function Exists(ByVal obj As CInjectedObject, ByVal useFindAttributes As Boolean) As Boolean If Find(obj, useFindAttributes) Is Nothing Then Return False Else Return True End If End Function Public Overloads Function Find(ByVal obj As Object) As CInjectedObject Dim injObj As CInjectedObject injObj = New CInjectedObject(obj) Return Find(injObj, False) End Function Public Overloads Function Find(ByVal obj As CInjectedObject, ByVal useFindAttributes As Boolean) As CInjectedObject Dim injObj As CInjectedObject Dim x As DictionaryEntry Dim attrmap As CAttributeMap Dim i As Integer Dim found As Boolean Dim cm As CClassMap Dim t As Type Dim interval As Double cm = obj.getClassMap 'We only check for objects of the same type Dim m_Enumerator As Collections.IEnumerator = Me.GetEnumerator() While m_Enumerator.MoveNext() x = m_Enumerator.Current injObj = x.Value t = injObj.GetObjectType If t Is obj.GetObjectType Or t.IsSubclassOf(obj.GetObjectType) Then found = True If useFindAttributes Then For i = 1 To cm.getFindSize attrmap = cm.FindAttributeMaps(i) If Not obj.getValueByAttribute(attrmap.Name).Equals(injObj.getValueByAttribute(attrmap.Name)) Then found = False Exit For End If Next i Else For i = 1 To cm.getKeySize attrmap = cm.KeyAttributeMaps(i) If Not obj.getValueByAttribute(attrmap.Name).Equals(injObj.getValueByAttribute(attrmap.Name)) Then found = False Exit For End If Next i End If If found Then 'If ce.TransactionType = CCacheEntry.CacheTransaction.Deleted Then ' Return Nothing 'End If Debug.WriteLine([String].Format("Injection Cache - getting {0} object from cache. Key..." & vbCrLf & x.Key.ToString, x.Key.ObjType.Name)) Return injObj End If End If End While Return Nothing End Function Public Overloads Sub Remove(ByVal obj As Object) Dim injObj As CInjectedObject If obj Is Nothing Then Exit Sub End If injObj = New CInjectedObject(obj) Dim injkey As New CInjectedObjectKey(injObj) If Not injkey.hasLegitValues Then Exit Sub End If 'If injObj.getClassMap.RelationalDatabase.getConnection(Nothing).Started Then ' ce = MyBase.Item(ckey) ' If Not (ce Is Nothing) Then ' ce.TransactionType = CCacheEntry.CacheTransaction.Deleted ' End If 'Else MyBase.Remove(injkey) 'End If End Sub End Class Index: CPersistentObject.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistentObject.vb,v retrieving revision 1.41 retrieving revision 1.42 diff -u -d -r1.41 -r1.42 --- CPersistentObject.vb 13 Oct 2004 05:19:01 -0000 1.41 +++ CPersistentObject.vb 14 Oct 2004 05:25:02 -0000 1.42 @@ -381,10 +381,13 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - <Browsable(False)> Public ReadOnly Property OriginalModifiedDate() As Date + <Browsable(False)> Public Property OriginalModifiedDate() As Date Implements IPersistentObject.OriginalModifiedDate Get Return m_originalModDate End Get + Set(ByVal Value As Date) + m_originalModDate = Value + End Set End Property '''----------------------------------------------------------------------------- @@ -432,7 +435,7 @@ End Set End Property - <Browsable(False)> Friend Property OriginalCacheKey() As CCacheKey + <Browsable(False)> Friend Property OriginalCacheKey() As CCacheKey Implements IPersistableObject.OriginalCacheKey Get Return m_retrievedCacheKey End Get @@ -456,7 +459,7 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Friend Sub ResetOriginalDates() + Friend Sub ResetOriginalDates() Implements IPersistentObject.ResetOriginalDates m_originalModDate = m_modifiedDate End Sub @@ -474,7 +477,7 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub setAttributeValue(ByVal pName As String, ByRef Value As Object) + Public Sub setAttributeValue(ByVal pName As String, ByRef Value As Object) Implements IPersistentObject.setAttributeValue If TypeOf (Value) Is System.DBNull Then Exit Sub @@ -523,7 +526,7 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getValueByAttribute(ByVal pName As String) As Object + Public Function getValueByAttribute(ByVal pName As String) As Object Implements IPersistentObject.getValueByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") If dotPos = -1 Then @@ -552,7 +555,7 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getObjectByAttribute(ByVal pName As String) As CPersistentObject + Public Function getObjectByAttribute(ByVal pName As String) As IPersistableObject Implements IPersistableObject.getObjectByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") If dotPos = -1 Then @@ -622,7 +625,7 @@ ''' [rbanks] 26/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function getCollectionByAttribute(ByVal pName As String) As CPersistentCollection + Public Overloads Function getCollectionByAttribute(ByVal pName As String) As IList Implements IPersistentObject.getCollectionByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") Try @@ -1114,7 +1117,7 @@ ''' [rbanks] 25/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overloads Function Equals(ByVal obj As CPersistentObject) As Boolean Implements IPersistentObject.Equals + Public Overloads Function Equals(ByVal obj As IPersistableObject) As Boolean Implements IPersistentObject.Equals Dim ck1, ck2 As CCacheKey If Me Is Nothing And Not obj Is Nothing Then Return False @@ -1174,7 +1177,7 @@ ''' [rbanks] 26/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overridable Function Copy() As CPersistentObject Implements IPersistentObject.Copy + Public Overridable Function Copy() As IPersistableObject Implements IPersistentObject.Copy Return Me.MemberwiseClone End Function @@ -1190,10 +1193,10 @@ ''' [rbanks] 12/08/2004 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overridable Sub ReplaceWith(ByVal obj As CPersistentObject) + Public Overridable Sub ReplaceWith(ByVal obj As IPersistableObject) Implements IPersistentObject.ReplaceWith 'Use reflection to copy all of the fields from Obj to me (by value) If obj Is Nothing Then Return - If Not obj.GetType Is Me.GetType Then + If Not obj.GetObjectType Is Me.GetObjectType Then Throw New Exception("Objects must be of the same type") End If Dim f, fields() As FieldInfo @@ -1545,7 +1548,7 @@ ''' [danymayer] 19/07/2004 Created ''' </history> '''----------------------------------------------------------------------------- - Function getObjectByClassMap(ByVal classMap As CClassMap) As CPersistentObject + Function getObjectByClassMap(ByVal classMap As CClassMap) As IPersistableObject Implements IPersistentObject.getObjectByClassMap Dim obj, Value As CPersistentObject Dim col As CPersistentCollection Dim i, k As Integer @@ -1762,4 +1765,8 @@ End Sub #End Region + Public Function GetObjectType() As System.Type Implements IPersistableObject.GetObjectType + Return Me.GetType + End Function + End Class Index: CCacheEntry.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CCacheEntry.vb,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- CCacheEntry.vb 9 Sep 2004 08:14:01 -0000 1.17 +++ CCacheEntry.vb 14 Oct 2004 05:25:02 -0000 1.18 @@ -26,11 +26,11 @@ Added End Enum - Private m_object As CPersistentObject - Private m_objectCopy As CPersistentObject + Private m_object As IPersistableObject + Private m_objectCopy As IPersistableObject Private m_transactionType As CCacheEntry.CacheTransaction Private m_expiryTime As Date - Private m_originalObject As CPersistentObject + Private m_originalObject As IPersistableObject '''----------------------------------------------------------------------------- ''' <summary> @@ -43,11 +43,11 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Property PersistentObject() As CPersistentObject + Public Property PersistentObject() As IPersistableObject Get Return m_object End Get - Set(ByVal Value As CPersistentObject) + Set(ByVal Value As IPersistableObject) m_object = Value End Set End Property @@ -74,11 +74,11 @@ 'Instead of returning a copy of the object we need to return the object itself 'Otherwise circular references during loading will refer to partial object copies instead of 'the real object. - Public Property OriginalObject() As CPersistentObject + Public Property OriginalObject() As IPersistableObject Get Return m_originalObject End Get - Set(ByVal Value As CPersistentObject) + Set(ByVal Value As IPersistableObject) m_originalObject = Value End Set End Property @@ -165,16 +165,26 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Sub New(ByVal obj As CPersistentObject) + + Public Sub New() + m_keyvalues = New Collection + m_hasLegitValues = False + End Sub + + Public Sub New(ByVal obj As IPersistableObject) + populateWith(obj) + End Sub + + Protected Sub populateWith(ByVal obj As IPersistableObject) Dim cm As CClassMap Dim i As Integer Dim am As CAttributeMap Dim x As Object m_keyvalues = New Collection - m_type = obj.GetType + m_type = obj.GetObjectType m_hasLegitValues = True - cm = obj.getClassMap(obj) + cm = obj.getClassMap For i = 1 To cm.getKeySize am = cm.getKeyAttributeMap(i) x = obj.getValueByAttribute(am.Name) @@ -347,17 +357,19 @@ i = m_type.Name.GetHashCode count = 1 For Each obj In m_keyvalues - If TypeOf obj Is Integer Then - i += CInt(obj).GetHashCode - ElseIf TypeOf obj Is String Then - i += CStr(obj).GetHashCode - ElseIf TypeOf obj Is Double Then - i += CDbl(obj).GetHashCode - Else - t = obj.GetType - i += t.Name.GetHashCode + If Not obj Is Nothing Then + If TypeOf obj Is Integer Then + i += CInt(obj).GetHashCode + ElseIf TypeOf obj Is String Then + i += CStr(obj).GetHashCode + ElseIf TypeOf obj Is Double Then + i += CDbl(obj).GetHashCode + Else + t = obj.GetType + i += t.Name.GetHashCode + End If + count += 1 End If - count += 1 Next Return CInt(i / count) End Function @@ -390,7 +402,11 @@ Try s = s & vbTab & i.ToString & ") " & obj.GetType.ToString & ": " & obj.ToString Catch x As Exception - s = s & vbTab & i.ToString & ") " & obj.GetType.ToString & ": " & "unprintable data" + If obj Is Nothing Then + s = s & vbTab & i.ToString & ") --Null Reference--: " & "unprintable data" + Else + s = s & vbTab & i.ToString & ") " & obj.GetType.ToString & ": " & "unprintable data" + End If End Try Next Return s @@ -444,7 +460,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overloads Sub Add(ByVal obj As CPersistentObject) + Public Overloads Sub Add(ByVal obj As IPersistableObject) Dim ce As CCacheEntry Dim ckey As CCacheKey @@ -470,7 +486,7 @@ End If If Not (MyBase.Item(ckey) Is Nothing) Then 'Replace values if possible, otherwise delete and add new - Debug.WriteLine("Cache - replacing existing " & obj.GetType.ToString & " object in cache with keys:" & vbCrLf & ckey.ToString) + Debug.WriteLine("Cache - replacing existing " & obj.GetObjectType.ToString & " object in cache with keys:" & vbCrLf & ckey.ToString) ce = MyBase.Item(ckey) If obj.ExpiryInterval > 0 Then ce.resetExpiry(obj.ExpiryInterval) @@ -489,7 +505,7 @@ MyBase.Add(ckey, ce) End Try Else - Debug.WriteLine("Cache - adding " & obj.GetType.ToString & " object with keys:" & vbCrLf & ckey.ToString) + Debug.WriteLine("Cache - adding " & obj.GetObjectType.ToString & " object with keys:" & vbCrLf & ckey.ToString) If obj.ExpiryInterval > 0 Then ce = New CCacheEntry(obj.ExpiryInterval) Else @@ -519,7 +535,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Function Find(ByVal obj As CPersistentObject) As CPersistentObject + Public Function Find(ByVal obj As IPersistableObject) As IPersistableObject Dim x As DictionaryEntry Dim ce As CCacheEntry Dim attrmap As CAttributeMap @@ -529,7 +545,7 @@ Dim t As Type Dim interval As Double - cm = obj.getClassMap(obj) + cm = obj.getClassMap 'Debug.WriteLine("Cache - Attempt to Find() <" & cm.Name & "> object in cache") @@ -543,13 +559,13 @@ While m_Enumerator.MoveNext() x = m_Enumerator.Current ce = x.Value - t = ce.PersistentObject.GetType - If t Is obj.GetType Or t.IsSubclassOf(obj.GetType) Then + t = ce.PersistentObject.GetObjectType + If t Is obj.GetObjectType Or t.IsSubclassOf(obj.GetObjectType) Then If ce.IsExpired() And Not ce.PersistentObject.IsDirty Then 'Debug.WriteLine("Cache - Removing expired object from cache during Find()") MyBase.Remove(x.Key) 'delete object from cache m_Enumerator = Me.GetEnumerator - m_Enumerator.Reset() 'Reset enumerator after removing item + m_Enumerator.Reset() 'Reset enumerator after removing item Else found = True For i = 1 To cm.getFindSize @@ -588,7 +604,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Default Public Overloads ReadOnly Property Item(ByVal OIDValue As String) As CPersistentObject + Default Public Overloads ReadOnly Property Item(ByVal OIDValue As String) As IPersistableObject Get Dim ce As CCacheEntry ce = MyBase.Item(OIDValue) @@ -621,7 +637,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Default Public Overloads ReadOnly Property Item(ByVal obj As CPersistentObject) As CPersistentObject + Default Public Overloads ReadOnly Property Item(ByVal obj As IPersistableObject) As IPersistableObject Get Dim ce As CCacheEntry Dim ckey As CCacheKey @@ -657,7 +673,7 @@ ''' [rbanks] 27/11/2003 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overloads Sub Remove(ByVal obj As CPersistentObject) + Public Overloads Sub Remove(ByVal obj As IPersistableObject) Dim ce As CCacheEntry If obj Is Nothing Then 'Debug.WriteLine("Rejected attempt to delete empty object from cache") @@ -781,12 +797,12 @@ End Set End Property - Private Function GetCachedObject(ByVal ce As CCacheEntry) As CPersistentObject + Private Function GetCachedObject(ByVal ce As CCacheEntry) As IPersistableObject If m_objectsLoading Then - Debug.WriteLine(" - returning original object " & ce.PersistentObject.GetType.Name) + Debug.WriteLine(" - returning original object " & ce.PersistentObject.GetObjectType.Name) Return ce.OriginalObject Else - Debug.WriteLine(" - returning copy of object " & ce.PersistentObject.GetType.Name) + Debug.WriteLine(" - returning copy of object " & ce.PersistentObject.GetObjectType.Name) Return ce.PersistentObject.Copy End If End Function --- NEW FILE: CInjectedObject.vb --- Imports System.Reflection 'Class to manage objects injected into the persistence broker 'These will be objects that do not inherit from the cperistentobject class, but which 'still need to be saved/retrieved from the database. Public Class CInjectedObject Implements IPersistableObject Public Enum State Loaded Modified Deleted Added NotLoaded End Enum Private m_object As Object Private m_objectState As State Private m_originalObject As Object Private m_associationsLoaded As Object Private m_oid As COID Private m_createdDate As Date 'Set when object is created Private m_modifiedDate As Date 'Set when Dirty flag is set on persisted objects Private m_originalModDate, m_blankDate As Date Private m_cacheExpiry As Double Private m_guid As Guid Private m_classmap As CClassMap Private m_persistent As Boolean Private m_retrievedCacheKey As CCacheKey Private m_loading As Boolean Private m_proxy As Boolean Public Sub New(ByVal obj As Object) MyBase.New() m_object = obj 'make a snapshot of the object as it currently exists m_originalObject = Activator.CreateInstance(m_object.GetType) ReplaceValues(m_object, m_originalObject) End Sub Public Property ReferencedObject() As Object Get Return m_object End Get Set(ByVal Value As Object) m_object = Value End Set End Property Public Property OriginalObject() As Object Get Return m_originalObject End Get Set(ByVal Value As Object) m_originalObject = Value End Set End Property Public Property CurrentState() As State Get Return m_objectState End Get Set(ByVal Value As State) m_objectState = Value End Set End Property Public Sub ResetToOriginal() ReplaceValues(m_originalObject, m_object) End Sub Sub ReplaceWith(ByVal obj As IPersistableObject) Implements IPersistableObject.ReplaceWith If Not obj.GetObjectType Is Me.GetObjectType Then Throw New Exception("Objects must be of the same type") End If Dim injObj As CInjectedObject If TypeOf (obj) Is CInjectedObject Then injObj = obj ReplaceValues(injObj.m_object, m_object) Else ReplaceValues(obj, m_object) End If End Sub Public Sub ReplaceValues(ByVal sourceObject As Object, ByVal targetObject As Object) 'Use reflection to copy all of the fields from sourceObj to targetobject (by value) If sourceObject Is Nothing OrElse targetObject Is Nothing Then Return If Not sourceObject.GetType Is targetObject.GetType Then Throw New Exception("Objects must be of the same type") End If Dim f, fields() As FieldInfo Dim value As Object Dim t As Type Try t = sourceObject.GetType While Not t Is Nothing fields = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) 'Note that this will copy event handlers as well For Each f In fields value = f.GetValue(sourceObject) f.SetValue(targetObject, value) Next If Not t.BaseType Is Nothing Then t = t.BaseType Else t = Nothing End If End While Catch ex As Exception Debug.WriteLine(ex.Message) End Try End Sub Public Function getClassMap() As CClassMap Implements IPersistableObject.getClassMap Dim ClassMap As CClassMap Dim persistenceBroker As CPersistenceBroker persistenceBroker = getPersistenceBrokerInstance() ClassMap = persistenceBroker.getClassMap(TypeName(m_object)) If ClassMap Is Nothing Then ClassMap = persistenceBroker.getClassMap(m_object.GetType.FullName) End If If (ClassMap Is Nothing) Then Throw New NoClassMapException("No class map for " & m_object.GetType.FullName) End If Return ClassMap End Function Public Function GetObjectType() As Type Implements IPersistableObject.GetObjectType If m_object Is Nothing Then Return GetType(Object) End If Return m_object.GetType End Function Public Function getValueByAttribute(ByVal pName As String) As Object Implements IPersistableObject.getValueByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") If dotPos = -1 Then Return CallByName(m_object, pName, CallType.Get) Else Dim o As Object Dim objName As String Dim propertyName As String objName = pName.Substring(0, dotPos) propertyName = pName.Substring(dotPos + 1) o = CallByName(m_object, objName, CallType.Get) Return CallByName(o, propertyName, CallType.Get) End If End Function Public Property AssociationsLoaded() As Boolean Implements IPersistableObject.AssociationsLoaded Get Return m_associationsLoaded End Get Set(ByVal Value As Boolean) m_associationsLoaded = Value End Set End Property Public Property CreatedDate() As Date Implements IPersistableObject.CreatedDate Get Return m_createdDate End Get Set(ByVal Value As Date) m_createdDate = Value End Set End Property Public Property ExpiryInterval() As Double Implements IPersistableObject.ExpiryInterval Get Return m_cacheExpiry End Get Set(ByVal Value As Double) m_cacheExpiry = Value End Set End Property Public Function getFieldLengthByName(ByVal x As String) As Integer Implements IPersistableObject.getFieldLengthByName Return getClassMap.getAttributeMapByString(x, True).ColumnMap.StorageSize() End Function Public Function getFieldTypeByName(ByVal x As String) As System.Type Implements IPersistableObject.getFieldTypeByName Return getClassMap.getAttributeMapByString(x, True).ColumnMap.StorageType End Function Public Property GUIDValue() As String Implements IPersistableObject.GUIDValue Get If m_guid.Equals(Guid.Empty) Then m_guid = Guid.NewGuid End If GUIDValue = m_guid.ToString("N") End Get Set(ByVal value As String) m_guid = New Guid(value) End Set End Property Public Function ObjectsMatch(ByVal sourceObject As Object, ByVal targetObject As Object) As Boolean 'Use reflection to compare all of the fields from sourceObj to targetobject (by value) If sourceObject Is Nothing AndAlso targetObject Is Nothing Then Return True If sourceObject Is Nothing OrElse targetObject Is Nothing Then Return False If Not sourceObject.GetType Is targetObject.GetType Then Return False End If Dim f, fields() As FieldInfo Dim value As Object, value1 As Object Dim t As Type Try t = sourceObject.GetType While Not t Is Nothing fields = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) 'Note that this will copy event handlers as well For Each f In fields value = f.GetValue(sourceObject) value1 = f.GetValue(targetObject) If Not Equals(value, value1) Then Return True End If Next If Not t.BaseType Is Nothing Then t = t.BaseType Else t = Nothing End If End While Catch ex As Exception Debug.WriteLine(ex.Message) Return False End Try Return False End Function Public Property IsDirty() As Boolean Implements IPersistableObject.IsDirty Get Return ObjectsMatch(m_object, m_originalObject) End Get Set(ByVal Value As Boolean) 'Do nothing End Set End Property Public Property IsLoading() As Boolean Implements IPersistableObject.IsLoading Get Return m_loading End Get Set(ByVal Value As Boolean) m_loading = Value End Set End Property Public ReadOnly Property isModifyOnly() As Boolean Implements IPersistableObject.isModifyOnly Get Return getClassMap.isModifyOnly End Get End Property Public Property IsProxy() As Boolean Implements IPersistableObject.IsProxy Get Return m_proxy End Get Set(ByVal Value As Boolean) m_proxy = Value End Set End Property Public ReadOnly Property isReadOnly() As Boolean Implements IPersistableObject.isReadOnly Get Return getClassMap.isReadOnly End Get End Property Public Property ModifiedDate() As Date Implements IPersistableObject.ModifiedDate Get Return m_modifiedDate End Get Set(ByVal Value As Date) m_modifiedDate = Value End Set End Property Public Property OIDValue() As String Implements IPersistableObject.OIDValue Get Dim oidfactory As COIDFactory If m_oid Is Nothing Then oidfactory = getOIDFactoryInstance() m_oid = oidfactory.newOID End If OIDValue = m_oid.OID End Get Set(ByVal value As String) If m_oid Is Nothing Then m_oid = New COID End If m_oid.OID = value End Set End Property Public Property Persistent() As Boolean Implements IPersistableObject.Persistent Get Return m_persistent End Get Set(ByVal Value As Boolean) m_persistent = Value End Set End Property Public Function getCollectionByAttribute(ByVal pName As String) As IList Implements IPersistableObject.getCollectionByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") Try If dotPos = -1 Then Return CallByName(m_object, pName, CallType.Get) Else Dim o As Object Dim objName As String Dim propertyName As String objName = pName.Substring(0, dotPos) propertyName = pName.Substring(dotPos + 1) o = CallByName(m_object, objName, CallType.Get) Return CallByName(o, propertyName, CallType.Get) End If Catch err As Exception Throw New Exception("getCollectionByAttribute failed", err) End Try End Function Public Function getObjectByAttribute(ByVal pName As String) As IPersistableObject Implements IPersistableObject.getObjectByAttribute Dim dotPos As Integer dotPos = pName.IndexOf(".") If dotPos = -1 Then Return CallByName(m_object, pName, CallType.Get) Else Dim o As Object Dim objName As String Dim propertyName As String objName = pName.Substring(0, dotPos) propertyName = pName.Substring(dotPos + 1) o = CallByName(m_object, objName, CallType.Get) Return CallByName(o, propertyName, CallType.Get) End If End Function Public Sub setAttributeValue(ByVal pName As String, ByRef Value As Object) Implements IPersistableObject.setAttributeValue If TypeOf (Value) Is System.DBNull Then Exit Sub End If Dim dotPos As Integer dotPos = pName.IndexOf(".") Try If dotPos = -1 Then If TypeOf (Value) Is System.SByte Then CallByName(m_object, pName, CallType.Set, IIf(Value.ToString = "1", True, False)) Else CallByName(m_object, pName, CallType.Set, Value) End If Else Dim o As Object Dim objName As String Dim propertyName As String objName = pName.Substring(0, dotPos) propertyName = pName.Substring(dotPos + 1) o = CallByName(m_object, objName, CallType.Get) If TypeOf (Value) Is System.SByte Then CallByName(o, propertyName, CallType.Set, IIf(Value.ToString = "1", True, False)) Else CallByName(o, propertyName, CallType.Set, Value) End If End If Catch ex As Exception Throw New AttributeValueException("Could not set attribute " & pName & " (Value Type: " _ & Value.GetType.Name & ") in CPersistentObject::SetAttributeValue." & vbCrLf & ex.Message, ex) End Try End Sub Friend Property OriginalCacheKey() As CCacheKey Implements IPersistableObject.OriginalCacheKey Get Return m_retrievedCacheKey End Get Set(ByVal Value As CCacheKey) m_retrievedCacheKey = Value End Set End Property Public Overloads Function Equals(ByVal obj As IPersistableObject) As Boolean Implements IPersistableObject.Equals Dim ck1, ck2 As CCacheKey If Me Is Nothing And Not obj Is Nothing Then Return False End If If obj Is Nothing And Not Me Is Nothing Then Return False End If ck1 = New CCacheKey(Me) ck2 = New CCacheKey(obj) Return ck1.Equals(ck2) And Me.Persistent = obj.Persistent End Function Public Function Copy() As IPersistableObject Implements IPersistableObject.Copy Dim m_object2 As Object m_object2 = Activator.CreateInstance(m_object.GetType) ReplaceValues(m_object, m_object2) Return New CInjectedObject(m_object2) End Function Friend Sub ResetOriginalDates() Implements IPersistableObject.ResetOriginalDates m_originalModDate = m_modifiedDate End Sub Function getObjectByClassMap(ByVal classMap As CClassMap) As IPersistableObject Implements IPersistableObject.getObjectByClassMap Dim obj, Value As IPersistableObject Dim col As IList Dim i, k As Integer Dim cm As CClassMap Dim de As DictionaryEntry Dim udamap As CUDAMap obj = classMap.CreateObjectInstance 'set persistent before populating the object since the dirty flag checks its validity If Me.Persistent Then obj.Persistent = True End If 'set the associated objects For i = 1 To classMap.getStraightAssociationMapSize udamap = classMap.getStraightAssociationMap(i) 'If udamap.SaveAutomatic Then If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then obj.setAttributeValue(udamap.Target, Me.getObjectByAttribute(udamap.Target)) ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Then obj.setAttributeValue(udamap.Target, Me.getCollectionByAttribute(udamap.Target)) End If 'End If Next i 'set object's attributes For i = 1 To classMap.AttributeMaps.Count obj.setAttributeValue(classMap.getAttributeMap(i).Name, Me.getValueByAttribute(classMap.getAttributeMap(i).Name)) Next 'if it has superclass add its attributes cm = classMap.SuperClass While Not cm Is Nothing 'set the associated objects For i = 1 To cm.getStraightAssociationMapSize udamap = cm.getStraightAssociationMap(i) 'If udamap.SaveAutomatic Then If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then obj.setAttributeValue(udamap.Target, Me.getObjectByAttribute(udamap.Target)) ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Then obj.setAttributeValue(udamap.Target, Me.getCollectionByAttribute(udamap.Target)) End If 'End If Next i 'set superclass's attributes For i = 1 To cm.AttributeMaps.Count obj.setAttributeValue(cm.getAttributeMap(i).Name, Me.getValueByAttribute(cm.getAttributeMap(i).Name)) Next cm = cm.SuperClass End While 'copy the OriginalModifiedDate and the ModifiedDate from the child to the parent. 'if we don't do this the object won't get saved correctly on subsequent calls. obj.setAttributeValue("ModifiedDate", Me.getValueByAttribute("ModifiedDate")) obj.OriginalModifiedDate = Me.OriginalModifiedDate obj.IsDirty = Me.IsDirty Return obj End Function Public Property OriginalModifiedDate() As Date Implements IPersistableObject.OriginalModifiedDate Get Return m_originalModDate End Get Set(ByVal Value As Date) m_originalModDate = Value End Set End Property End Class Index: modPersistenceBrokerSingleton.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/modPersistenceBrokerSingleton.vb,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- modPersistenceBrokerSingleton.vb 28 Sep 2004 07:30:33 -0000 1.8 +++ modPersistenceBrokerSingleton.vb 14 Oct 2004 05:25:02 -0000 1.9 @@ -149,7 +149,7 @@ ''' [rbanks] 18/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- -Module modOIDFactorySingleton +Public Module modOIDFactorySingleton '''----------------------------------------------------------------------------- ''' <summary> ''' Gets a reference to the COIDFactory instance. |
