Menu
▾
▴
[Jcframework-commits] dotnet CInjectedObjects.vb,1.5,1.6 CMultiRetrieveCriteria.vb,1.19,1.20 CMultiSummaryCriteria.vb,1.14,1.15 CPersistenceBroker.vb,1.99,1.100 CPersistentCriteria.vb,1.11,1.12
|
From: Richard B. <rb...@us...> - 2005-03-16 11:32:58
|
Update of /cvsroot/jcframework/dotnet In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18016 Modified Files: CInjectedObjects.vb CMultiRetrieveCriteria.vb CMultiSummaryCriteria.vb CPersistenceBroker.vb CPersistentCriteria.vb Log Message: Multiple fixes covering nested recursive associations in noninherited objects and problems in summary criteria where conditions. Index: CMultiSummaryCriteria.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CMultiSummaryCriteria.vb,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- CMultiSummaryCriteria.vb 16 Mar 2005 09:34:25 -0000 1.14 +++ CMultiSummaryCriteria.vb 16 Mar 2005 11:32:41 -0000 1.15 @@ -337,154 +337,198 @@ ''' </history> '''----------------------------------------------------------------------------- Public Sub addOrderAttributeByAscend(ByVal attributeName As String, ByVal pAscend As Boolean) - Dim orderEntry As COrderEntry - orderEntry = New COrderEntry - orderEntry.AttributeMap = ClassMap.getAttributeMapByString(attributeName, True) - orderEntry.Ascend = pAscend - m_orderAttributes.Add(orderEntry) - End Sub + Dim orderEntry As COrderEntry + orderEntry = New COrderEntry - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Returns a new CCriteriaCondition. - ''' </summary> - ''' <returns></returns> - ''' <remarks>The current objects classmap, tables and associations are referenced in the returned CCriteriaCondition object.</remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Function getNewCondition() As CCriteriaCondition - Dim criCond As CCriteriaCondition - criCond = New CCriteriaCondition - criCond.ClassMap = Me.ClassMap - criCond.Tables = Me.Tables - criCond.Associations = Me.Associations - getNewCondition = criCond - End Function + If attributeName.IndexOf(".") >= 0 Then + Dim Parts() As String + Parts = attributeName.Split(".") + attributeName = Parts(1) + Dim cm As CClassMap + For Each cm In m_fromCMaps + If cm.Name.Equals(Parts(0)) Then + orderEntry.ClassMap = cm + orderEntry.AttributeMap = cm.getAttributeMapByString(attributeName, True) + Exit For + End If + Next + Else + orderEntry.ClassMap = ClassMap + orderEntry.AttributeMap = ClassMap.getAttributeMapByString(attributeName, True) + End If + orderEntry.Ascend = pAscend + m_orderAttributes.Add(orderEntry) + End Sub - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Generates an SQL statement based on the properties of this object. - ''' </summary> - ''' <returns></returns> - ''' <remarks>The SQL statement returned will be a select statement that will - ''' aggregate the specified attributes and group and order the data according - ''' to the values that have been set for this object.</remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Function getSqlStatementParameters() As CSqlStatement - Dim statement As New CSqlStatement - Dim i As Short - Dim persObj As IPersistableObject - Dim cm As CClassMap - Dim isFirst As Boolean = True - Dim s As String - Dim j As Integer - Dim mapname As String + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Returns a new CCriteriaCondition. + ''' </summary> + ''' <returns></returns> + ''' <remarks>The current objects classmap, tables and associations are referenced in the returned CCriteriaCondition object.</remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Function getNewCondition() As CCriteriaCondition + Dim criCond As CCriteriaCondition + criCond = New CCriteriaCondition + criCond.ClassMap = Me.ClassMap + criCond.Tables = Me.Tables + criCond.Associations = Me.Associations + getNewCondition = criCond + End Function - statement.addSqlClause(ClassMap.RelationalDatabase.getClauseStringSelect) - If m_rows > 0 And Me.ClassMap.RelationalDatabase.limitClauseAtStart Then - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringLimit) - If m_offset > 0 AndAlso Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then - statement.addSqlClause(" " & Str(m_offset) & ",") - End If - statement.addSqlClause(" " & Str(m_rows)) - End If - statement.addSqlClause(" ") - isFirst = True - For i = 1 To m_fieldsForSum.Count - mapname = m_aliasForSum(i) - Select Case m_methodsForSum(i) - Case SumMethod.Avg - s = ClassMap.RelationalDatabase.getClauseStringAvg(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) - Case SumMethod.Max - s = ClassMap.RelationalDatabase.getClauseStringMax(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) - Case SumMethod.Min - s = ClassMap.RelationalDatabase.getClauseStringMin(m_fieldsForSum(i).ColumnMap.getAliasQualifiedName(mapname)) - Case SumMethod.Sum - s = ClassMap.RelationalDatabase.getClauseStringSum(m_fieldsForSum(i).ColumnMap.getAliasQualifiedName(mapname)) - Case SumMethod.Count - s = ClassMap.RelationalDatabase.getClauseStringCount(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) - End Select - If isFirst Then - statement.addSqlClause(s) - Else - statement.addSqlClause(", " & s) - End If - isFirst = False - Next i + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Generates an SQL statement based on the properties of this object. + ''' </summary> + ''' <returns></returns> + ''' <remarks>The SQL statement returned will be a select statement that will + ''' aggregate the specified attributes and group and order the data according + ''' to the values that have been set for this object.</remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Function getSqlStatementParameters() As CSqlStatement + Dim statement As New CSqlStatement + Dim i As Short + Dim persObj As IPersistableObject + Dim cm As CClassMap + Dim isFirst As Boolean = True + Dim s As String + Dim j As Integer + Dim mapname As String + Dim ht As New Hashtable - 'Now for the join clauses. We must process in recursive fashion - 'in order to have correct bracketing in the statement. - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringFrom & " ") - statement.addSqlClause(m_joins.GetSQLString) + statement.addSqlClause(ClassMap.RelationalDatabase.getClauseStringSelect) + If m_rows > 0 And Me.ClassMap.RelationalDatabase.limitClauseAtStart Then + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringLimit) + If m_offset > 0 AndAlso Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then + statement.addSqlClause(" " & Str(m_offset) & ",") + End If + statement.addSqlClause(" " & Str(m_rows)) + End If + statement.addSqlClause(" ") + isFirst = True + For i = 1 To m_fieldsForSum.Count + mapname = m_aliasForSum(i) + Select Case m_methodsForSum(i) + Case SumMethod.Avg + s = ClassMap.RelationalDatabase.getClauseStringAvg(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) + Case SumMethod.Max + s = ClassMap.RelationalDatabase.getClauseStringMax(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) + Case SumMethod.Min + s = ClassMap.RelationalDatabase.getClauseStringMin(m_fieldsForSum(i).ColumnMap.getAliasQualifiedName(mapname)) + Case SumMethod.Sum + s = ClassMap.RelationalDatabase.getClauseStringSum(m_fieldsForSum(i).ColumnMap.getAliasQualifiedName(mapname)) + Case SumMethod.Count + s = ClassMap.RelationalDatabase.getClauseStringCount(m_fieldsForSum(i).ColumnMap.getaliasQualifiedName(mapname)) + End Select + If isFirst Then + statement.addSqlClause(s) + Else + statement.addSqlClause(", " & s) + End If + isFirst = False + Next i - If m_offset > 0 And Not Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then - addOffsetSubCriteria(m_offset) - End If - fillStatementWithWhere(statement) + 'Now for the join clauses. We must process in recursive fashion + 'in order to have correct bracketing in the statement. + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringFrom & " ") + statement.addSqlClause(m_joins.GetSQLString) - Dim attMap As CAttributeMap - If m_groupAttributes.Count() > 0 Then - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringGroupBy) - For i = 1 To m_groupAttributes.Count() - attMap = m_groupAttributes.Item(i) - If i > 1 Then - statement.addSqlClause(", ") - Else - statement.addSqlClause(" ") - End If - statement.addSqlClause(attMap.ColumnMap.getFullyQualifiedName) - Next i - End If + 'Need to set correct table aliases for the selection criteria in the where condition + j = 0 + For Each cm In m_fromCMaps + j += 1 + mapname = "t" & j.ToString + ht.Add(cm.Name, mapname) + UpdateConditionAliases(WhereCondition, mapname, cm.Name) + Next - Dim entry As COrderEntry - If m_orderAttributes.Count() > 0 Then - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringOrderBy) - For i = 1 To m_orderAttributes.Count() - entry = m_orderAttributes.Item(i) - If i > 1 Then - statement.addSqlClause(", ") - Else - statement.addSqlClause(" ") - End If - statement.addSqlClause(entry.AttributeMap.ColumnMap.getFullyQualifiedName) - If entry.Ascend Then - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringAscend) - Else - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringDescend) - End If - Next i - End If + If m_offset > 0 And Not Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then + addOffsetSubCriteria(m_offset) + End If + fillStatementWithWhere(statement) - If m_rows > 0 And Not Me.ClassMap.RelationalDatabase.limitClauseAtStart Then - statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringLimit) - If m_offset > 0 AndAlso Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then - statement.addSqlClause(" " & Str(m_offset) & ",") - End If - statement.addSqlClause(" " & Str(m_rows)) - End If + Dim attMap As CAttributeMap + If m_groupAttributes.Count() > 0 Then + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringGroupBy) + For i = 1 To m_groupAttributes.Count() + attMap = m_groupAttributes.Item(i) + If i > 1 Then + statement.addSqlClause(", ") + Else + statement.addSqlClause(" ") + End If + statement.addSqlClause(attMap.ColumnMap.getAliasQualifiedName("t1")) + Next i + End If - getSqlStatementParameters = statement - End Function + Dim entry As COrderEntry + If m_orderAttributes.Count() > 0 Then + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringOrderBy) + For i = 1 To m_orderAttributes.Count() + entry = m_orderAttributes.Item(i) + If i > 1 Then + statement.addSqlClause(", ") + Else + statement.addSqlClause(" ") + End If + statement.addSqlClause(entry.AttributeMap.ColumnMap.getAliasQualifiedName(ht(entry.ClassMap.Name))) + If entry.Ascend Then + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringAscend) + Else + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringDescend) + End If + Next i + End If - '''----------------------------------------------------------------------------- - ''' <summary> - ''' Indicates to the persistence broker that the CMultiSummaryCriteria should now be processed. - ''' </summary> - ''' <returns>A CCursor containing the results of the criteria.</returns> - ''' <remarks></remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Function perform() As CCursor - Static persistentBroker As CPersistenceBroker - persistentBroker = getPersistenceBrokerInstance() - perform = persistentBroker.Instance.processMultiSummaryCriteria(Me) - End Function + If m_rows > 0 And Not Me.ClassMap.RelationalDatabase.limitClauseAtStart Then + statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringLimit) + If m_offset > 0 AndAlso Me.ClassMap.RelationalDatabase.supportsSelectOffsets Then + statement.addSqlClause(" " & Str(m_offset) & ",") + End If + statement.addSqlClause(" " & Str(m_rows)) + End If + + getSqlStatementParameters = statement + End Function + + '''----------------------------------------------------------------------------- + ''' <summary> + ''' Indicates to the persistence broker that the CMultiSummaryCriteria should now be processed. + ''' </summary> + ''' <returns>A CCursor containing the results of the criteria.</returns> + ''' <remarks></remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Function perform() As CCursor + perform = getPersistenceBrokerInstance().processMultiSummaryCriteria(Me) + End Function + + Private Sub UpdateConditionAliases(ByRef criCond As CCriteriaCondition, ByVal tblAlias As String, ByVal className As String) + Dim obj As Object + Dim selcri As CSelectionCriteria + Dim subCond As CCriteriaCondition + + For Each obj In criCond.Parts + If obj.GetType.IsSubclassOf(GetType(CSelectionCriteria)) Then + selcri = obj + If selcri.ClassMap.Name = className Then + selcri.TableAlias = tblAlias + End If + End If + If TypeOf (obj) Is CCriteriaCondition Then + subCond = obj + UpdateConditionAliases(subCond, tblAlias, className) + End If + Next + + End Sub End Class Index: CPersistenceBroker.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistenceBroker.vb,v retrieving revision 1.99 retrieving revision 1.100 diff -u -d -r1.99 -r1.100 --- CPersistenceBroker.vb 11 Mar 2005 04:40:55 -0000 1.99 +++ CPersistenceBroker.vb 16 Mar 2005 11:32:42 -0000 1.100 @@ -1763,7 +1763,8 @@ rs = conn.processSelectStatement(statement) Catch ex As Exception rs = Nothing - clMap.RelationalDatabase.freeConnection(conn) + clMap.RelationalDatabase.freeConnection(conn) + Throw ex End Try cursor = New CCursor @@ -2594,99 +2595,101 @@ Return queue End If If includeBaseObject Then - AddToQueue(obj, queue) - End If - Return queue - 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 Not obj.IsReadOnly AndAlso Not obj.IsModifyOnly) Then - If GetType(IValidation).IsInstanceOfType(obj.GetSourceObject) Then - 'If obj.GetObjectType.IsSubclassOf(GetType(CPersistentObject)) Then - If CType(obj.GetSourceObject, IValidation).IsValid Then 'Do not save if object is not valid - 'obj.IsDirty = False 'Added to queue so clear dirty flag - AddToQueue(obj, queue) - End If - Else - AddToQueue(obj, queue) - End If - End If - End If + AddToQueue(obj, queue) + 'Do not return - since we saved this object we also need to check it's associations + Else + Return queue + 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 Not obj.IsReadOnly AndAlso Not obj.IsModifyOnly) Then + If GetType(IValidation).IsInstanceOfType(obj.GetSourceObject) Then + 'If obj.GetObjectType.IsSubclassOf(GetType(CPersistentObject)) Then + If CType(obj.GetSourceObject, IValidation).IsValid Then 'Do not save if object is not valid + 'obj.IsDirty = False 'Added to queue so clear dirty flag + AddToQueue(obj, queue) + End If + Else + AddToQueue(obj, queue) + End If + End If + End If - 'Now process the object associations to see what else needs saving - cm = obj.GetClassMap() + 'Now process the object associations to see what else needs saving + cm = obj.GetClassMap() - While Not cm Is Nothing - For i = 1 To cm.getStraightAssociationMapSize - udamap = cm.getStraightAssociationMap(i) - If udamap.SaveAutomatic Then - If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then - value = obj.GetObjectByAttribute(udamap.FromClassTarget) - If Not value Is Nothing Then - For Each o In getObjectsToSave(value, True, checkAssociationsRecursivly) - queue.Enqueue(o) - Next - End If - ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Then - col = obj.GetCollectionByAttribute(udamap.FromClassTarget) - If Not col Is Nothing Then - For k = 0 To col.Count() - 1 - tmpObj = col.Item(k) - If Not tmpObj.GetType.IsSubclassOf(GetType(CPersistentObject)) Then - value = getInjectedObject(tmpObj) - Else - value = tmpObj - End If - For Each o In getObjectsToSave(value, True, checkAssociationsRecursivly) - queue.Enqueue(o) - Next - Next k - End If - ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.MANY_TO_MANY Then - If obj.GetClassMap.Name = udamap.FromClass.Name Then - col = obj.GetCollectionByAttribute(udamap.FromClassTarget) - Else - If Not udamap.ToClassTarget Is Nothing Then - col = obj.GetCollectionByAttribute(udamap.ToClassTarget) - End If - End If - 'To ensure consistency of the association we need to get a list of records in the mapping table - 'and check wether the record is still valid. Removal of an object from a collection - 'should mean that we have to delete the associationtable record. - Dim state As New CAssociationState(obj, udamap) - If Not col Is Nothing Then - For k = 0 To col.Count() - 1 - tmpObj = col.Item(k) - If Not tmpObj.GetType.IsSubclassOf(GetType(CPersistentObject)) Then - value = getInjectedObject(tmpObj) - Else - value = tmpObj - End If - aObj = Nothing - isNewManyToMany = state.ValidateObject(value) - For Each qObj In getObjectsToSave(value, True, checkAssociationsRecursivly) - queue.Enqueue(qObj) - Next - If isNewManyToMany Then - 'We need to create an association object here for the class. - aObj = New CAssociationObject - aObj.ObjectA = obj - aObj.ObjectB = value - aObj.Association = udamap - queue.Enqueue(aObj) - End If - Next k - 'Remove old association records for items removed from the collection - state.DoCleanUp() - End If - End If - End If - Next i - cm = cm.SuperClass - End While + While Not cm Is Nothing + For i = 1 To cm.getStraightAssociationMapSize + udamap = cm.getStraightAssociationMap(i) + If udamap.SaveAutomatic Then + If udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_ONE Then + value = obj.GetObjectByAttribute(udamap.FromClassTarget) + If Not value Is Nothing Then + For Each o In getObjectsToSave(value, True, checkAssociationsRecursivly) + queue.Enqueue(o) + Next + End If + ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.ONE_TO_MANY Then + col = obj.GetCollectionByAttribute(udamap.FromClassTarget) + If Not col Is Nothing Then + For k = 0 To col.Count() - 1 + tmpObj = col.Item(k) + If Not tmpObj.GetType.IsSubclassOf(GetType(CPersistentObject)) Then + value = getInjectedObject(tmpObj, True) + Else + value = tmpObj + End If + For Each o In getObjectsToSave(value, True, checkAssociationsRecursivly) + queue.Enqueue(o) + Next + Next k + End If + ElseIf udamap.Cardinality = CUDAMap.CardinalityEnum.MANY_TO_MANY Then + If obj.GetClassMap.Name = udamap.FromClass.Name Then + col = obj.GetCollectionByAttribute(udamap.FromClassTarget) + Else + If Not udamap.ToClassTarget Is Nothing Then + col = obj.GetCollectionByAttribute(udamap.ToClassTarget) + End If + End If + 'To ensure consistency of the association we need to get a list of records in the mapping table + 'and check wether the record is still valid. Removal of an object from a collection + 'should mean that we have to delete the associationtable record. + Dim state As New CAssociationState(obj, udamap) + If Not col Is Nothing Then + For k = 0 To col.Count() - 1 + tmpObj = col.Item(k) + If Not tmpObj.GetType.IsSubclassOf(GetType(CPersistentObject)) Then + value = getInjectedObject(tmpObj, True) + Else + value = tmpObj + End If + aObj = Nothing + isNewManyToMany = state.ValidateObject(value) + For Each qObj In getObjectsToSave(value, True, checkAssociationsRecursivly) + queue.Enqueue(qObj) + Next + If isNewManyToMany Then + 'We need to create an association object here for the class. + aObj = New CAssociationObject + aObj.ObjectA = obj + aObj.ObjectB = value + aObj.Association = udamap + queue.Enqueue(aObj) + End If + Next k + 'Remove old association records for items removed from the collection + state.DoCleanUp() + End If + End If + End If + Next i + cm = cm.SuperClass + End While - Return queue + Return queue End Function ''' ----------------------------------------------------------------------------- @@ -2846,382 +2849,397 @@ obj = injObj.GetSourceObject End Sub - Public Function getInjectedObject(ByVal obj As Object) As CInjectedObject - Dim injObj As CInjectedObject - injObj = m_injectedObjects.Find(obj) - If injObj Is Nothing Then - injObj = New CInjectedObject(obj) - End If - Return injObj - End Function + Public Function getInjectedObject(ByVal obj As Object) As CInjectedObject + Return getInjectedObject(obj, False) + End Function - Public Function LocateOrCacheInjObject(ByVal obj As Object) As CInjectedObject - Dim injObj As CInjectedObject - injObj = m_injectedObjects.Find(obj) - If injObj Is Nothing Then - injObj = New CInjectedObject(obj) - m_injectedObjects.Add(injObj) - End If - Return injObj - End Function + Public Function getInjectedObject(ByVal obj As Object, ByVal createTemporary As Boolean) As CInjectedObject + Dim injObj As CInjectedObject + injObj = m_injectedObjects.Find(obj) + If injObj Is Nothing Then + injObj = New CInjectedObject(obj) + If createTemporary Then + 'When a single injected object has a reference to a set of objects that are + 'recursively referencing each other we need to add the objects to the cache + 'in order to prevent nested recursion. This temporary addition is only + 'used in getObjectsToSave + m_injectedObjects.AddTemp(injObj, True) + End If + End If + Return injObj + End Function - Public Sub StartTracking(ByVal obj As Object) - If Not TypeOf (obj) Is CInjectedObject Then - Dim injObj As CInjectedObject - injObj = New CInjectedObject(obj) - m_injectedObjects.Add(injObj) - Else - m_injectedObjects.Add(obj) - End If - End Sub + Public Function LocateOrCacheInjObject(ByVal obj As Object) As CInjectedObject + Dim injObj As CInjectedObject + injObj = m_injectedObjects.Find(obj) + If injObj Is Nothing Then + injObj = New CInjectedObject(obj) + m_injectedObjects.Add(injObj) + End If + Return injObj + End Function - Public Function ObjectIsTracked(ByVal obj) As Boolean - Debug.WriteLine(m_injectedObjects) - Return m_injectedObjects.isTracked(obj) - End Function + Public Sub StartTracking(ByVal obj As Object) + If Not TypeOf (obj) Is CInjectedObject Then + Dim injObj As CInjectedObject + injObj = New CInjectedObject(obj) + m_injectedObjects.Add(injObj) + Else + m_injectedObjects.Add(obj) + End If + End Sub - Public Sub MarkForDeletion(ByVal obj As Object) - MarkForDeletion(obj, False) - End Sub + Public Function ObjectIsTracked(ByVal obj) As Boolean + Debug.WriteLine(m_injectedObjects) + Return m_injectedObjects.isTracked(obj) + End Function - Public Sub MarkForDeletion(ByVal obj As Object, ByVal deleteParents As Boolean) - Dim injObj As CInjectedObject - injObj = m_injectedObjects.Find(obj) - If injObj Is Nothing Then - 'Nothing to do - Else - injObj.MarkedForDeletion = True - injObj.WillDeleteParents = deleteParents - End If - End Sub + Public Sub MarkForDeletion(ByVal obj As Object) + MarkForDeletion(obj, False) + End Sub - Public Sub PersistChanges() - PersistChanges(True) - End Sub + Public Sub MarkForDeletion(ByVal obj As Object, ByVal deleteParents As Boolean) + Dim injObj As CInjectedObject + injObj = m_injectedObjects.Find(obj) + If injObj Is Nothing Then + 'Nothing to do + Else + injObj.MarkedForDeletion = True + injObj.WillDeleteParents = deleteParents + End If + End Sub - Public Sub PersistChanges(ByVal checkAssociationsRecursively As Boolean) - Me.startTransaction() - Try - Dim injObj As CInjectedObject - m_inPersistChangesLoop = True - 'Need to copy the injected object cache as saving objects may result - 'in the collection being modified which would break the for/each loop. - Dim objectsToPersist As New CInjectedObjectCache - For Each de As DictionaryEntry In m_injectedObjects - objectsToPersist.Add(de.Key, de.Value) - Next - 'We will try to save/create objects first and then we will process deletes - 'This will prevent us trying to update objects that have been - 'autodeleted by another object (which would throw an exception) - For Each de As DictionaryEntry In objectsToPersist - injObj = de.Value - If Not injObj.MarkedForDeletion Then - PersistChanges(injObj.ReferencedObject) - End If - Next - For Each de As DictionaryEntry In objectsToPersist - injObj = de.Value - If injObj.MarkedForDeletion And injObj.Persistent Then - PersistChanges(injObj.ReferencedObject) - End If - Next - m_inPersistChangesLoop = False - For Each obj As CInjectedObject In m_objectsToDelete - m_injectedObjects.Remove(obj) - Next - m_objectsToDelete.Clear() - Me.commit() - Catch ex As Exception - m_inPersistChangesLoop = False - Me.rollback() - Throw ex - End Try - End Sub + Public Sub PersistChanges() + PersistChanges(True) + End Sub - Public Sub PersistChanges(ByVal obj As Object) - PersistChanges(obj, True) - End Sub + Public Sub PersistChanges(ByVal checkAssociationsRecursively As Boolean) + Me.startTransaction() + Try + Dim injObj As CInjectedObject + m_inPersistChangesLoop = True + 'Need to copy the injected object cache as saving objects may result + 'in the collection being modified which would break the for/each loop. + Dim objectsToPersist As New CInjectedObjectCache + For Each de As DictionaryEntry In m_injectedObjects + objectsToPersist.Add(de.Key, de.Value) + Next + 'We will try to save/create objects first and then we will process deletes + 'This will prevent us trying to update objects that have been + 'autodeleted by another object (which would throw an exception) + For Each de As DictionaryEntry In objectsToPersist + injObj = de.Value + If Not injObj.MarkedForDeletion Then + PersistChanges(injObj.ReferencedObject) + End If + Next + For Each de As DictionaryEntry In objectsToPersist + injObj = de.Value + If injObj.MarkedForDeletion And injObj.Persistent Then + PersistChanges(injObj.ReferencedObject) + End If + Next + m_inPersistChangesLoop = False + For Each obj As CInjectedObject In m_objectsToDelete + m_injectedObjects.Remove(obj) + Next + m_objectsToDelete.Clear() + Me.commit() + m_injectedObjects.CleanUp() + Catch ex As Exception + m_inPersistChangesLoop = False + Me.rollback() + Throw ex + End Try + End Sub - Public Sub PersistChanges(ByVal obj As Object, ByVal checkAssociationsRecursively As Boolean) - Dim value As IPersistableObject - Dim queue As queue - Dim qObject As Object - Dim injObj As CInjectedObject - Dim ckey As CCacheKey - Dim savedKeys As New ArrayList + Public Sub PersistChanges(ByVal obj As Object) + PersistChanges(obj, True) + End Sub - 'If for some reason the object isn't being tracked for changes yet, we will start - 'tracking it now. - injObj = LocateOrCacheInjObject(obj) + Public Sub PersistChanges(ByVal obj As Object, ByVal checkAssociationsRecursively As Boolean) + Dim value As IPersistableObject + Dim queue As Queue + Dim qObject As Object + Dim injObj As CInjectedObject + Dim ckey As CCacheKey + Dim savedKeys As New ArrayList - If injObj.MarkedForDeletion Then - deleteObject(injObj, injObj.WillDeleteParents) - If Not m_inPersistChangesLoop Then - For Each xobj As CInjectedObject In m_objectsToDelete - m_injectedObjects.Remove(xobj) - Next - m_objectsToDelete.Clear() - End If - Else - 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 - qObject = queue.Dequeue() - Try - If GetType(CAssociationObject).IsInstanceOfType(qObject) Then - saveAssociationObject(qObject) - Else - value = qObject - ckey = New CCacheKey(value) - If savedKeys.Contains(ckey) Then - 'object was already saved (could be new object referenced by multiple other new objects) - Debug.WriteLine("The object with key " & ckey.ToString & " was already saved once") - Else - saveObject(value) - 'Recalculate key value - required when identity columns are used - ckey = New CCacheKey(value) - savedKeys.Add(ckey) - End If - value.IsDirty = False - End If - 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 - Loop - commit() - End If - End If - End Sub + 'If for some reason the object isn't being tracked for changes yet, we will start + 'tracking it now. + injObj = LocateOrCacheInjObject(obj) - Friend Property InjectedObjects() As CInjectedObjectCache - Get - Return m_injectedObjects - End Get - Set(ByVal Value As CInjectedObjectCache) - m_injectedObjects = Value - End Set - End Property + If injObj.MarkedForDeletion Then + deleteObject(injObj, injObj.WillDeleteParents) + If Not m_inPersistChangesLoop Then + For Each xobj As CInjectedObject In m_objectsToDelete + m_injectedObjects.Remove(xobj) + Next + m_objectsToDelete.Clear() + End If + Else + 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 + qObject = queue.Dequeue() + Try + If GetType(CAssociationObject).IsInstanceOfType(qObject) Then + saveAssociationObject(qObject) + Else + value = qObject + ckey = New CCacheKey(value) + If savedKeys.Contains(ckey) Then + 'object was already saved (could be new object referenced by multiple other new objects) + Debug.WriteLine("The object with key " & ckey.ToString & " was already saved once") + Else + saveObject(value) + 'Recalculate key value - required when identity columns are used + ckey = New CCacheKey(value) + savedKeys.Add(ckey) + End If + value.IsDirty = False + End If + 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 + Loop + commit() + End If + End If + If Not m_inPersistChangesLoop Then + m_injectedObjects.CleanUp() + End If + End Sub - Friend Sub InitPerformanceCounters() - Try - If Not PerformanceCounterCategory.Exists("Atoms.Framework") Then + Friend Property InjectedObjects() As CInjectedObjectCache + Get + Return m_injectedObjects + End Get + Set(ByVal Value As CInjectedObjectCache) + m_injectedObjects = Value + End Set + End Property - Dim CCDC As New CounterCreationDataCollection + Friend Sub InitPerformanceCounters() + Try + If Not PerformanceCounterCategory.Exists("Atoms.Framework") Then - Dim SQLHitsCount64 As New CounterCreationData - SQLHitsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - SQLHitsCount64.CounterHelp = "SQLStatements Executed per Sec." - SQLHitsCount64.CounterName = "PCSQLHits" - CCDC.Add(SQLHitsCount64) + Dim CCDC As New CounterCreationDataCollection - Dim CacheHitsCount64 As New CounterCreationData - CacheHitsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - CacheHitsCount64.CounterHelp = "Cache Reads per Sec." - CacheHitsCount64.CounterName = "PCCacheHits" - CCDC.Add(CacheHitsCount64) + Dim SQLHitsCount64 As New CounterCreationData + SQLHitsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + SQLHitsCount64.CounterHelp = "SQLStatements Executed per Sec." + SQLHitsCount64.CounterName = "PCSQLHits" + CCDC.Add(SQLHitsCount64) - Dim InsertsCount64 As New CounterCreationData - InsertsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - InsertsCount64.CounterHelp = "Inserts per Sec." - InsertsCount64.CounterName = "PCInserts" - CCDC.Add(InsertsCount64) + Dim CacheHitsCount64 As New CounterCreationData + CacheHitsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + CacheHitsCount64.CounterHelp = "Cache Reads per Sec." + CacheHitsCount64.CounterName = "PCCacheHits" + CCDC.Add(CacheHitsCount64) - Dim UpdatesCount64 As New CounterCreationData - UpdatesCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - UpdatesCount64.CounterHelp = "Updates per Sec." - UpdatesCount64.CounterName = "PCUpdates" - CCDC.Add(UpdatesCount64) + Dim InsertsCount64 As New CounterCreationData + InsertsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + InsertsCount64.CounterHelp = "Inserts per Sec." + InsertsCount64.CounterName = "PCInserts" + CCDC.Add(InsertsCount64) - Dim ReadsCount64 As New CounterCreationData - ReadsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - ReadsCount64.CounterHelp = "Reads per Sec." - ReadsCount64.CounterName = "PCReads" - CCDC.Add(ReadsCount64) + Dim UpdatesCount64 As New CounterCreationData + UpdatesCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + UpdatesCount64.CounterHelp = "Updates per Sec." + UpdatesCount64.CounterName = "PCUpdates" + CCDC.Add(UpdatesCount64) - Dim DeletesCount64 As New CounterCreationData - DeletesCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - DeletesCount64.CounterHelp = "Deletes per Sec." - DeletesCount64.CounterName = "PCDeletes" - CCDC.Add(DeletesCount64) + Dim ReadsCount64 As New CounterCreationData + ReadsCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + ReadsCount64.CounterHelp = "Reads per Sec." + ReadsCount64.CounterName = "PCReads" + CCDC.Add(ReadsCount64) - Dim CriteriaCount64 As New CounterCreationData - CriteriaCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 - CriteriaCount64.CounterHelp = "xCriteria per Sec." - CriteriaCount64.CounterName = "PCCriteria" - CCDC.Add(CriteriaCount64) + Dim DeletesCount64 As New CounterCreationData + DeletesCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + DeletesCount64.CounterHelp = "Deletes per Sec." + DeletesCount64.CounterName = "PCDeletes" + CCDC.Add(DeletesCount64) - Dim CacheSizeCount64 As New CounterCreationData - CacheSizeCount64.CounterType = PerformanceCounterType.NumberOfItems64 - CacheSizeCount64.CounterHelp = "Cache Size (No. of entries)" - CacheSizeCount64.CounterName = "PCCacheSize" - CCDC.Add(CacheSizeCount64) + Dim CriteriaCount64 As New CounterCreationData + CriteriaCount64.CounterType = PerformanceCounterType.RateOfCountsPerSecond64 + CriteriaCount64.CounterHelp = "xCriteria per Sec." + CriteriaCount64.CounterName = "PCCriteria" + CCDC.Add(CriteriaCount64) - Dim AvgOpTimeCount64 As New CounterCreationData - AvgOpTimeCount64.CounterType = PerformanceCounterType.AverageTimer32 - AvgOpTimeCount64.CounterHelp = "Average Operation Time" - AvgOpTimeCount64.CounterName = "PCAverageTime" - CCDC.Add(AvgOpTimeCount64) + Dim CacheSizeCount64 As New CounterCreationData + CacheSizeCount64.CounterType = PerformanceCounterType.NumberOfItems64 + CacheSizeCount64.CounterHelp = "Cache Size (No. of entries)" + CacheSizeCount64.CounterName = "PCCacheSize" + CCDC.Add(CacheSizeCount64) - Dim BaseAvgOpTimeCount64 As New CounterCreationData - BaseAvgOpTimeCount64.CounterType = PerformanceCounterType.AverageBase - BaseAvgOpTimeCount64.CounterName = "Average Operation Time Count" - BaseAvgOpTimeCount64.CounterHelp = "PCAverageTimeBase" - CCDC.Add(BaseAvgOpTimeCount64) + Dim AvgOpTimeCount64 As New CounterCreationData + AvgOpTimeCount64.CounterType = PerformanceCounterType.AverageTimer32 + AvgOpTimeCount64.CounterHelp = "Average Operation Time" + AvgOpTimeCount64.CounterName = "PCAverageTime" + CCDC.Add(AvgOpTimeCount64) - ' Create the category. - PerformanceCounterCategory.Create("Atoms.Framework", "Performance Counters for the Atoms.Framework", CCDC) - End If + Dim BaseAvgOpTimeCount64 As New CounterCreationData + BaseAvgOpTimeCount64.CounterType = PerformanceCounterType.AverageBase + BaseAvgOpTimeCount64.CounterName = "Average Operation Time Count" + BaseAvgOpTimeCount64.CounterHelp = "PCAverageTimeBase" + CCDC.Add(BaseAvgOpTimeCount64) - Dim instanceName As String - instanceName = System.Diagnostics.Process.GetCurrentProcess.ProcessName - ' Create the counters. - PCSQLHits = New PerformanceCounter("Atoms.Framework", "PCSQLHits", False) - PCCacheHits = New PerformanceCounter("Atoms.Framework", "PCCacheHits", False) - PCInserts = New PerformanceCounter("Atoms.Framework", "PCInserts", False) - PCUpdates = New PerformanceCounter("Atoms.Framework", "PCUpdates", False) - PCReads = New PerformanceCounter("Atoms.Framework", "PCReads", False) - PCDeletes = New PerformanceCounter("Atoms.Framework", "PCDeletes", False) - PCCriteria = New PerformanceCounter("Atoms.Framework", "PCCriteria", False) - PCCacheSize = New PerformanceCounter("Atoms.Framework", "PCCacheSize", False) - PCAverageTime = New PerformanceCounter("Atoms.Framework", "PCAverageTime", False) - PCAverageTimeBase = New PerformanceCounter("Atoms.Framework", "PCAverageTimeBase", False) + ' Create the category. + PerformanceCounterCategory.Create("Atoms.Framework", "Performance Counters for the Atoms.Framework", CCDC) + End If - PCSQLHits.RawValue = 0 - PCCacheHits.RawValue = 0 - PCInserts.RawValue = 0 - PCUpdates.RawValue = 0 - PCReads.RawValue = 0 - PCDeletes.RawValue = 0 - PCCriteria.RawValue = 0 - PCCacheSize.RawValue = 0 - PCAverageTime.RawValue = 0 - PCAverageTimeBase.RawValue = 0 - Catch ex As Exception - Trace.WriteLine("Could not create performance counters. If using ASP.NET please see http://objectsharp.com/Blogs/bruce/archive/2003/12/05/222.aspx" & _ - vbCrLf & ex.Message) - End Try - End Sub + Dim instanceName As String + instanceName = System.Diagnostics.Process.GetCurrentProcess.ProcessName + ' Create the counters. + PCSQLHits = New PerformanceCounter("Atoms.Framework", "PCSQLHits", False) + PCCacheHits = New PerformanceCounter("Atoms.Framework", "PCCacheHits", False) + PCInserts = New PerformanceCounter("Atoms.Framework", "PCInserts", False) + PCUpdates = New PerformanceCounter("Atoms.Framework", "PCUpdates", False) + PCReads = New PerformanceCounter("Atoms.Framework", "PCReads", False) + PCDeletes = New PerformanceCounter("Atoms.Framework", "PCDeletes", False) + PCCriteria = New PerformanceCounter("Atoms.Framework", "PCCriteria", False) + PCCacheSize = New PerformanceCounter("Atoms.Framework", "PCCacheSize", False) + PCAverageTime = New PerformanceCounter("Atoms.Framework", "PCAverageTime", False) + PCAverageTimeBase = New PerformanceCounter("Atoms.Framework", "PCAverageTimeBase", False) - Public Shared Sub CopyCollections(ByVal fromObject As Object, ByRef toObject As Object) - Dim t, iEnumerableType, iListType, iDicType As Type - Dim fromColl, toColl, collItem As Object - Dim il As IList - Dim id As IDictionary - Dim f, fields() As FieldInfo - Dim value As Object + PCSQLHits.RawValue = 0 + PCCacheHits.RawValue = 0 + PCInserts.RawValue = 0 + PCUpdates.RawValue = 0 + PCReads.RawValue = 0 + PCDeletes.RawValue = 0 + PCCriteria.RawValue = 0 + PCCacheSize.RawValue = 0 + PCAverageTime.RawValue = 0 + PCAverageTimeBase.RawValue = 0 + Catch ex As Exception + Trace.WriteLine("Could not create performance counters. If using ASP.NET please see http://objectsharp.com/Blogs/bruce/archive/2003/12/05/222.aspx" & _ + vbCrLf & ex.Message) + End Try + End Sub - t = fromObject.GetType - fields = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) - For Each f In fields - iListType = f.FieldType.GetInterface("IList", True) - iDicType = f.FieldType.GetInterface("IDictionary", True) - If Not iListType Is Nothing OrElse Not iDicType Is Nothing Then - Dim ICloneType As Type = f.FieldType.GetInterface("ICloneable", True) - If Not ICloneType Is Nothing Then - 'Getting the ICloneable interface from the object. - If Not f.GetValue(fromObject) Is Nothing Then - Dim IClone As ICloneable = CType(f.GetValue(fromObject), ICloneable) - toColl = IClone.Clone() - Else - toColl = Nothing - End If - Else - fromColl = f.GetValue(fromObject) - If Not fromColl Is Nothing Then - 'If the field doesn't support the ICloneable interface then just set it. - t = f.FieldType - toColl = Activator.CreateInstance(t) - 'need to copy references one-by-one - 'Also neeed to connect event handlers of new collection to new object based - 'on event connections of the old collection and the old object - Dim fColl, fieldsColl() As FieldInfo - Dim d, newD, delArray(), newDelArray() As [Delegate] - Dim collDel As MulticastDelegate - While Not t Is Nothing - fieldsColl = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) - For Each fColl In fieldsColl - If fColl.FieldType.Name = fColl.Name & "Handler" OrElse fColl.FieldType Is GetType(EventHandler) Then - 'This is an event! - d = fColl.GetValue(fromColl) - collDel = Nothing - If Not d Is Nothing Then - delArray = d.GetInvocationList - For Each d In delArray - If Not d.Target.GetType.GetInterface("IPersistableObject") Is Nothing Then - If CType(d.Target, IPersistableObject).Equals(fromObject) Then - newD = MulticastDelegate.CreateDelegate(fColl.FieldType, toObject, d.Method.Name) - If collDel Is Nothing Then - collDel = newD - Else - collDel.Combine(collDel, newD) - End If - End If - End If - Next - fColl.SetValue(toColl, collDel) - End If - End If - Next - If t.IsSubclassOf(GetType(CPersistentCollection)) Then - t = t.BaseType - Else - t = Nothing - End If - End While - If Not iListType Is Nothing Then - il = CType(toColl, IList) - For Each collItem In fromColl - il.Add(collItem) - Next - Else - id = CType(toColl, IDictionary) - For Each de As DictionaryEntry In fromColl - id.Add(de.Key, de.Value) - Next - End If - Else - toColl = Nothing - End If - End If - If Not toColl Is Nothing AndAlso f.FieldType Is GetType(CPersistentCollection) OrElse f.FieldType.IsSubclassOf(GetType(CPersistentCollection)) Then - Dim c As CPersistentCollection - c = CType(toColl, CPersistentCollection) - If Not c.ContainerObject Is Nothing AndAlso c.ContainerObject.Equals(fromObject) Then - c.ContainerObject = toObject - End If - End If - f.SetValue(toObject, toColl) - End If - Next - End Sub + Public Shared Sub CopyCollections(ByVal fromObject As Object, ByRef toObject As Object) + Dim t, iEnumerableType, iListType, iDicType As Type + Dim fromColl, toColl, collItem As Object + Dim il As IList + Dim id As IDictionary + Dim f, fields() As FieldInfo + Dim value As Object - Private Sub AddToQueue(ByVal obj As Object, ByRef queue As Queue) - Call AddToQueue(obj, queue, True) - End Sub - Private Sub AddToQueue(ByVal obj As Object, ByRef queue As Queue, ByVal includeObject As Boolean) - '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 + t = fromObject.GetType + fields = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) + For Each f In fields + iListType = f.FieldType.GetInterface("IList", True) + iDicType = f.FieldType.GetInterface("IDictionary", True) + If Not iListType Is Nothing OrElse Not iDicType Is Nothing Then + Dim ICloneType As Type = f.FieldType.GetInterface("ICloneable", True) + If Not ICloneType Is Nothing Then + 'Getting the ICloneable interface from the object. + If Not f.GetValue(fromObject) Is Nothing Then + Dim IClone As ICloneable = CType(f.GetValue(fromObject), ICloneable) + toColl = IClone.Clone() + Else + toColl = Nothing + End If + Else + fromColl = f.GetValue(fromObject) + If Not fromColl Is Nothing Then + 'If the field doesn't support the ICloneable interface then just set it. + t = f.FieldType + toColl = Activator.CreateInstance(t) + 'need to copy references one-by-one + 'Also neeed to connect event handlers of new collection to new object based + 'on event connections of the old collection and the old object + Dim fColl, fieldsColl() As FieldInfo + Dim d, newD, delArray(), newDelArray() As [Delegate] + Dim collDel As MulticastDelegate + While Not t Is Nothing + fieldsColl = t.GetFields(BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public) + For Each fColl In fieldsColl + If fColl.FieldType.Name = fColl.Name & "Handler" OrElse fColl.FieldType Is GetType(EventHandler) Then + 'This is an event! + d = fColl.GetValue(fromColl) + collDel = Nothing + If Not d Is Nothing Then + delArray = d.GetInvocationList + For Each d In delArray + If Not d.Target.GetType.GetInterface("IPersistableObject") Is Nothing Then + If CType(d.Target, IPersistableObject).Equals(fromObject) Then + newD = MulticastDelegate.CreateDelegate(fColl.FieldType, toObject, d.Method.Name) + If collDel Is Nothing Then + collDel = newD + Else + collDel.Combine(collDel, newD) + End If + End If + End If + Next + fColl.SetValue(toColl, collDel) + End If + End If + Next + If t.IsSubclassOf(GetType(CPersistentCollection)) Then + t = t.BaseType + Else + t = Nothing + End If + End While + If Not iListType Is Nothing Then + il = CType(toColl, IList) + For Each collItem In fromColl + il.Add(collItem) + Next + Else + id = CType(toColl, IDictionary) + For Each de As DictionaryEntry In fromColl + id.Add(de.Key, de.Value) + Next + End If + Else + toColl = Nothing + End If + End If + If Not toColl Is Nothing AndAlso f.FieldType Is GetType(CPersistentCollection) OrElse f.FieldType.IsSubclassOf(GetType(CPersistentCollection)) Then + Dim c As CPersistentCollection + c = CType(toColl, CPersistentCollection) + If Not c.ContainerObject Is Nothing AndAlso c.ContainerObject.Equals(fromObject) Then + c.ContainerObject = toObject + End If + End If + f.SetValue(toObject, toColl) + End If + Next + End Sub + + Private Sub AddToQueue(ByVal obj As Object, ByRef queue As Queue) + Call AddToQueue(obj, queue, True) + End Sub + Private Sub AddToQueue(ByVal obj As Object, ByRef queue As Queue, ByVal includeObject As Boolean) + '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: CMultiRetrieveCriteria.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CMultiRetrieveCriteria.vb,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- CMultiRetrieveCriteria.vb 28 Feb 2005 23:07:44 -0000 1.19 +++ CMultiRetrieveCriteria.vb 16 Mar 2005 11:32:41 -0000 1.20 @@ -405,7 +405,7 @@ Else statement.addSqlClause(" ") End If - statement.addSqlClause(entry.AttributeMap.ColumnMap.getAliasQualifiedName(ht(entry.ClassMap.Name))) + statement.addSqlClause(entry.AttributeMap.ColumnMap.getAliasQualifiedName(ht(entry.ClassMap.Name))) 'statement.addSqlClause(entry.AttributeMap.ColumnMap.getAliasQualifiedName("t1")) If entry.Ascend Then statement.addSqlClause(" " & Me.ClassMap.RelationalDatabase.getClauseStringAscend) Index: CPersistentCriteria.vb =================================================================== RCS file: /cvsroot/jcframework/dotnet/CPersistentCriteria.vb,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- CPersistentCriteria.vb 1 Mar 2005 03:16:57 -0000 1.11 +++ CPersistentCriteria.vb 16 Mar 2005 11:32:43 -0000 1.12 @@ -7,17 +7,17 @@ ''' </summary> '''----------------------------------------------------------------------------- Public Interface _CPersistentCriteria - Property Criteria() As Collection - Property Tables() As Collection - Property Associations() As Collection - Property ClassName() As String - Property ClassMap() As CClassMap - Property WhereCondition() As CCriteriaCondition - Sub setClassMap(ByRef pClassName As String) - Sub fillStatementWithCondition(ByRef statement As CSqlStatement) - Sub fillStatementWithWhere(ByRef statement As CSqlStatement) - Function getSize() As Short - Sub addOffsetSubCriteria(ByVal offset As Integer) + Property Criteria() As Collection + Property Tables() As Collection + Property Associations() As Collection + Property ClassName() As String + Property ClassMap() As CClassMap + Property WhereCondition() As CCriteriaCondition + Sub setClassMap(ByRef pClassName As String) + Sub fillStatementWithCondition(ByRef statement As CSqlStatement) + Sub fillStatementWithWhere(ByRef statement As CSqlStatement) + Function getSize() As Short + Sub addOffsetSubCriteria(ByVal offset As Integer) End Interface '''----------------------------------------------------------------------------- @@ -40,298 +40,298 @@ ''' </history> '''----------------------------------------------------------------------------- Public Class CPersistentCriteria - Implements _CPersistentCriteria + Implements _CPersistentCriteria - '************************************************** - 'Class: CPersistentCriteria - 'Author: Juan Carlos Alvarez - '************************************************** + '************************************************** + 'Class: CPersistentCriteria + 'Author: Juan Carlos Alvarez + '************************************************** - Private m_criteria As Collection - Private m_className As String - Private m_classMap As CClassMap - Private m_Tables As Collection - Private m_Associations As Collection - Private m_WhereCondition As CCriteriaCondition + Private m_criteria As Collection + Private m_className As String + Private m_classMap As CClassMap + Private m_Tables As Collection + Private m_Associations As Collection + Private m_WhereCondition As CCriteriaCondition - '''----------------------------------------------------------------------------- - ''' <summary> - ''' A collection of the various sub-criteria that make up this criteria. - ''' </summary> - ''' <value>A collection of criteria objects</value> - ''' <remarks></remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Property Criteria() As Collection Implements _CPersistentCriteria.Criteria - Get - Criteria = m_criteria - End Get - Set(ByVal Value As Collection) - m_criteria = Value - End Set - End Property + '''----------------------------------------------------------------------------- + ''' <summary> + ''' A collection of the various sub-criteria that make up this criteria. + ''' </summary> + ''' <value>A collection of criteria objects</value> + ''' <remarks></remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Property Criteria() As Collection Implements _CPersistentCriteria.Criteria + Get + Criteria = m_criteria + End Get + Set(ByVal Value As Collection) + m_criteria = Value + End Set + End Property - '''----------------------------------------------------------------------------- - ''' <summary> - ''' A Collection of the various tables used in the criteria. - ''' </summary> - ''' <value></value> - ''' <remarks></remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Property Tables() As Collection Implements _CPersistentCriteria.Tables - Get - Tables = m_Tables - End Get - Set(ByVal Value As Collection) - m_Tables = Value - End Set - End Property + '''----------------------------------------------------------------------------- + ''' <summary> + ''' A Collection of the various tables used in the criteria. + ''' </summary> + ''' <value></value> + ''' <remarks></remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Property Tables() As Collection Implements _CPersistentCriteria.Tables + Get + Tables = m_Tables + End Get + Set(ByVal Value As Collection) + m_Tables = Value + End Set + End Property - '''----------------------------------------------------------------------------- - ''' <summary> - ''' A collection of the associations used to link the tables in the criteria together. - ''' </summary> - ''' <value></value> - ''' <remarks></remarks> - ''' <history> - ''' [rbanks] 17/12/2003 Created - ''' </history> - '''----------------------------------------------------------------------------- - Public Property Associations() As Collection Implements _CPersistentCriteria.Associations - Get - Associations = m_Associations - End Get - Set(ByVal Value As Collection) - m_Associations = Value - End Set - End Property + '''----------------------------------------------------------------------------- + ''' <summary> + ''' A collection of the associations used to link the tables in the criteria together. + ''' </summary> + ''' <value></value> + ''' <remarks></remarks> + ''' <history> + ''' [rbanks] 17/12/2003 Created + ''' </history> + '''----------------------------------------------------------------------------- + Public Property Associations() As Collection Implements _CPersistentCriteria.Associations + Get + Associations = m_Associations + End Get + Set(ByVal Value As Collection) + m_Associations = Value + End Set + End Property - '''----------------------------------------------------------------------------- - ''' <summary> - ''' The class name of the primary object in the criteria. - ''' </summary> - ''' <value>A string representing the primary class... [truncated message content] |
