Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [720] branches/EnsureObjectsDev
|
From: <sr...@us...> - 2006-11-27 08:09:32
|
Revision: 720
http://svn.sourceforge.net/instantobjects/revision/?rev=720&view=rev
Author: srmitch
Date: 2006-11-27 00:09:29 -0800 (Mon, 27 Nov 2006)
Log Message:
-----------
1. Add an 'EnsureContainerObjects' property to the TInstantObject class. This property, when set to true, will cause all persistent objects referenced in container attributes of instances of this class to be retrieved and instantiated in one process for each container attribute. Container attributes, however, that have their 'EnsureContainerObjects' property (see below) set to true are ignored. The new property will be added to the class metadata so that it can be available at design-time and is persistent;
2. Add a 'Ensure Container Attribute Objects' check box option to the 'Class' page of the Class Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
3. Add an 'EnsureContainerObjects' property to the TInstantAttribute class. This property, when set to true, will cause all persistent objects referenced in a container attribute to be retrieved and instantiated in one process during the its creation. The new property will be added to the attribute metadata so that it can be available at design-time and is persistent;
4. Add an 'Ensure Container Objects' check box option to the 'Access' page of the Attribute Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
5. Add an 'EnsureObjects' property to TInstantCustomExposer and publish it in TInstantSelector. Add an 'EnsureObjects' property to TInstantQuery to support the new 'EnsureObjects' property in TInstantSelector;
6. Add several methods to the TInstantBroker and derived/supporting classes to provide the necessary processing for the retrieval and instantiation of multiple persistent objects and/or their container attribute objects. The TInstantBroker public methods are as follows:
- procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
[Used to instantiate all the objects of AObjectsClass in the persistent store. RetrieveAllObjects passes back the retrieved objects in AObjectIdList, which must be created before calling.]
- procedure TInstantBroker.RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
[Used to instantiate the objects referenced in AObjRefList from the persistent store. RetrieveMixedObjects passes back the retrieved objects in AObjRefList, which must be created and initialised before calling.]
- procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
[Used to instantiate the objects of AObjectsClass referenced by their Id in AObjectIdList from the persistent store. RetrieveObjects passes back the retrieved objects in AObjectIdList, which must be created and initialised before calling.]
Modified Paths:
--------------
branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm
branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas
branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas
branches/EnsureObjectsDev/Source/Core/InstantCode.pas
branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas
branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas
branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas
branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm
branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas
branches/EnsureObjectsDev/Source/Design/InstantClassEditor.dfm
branches/EnsureObjectsDev/Source/Design/InstantClassEditor.pas
branches/EnsureObjectsDev/Tests/TestInstantAttribute.pas
branches/EnsureObjectsDev/Tests/TestInstantAttributeMetadata.pas
branches/EnsureObjectsDev/Tests/TestInstantClassMetadata.pas
branches/EnsureObjectsDev/Tests/TestInstantObject.pas
branches/EnsureObjectsDev/Tests/TestMinimalModel.pas
Added Paths:
-----------
branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm 2006-11-27 08:09:29 UTC (rev 720)
@@ -8,6 +8,7 @@
FieldOptions = [foObjects, foThorough]
Sorted = True
OnCompare = CountrySelectorCompare
+ EnsureObjects = True
Command.Strings = (
'SELECT * FROM TCountry')
Left = 40
@@ -22,6 +23,7 @@
FieldOptions = [foObjects, foThorough]
Sorted = True
OnCompare = CategorySelectorCompare
+ EnsureObjects = True
Command.Strings = (
'SELECT * FROM TCategory')
Left = 136
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -166,7 +166,7 @@
end;
TPerson = class(TContact)
- {IOMETADATA stored;
+ {IOMETADATA stored ensureobjects;
BirthDate: DateTime;
Emails: Parts(TEmail) external 'Person_Emails';
Employer: Reference(TCompany);
@@ -211,7 +211,7 @@
end;
TCompany = class(TContact)
- {IOMETADATA stored;
+ {IOMETADATA stored ensureobjects;
Employees: References(TPerson) external 'Company_Employees'; }
_Employees: TInstantReferences;
private
Added: branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
===================================================================
--- branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt (rev 0)
+++ branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt 2006-11-27 08:09:29 UTC (rev 720)
@@ -0,0 +1,42 @@
+RFC: IO-002
+Title: EnsureObjects Performance Enhancement Option
+Author: Steven Mitchell
+First Draft: 27 Nov 2006
+Current Revision: 0, 27 Nov 2006
+
+= Goal =
+
+Currently all object retrievals from the persistence store (eg database) in the IO framework is done individually for each persistent object and each of its container attribute objects. Employing such a 'lazy load' philosophy has both advantages and disadvantages. One of the disadvantages can be the numerous round trips to the persistence store to load a list of objects. This can cause noticeable delays and network traffic when connecting to remote persistence stores. Options in the IO framework to allow the retrieval and instantiation of multiple persistent objects would be helpful to reduce these problems.
+
+= Proposal =
+
+To provide run-time and design-time options within the IO framework to allow the retrieval and instantiation of multiple persistent objects and/or their container attribute objects as follows:
+
+1. Add an 'EnsureContainerObjects' property to the TInstantObject class. This property, when set to true, will cause all persistent objects referenced in container attributes of instances of this class to be retrieved and instantiated in one process for each container attribute. Container attributes, however, that have their 'EnsureContainerObjects' property (see below) set to true are ignored. The new property will be added to the class metadata so that it can be available at design-time and is persistent;
+
+2. Add a 'Ensure Container Attribute Objects' check box option to the 'Class' page of the Class Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
+
+3. Add an 'EnsureContainerObjects' property to the TInstantAttribute class. This property, when set to true, will cause all persistent objects referenced in a container attribute to be retrieved and instantiated in one process during the its creation. The new property will be added to the attribute metadata so that it can be available at design-time and is persistent;
+
+4. Add an 'Ensure Container Objects' check box option to the 'Access' page of the Attribute Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
+
+5. Add an 'EnsureObjects' property to TInstantCustomExposer and publish it in TInstantSelector. Add an 'EnsureObjects' property to TInstantQuery to support the new 'EnsureObjects' property in TInstantSelector;
+
+6. Add several methods to the TInstantBroker and derived/supporting classes to provide the necessary processing for the retrieval and instantiation of multiple persistent objects and/or their container attribute objects. The TInstantBroker public methods are as follows:
+
+- procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+[Used to instantiate all the objects of AObjectsClass in the persistent store. RetrieveAllObjects passes back the retrieved objects in AObjectIdList, which must be created before calling.]
+
+- procedure TInstantBroker.RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
+[Used to instantiate the objects referenced in AObjRefList from the persistent store. RetrieveMixedObjects passes back the retrieved objects in AObjRefList, which must be created and initialised before calling.]
+
+- procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+[Used to instantiate the objects of AObjectsClass referenced by their Id in AObjectIdList from the persistent store. RetrieveObjects passes back the retrieved objects in AObjectIdList, which must be created and initialised before calling.]
+
+= Use =
+
+NOTE: Initially only implemented when using SQL based brokers. Use with other brokers will raise exceptions.
+
+At design-time use InstantObjects Model Explorer to 'ensure the attributes' of the class or its individual container attributes as desired.
+
+At run-time use the broker methods passing in an appropriately created list. Use a TInstantQuery (TInstantSQLQuery only implemented initially) and set its 'EnsureObjects' property to true before opening it.
Property changes on: branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -120,9 +120,15 @@
function GetSQLWildcard: string; virtual;
function InternalDisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
function InternalRetrieveObject(AObject: TInstantObject;
const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
public
@@ -153,6 +159,12 @@
override;
function FindResolver(const TableName: string):
TInstantNavigationalResolver;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
property ResolverCount: Integer read GetResolverCount;
property Resolvers[Index: Integer]: TInstantNavigationalResolver
read GetResolvers;
@@ -182,10 +194,18 @@
virtual;
function CreateDataSet(const AStatement: string; AParams: TParams = nil):
TDataSet; virtual; abstract;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
public
destructor Destroy; override;
function AcquireDataSet(const AStatement: string; AParams: TParams = nil):
TDataSet; virtual;
+ procedure CreateObjectsFromDataset(AObjectsClass: TInstantObjectClass;
+ ADataSet: TDataSet; AObjectIdList: TStrings);
procedure ReleaseDataSet(const ADataSet: TDataSet); virtual;
function DataTypeToColumnType(DataType: TInstantDataType;
Size: Integer): string; virtual; abstract;
@@ -668,6 +688,7 @@
function BuildFieldList(Map: TInstantAttributeMap;
Additional: array of string): string; overload;
function BuildFieldList(const S: string): string; overload;
+ function BuildTableQualifiedFieldList(const S, ATableName: string): string;
function BuildParam(const AName: string): string; virtual;
function BuildParamList(Map: TInstantAttributeMap;
Additional: array of string): string;
@@ -705,6 +726,9 @@
string; virtual;
function InternalGenerateSelectExternalPartSQL(Map: TInstantAttributeMap):
string; virtual;
+ function InternalGenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+ virtual;
function InternalGenerateSelectTablesSQL: string; virtual;
function InternalGenerateUpdateConcurrentSQL(Map: TInstantAttributeMap):
string; virtual;
@@ -732,6 +756,8 @@
function GenerateSelectSQL(Map: TInstantAttributeMap): string;
function GenerateSelectExternalSQL(Map: TInstantAttributeMap): string;
function GenerateSelectExternalPartSQL(Map: TInstantAttributeMap): string;
+ function GenerateSelectMultipleQualifiedSQL(Maps: TInstantAttributeMaps; const
+ StatementInParameters: string = ''): string;
function GenerateSelectTablesSQL: string;
function GenerateUpdateConcurrentSQL(Map: TInstantAttributeMap): string;
function GenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
@@ -1088,6 +1114,20 @@
ConflictAction);
end;
+procedure TInstantCustomRelationalBroker.InternalRetrieveAllObjects(
+ AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveAllObjects', ClassName]);
+end;
+
+procedure TInstantCustomRelationalBroker.InternalRetrieveMixedObjects(
+ AObjRefList: TInstantObjectReferenceList);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveMixedObjects', ClassName]);
+end;
+
function TInstantCustomRelationalBroker.InternalRetrieveObject(
AObject: TInstantObject; const AObjectId: string;
ConflictAction: TInstantConflictAction): Boolean;
@@ -1096,6 +1136,13 @@
ConflictAction);
end;
+procedure TInstantCustomRelationalBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveObjects', ClassName]);
+end;
+
function TInstantCustomRelationalBroker.InternalStoreObject(
AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
begin
@@ -1266,6 +1313,27 @@
Result := ResolverList[Index] as TInstantNavigationalResolver;
end;
+procedure TInstantNavigationalBroker.InternalRetrieveAllObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveAllObjects', ClassName]);
+end;
+
+procedure TInstantNavigationalBroker.InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveMixedObjects', ClassName]);
+end;
+
+procedure TInstantNavigationalBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveObjects', ClassName]);
+end;
+
destructor TInstantSQLBroker.Destroy;
begin
FGenerator.Free;
@@ -1310,6 +1378,92 @@
raise EInstantError.CreateFmt(SMissingImplementation, ['AssignDataSetParams', ClassName]);
end;
+procedure TInstantSQLBroker.CreateObjectsFromDataset(AObjectsClass:
+ TInstantObjectClass; ADataSet: TDataSet; AObjectIdList: TStrings);
+
+ procedure UpdateListWithObject(AObject: TInstantObject;
+ const AObjectId: string);
+ var
+ Idx: Integer;
+ begin
+ Idx := AObjectIdList.IndexOf(AObjectId);
+ if Idx = -1 then
+ begin
+ Idx := AObjectIdList.Add(AObjectId);
+ AObjectIdList.Objects[Idx] := AObject;
+ end
+ else
+ AObjectIdList.Objects[Idx] := AObject;
+ end;
+
+ procedure ResolveAttributesFromDataset(AObject: TInstantObject;
+ const AObjectId: string);
+ var
+ I: Integer;
+ Map: TInstantAttributeMap;
+ begin
+ with AObject.Metadata do
+ begin
+ for I := 0 to Pred(StorageMaps.Count) do
+ begin
+ Map := StorageMaps[I];
+ if Map.IsRootMap then
+ SetObjectUpdateCount(AObject,
+ ADataSet.FieldByName(InstantUpdateCountFieldName).AsInteger);
+ TInstantSQLResolver(EnsureResolver(Map)).ReadAttributes(
+ AObject, AObjectId, Map, ADataset);
+ end;
+ end;
+ end;
+
+var
+ Obj: TInstantObject;
+ ObjStore: TInstantObjectStore;
+ DsId: string;
+ DsWasActive: Boolean;
+ Instance: TInstantObject;
+begin
+ if not Assigned(AObjectIdList) or not Assigned(ADataSet) then
+ Exit;
+
+ DsWasActive := ADataset.Active;
+ if not DsWasActive then
+ ADataset.Open;
+ try
+ ObjStore := Connector.EnsureObjectStore(AObjectsClass);
+ ADataset.First;
+ while not ADataset.Eof do
+ begin
+ DsId := ADataset.FindField(InstantIdFieldName).AsString;
+ Obj := AObjectsClass.Create(Connector);
+ Instance := ObjStore.Find(DsId);
+ if Assigned(Instance) then
+ begin
+ Obj.FreeInstance;
+ Obj := Instance;
+ Obj.AddRef;
+ end
+ else
+ begin
+ Obj.DisableChanges;
+ try
+ ResolveAttributesFromDataset(Obj, DsId);
+ finally
+ Obj.EnableChanges;
+ end;
+ ObjStore.EnsureObject(DsId, Obj);
+ end;
+
+ UpdateListWithObject(Obj, DsId);
+
+ ADataset.Next;
+ end;
+ finally
+ if not DsWasActive then
+ ADataset.Close;
+ end;
+end;
+
function TInstantSQLBroker.EnsureResolver(
AMap: TInstantAttributeMap): TInstantCustomResolver;
begin
@@ -1396,6 +1550,38 @@
end;
end;
+procedure TInstantSQLBroker.InternalRetrieveAllObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+var
+ Params: TParams;
+ Statement: string;
+ Resolver: TInstantSQLResolver;
+ ObjDataset: TDataset;
+ Maps: TInstantAttributeMaps;
+begin
+ if not AObjectsClass.Metadata.IsStored or not Assigned(AObjectIdList) then
+ Exit;
+
+ Maps := AObjectsClass.Metadata.StorageMaps;
+ Statement := Generator.GenerateSelectMultipleQualifiedSQL(Maps);
+ Resolver := TInstantSQLResolver(EnsureResolver(Maps.RootMap));
+
+ Params := TParams.Create;
+ try
+ Resolver.AddParam(Params, InstantClassFieldName, ftString).AsString :=
+ AObjectsClass.ClassName;
+
+ ObjDataset := AcquireDataSet(Statement, Params);
+ try
+ CreateObjectsFromDataset(AObjectsClass, ObjDataset, AObjectIdList);
+ finally
+ ReleaseDataSet(ObjDataset);
+ end;
+ finally
+ Params.Free;
+ end;
+end;
+
procedure TInstantSQLBroker.ReleaseDataSet(const ADataSet: TDataSet);
begin
if FStatementCacheCapacity <> 0 then
@@ -1404,6 +1590,123 @@
ADataSet.Free;
end;
+procedure TInstantSQLBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+var
+ I: Integer;
+ Params: TParams;
+ ObjDataset: TDataset;
+ Resolver: TInstantSQLResolver;
+ Statement, StatementInParameters: String;
+
+begin
+ if not AObjectsClass.Metadata.IsStored or (AObjectIdList.Count = 0) then
+ Exit;
+
+ StatementInParameters := '';
+ for I:=0 to Pred(AObjectIdList.Count) do
+ begin
+ StatementInParameters := StatementInParameters + ':' +
+ InstantIdFieldName + IntToStr(I);
+ if I < Pred(AObjectIdList.Count) then
+ StatementInParameters := StatementInParameters + ', ';
+ end;
+
+ Statement := Generator.GenerateSelectMultipleQualifiedSQL(
+ AObjectsClass.Metadata.StorageMaps, StatementInParameters);
+
+ Resolver := TInstantSQLResolver(
+ EnsureResolver(AObjectsClass.Metadata.StorageMaps.RootMap));
+
+ Params := TParams.Create;
+ try
+ Resolver.AddParam(Params, InstantClassFieldName, ftString).AsString :=
+ AObjectsClass.ClassName;
+ for I := 0 to Pred(AObjectIdList.Count) do
+ begin
+ Resolver.AddIdParam(Params, InstantIdFieldName + IntToStr(I),
+ AObjectIdList[I]);
+ end;
+
+ ObjDataset := AcquireDataSet(Statement, Params);
+ try
+ CreateObjectsFromDataset(AObjectsClass, ObjDataset, AObjectIdList);
+ finally
+ ReleaseDataSet(ObjDataset);
+ end;
+ finally
+ Params.Free;
+ end;
+end;
+
+procedure TInstantSQLBroker.InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+
+ function IsReferencedClassPersistent(AObjRef: TInstantObjectReference):
+ Boolean;
+ begin
+ Result := AObjRef.ObjectClass.Metadata.IsStored;
+ end;
+
+var
+ I: Integer;
+ ClassNameList: TStringList;
+ J: Integer;
+ Idx: Integer;
+ ObjIdList: TStringList;
+ K: Integer;
+ ObjClassName: string;
+ Ref: TInstantObjectReference;
+begin
+ if not Assigned(AObjRefList) or (AObjRefList.Count = 0) then
+ Exit;
+
+ ClassNameList := TStringList.Create;
+ try
+ for I := 0 to Pred(AObjRefList.Count) do
+ begin
+ Ref := AObjRefList.RefItems[I];
+ ObjClassName := Ref.ObjectClassName;
+ Idx := ClassNameList.IndexOf(ObjClassName);
+ if (Idx = -1) and IsReferencedClassPersistent(Ref) then
+ ClassNameList.Add(ObjClassName);
+ end;
+
+ for I := 0 to Pred(ClassNameList.Count) do
+ begin
+ ObjIdList := TStringList.Create;
+ try
+ for J := 0 to Pred(AObjRefList.Count) do
+ if AObjRefList.RefItems[J].ObjectClassName = ClassNameList[I] then
+ begin
+ Idx := ObjIdList.IndexOf(AObjRefList.RefItems[J].ObjectId);
+ if Idx = -1 then
+ ObjIdList.Add(AObjRefList.RefItems[J].ObjectId);
+ end;
+
+ RetrieveObjects(InstantFindClass(ClassNameList[I]), ObjIdList);
+
+ for J := 0 to Pred(ObjIdList.Count) do
+ for K := 0 to Pred(AObjRefList.Count) do
+ if AObjRefList.RefItems[K].Equals(
+ TInstantObject(ObjIdList.Objects[J])) then
+ begin
+ if not AObjRefList.RefItems[K].HasInstance then
+ AObjRefList[K] := TInstantObject(ObjIdList.Objects[J]);
+ if AObjRefList.RefItems[K].OwnsInstance then
+ ObjIdList.Objects[J].Free;
+ Break;
+ end;
+
+ finally
+ ObjIdList.Free;
+ end;
+ end;
+ finally
+ ClassNameList.Free;
+ end;
+end;
+
{ TInstantRelationalConnector }
procedure TInstantRelationalConnector.DoGetDataSet(const CommandText: string;
@@ -4178,6 +4481,29 @@
Result := BuildList(Map, Additional, EmbraceField);
end;
+function TInstantSQLGenerator.BuildTableQualifiedFieldList(const S, ATableName:
+ string): string;
+var
+ I: Integer;
+ List: TStringList;
+begin
+ List := TStringList.Create;
+ try
+ InstantStrToList(S, List, [' ', ',']);
+ Result := '';
+ for I := 0 to Pred(List.Count) do
+ begin
+ if Trim(List[I]) <> '' then
+ Result := Result + InstantEmbrace(ATableName, Broker.SQLDelimiters)
+ + '.' + List[I] + ' , ';
+ end;
+ if Length(Result) > 0 then
+ Delete(Result, Length(Result) - 2, 3);
+ finally
+ List.Free;
+ end;
+end;
+
function TInstantSQLGenerator.BuildList(Map: TInstantAttributeMap;
Additional: array of string; StringFunc: TInstantStringFunc;
const Delimiter: string): string;
@@ -4365,6 +4691,13 @@
Result := InternalGenerateSelectSQL(Map);
end;
+function TInstantSQLGenerator.GenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+begin
+ Result := InternalGenerateSelectMultipleQualifiedSQL(Maps,
+ StatementInParameters);
+end;
+
function TInstantSQLGenerator.GenerateSelectTablesSQL: string;
begin
Result := InternalGenerateSelectTablesSQL;
@@ -4587,6 +4920,65 @@
[FieldStr, EmbraceTable(Map.Name), WhereStr]);
end;
+function TInstantSQLGenerator.InternalGenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+var
+ FieldStr: string;
+ TableStr: String;
+ Map: TInstantAttributeMap;
+ WhereStr: string;
+ WhereStrA: string;
+ WhereStrB: string;
+ RootClassFldName: string;
+ RootIdFldName: string;
+ I: Integer;
+
+ function BuildTableQualifiedFieldStr(AMap: TInstantAttributeMap): string;
+ begin
+ if AMap.IsRootMap then
+ Result := BuildFieldList(AMap, [InstantClassFieldName,
+ InstantIdFieldName, InstantUpdateCountFieldName])
+ else
+ Result := BuildFieldList(AMap, []);
+ Result := BuildTableQualifiedFieldList(Result, AMap.Name);
+ end;
+
+begin
+ Map := Maps.RootMap;
+ RootClassFldName := EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantClassFieldName);
+ RootIdFldName := EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantIdFieldName);
+ WhereStrA := RootClassFldName + '=:' + InstantClassFieldName;
+ if StatementInParameters <> '' then
+ WhereStrB := RootIdFldName + ' IN (' + StatementInParameters + ')';
+ FieldStr := BuildTableQualifiedFieldStr(Map);
+ TableStr := EmbraceTable(Map.Name);
+
+ for I := 0 to Pred(Maps.Count) do
+ begin
+ Map := Maps[I];
+ if not Map.IsRootMap then
+ begin
+ FieldStr := FieldStr + ', ' + BuildTableQualifiedFieldStr(Map);
+ TableStr := TableStr + ', ' + EmbraceTable(Map.Name);
+ WhereStrA := WhereStrA + ' AND ' + EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantClassFieldName) + '=' + RootClassFldName;
+ if StatementInParameters <> '' then
+ WhereStrB := WhereStrB + ' AND ' + EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantIdFieldName) + '=' + RootIdFldName;
+ end;
+ end;
+
+ if StatementInParameters <> '' then
+ WhereStrB := ' AND ' + WhereStrB;
+
+ WhereStr := WhereStrA + WhereStrB;
+
+ Result := Format('SELECT %s FROM %s WHERE %s',
+ [FieldStr, TableStr, WhereStr]);
+end;
+
function TInstantSQLGenerator.InternalGenerateSelectTablesSQL: string;
begin
raise EInstantError.CreateFmt(SUnsupportedOperation,
@@ -5826,6 +6218,9 @@
if (MaxCount > 0) and (ObjectReferenceList.Count = MaxCount) then break;
DataSet.Next;
end;
+
+ if EnsureObjects and (ObjectReferenceList.Count > 0) then
+ Connector.Broker.RetrieveMixedObjects(ObjectReferenceList);
finally
DataSet.EnableControls;
end;
Modified: branches/EnsureObjectsDev/Source/Core/InstantCode.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantCode.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantCode.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -625,6 +625,8 @@
procedure SetStorageKind(const Value: TInstantStorageKind);
function GetCanHaveStorageName: boolean;
function GetCanBeExternal: boolean;
+ function GetEnsureContainerObjects: Boolean;
+ procedure SetEnsureContainerObjects(const Value: Boolean);
protected
function GetIsDefault: Boolean; virtual;
function GetMethodName(MethodType: TInstantCodeContainerMethodType): string;
@@ -677,6 +679,8 @@
property AttributeTypeName: string read GetAttributeTypeName
write SetAttributeTypeName;
property AttributeTypeText: string read GetAttributeTypeText;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property ExternalStorageName: string read GetExternalStorageName
write SetExternalStorageName;
property IncludeAddMethod: Boolean read GetIncludeAddMethod
@@ -759,11 +763,13 @@
function GetAttributeCount: Integer;
function GetAttributes(Index: Integer): TInstantCodeAttribute;
function GetClassStatement: string;
+ function GetEnsureContainerObjects: Boolean;
function GetIsStored: Boolean;
function GetMetadata: TInstantClassMetadata;
function GetOwner: TInstantCodeClass; reintroduce;
function GetPersistence: TInstantPersistence;
function GetStorageName: string;
+ procedure SetEnsureContainerObjects(const Value: Boolean);
procedure SetPersistence(Value: TInstantPersistence);
procedure SetStorageName(const Value: string);
protected
@@ -797,6 +803,8 @@
property Metadata: TInstantClassMetadata read GetMetadata;
property Owner: TInstantCodeClass read GetOwner;
published
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
end;
@@ -851,6 +859,7 @@
function GetBaseClassName: string;
function GetDivisionCount: Integer;
function GetDivisions(Index: Integer): TInstantCodeDivision;
+ function GetEnsureContainerObjects: Boolean;
function GetFieldCount: Integer;
function GetFields(Index: Integer): TInstantCodeField;
function GetImplementationComment: string;
@@ -875,6 +884,7 @@
procedure SetStorageName(const Value: string);
procedure SetUnitName(const Value: string);
procedure RemoveDivision(Division: TInstantCodeDivision);
+ procedure SetEnsureContainerObjects(const Value: Boolean);
protected
function AddDivision(Visibility: TInstantCodeVisibility): TInstantCodeDivision;
procedure InsertDivision(Division: TInstantCodeDivision);
@@ -949,6 +959,8 @@
property SubClasses[Index: Integer]: TInstantCodeClass read GetSubClass;
published
property BaseClassName: string read GetBaseClassName write SetBaseClassName;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
property UnitName: string read GetUnitName write SetUnitName;
@@ -1548,6 +1560,7 @@
MetaKeyEmbedded = 'embedded';
MetaKeyValid = 'valid';
MetaKeyWidth = 'width';
+ MetaKeyEnsureObjects = 'ensureobjects';
ModuleTypeNames: array[TInstantCodeModuleType] of string =
('program', 'unit', 'library');
@@ -1794,6 +1807,8 @@
Token := ReadToken;
if SameText(Token, MetaKeyStored) then
FMetadata.StorageName := ReadStringValue;
+ if SameText(Token, MetaKeyEnsureObjects) then
+ FMetadata.EnsureContainerObjects := True;
if SameText(Token, MetaKeyDefault) then
FMetadata.IsDefault := True;
if SameText(Token, MetaKeyExternal) then
@@ -3623,6 +3638,7 @@
Self.IsIndexed := IsIndexed;
Self.IsRequired := IsRequired;
Self.ReadOnly := ReadOnly;
+ Self.EnsureContainerObjects := EnsureContainerObjects;
Self.SingularName := SingularName;
Self.Visibility := Visibility;
Self.Metadata.Assign(Metadata);
@@ -4041,6 +4057,8 @@
Writer.Write(' ' + MetaKeyRequired);
if IsDefault then
Writer.Write(' ' + MetaKeyDefault);
+ if EnsureContainerObjects then
+ Writer.Write(' ' + MetaKeyEnsureObjects);
Writer.Write(';');
end;
@@ -4211,6 +4229,16 @@
Result := AttributeType in [atPart, atParts, atReferences];
end;
+function TInstantCodeAttribute.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
+procedure TInstantCodeAttribute.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ Metadata.EnsureContainerObjects := Value;
+end;
+
{ TInstantCodeClassLink }
function TInstantCodeClassLink.FindInstance: TInstantCodeObject;
@@ -4320,6 +4348,7 @@
begin
Self.Persistence := Persistence;
Self.StorageName := StorageName;
+ Self.EnsureContainerObjects := EnsureContainerObjects;
Self.AssignAttributes(FAttributes);
end;
end;
@@ -4404,18 +4433,35 @@
function TInstantCodeMetadataInfo.GetClassStatement: string;
begin
+ if (AttributeCount = 0) and (Persistence = peEmbedded) then
+ begin
+ Result := MetaKeyEmbedded + ';';
+ Exit
+ end;
+
+ Result := '';
if Persistence = peStored then
begin
Result := MetaKeyStored;
if Metadata.StorageName <> '' then
Result := Result + ' ''' + StorageName + '''';
+ end;
+
+ if EnsureContainerObjects then
+ if Result <> '' then
+ Result := Result + ' ' + MetaKeyEnsureObjects
+ else
+ Result := MetaKeyEnsureObjects;
+
+ if Result <> '' then
Result := Result + ';';
- end else if AttributeCount = 0 then
- Result := MetaKeyEmbedded + ';'
- else
- Result := '';
end;
+function TInstantCodeMetadataInfo.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
function TInstantCodeMetadataInfo.GetIsEmpty: Boolean;
begin
Result := False;
@@ -4532,6 +4578,11 @@
begin
Persistence := peStored;
StorageName := Reader.ReadStringValue;
+ Reader.ReadEndOfStatement(False);
+ end else if SameText(Token, MetaKeyEnsureObjects) then
+ begin
+ EnsureContainerObjects := True;
+ StorageName := Reader.ReadStringValue;
Reader.ReadEndOfStatement(True);
end else if Token = '}' then
Break
@@ -4600,6 +4651,12 @@
FAttributes.Remove(Attribute);
end;
+procedure TInstantCodeMetadataInfo.SetEnsureContainerObjects(const Value:
+ Boolean);
+begin
+ Metadata.EnsureContainerObjects := Value;
+end;
+
procedure TInstantCodeMetadataInfo.SetName(const Value: string);
begin
Metadata.Name := Value;
@@ -5065,6 +5122,11 @@
Result := FDivisions[Index];
end;
+function TInstantCodeClass.GetEnsureContainerObjects: Boolean;
+begin
+ Result := MetadataInfo.EnsureContainerObjects;
+end;
+
function TInstantCodeClass.GetFieldCount: Integer;
begin
Result := FFields.Count;
@@ -5336,6 +5398,11 @@
FBaseClassLink.Name := Value;
end;
+procedure TInstantCodeClass.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ MetadataInfo.EnsureContainerObjects := Value;
+end;
+
procedure TInstantCodeClass.SetName(const Value: string);
var
I: Integer;
Modified: branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -76,6 +76,7 @@
private
FAttributeMetadatas: TInstantAttributeMetadatas;
FDefaultContainerName: string;
+ FEnsureContainerObjects: Boolean;
FMemberMap: TInstantAttributeMap;
FParent: TInstantClassMetadata;
FParentName: string;
@@ -126,6 +127,8 @@
published
property DefaultContainerName: string read FDefaultContainerName
write FDefaultContainerName;
+ property EnsureContainerObjects: Boolean read FEnsureContainerObjects write
+ FEnsureContainerObjects;
property ParentName: string read GetParentName write SetParentName;
property Persistence: TInstantPersistence read FPersistence
write FPersistence;
@@ -436,6 +439,7 @@
FDefaultValue: string;
FDisplayWidth: Integer;
FEditMask: string;
+ FEnsureContainerObjects: Boolean;
FIsIndexed: Boolean;
FIsRequired: Boolean;
FObjectClassName: string;
@@ -500,6 +504,8 @@
property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth
default 0;
property EditMask: string read FEditMask write FEditMask;
+ property EnsureContainerObjects: Boolean read FEnsureContainerObjects write
+ FEnsureContainerObjects;
property ExternalStorageName: string read FExternalStorageName
write FExternalStorageName;
property StorageKind: TInstantStorageKind read FStorageKind
@@ -584,6 +590,7 @@
Self.FDefaultContainerName := FDefaultContainerName;
Self.FStorageName := FStorageName;
Self.FPersistence := FPersistence;
+ Self.FEnsureContainerObjects := FEnsureContainerObjects;
end;
end;
@@ -1648,6 +1655,7 @@
Self.FEditMask := FEditMask;
Self.FIsIndexed := FIsIndexed;
Self.FIsRequired := FIsRequired;
+ Self.FEnsureContainerObjects := FEnsureContainerObjects;
Self.FObjectClassName := FObjectClassName;
Self.FSize := FSize;
Self.FStorageName := FStorageName;
Modified: branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -156,6 +156,7 @@
private
FIsChanged: Boolean;
function GetIsIndexed: Boolean;
+ function GetEnsureContainerObjects: Boolean;
function GetIsRequired: Boolean;
function GetMetadata: TInstantAttributeMetadata;
function GetName: string;
@@ -212,6 +213,7 @@
property IsChanged: Boolean read GetIsChanged write SetIsChanged;
property IsDefault: Boolean read GetIsDefault;
property IsIndexed: Boolean read GetIsIndexed;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects;
property IsMandatory: Boolean read GetIsMandatory;
property IsRequired: Boolean read GetIsRequired;
property Name: string read GetName;
@@ -566,8 +568,10 @@
private
function GetItems(Index: Integer): TInstantObject;
function GetChangeCount: Integer;
+ function GetObjectReferences(Index: Integer): TInstantObjectReference;
procedure SetItems(Index: Integer; AValue: TInstantObject);
procedure QuickSort(L, R: Integer; Compare: TInstantSortCompare);
+ procedure SetObjectReferences(Index: Integer; AValue: TInstantObjectReference);
protected
procedure AfterContentChange(ChangeType: TInstantContentChangeType;
Index: Integer; AObject: TInstantObject);
@@ -577,27 +581,37 @@
function GetCount: Integer; virtual; abstract;
function GetInstances(Index: Integer): TInstantObject; virtual;
function GetIsDefault: Boolean; override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); virtual; abstract;
function InternalAdd(AObject: TInstantObject): Integer; virtual; abstract;
function InternalAddReference(const AObjectClassName, AObjectId: string):
Integer; virtual; abstract;
procedure InternalClear; virtual; abstract;
procedure InternalDelete(Index: Integer); virtual; abstract;
+ procedure InternalEnsureObjects; virtual;
function InternalGetItems(Index: Integer): TInstantObject; virtual; abstract;
function InternalIndexOf(AObject: TInstantObject): Integer; virtual; abstract;
function InternalIndexOfInstance(Instance: Pointer): Integer; virtual; abstract;
procedure InternalExchange(Index1, Index2: Integer); virtual; abstract;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ virtual; abstract;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); virtual; abstract;
procedure InternalMove(CurIndex, NewIndex: Integer); virtual; abstract;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); virtual; abstract;
procedure ValidateObject(AObject: TInstantObject); override;
property Instances[Index: Integer]: TInstantObject read GetInstances;
+ property ObjectReferences[Index: Integer]: TInstantObjectReference read
+ GetObjectReferences write SetObjectReferences;
public
+ constructor Create(AOwner: TInstantAbstractObject = nil; AMetadata:
+ TInstantCollectionItem = nil); override;
function Add(AObject: TInstantObject): Integer;
function AddReference(const AObjectClassName, AObjectId: string): Integer;
function AttachObject(AObject: TInstantObject): Boolean; override;
procedure Clear;
procedure Delete(Index: Integer);
function DetachObject(AObject: TInstantObject): Boolean; override;
+ procedure EnsureObjects;
procedure Exchange(Index1, Index2: Integer);
function HasItem(Index: Integer): Boolean;
function IndexOf(AObject: TInstantObject): Integer;
@@ -625,10 +639,7 @@
property ObjectList: TObjectList read GetObjectList;
function CreateObjectReference(AObject: TInstantObject): TInstantObjectReference;
function GetObjectReferenceList: TObjectList;
- function GetObjectReferences(Index: Integer): TInstantObjectReference;
- procedure SetObjectReferences(Index: Integer; Value: TInstantObjectReference);
property ObjectReferenceList: TObjectList read GetObjectReferenceList;
- property ObjectReferences[Index: Integer]: TInstantObjectReference read GetObjectReferences write SetObjectReferences;
protected
class function AttributeType: TInstantAttributeType; override;
function GetAllowOwned: Boolean; override;
@@ -640,13 +651,18 @@
Integer; override;
procedure InternalClear; override;
procedure InternalDelete(Index: Integer); override;
+ procedure InternalEnsureObjects; override;
function InternalGetItems(Index: Integer): TInstantObject; override;
function InternalIndexOf(AObject: TInstantObject): Integer; override;
function InternalIndexOfInstance(Instance: Pointer): Integer; override;
procedure InternalExchange(Index1, Index2: Integer); override;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ override;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); override;
procedure InternalMove(CurIndex, NewIndex: Integer); override;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); override;
procedure ReadObject(Reader: TInstantReader); override;
procedure SetAllowOwned(Value: Boolean); virtual;
procedure ValidateObject(AObject: TInstantObject); override;
@@ -682,9 +698,13 @@
function InternalIndexOf(AObject: TInstantObject): Integer; override;
function InternalIndexOfInstance(Instance: Pointer): Integer; override;
procedure InternalExchange(Index1, Index2: Integer); override;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ override;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); override;
procedure InternalMove(CurIndex, NewIndex: Integer); override;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); override;
procedure ReadObject(Reader: TInstantReader); override;
procedure SetAllowOwned(Value: Boolean); virtual;
procedure ValidateObject(AObject: TInstantObject); override;
@@ -788,6 +808,7 @@
procedure Init;
procedure Finit;
function GetConnector: TInstantConnector;
+ function GetEnsureContainerObjects: Boolean;
procedure PerformUpdate(Operation: TInstantUpdateOperation; OperationType: TInstantOperationType;
ConflictAction: TInstantConflictAction);
procedure ReadAttributes(Reader: TInstantReader);
@@ -829,6 +850,7 @@
procedure Destruct; virtual;
procedure DisposeOwnedObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction);
+ procedure EnsureContainerAttributeObjects; virtual;
procedure Finalize; virtual;
function GenerateId: string; virtual;
function GetCaption: string; virtual;
@@ -845,6 +867,7 @@
procedure RestoreState; virtual;
procedure SaveState; virtual;
procedure SetConnector(AConnector: TInstantConnector); virtual;
+ procedure SetEnsureContainerObjects(const Value: Boolean); virtual;
procedure SetId(const Value: string); virtual;
function VerifyOperation(OperationType: TInstantOperationType): TInstantVerificationResult; virtual;
procedure WriteObject(Writer: TInstantWriter); override;
@@ -903,6 +926,8 @@
property Caption: string read GetCaption;
property ClassId: string read GetClassId;
property Connector: TInstantConnector read GetConnector;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property HasDefaultContainer: Boolean read GetHasDefaultContainer;
property IsChanged: Boolean read GetIsChanged write SetIsChanged;
property IsDefault: Boolean read GetIsDefault;
@@ -1023,6 +1048,7 @@
procedure AbandonObjects;
procedure DisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction);
+ procedure EnsureObject(const AObjectId: string; AObject: TInstantObject);
function Find(const AObjectId: string): TInstantObject;
procedure ObjectDestroyed(AObject: TInstantObject);
procedure RefreshObject(AObject: TInstantObject);
@@ -1098,6 +1124,7 @@
private
FCommand: string;
FConnector: TInstantConnector;
+ FEnsureObjects: Boolean;
FMaxCount: Integer;
function GetConnector: TInstantConnector;
function GetObjectCount: Integer;
@@ -1140,6 +1167,7 @@
property Active: Boolean read GetActive write SetActive;
property Command: string read FCommand write SetCommand;
property Connector: TInstantConnector read GetConnector;
+ property EnsureObjects: Boolean read FEnsureObjects write FEnsureObjects;
property MaxCount: Integer read FMaxCount write FMaxCount;
property ObjectClass: TClass read GetObjectClass;
property ObjectClassName: string read GetObjectClassName;
@@ -1293,6 +1321,7 @@
property Items[Index: Integer]: TInstantObject read GetItems write SetItems;
default;
property RefItems[Index: Integer]: TInstantObjectReference read GetRefItems;
+ property RefOwnsInstance: Boolean read FRefOwnsInstance;
end;
TInstantBroker = class(TInstantStreamable)
@@ -1316,6 +1345,12 @@
function InternalRetrieveObject(AObject: TInstantObject;
const AObjectId: string; ConflictAction: TInstantConflictAction):
Boolean; virtual; abstract;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); virtual; abstract;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); virtual; abstract;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); virtual; abstract;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; virtual; abstract;
public
@@ -1349,6 +1384,11 @@
function IsCatalogSupported: Boolean;
function RetrieveObject(AObject: TInstantObject; const AObjectId: string;
ConflictAction: TInstantConflictAction): Boolean;
+ procedure RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList:
+ TStrings);
+ procedure RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
+ procedure RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList:
+ TStrings);
procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
function StoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean;
@@ -2352,6 +2392,11 @@
Result := Assigned(Metadata) and Metadata.IsIndexed;
end;
+function TInstantAttribute.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Assigned(Metadata) and Metadata.EnsureContainerObjects;
+end;
+
function TInstantAttribute.GetIsMandatory: Boolean;
begin
Result := IsRequired or IsIndexed;
@@ -4124,6 +4169,14 @@
ObjectReference.WriteAsObject(Writer);
end;
+constructor TInstantContainer.Create(AOwner: TInstantAbstractObject = nil;
+ AMetadata: TInstantCollectionItem = nil);
+begin
+ inherited Create(AOwner, AMetadata);
+ if EnsureContainerObjects then
+ EnsureObjects;
+end;
+
{ TInstantContainer }
function TInstantContainer.Add(AObject: TInstantObject): Integer;
@@ -4206,6 +4259,56 @@
Result := Remove(AObject) <> -1;
end;
+procedure TInstantContainer.EnsureObjects;
+begin
+ InternalEnsureObjects;
+end;
+
+procedure TInstantContainer.InternalEnsureObjects;
+var
+ I: Integer;
+ Ref: TInstantObjectReference;
+ ObjRefList: TInstantObjectReferenceList;
+ J: Integer;
+begin
+ if (Metadata.StorageKind <> skExternal) and
+ (Metadata.AttributeType = atParts) then
+ Exit;
+
+ ObjRefList := TInstantObjectReferenceList.Create(False);
+ try
+ for I := 0 to Pred(Count) do
+ begin
+ if not HasItem(I) then
+ begin
+ Ref := ObjRefList.Add;
+ Ref.ReferenceObject(ObjectReferences[I].ObjectClassName,
+ ObjectReferences[I].ObjectId);
+ end;
+ end;
+
+ if ObjRefList.Count > 0 then
+ begin
+ Connector.Broker.RetrieveMixedObjects(ObjRefList);
+
+ for I := 0 to Pred(ObjRefList.Count) do
+ begin
+ for J := 0 to Pred(Count) do
+ begin
+ if ObjectReferences[J].Equals(ObjRefList[I]) then
+ begin
+ if not ObjectReferences[J].HasInstance then
+ Items[J] := ObjRefList[I];
+ Break;
+ end;
+ end;
+ end;
+ end;
+ finally
+ ObjRefList.Free;
+ end;
+end;
+
procedure TInstantContainer.Exchange(Index1, Index2: Integer);
begin
CheckRange(Index1);
@@ -4245,6 +4348,13 @@
Result := InternalGetItems(Index);
end;
+function TInstantContainer.GetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ CheckRange(Index);
+ Result := InternalGetObjectReferences(Index);
+end;
+
function TInstantContainer.HasItem(Index: Integer): Boolean;
begin
Result := Assigned(Instances[Index]);
@@ -4417,6 +4527,12 @@
end;
end;
+procedure TInstantContainer.SetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference);
+begin
+ InternalSetObjectReferences(Index, AValue);
+end;
+
procedure TInstantContainer.Sort(Compare: TInstantSortCompare);
begin
if Count > 1 then
@@ -4504,6 +4620,12 @@
Result := False;
end;
+procedure TInstantParts.InternalEnsureObjects;
+begin
+ if Metadata.StorageKind = skExternal then
+ inherited;
+end;
+
function TInstantParts.GetAllowOwned: Boolean;
begin
Result := FAllowOwned;
@@ -4553,12 +4675,6 @@
Result := FObjectReferenceList;
end;
-function TInstantParts.GetObjectReferences(
- Index: Integer): TInstantObjectReference;
-begin
- Result := TInstantObjectReference(ObjectReferenceList[Index]);
-end;
-
function TInstantParts.InternalAdd(AObject: TInstantObject): Integer;
var
Ref: TInstantObjectReference;
@@ -4664,6 +4780,15 @@
end;
end;
+function TInstantParts.InternalGetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ if Metadata.StorageKind = skEmbedded then
+ Result := nil
+ else
+ Result := TInstantObjectReference(ObjectReferenceList[Index]);
+end;
+
function TInstantParts.InternalIndexOf(AObject: TInstantObject): Integer;
var
Ref: TInstantObjectReference;
@@ -4744,6 +4869,15 @@
ObjectReferences[Index].Instance := AValue;
end;
+procedure TInstantParts.InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference);
+begin
+ if (Metadata.StorageKind = skExternal)
+ and not TInstantObjectReference(ObjectReferenceList[Index]).Equals(
+ AValue.ObjectClassName, AValue.ObjectId) then
+ TInstantObjectReference(ObjectReferenceList[Index]).Assign(AValue);
+end;
+
procedure TInstantParts.ReadObject(Reader: TInstantReader);
var
Obj: TPersistent;
@@ -4769,12 +4903,6 @@
FAllowOwned := Value;
end;
-procedure TInstantParts.SetObjectReferences(Index: Integer;
- Value: TInstantObjectReference);
-begin
- ObjectReferenceList[Index] := Value;
-end;
-
procedure TInstantParts.SetOwnerContext(AObject: TInstantObject);
begin
if Assigned(AObject) then
@@ -4883,7 +5011,7 @@
function TInstantReferences.GetInstances(Index: Integer): TInstantObject;
begin
- Result := ObjectReferenceList[Index];
+ Result := RefItems[Index].Instance;
end;
function TInstantReferences.GetObjectReferenceList: TInstantObjectReferenceList;
@@ -4943,6 +5071,12 @@
Result := ObjectReferenceList[Index];
end;
+function TInstantReferences.InternalGetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ Result := RefItems[Index];
+end;
+
function TInstantReferences.InternalIndexOf(
AObject: TInstantObject): Integer;
begin
@@ -4972,6 +5106,13 @@
ObjectReferenceList[Index] := AValue;
end;
+procedure TInstantReferences.InternalSetObjectReferences(Index: Integer;
+ AValue: TInstantObjectReference);
+begin
+ if not RefItems[Index].Equals(AValue.ObjectClassName, AValue.ObjectId) then
+ RefItems[Index].Assign(AValue);
+end;
+
procedure TInstantReferences.LoadObjectsFromStream(AStream: TStream);
var
I: Integer;
@@ -6226,6 +6367,8 @@
AfterCreateAttributes;
DisableChanges;
try
+ if EnsureContainerObjects then
+ EnsureContainerAttributeObjects;
try
Initialize;
except
@@ -6552,6 +6695,30 @@
end;
end;
end;
+
+procedure TInstantObject.EnsureContainerAttributeObjects;
+var
+ I: Integer;
+ AttrMetadata: TInstantAttributeMetadata;
+ Attr: TInstantContainer;
+ J: Integer;
+begin
+ CodeSite.EnterMethod(Self, 'TInstantObject.EnsureContainerAttributeObjects');
+ for I := 0 to Pred(Metadata.MemberMap.Count) do
+ begin
+ AttrMetadata := Metadata.MemberMap[I];
+ if (AttrMetadata.AttributeType in [atParts, atReferences]) and
+ (not AttrMetadata.EnsureContainerObjects) then
+ begin
+ Attr := TInstantContainer(AttributeByName(AttrMetadata.Name));
+ Attr.EnsureObjects;
+ for J := 0 to Pred(TInstantContainer(Attr).Count) do
+ Attr[J].EnsureContainerAttributeObjects;
+ end;
+ end;
+ CodeSite.ExitMethod(Self, 'TInstantObject.EnsureContainerAttributeObjects');
+end;
+
{$O+}
function TInstantObject.GetConnector: TInstantConnector;
@@ -6559,6 +6726,11 @@
Result := inherited GetConnector as TInstantConnector;
end;
+function TInstantObject.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
procedure TInstantObject.SaveState;
begin
if State.PersistentId = '' then
@@ -6584,6 +6756,16 @@
FObjectStore := nil;
end;
+procedure TInstantObject.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ if EnsureContainerObjects <> Value then
+ begin
+ Metadata.EnsureContainerObjects := Value;
+ if EnsureContainerObjects then
+ EnsureContainerAttributeObjects;
+ end;
+end;
+
procedure TInstantObject.SetId(const Value: string);
begin
if Value <> FId then
@@ -7225,6 +7407,13 @@
end;
end;
+procedure TInstantObjectStore.EnsureObject(const AObjectId: string; AObject:
+ TInstantObject);
+begin
+ AObject.SetPersistentId(AObjectId);
+ AddToCache(AObject);
+end;
+
function TInstantObjectStore.Find(const AObjectId: string): TInstantObject;
begin
Result := FCache.Find(AObjectId);
@@ -8335,6 +8524,24 @@
Result := InternalRetrieveObject(AObject, AObjectId, ConflictAction);
end;
+procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings);
+begin
+ InternalRetrieveObjects(AObjectsClass, AObjectIdList);
+end;
+
+procedure TInstantBroker.RetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+begin
+ InternalRetrieveMixedObjects(AObjRefList);
+end;
+
+procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings);
+begin
+ InternalRetrieveAllObjects(AObjectsClass, AObjectIdList);
+end;
+
procedure TInstantBroker.SetObjectUpdateCount(AObject: TInstantObject;
Value: Integer);
begin
Modified: branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -307,6 +307,7 @@
FSorted: Boolean;
FAfterPostField: TInstantFieldEvent;
FBeforePostField: TInstantFieldEvent;
+ FEnsureObjects: Boolean;
FOnCompare: TInstantCompareObjectsEvent;
FOnCreateObject: TInstantCreateObjectEvent;
FOnFieldError: TInstantFieldErrorEvent;
@@ -474,6 +475,8 @@
property ContentBuffer: TInstantContentBuffer read GetContentBuffer;
property CurrentBuffer: PChar read GetCurrentBuffer;
property DesignClass: TInstantCodeClass read GetDesignClass;
+ property EnsureObjects: Boolean read FEnsureObjects write FEnsureObjects
+ default False;
property HasCurrentBuffer: Boolean read GetHasCurrentBuffer;
property InContent: Boolean read GetInContent;
property Mode: TInstantAccessMode read GetMode write SetMode default amObject;
@@ -698,6 +701,7 @@
property AfterOpen;
property BeforeClose;
property BeforeOpen;
+ property EnsureObjects default False;
end;
TInstantBlobStream = class(TStream)
@@ -4671,6 +4675,7 @@
DestroyQuery;
end;
Query.Params := Params;
+ Query.EnsureObjects := EnsureObjects;
Query.Open;
inherited;
end;
Modified: branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm
===================================================================
--- branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm 2006-11-27 08:09:29 UTC (rev 720)
@@ -303,6 +303,22 @@
TabOrder = 1
end
end
+ object OtherOptionsGroupBox: TGroupBox
+ Left = 8
+ Top = 183
+ Width = 209
+ Height = 63
+ Caption = 'Other Options'
+ TabOrder = 4
+ object OtherOptionEnsureContainerObjectsCheckBox: TCheckBox
+ Left = 8
+ Top = 15
+ Width = 190
+ Height = 17
+ Caption = 'E&nsure Container Objects'
+ TabOrder = 0
+ end
+ end
end
object PresentationSheet: TTabSheet
Caption = 'Presentation'
Modified: branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -101,6 +101,8 @@
StorageKindEdit: TDBComboBox;
StorageKindLabel: TLabel;
AutoExternalStorageNameCheckBox: TCheckBox;
+ OtherOptionsGroupBox: TGroupBox;
+ OtherOptionEnsureContainerObjectsCheckBox: TCheckBox;
procedure NameEditKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure NameEditChange(Sender: TObject);
@@ -224,6 +226,8 @@
OptionRequired...
[truncated message content] |
