From: Richard B. <rb...@us...> - 2005-04-01 00:05:27
|
Update of /cvsroot/jcframework/dotnet In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18014 Modified Files: CCacheEntry.vb CClassMap.vb CCriteriaCondition.vb CInjectedObject.vb CInjectedObjects.vb CMultiSummaryCriteria.vb CPersistenceBroker.vb CPersistentCollection.vb CPersistentObject.vb CRetrieveCriteria.vb IPersistentObject.vb Log Message: Fixes for a number of issues with injected objects. Fixes for transactions when errors occur during the rollback, etc Fixes for removing event listeners from objects added to the cache to prevent multiple event firing. Index: CPersistenceBroker.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistenceBroker.vb,v retrieving revision 1.102 retrieving revision 1.103 diff -u -d -r1.102 -r1.103 --- CPersistenceBroker.vb 22 Mar 2005 06:09:11 -0000 1.102 +++ CPersistenceBroker.vb 1 Apr 2005 00:04:08 -0000 1.103 @@ -343,11 +343,11 @@ Do If useFind Then If Not skipClass Then - For i = 1 To cm2.getFindSize - am = cm2.FindAttributeMaps(i) + For i = 1 To cm2.getFindSize + am = cm2.FindAttributeMaps(i) paramCount += 1 statement.addSqlParameter(paramCount, obj.GetValueByAttribute(am.Name), am.ColumnMap) - Next i + Next i [...1130 lines suppressed...] + 'Called recursively so that objects with superclasses are queued from the + 'top most object down. + Dim cm As CClassMap + Dim tmpobj As Object + cm = obj.GetClassMap() + If Not cm.SuperClass Is Nothing Then + tmpobj = obj.GetObjectByClassMap(cm.SuperClass) + If cm.SharedTableField Is Nothing Then + AddToQueue(tmpobj, queue, True) + Else + AddToQueue(tmpobj, queue, False) + End If + End If + If includeObject Then + queue.Enqueue(obj) + End If + Return + End Sub End Class \ No newline at end of file Index: IPersistentObject.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/IPersistentObject.vb,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- IPersistentObject.vb 22 Mar 2005 06:09:11 -0000 1.12 +++ IPersistentObject.vb 1 Apr 2005 00:04:20 -0000 1.13 @@ -28,7 +28,7 @@ Function GetObjectType() As Type Function Equals(ByVal obj As IPersistableObject) As Boolean Function Copy() As IPersistableObject - Sub ReplaceWith(ByVal obj As IPersistableObject) + Sub ReplaceWith(ByVal obj As IPersistableObject, ByVal copyEventHandlers As Boolean) Function GetObjectByClassMap(ByVal classMap As CClassMap) As IPersistableObject Function GetSourceObject() As Object Function HasValidKey() As Boolean Index: CRetrieveCriteria.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CRetrieveCriteria.vb,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- CRetrieveCriteria.vb 28 Oct 2004 00:16:12 -0000 1.11 +++ CRetrieveCriteria.vb 1 Apr 2005 00:04:20 -0000 1.12 @@ -92,7 +92,7 @@ m_offset = -1 m_rows = -1 m_Having = Nothing - m_fullObjects = False 'default to proxy objects only + m_fullObjects = False 'default to proxy objects only End Sub Protected Overrides Sub Finalize() @@ -285,25 +285,25 @@ Return persistentBroker.Instance.processRetrieveCriteria(obj, Me, m_fullObjects) End Function - ''' ----------------------------------------------------------------------------- - ''' <summary> - ''' Starts processing of the retrieve criteria - ''' </summary> - ''' <returns>A CCursor containing the results of the criteria</returns> - ''' <remarks> - ''' </remarks> - ''' <exception>A NoClassMapException will be thrown if the class map has not been set</exception> - ''' <history> - ''' [rbanks] 16/08/2004 Created - ''' </history> - ''' ----------------------------------------------------------------------------- - Public Function perform() As CCursor - Static persistentBroker As CPersistenceBroker - persistentBroker = getPersistenceBrokerInstance() - If Me.ClassMap Is Nothing Then - Throw New NoClassMapException("No class map has been set for the retrieve criteria") - End If - Return persistentBroker.Instance.processRetrieveCriteria(Me.ClassMap, Me, m_fullObjects) - End Function + ''' ----------------------------------------------------------------------------- + ''' <summary> + ''' Starts processing of the retrieve criteria + ''' </summary> + ''' <returns>A CCursor containing the results of the criteria</returns> + ''' <remarks> + ''' </remarks> + ''' <exception>A NoClassMapException will be thrown if the class map has not been set</exception> + ''' <history> + ''' [rbanks] 16/08/2004 Created + ''' </history> + ''' ----------------------------------------------------------------------------- + Public Function perform() As CCursor + Static persistentBroker As CPersistenceBroker + persistentBroker = getPersistenceBrokerInstance() + If Me.ClassMap Is Nothing Then + Throw New NoClassMapException("No class map has been set for the retrieve criteria") + End If + Return persistentBroker.Instance.processRetrieveCriteria(Me.ClassMap, Me, m_fullObjects) + End Function End Class \ No newline at end of file Index: CCacheEntry.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CCacheEntry.vb,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- CCacheEntry.vb 28 Feb 2005 23:07:43 -0000 1.30 +++ CCacheEntry.vb 1 Apr 2005 00:03:51 -0000 1.31 @@ -578,7 +578,7 @@ End If Try ce.OriginalObject = obj - ce.PersistentObject.ReplaceWith(obj) + ce.PersistentObject.ReplaceWith(obj, False) Catch MyBase.Remove(ckey) MyBase.Add(ckey, ce) @@ -830,6 +830,7 @@ Dim x As DictionaryEntry Dim ce As CCacheEntry + Try 'Lets save objects first - just means resetting transaction to None For Each x In Me ce = x.Value @@ -850,6 +851,9 @@ For Each ck In al MyBase.Remove(ck) Next + Catch ex As Exception + Throw New SaveException("Failed to commit cache changes at end of transaction", ex) + End Try End Sub Friend Sub AbortChanges(ByVal reldb As _CRelationalDatabase) @@ -858,6 +862,7 @@ Dim x As DictionaryEntry Dim ce As CCacheEntry + Try For Each x In Me ce = x.Value If ce.PersistentObject.GetClassMap.RelationalDatabase Is reldb Then @@ -890,6 +895,9 @@ For Each ck In al MyBase.Remove(ck) Next + Catch ex As Exception + Throw New SaveException("Failed to rollback cache changed at end of transaction", ex) + End Try End Sub Friend Sub StartTransaction(ByVal reldb As _CRelationalDatabase) @@ -897,12 +905,18 @@ Dim ce As CCacheEntry 'precopy collection objects + Try For Each x In Me ce = x.Value + If Not ce.PersistentObject Is Nothing Then If ce.PersistentObject.GetClassMap.RelationalDatabase Is reldb Then ce.CopyObject() End If + End If Next + Catch ex As Exception + Throw New RetrieveException("Failed to initialise cache at start of transaction", ex) + End Try End Sub Public Property ObjectsAreLoading() As Boolean @@ -977,4 +991,21 @@ Return m_status End Get End Property + + Public Function GetValueArray() As ArrayList + Dim al As ArrayList + Dim valArray(Me.Values.Count) As Object + Me.Values.CopyTo(valArray, 0) + al = New ArrayList(valArray) + Return al + End Function + + Public Function GetKeyArray() As ArrayList + Dim al As ArrayList + Dim valArray(Me.Keys.Count) As Object + Me.Keys.CopyTo(valArray, 0) + al = New ArrayList(valArray) + Return al + End Function + End Class \ No newline at end of file Index: CCriteriaCondition.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CCriteriaCondition.vb,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- CCriteriaCondition.vb 15 Mar 2005 11:14:50 -0000 1.18 +++ CCriteriaCondition.vb 1 Apr 2005 00:04:06 -0000 1.19 @@ -177,7 +177,7 @@ m_classMap = cm End Sub - ''' ----------------------------------------------------------------------------- + ''' ----------------------------------------------------------------------------- ''' <summary> ''' Adds a subcriteria to this criteria ''' </summary> @@ -291,7 +291,7 @@ udaMap = clMap.AssociationMaps(strName) m_Associations.Add(udaMap) - clMap = udaMap.toclass + clMap = udaMap.ToClass If Not clMap Is Nothing Then For j = 1 To clMap.Tables.Count() m_Tables.Add(clMap.Tables.Item(j)) @@ -319,7 +319,7 @@ End If End Sub - '''----------------------------------------------------------------------------- + '''----------------------------------------------------------------------------- ''' <summary> ''' Creates a Greater Than selection criteria. ''' </summary> Index: CPersistentCollection.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistentCollection.vb,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- CPersistentCollection.vb 16 Mar 2005 04:59:24 -0000 1.18 +++ CPersistentCollection.vb 1 Apr 2005 00:04:18 -0000 1.19 @@ -44,166 +44,166 @@ ''' [rbanks] 17/12/2003 Created ''' </history> '''----------------------------------------------------------------------------- - <Browsable(False)> _ - Public Property ContainerObject() As CPersistentObject - Get - Return m_container - End Get - Set(ByVal Value As CPersistentObject) - m_container = Value - End Set - End Property + <Browsable(False)> _ + Public Property ContainerObject() As CPersistentObject + Get + Return m_container + End Get + Set(ByVal Value As CPersistentObject) + m_container = Value + End Set + End Property - <Browsable(False)> Public Shadows ReadOnly Property Count() As Integer - Get - Return MyBase.Count - End Get - End Property + <Browsable(False)> Public Shadows ReadOnly Property Count() As Integer + Get + Return MyBase.Count + End Get + End Property - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Adds an item to the collection. - ''' </summary> - ''' <param name="cp">A CPersistentObject to be added.</param> - ''' <remarks>The persistent object is added to the collection. If the container - ''' object reference is set then the dirty flag on the container object is set.</remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Sub Add(ByVal cp As CPersistentObject) - ' Debug.WriteLine("Coll: add method called") - list.Add(cp) - End Sub + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Adds an item to the collection. + ''' </summary> + ''' <param name="cp">A CPersistentObject to be added.</param> + ''' <remarks>The persistent object is added to the collection. If the container + ''' object reference is set then the dirty flag on the container object is set.</remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Sub Add(ByVal cp As CPersistentObject) + ' Debug.WriteLine("Coll: add method called") + list.Add(cp) + End Sub - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Removes an item from the collection. - ''' </summary> - ''' <param name="index">The zero-based position of the item in the collection to remove.</param> - ''' <remarks>Removes the specified item from the collection and sets the - ''' dirty flag on the container object. - ''' <para>An exception is thrown if the index is greater than the number of items in the collection or is - ''' less than zero.</para></remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Sub Remove(ByVal index As Integer) - ' Debug.WriteLine("Coll: Removing index " & index) - If index > Count - 1 Or index < 0 Then - Throw New Exception("PersistentCollection index value is outside of bounds") - End If - list.RemoveAt(index) - End Sub - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Removes an object from the collection. - ''' </summary> - ''' <param name="value">The object to remove.</param> - ''' <remarks>Removes the specified object from the collection and sets the - ''' dirty flag on the container object.</remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Sub Remove(ByVal value As CPersistentObject) - ' Debug.WriteLine("Coll: Removing " & value.GetType.Name) - list.Remove(value) - End Sub - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Retrieves the item at the specified position. - ''' </summary> - ''' <param name="index">The zero-based position of the item in the collection.</param> - ''' <value>The CPersistentObject from the specified position.</value> - ''' <remarks>If the index does not refer to a valid position within the collection - ''' and exception will be thrown.</remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Default Public ReadOnly Property Item(ByVal index As Integer) As CPersistentObject - Get - ' Debug.WriteLine("Coll: index property = " & index) - Return CType(list.Item(index), CPersistentObject) - End Get - End Property + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Removes an item from the collection. + ''' </summary> + ''' <param name="index">The zero-based position of the item in the collection to remove.</param> + ''' <remarks>Removes the specified item from the collection and sets the + ''' dirty flag on the container object. + ''' <para>An exception is thrown if the index is greater than the number of items in the collection or is + ''' less than zero.</para></remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Sub Remove(ByVal index As Integer) + ' Debug.WriteLine("Coll: Removing index " & index) + If index > Count - 1 Or index < 0 Then + Throw New Exception("PersistentCollection index value is outside of bounds") + End If + list.RemoveAt(index) + End Sub + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Removes an object from the collection. + ''' </summary> + ''' <param name="value">The object to remove.</param> + ''' <remarks>Removes the specified object from the collection and sets the + ''' dirty flag on the container object.</remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Sub Remove(ByVal value As CPersistentObject) + ' Debug.WriteLine("Coll: Removing " & value.GetType.Name) + list.Remove(value) + End Sub + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Retrieves the item at the specified position. + ''' </summary> + ''' <param name="index">The zero-based position of the item in the collection.</param> + ''' <value>The CPersistentObject from the specified position.</value> + ''' <remarks>If the index does not refer to a valid position within the collection + ''' and exception will be thrown.</remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Default Public ReadOnly Property Item(ByVal index As Integer) As CPersistentObject + Get + ' Debug.WriteLine("Coll: index property = " & index) + Return CType(list.Item(index), CPersistentObject) + End Get + End Property - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Attempts to save each item in the collection - ''' </summary> - ''' <value>An integer containing the number of objects that were actually saved.</value> - ''' <remarks>Each item in the collection is saved. If an error occurs during the saving - ''' of any object the process is immediately aborted and an exception is thrown. - ''' All objects are saved as part of a single transaction and the transaction is rolled back - ''' when there is an error.</remarks> - ''' <history> - ''' [rbanks] 21/05/2004 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Function Save() As Integer - Dim cp As CPersistentObject - Dim i As Integer = 0 - Dim pb As CPersistenceBroker = getPersistenceBrokerInstance() + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Attempts to save each item in the collection + ''' </summary> + ''' <value>An integer containing the number of objects that were actually saved.</value> + ''' <remarks>Each item in the collection is saved. If an error occurs during the saving + ''' of any object the process is immediately aborted and an exception is thrown. + ''' All objects are saved as part of a single transaction and the transaction is rolled back + ''' when there is an error.</remarks> + ''' <history> + ''' [rbanks] 21/05/2004 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Function Save() As Integer + Dim cp As CPersistentObject + Dim i As Integer = 0 + Dim pb As CPersistenceBroker = getPersistenceBrokerInstance() - pb.startTransaction() - For Each cp In list - Try - If cp.IsDirty Then - cp.Save() - If Not cp.IsDirty Then - 'Object was saved - increment counter - i += 1 - End If - End If - Catch ex As Exception - pb.rollback() - Throw New SaveException(ex.Message, ex) - End Try - Next - pb.commit() - Return i - End Function + pb.startTransaction() + For Each cp In list + Try + If cp.IsDirty Then + cp.Save() + If Not cp.IsDirty Then + 'Object was saved - increment counter + i += 1 + End If + End If + Catch ex As Exception + pb.rollback() + Throw New SaveException(ex.Message, ex) + End Try + Next + pb.commit() + Return i + End Function - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Attempts to delete each item in the collection - ''' </summary> - ''' <remarks>Each item in the collection is deleted. If an error occurs during the process - ''' an exception is thrown. All objects are deleted within a single transaction and the transaction is rolled back - ''' when there is an error.</remarks> - ''' <history> - ''' [rbanks] 21/05/2004 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Sub Delete() - Dim cp As CPersistentObject - Dim i As Integer = 0 - Dim pb As CPersistenceBroker = getPersistenceBrokerInstance() + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Attempts to delete each item in the collection + ''' </summary> + ''' <remarks>Each item in the collection is deleted. If an error occurs during the process + ''' an exception is thrown. All objects are deleted within a single transaction and the transaction is rolled back + ''' when there is an error.</remarks> + ''' <history> + ''' [rbanks] 21/05/2004 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Sub Delete() + Dim cp As CPersistentObject + Dim i As Integer = 0 + Dim pb As CPersistenceBroker = getPersistenceBrokerInstance() - pb.startTransaction() - For Each cp In list - Try - cp.Delete() - Catch ex As Exception - pb.rollback() - Throw New DeleteException(ex.Message, ex) - End Try - Next - pb.commit() - Me.Clear() - End Sub + pb.startTransaction() + For Each cp In list + Try + cp.Delete() + Catch ex As Exception + pb.rollback() + Throw New DeleteException(ex.Message, ex) + End Try + Next + pb.commit() + Me.Clear() + End Sub - Private Sub ItemDirtiedHandler(ByVal sender As Object, ByVal e As EventArgs) - ' Debug.WriteLine("Collection trapped item dirtied event for " & sender.GetType.Name) - RaiseEvent ItemDirtied(Me, e) + Private Sub ItemDirtiedHandler(ByVal sender As Object, ByVal e As EventArgs) + ' Debug.WriteLine("Collection trapped item dirtied event for " & sender.GetType.Name) + RaiseEvent ItemDirtied(Me, e) If Not Me.ContainerObject Is Nothing Then 'Debug.WriteLine("item dirtied - dirtying container") ContainerObject.SetDirtyFlag() End If - End Sub + End Sub #End Region #Region "IBindlingList" Index: CClassMap.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CClassMap.vb,v retrieving revision 1.55 retrieving revision 1.56 diff -u -d -r1.55 -r1.56 --- CClassMap.vb 22 Mar 2005 06:09:03 -0000 1.55 +++ CClassMap.vb 1 Apr 2005 00:03:53 -0000 1.56 @@ -278,7 +278,12 @@ '''----------------------------------------------------------------------------- Public Property FindAttributeMaps() As Collection Get - FindAttributeMaps = m_findAttributeMaps + If m_findAttributeMaps.Count = 0 Then + 'When no find attributes specified, find will use the primary key attributes + Return m_keyAttributeMaps + Else + Return m_findAttributeMaps + End If End Get Set(ByVal Value As Collection) m_findAttributeMaps = Value @@ -808,7 +813,7 @@ ''' </history> '''----------------------------------------------------------------------------- Public Function getKeySize() As Short - getKeySize = Me.KeyAttributeMaps.Count() + Return m_keyAttributeMaps.Count End Function '''----------------------------------------------------------------------------- @@ -822,7 +827,11 @@ ''' </history> '''----------------------------------------------------------------------------- Public Function getFindSize() As Short - Return m_findAttributeMaps.Count() + If m_findAttributeMaps.Count = 0 Then + Return m_keyAttributeMaps.Count + Else + Return m_findAttributeMaps.Count + End If End Function '''----------------------------------------------------------------------------- @@ -853,9 +862,11 @@ ''' </history> '''----------------------------------------------------------------------------- Public Function getFindAttributeMap(ByVal index As Short) As CAttributeMap - Dim AttrMap As CAttributeMap - AttrMap = m_findAttributeMaps.Item(index) - getFindAttributeMap = AttrMap + If m_findAttributeMaps.Count = 0 Then + Return m_keyAttributeMaps.Item(index) + Else + Return m_findAttributeMaps.Item(index) + End If End Function '''----------------------------------------------------------------------------- @@ -2083,9 +2094,13 @@ End Property Public Function CreateObjectInstance() As IPersistableObject + Return CreateObjectInstance(False) + End Function + + Public Function CreateObjectInstance(ByVal setStrongReference As Boolean) As IPersistableObject Dim ip As IPersistableObject If m_classFactoryName Is Nothing Then - Return CreateObjectInstanceNoFactory() + Return CreateObjectInstanceNoFactory(setStrongReference) End If 'Try to locate the object factory @@ -2128,11 +2143,11 @@ End Try m_classFactory = CType(obj, IClassFactory) End If - ip = CreateObjectInstanceViaFactory() + ip = CreateObjectInstanceViaFactory(setStrongReference) Return ip End Function - Private Function CreateObjectInstanceNoFactory() As IPersistableObject + Private Function CreateObjectInstanceNoFactory(ByVal setStrongReference As Boolean) As IPersistableObject Dim obj As Object Dim ip As IPersistableObject Dim pbroker As CPersistenceBroker @@ -2168,25 +2183,33 @@ If t Is Nothing Then Return Nothing obj = Activator.CreateInstance(t) End If - Try + If TypeOf obj Is IPersistableObject Then ip = CType(obj, IPersistableObject) - Catch ex As Exception + Else + 'If setStrongReference Then + ' ip = New CInjectedObject(obj, True) + 'Else ip = New CInjectedObject(obj) - End Try + 'End If + End If Return ip End Function - Public Function CreateObjectInstanceViaFactory() As IPersistableObject + Public Function CreateObjectInstanceViaFactory(ByVal setStrongReference As Boolean) As IPersistableObject Dim obj As Object Dim ip As IPersistableObject Dim pbroker As CPersistenceBroker obj = m_classFactory.CreateObject - Try + If TypeOf obj Is IPersistableObject Then ip = CType(obj, IPersistableObject) - Catch ex As Exception + Else + 'If setStrongReference Then + ' ip = New CInjectedObject(obj, True) + 'Else ip = New CInjectedObject(obj) - End Try + 'End If + End If Return ip End Function Index: CMultiSummaryCriteria.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CMultiSummaryCriteria.vb,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- CMultiSummaryCriteria.vb 21 Mar 2005 08:00:23 -0000 1.16 +++ CMultiSummaryCriteria.vb 1 Apr 2005 00:04:08 -0000 1.17 @@ -217,11 +217,11 @@ End If cm2 = fromObj.GetClassMap + cm = obj.GetClassMap am = cm2.GetAssociationMapByName(assocName) If am Is Nothing Then Throw New NoAssociationException("Invalid association " & assocName & " selected - no such association exists") End If - cm = obj.GetClassMap m_fromCMaps.Add(cm) i = m_fromCMaps.Count mapName = "t" & i.ToString @@ -267,8 +267,7 @@ strName = myArrayStrings(i) udaMap = clMap.AssociationMaps(strName) If udaMap Is Nothing Then - Throw New AToMSFramework.RetrieveException("Could not find association named " & strName & " for class " & clMap.Name) - + Throw New RetrieveException("Could not find association named " & strName & " for class " & clMap.Name) End If clMap = udaMap.ToClass If clMap Is Nothing Then Index: CInjectedObjects.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CInjectedObjects.vb,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- CInjectedObjects.vb 16 Mar 2005 11:32:34 -0000 1.6 +++ CInjectedObjects.vb 1 Apr 2005 00:04:07 -0000 1.7 @@ -20,12 +20,12 @@ End Sub Public Property Temporary() As Boolean - Get - Return m_istemporary - End Get - Set(ByVal Value As Boolean) - m_istemporary = Value - End Set + Get + Return m_istemporary + End Get + Set(ByVal Value As Boolean) + m_istemporary = Value + End Set End Property Public Sub NewInjObj(ByVal injobj As CInjectedObject) @@ -40,30 +40,30 @@ Return m_hashCode End Function - Private Sub CalculateHashCode() - Dim i As Long - Dim count As Integer - Dim obj As Object - Dim t As Type - i = m_type.Name.GetHashCode - count = 1 - For Each obj In m_keyvalues - 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 - Next - m_hashCode = CInt(i / count) - End Sub + 'Private Sub CalculateHashCode() + ' Dim i As Long + ' Dim count As Integer + ' Dim obj As Object + ' Dim t As Type + ' i = m_type.Name.GetHashCode + ' count = 1 + ' For Each obj In m_keyvalues + ' 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 + ' Next + ' m_hashCode = CInt(i / count) + 'End Sub Protected Sub populateKey(ByVal injObj As IPersistableObject) Dim cm As CClassMap @@ -82,7 +82,8 @@ End If m_keyvalues.Add(x) Next - CalculateHashCode() + m_hashCode = injObj.GetSourceObject.GetHashCode + 'CalculateHashCode() End Sub Public Overloads Shared Function Equals(ByVal obj1 As Object, ByVal obj2 As Object) As Boolean @@ -101,11 +102,14 @@ If Not (Me.m_type Is key.m_type) Then Return False End If - For i = 1 To m_keyvalues.Count - If m_keyvalues(i) <> key.m_keyvalues(i) Then + If Me.GetHashCode <> obj1.GetHashCode Then Return False End If - Next + 'For i = 1 To m_keyvalues.Count + ' If m_keyvalues(i) <> key.m_keyvalues(i) Then + ' Return False + ' End If + 'Next Return True End Function @@ -167,7 +171,7 @@ End Sub Public Overloads Sub Add(ByVal obj As CInjectedObject) - Me.AddTemp(obj, False) + Me.AddTemp(obj, False) End Sub Public Overloads Function isTracked(ByVal obj As Object) As Boolean @@ -217,6 +221,12 @@ Dim interval As Double Dim ikey As CInjectedObjectKey + 'Before we start looking at the cache we call the garbage collector to ensure + 'that weakreferences in CInjectedObject are cleared - ie the IsAlive flag is updated. + ' This may be a big performance hit - we'll have to watch and see + 'GC.Collect() + 'GC.WaitForPendingFinalizers() + 'We cannot use the dictionary key to find an object as changes to the key attributes 'of an object will result in a different dictionary key being generated and an 'we won't be able to find the object, even though it exists. @@ -230,8 +240,13 @@ x = CType(m_Enumerator.Current, DictionaryEntry) injObj = CType(x.Value, CInjectedObject) t = injObj.GetObjectType + 'If Not injObj.IsAlive Then + ' MyBase.Remove(x.Key) + ' m_Enumerator = Me.GetEnumerator + ' m_Enumerator.Reset() 'Reset enumerator after removing item + 'Else + found = True If t Is obj.GetObjectType OrElse (CheckSubClasses AndAlso t.IsSubclassOf(obj.GetObjectType)) Then - found = True Try If useFindAttributes Then For i = 1 To cm.getFindSize @@ -260,6 +275,7 @@ Return injObj End If End If + 'End If End While Return Nothing End Function @@ -280,26 +296,45 @@ End Sub Public Sub CleanUp() - 'Clean up cache by resetting isqueued flags and also removing temp entries - Dim toRemove As New Collection - Dim obj As CInjectedObject - Dim k As CInjectedObjectKey - For Each de As DictionaryEntry In Me - k = CType(de.Key, CInjectedObjectKey) - If k.Temporary Then - toRemove.Add(k) - Else - If Not de.Value Is Nothing Then - obj = CType(de.Value, CInjectedObject) - If obj.IsQueued Then - obj.IsQueued = False - End If - End If - End If - Next - For Each k In toRemove - Remove(k) - Next + 'Clean up cache by resetting isqueued flags, removing temp entries, and clearing strong references + Dim toRemove As New Collection + Dim obj As CInjectedObject + Dim k As CInjectedObjectKey + + 'Clear any strong references first - these would only be present set + 'during object retrieval to ensure injectedobjects stayed in the collection + 'For Each de As DictionaryEntry In Me + ' If Not de.Value Is Nothing Then + ' obj = CType(de.Value, CInjectedObject) + ' If Not obj.StrongReference Is Nothing Then + ' obj.StrongReference = Nothing + ' End If + ' End If + 'Next + + 'GC.Collect() + 'GC.WaitForPendingFinalizers() + + For Each de As DictionaryEntry In Me + k = CType(de.Key, CInjectedObjectKey) + If k.Temporary Then + toRemove.Add(k) + Else + If Not de.Value Is Nothing Then + obj = CType(de.Value, CInjectedObject) + 'If Not obj.IsAlive Then + ' toRemove.Add(k) + 'Else + If obj.IsQueued Then + obj.IsQueued = False + End If + 'End If + End If + End If + Next + For Each k In toRemove + Remove(k) + Next End Sub Public Overrides Function ToString() As String @@ -323,5 +358,22 @@ outString &= ">>>> END TRACKED OBJECTS DUMP <<<<" Return outString End Function + + Public Function GetValueArray() As ArrayList + Dim al As ArrayList + Dim valArray(Me.Values.Count) As Object + Me.Values.CopyTo(valArray, 0) + al = New ArrayList(valArray) + Return al + End Function + + Public Function GetKeyArray() As ArrayList + Dim al As ArrayList + Dim valArray(Me.Keys.Count) As Object + Me.Keys.CopyTo(valArray, 0) + al = New ArrayList(valArray) + Return al + End Function + End Class Index: CInjectedObject.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CInjectedObject.vb,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- CInjectedObject.vb 22 Mar 2005 06:09:11 -0000 1.20 +++ CInjectedObject.vb 1 Apr 2005 00:04:07 -0000 1.21 @@ -24,9 +24,13 @@ Private m_markedForDeletion As Boolean Private m_deleteParents As Boolean Private m_oneToManyCollections As New Collection + 'Private m_strongReference As Object Public Sub New(ByVal obj As Object) MyBase.New() + If TypeOf obj Is IPersistableObject Then + obj = CType(obj, IPersistableObject).GetSourceObject + End If m_object = obj m_originalObject = Activator.CreateInstance(obj.GetType) End Sub @@ -36,7 +40,7 @@ Return m_object End Get Set(ByVal Value As Object) - m_object = New WeakReference(Value) + m_object = Value End Set End Property @@ -50,37 +54,44 @@ End Property Public Sub ResetToOriginal() - ReplaceValues(m_originalObject, m_object) + ReplaceValues(m_originalObject, m_object, False) End Sub - Sub ReplaceWith(ByVal obj As IPersistableObject) Implements IPersistableObject.ReplaceWith + Sub ReplaceWith(ByVal obj As IPersistableObject, ByVal copyEventHandlers As Boolean) 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 Not obj.IsIPersistentObject Then injObj = CType(obj, CInjectedObject) - ReplaceValues(injObj.m_object, m_object) + ReplaceValues(injObj.m_object, m_object, copyEventHandlers) Else - ReplaceValues(obj, m_object) + ReplaceValues(obj, m_object, copyEventHandlers) End If End Sub - Public Sub ReplaceValues(ByVal sourceObject As Object, ByVal targetObject As Object) + Public Sub ReplaceValues(ByVal sourceObject As Object, ByVal targetObject As Object, ByVal copyEventHandlers As Boolean) '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 + If Not sourceObject.GetType Is targetObject.GetType And Not sourceObject.GetType.IsSubclassOf(targetObject.GetType) Then Throw New Exception("Objects must be of the same type") End If + If sourceObject Is targetObject Then + 'Same object so nothing to do + Exit Sub + End If Dim f, fields() As FieldInfo Dim value As Object Dim t, iListType, iDicType As Type Try - t = sourceObject.GetType + t = targetObject.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 + If Not copyEventHandlers AndAlso (f.FieldType.Name = f.Name & "Handler" OrElse f.FieldType Is GetType(EventHandler)) Then + 'This is an event! + 'Do Nothing + Else iListType = f.FieldType.GetInterface("IList", True) iDicType = f.FieldType.GetInterface("IDictionary", True) 'Do not copy collections yet - we'll do that at the end @@ -88,6 +99,7 @@ value = f.GetValue(sourceObject) f.SetValue(targetObject, value) End If + End If Next If Not t.BaseType Is Nothing Then t = t.BaseType @@ -264,7 +276,7 @@ 'Since we check for value differences to tell if an object is dirty, we need to 'replace the original object values with the current ones. If Value = False Then - ReplaceValues(m_object, m_originalObject) + ReplaceValues(m_object, m_originalObject, False) End If End Set End Property @@ -347,29 +359,37 @@ End Property Public Function getCollectionByAttribute(ByVal pName As String) As IList Implements IPersistableObject.getCollectionByAttribute + Return getCollectionByAttribute(m_object, pName) + End Function + + Private Function getCollectionByAttribute(ByVal srcObj As Object, ByVal pName As String) As IList Dim dotPos As Integer dotPos = pName.IndexOf(".") Try If dotPos = -1 Then - Return CType(CallByName(m_object, pName, CallType.Get), IList) + Return CType(CallByName(srcObj, pName, CallType.Get), IList) 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) + o = CallByName(srcObj, objName, CallType.Get) If o Is Nothing Then Return Nothing End If Return CType(CallByName(o, propertyName, CallType.Get), IList) End If Catch err As Exception - Throw New Exception("getCollectionByAttribute failed for attribute " & pName & " in " & m_object.GetType.FullName, err) + Throw New Exception("getCollectionByAttribute failed for attribute " & pName & " in " & srcObj.GetType.FullName, err) End Try End Function Public Function getObjectByAttribute(ByVal pName As String) As IPersistableObject Implements IPersistableObject.getObjectByAttribute + Return getObjectByAttribute(m_object, pName) + End Function + + Private Function getObjectByAttribute(ByVal srcObj As Object, ByVal pName As String) As IPersistableObject Dim dotPos As Integer Dim obj As Object Dim injobj As CInjectedObject @@ -378,14 +398,14 @@ dotPos = pName.IndexOf(".") Try If dotPos = -1 Then - obj = CallByName(m_object, pName, CallType.Get) + obj = CallByName(srcObj, 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) + o = CallByName(srcObj, objName, CallType.Get) If o Is Nothing Then Return Nothing End If @@ -399,7 +419,7 @@ injobj = pbroker.getInjectedObject(obj) End If Catch ex As Exception - Throw New Exception("getObjectByAttribute failed for attribute " & pName & " in " & m_object.GetType.FullName, ex) + Throw New Exception("getObjectByAttribute failed for attribute " & pName & " in " & srcObj.GetType.FullName, ex) End Try Return injobj End Function @@ -504,21 +524,29 @@ obj.State = Me.State End If + Dim ci As CInjectedObject + If Not obj.IsIPersistentObject Then + ci = CType(obj, CInjectedObject) + End If + 'set object's attributes - also copy the original values as well. 'set the associated objects For i = 1 To classMap.getStraightAssociationMapSize udamap = classMap.getStraightAssociationMap(i) If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then obj.SetAttributeValue(udamap.FromClassTarget, Me.getObjectByAttribute(udamap.FromClassTarget)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, udamap.FromClassTarget, Me.getObjectByAttribute(m_originalObject, udamap.FromClassTarget)) ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Or udamap.Cardinality = CUDAMap.CardinalityEnum.MANY_TO_MANY Then obj.SetAttributeValue(udamap.FromClassTarget, Me.getCollectionByAttribute(udamap.FromClassTarget)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, udamap.FromClassTarget, Me.getCollectionByAttribute(m_originalObject, udamap.FromClassTarget)) End If Next i - - 'set object's attributes Dim AttrMap As CAttributeMap For i = 1 To CType(classMap.AttributeMaps.Count, Short) AttrMap = classMap.getAttributeMap(i) + If Not AttrMap.ColumnMap Is Nothing Then obj.SetAttributeValue(AttrMap.Name, Me.getValueByAttribute(AttrMap.Name)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, AttrMap.Name, Me.getOriginalValueByAttribute(AttrMap.Name)) + End If Next 'if it has superclass add its attributes @@ -529,21 +557,23 @@ udamap = cm.getStraightAssociationMap(i) If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then obj.SetAttributeValue(udamap.FromClassTarget, Me.getObjectByAttribute(udamap.FromClassTarget)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, udamap.FromClassTarget, Me.getObjectByAttribute(m_originalObject, udamap.FromClassTarget)) ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Or udamap.Cardinality = CUDAMap.CardinalityEnum.MANY_TO_MANY Then obj.SetAttributeValue(udamap.FromClassTarget, Me.getCollectionByAttribute(udamap.FromClassTarget)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, udamap.FromClassTarget, Me.getCollectionByAttribute(m_originalObject, udamap.FromClassTarget)) End If Next i 'set superclass's attributes For i = 1 To CType(cm.AttributeMaps.Count, Short) AttrMap = cm.getAttributeMap(i) + If Not AttrMap.ColumnMap Is Nothing Then obj.SetAttributeValue(AttrMap.Name, Me.getValueByAttribute(AttrMap.Name)) + If Not ci Is Nothing Then ci.setAttributeValue(ci.m_originalObject, AttrMap.Name, Me.getValueByAttribute(m_originalObject, AttrMap.Name)) + End If Next cm = cm.SuperClass End While - - obj.IsDirty = Me.IsDirty - Return obj End Function @@ -709,5 +739,10 @@ Public Function IsIPersistentObject() As Boolean Implements IPersistableObject.IsIPersistentObject Return False End Function + + Public Function IsAlive() As Boolean + Return True + 'Return m_object.IsAlive + End Function End Class Index: CPersistentObject.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistentObject.vb,v retrieving revision 1.60 retrieving revision 1.61 diff -u -d -r1.60 -r1.61 --- CPersistentObject.vb 22 Mar 2005 06:09:11 -0000 1.60 +++ CPersistentObject.vb 1 Apr 2005 00:04:18 -0000 1.61 @@ -528,11 +528,11 @@ propertyName = pName.Substring(dotPos + 1) o = CallByName(Me, objName, CallType.Get) If o.GetType.IsValueType Then - Val = o + val = o If TypeOf (Value) Is System.SByte Then - CallByName(Val, propertyName, CallType.Set, IIf(Value.ToString = "1", True, False)) + CallByName(val, propertyName, CallType.Set, IIf(Value.ToString = "1", True, False)) Else - CallByName(Val, propertyName, CallType.Set, Value) + CallByName(val, propertyName, CallType.Set, Value) End If CallByName(Me, objName, CallType.Set, val) Else @@ -689,7 +689,7 @@ Return CallByName(o, propertyName, CallType.Get) End If Catch err As Exception - Throw New Exception("getCollectionByAttribute failed for class " & Me.getclassmap.name & " attribute: " & " " & pname, err) + Throw New Exception("getCollectionByAttribute failed for class " & Me.getClassMap.Name & " attribute: " & " " & pName, err) End Try End Function @@ -865,9 +865,10 @@ Dim x As Boolean Dim obj As CPersistentObject obj = Me.getNewObject - obj.ReplaceWith(Me) + 'Make sure event handlers are copied so that events fire during retrieve + obj.ReplaceWith(Me, True) x = obj.Retrieve(obj) - Me.ReplaceWith(obj) + Me.ReplaceWith(obj, False) Return x End Function @@ -934,8 +935,8 @@ Debug.WriteLine("The object with key " & ckey.ToString & " was already saved once") Else persistentBroker.saveObject(value) - 'Recopy one-to-many collections incase object is resaved later - value.CopyOneToManyCollections() + 'Recopy one-to-many collections incase object is resaved later + value.CopyOneToManyCollections() 'Need to recalculate the key here to handle objects using identity (autonumber) keys ckey = New CCacheKey(value) savedKeys.Add(ckey) @@ -1119,9 +1120,10 @@ Dim x As Boolean Dim obj As CPersistentObject obj = Me.getNewObject - obj.ReplaceWith(Me) + 'Make sure event handlers are copied so that events fire during find + obj.ReplaceWith(Me, True) x = obj.Find(obj) - Me.ReplaceWith(obj) + Me.ReplaceWith(obj, False) Return x End Function @@ -1282,7 +1284,7 @@ Public Overridable Function Copy() As IPersistableObject Implements IPersistentObject.Copy Dim obj As CPersistentObject obj = Me.getClassMap.CreateObjectInstance - obj.ReplaceWith(Me) + obj.ReplaceWith(Me, False) Return obj End Function @@ -1298,7 +1300,7 @@ ''' [rbanks] 12/08/2004 Created ''' </history> '''----------------------------------------------------------------------------- - Public Overridable Sub ReplaceWith(ByVal obj As IPersistableObject) Implements IPersistentObject.ReplaceWith + Public Overridable Sub ReplaceWith(ByVal obj As IPersistableObject, ByVal copyEventHandlers As Boolean) Implements IPersistentObject.ReplaceWith 'Use reflection to copy all of the fields from Obj to me (by value) 'Also copy collections If obj Is Nothing Then Return @@ -1312,14 +1314,18 @@ t = Me.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 - iListType = f.FieldType.GetInterface("IList", True) - iDicType = f.FieldType.GetInterface("IDictionary", True) - 'Do not copy collections yet - we'll do that at the end - If iListType Is Nothing AndAlso iDicType Is Nothing Then - value = f.GetValue(obj) - f.SetValue(Me, value) + If Not copyEventHandlers AndAlso (f.FieldType.Name = f.Name & "Handler" OrElse f.FieldType Is GetType(EventHandler)) Then + 'This is an event! + 'Do Nothing + Else + iListType = f.FieldType.GetInterface("IList", True) + iDicType = f.FieldType.GetInterface("IDictionary", True) + 'Do not copy collections yet - we'll do that at the end + If iListType Is Nothing AndAlso iDicType Is Nothing Then + value = f.GetValue(obj) + f.SetValue(Me, value) + End If End If Next If t.IsSubclassOf(GetType(CPersistentObject)) Then @@ -1762,9 +1768,9 @@ For Each collItem In origIList If NotInCollection(fromIList, collItem) Then If Not TypeOf collItem Is IPersistableObject Then - injObj = getPersistenceBrokerInstance.getInjectedObject(collItem, True) + injobj = getPersistenceBrokerInstance.getInjectedObject(collItem, True) Else - injObj = collItem + injobj = collItem End If toColl.Add(collItem) End If @@ -1831,7 +1837,7 @@ Public Overridable Sub BeginEdit() Implements System.ComponentModel.IEditableObject.BeginEdit If Not m_editing Then m_preEditCopy = Me.getNewObject - m_preEditCopy.ReplaceWith(Me) + m_preEditCopy.ReplaceWith(Me, False) m_editing = True End If End Sub @@ -1851,7 +1857,7 @@ <EditorBrowsable(EditorBrowsableState.Advanced)> _ Public Overridable Sub CancelEdit() Implements System.ComponentModel.IEditableObject.CancelEdit m_editing = False - Me.ReplaceWith(m_preEditCopy) + Me.ReplaceWith(m_preEditCopy, False) m_preEditCopy = Nothing If m_isNew Then m_isNew = False |