Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects:[918] trunk
|
From: <na...@us...> - 2010-09-16 10:28:44
|
Revision: 918
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=918&view=rev
Author: nandod
Date: 2010-09-16 10:28:36 +0000 (Thu, 16 Sep 2010)
Log Message:
-----------
+ Burst Load Mode. Includes support in PrimerExternal's Query form.
* svn:ignore set.
Modified Paths:
--------------
trunk/Demos/PrimerCross/QueryView.dfm
trunk/Demos/PrimerCross/QueryView.pas
trunk/Demos/PrimerCross/RandomData.pas
trunk/Source/Brokers/XML/InstantXML.pas
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantCommand.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantTypes.pas
Added Paths:
-----------
trunk/Docs/Burst_Load_Modes.txt
Property Changed:
----------------
trunk/Source/Brokers/ADO/DXE/
trunk/Source/Brokers/BDE/DXE/
trunk/Source/Brokers/DBX/DXE/
trunk/Source/Brokers/IBX/DXE/
trunk/Source/Brokers/XML/DXE/
trunk/Source/Catalogs/IBFb/DXE/
trunk/Source/Catalogs/MSSql/DXE/
trunk/Source/Catalogs/MySQL/DXE/
trunk/Source/Core/DXE/
trunk/Source/Design/DXE/
Modified: trunk/Demos/PrimerCross/QueryView.dfm
===================================================================
--- trunk/Demos/PrimerCross/QueryView.dfm 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Demos/PrimerCross/QueryView.dfm 2010-09-16 10:28:36 UTC (rev 918)
@@ -19,16 +19,16 @@
BorderWidth = 30
TabOrder = 0
object CommandLabel: TLabel
- Left = 32
- Top = 16
+ Left = 30
+ Top = 14
Width = 47
Height = 13
Caption = '&Command'
FocusControl = CommandEdit
end
object ExampleLabel: TLabel
- Left = 125
- Top = 124
+ Left = 315
+ Top = 125
Width = 40
Height = 13
Caption = 'E&xample'
@@ -44,6 +44,14 @@
Caption = '&Max Count:'
FocusControl = MaxCountEdit
end
+ object Label1: TLabel
+ Left = 168
+ Top = 124
+ Width = 26
+ Height = 13
+ Caption = 'Mode'
+ FocusControl = LoadModeComboBox
+ end
object CommandEdit: TMemo
Left = 30
Top = 30
@@ -61,20 +69,19 @@
object ExecuteButton: TButton
Left = 30
Top = 119
- Width = 75
+ Width = 59
Height = 25
Action = ExecuteAction
- TabOrder = 2
+ TabOrder = 1
end
object ExampleComboBox: TComboBox
- Left = 168
+ Left = 361
Top = 121
- Width = 461
+ Width = 268
Height = 21
Style = csDropDownList
DropDownCount = 12
- ItemHeight = 13
- TabOrder = 1
+ TabOrder = 4
OnClick = ExampleComboBoxClick
end
object MaxCountEdit: TMaskEdit
@@ -84,9 +91,31 @@
Height = 21
EditMask = '#########;1; '
MaxLength = 9
- TabOrder = 3
+ TabOrder = 5
Text = '0 '
end
+ object LoadModeComboBox: TComboBox
+ Left = 202
+ Top = 121
+ Width = 101
+ Height = 21
+ Style = csDropDownList
+ ItemIndex = 0
+ TabOrder = 3
+ Text = 'Keys First'
+ Items.Strings = (
+ 'Keys First'
+ 'Full Burst')
+ end
+ object FetchAllCheckBox: TCheckBox
+ Left = 95
+ Top = 124
+ Width = 58
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'Fetch All'
+ TabOrder = 2
+ end
end
object ResultPageControl: TPageControl
Left = 0
@@ -131,6 +160,24 @@
TabOrder = 0
end
end
+ object StatsTabSheet: TTabSheet
+ Caption = 'Stats'
+ ImageIndex = 2
+ object StatsMemo: TMemo
+ Left = 0
+ Top = 0
+ Width = 764
+ Height = 139
+ Align = alClient
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Courier New'
+ Font.Style = []
+ ParentFont = False
+ TabOrder = 0
+ end
+ end
end
object TestSelector: TInstantSelector
AfterScroll = TestSelectorAfterScroll
Modified: trunk/Demos/PrimerCross/QueryView.pas
===================================================================
--- trunk/Demos/PrimerCross/QueryView.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Demos/PrimerCross/QueryView.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -40,6 +40,11 @@
ResultTabSheet: TTabSheet;
TranslatedQueryTabSheet: TTabSheet;
TranslatedQueryMemo: TMemo;
+ Label1: TLabel;
+ LoadModeComboBox: TComboBox;
+ StatsTabSheet: TTabSheet;
+ StatsMemo: TMemo;
+ FetchAllCheckBox: TCheckBox;
procedure ExecuteActionExecute(Sender: TObject);
procedure ExampleComboBoxClick(Sender: TObject);
procedure TestSelectorAfterScroll(DataSet: TDataSet);
@@ -63,7 +68,7 @@
{$R *.dfm}
uses
- InstantPersistence, InstantBrokers, InstantConsts;
+ InstantPersistence, InstantBrokers, InstantConsts, InstantTypes;
const
Examples: array[0..11, 0..1] of string = (
@@ -113,16 +118,31 @@
end;
procedure TQueryViewForm.ExecuteActionExecute(Sender: TObject);
+var
+ LStartTime: Cardinal;
begin
-{$IFDEF IO_STATEMENT_LOGGING}
- TranslatedQueryMemo.Clear;
-{$ENDIF}
- with TestSelector do
- begin
- Close;
- TestSelector.MaxCount := StrToInt(Trim(MaxCountEdit.text));
- Command.Text := CommandEdit.Text;
- Open;
+ LStartTime := GetTickCount;
+ try
+ TestSelector.RequestedLoadMode := TInstantLoadMode(LoadModeComboBox.ItemIndex);
+ {$IFDEF IO_STATEMENT_LOGGING}
+ TranslatedQueryMemo.Clear;
+ {$ENDIF}
+ with TestSelector do
+ begin
+ Close;
+ TestSelector.MaxCount := StrToInt(Trim(MaxCountEdit.Text));
+ Command.Text := CommandEdit.Text;
+ Open;
+ if FetchAllCheckBox.Checked then
+ while not Eof do
+ Next;
+ ResultPageControl.ActivePage := ResultTabSheet;
+ end;
+ finally
+ StatsMemo.Clear;
+ StatsMemo.Lines.Add('Requested load mode: ' + LoadModeComboBox.Items[Ord(TestSelector.RequestedLoadMode)]);
+ StatsMemo.Lines.Add('Actual load mode: ' + LoadModeComboBox.Items[Ord(TestSelector.ActualLoadMode)]);
+ StatsMemo.Lines.Add(Format('Elapsed time: %ns', [(GetTickCount - LStartTime) / 1000.00]));
end;
end;
Modified: trunk/Demos/PrimerCross/RandomData.pas
===================================================================
--- trunk/Demos/PrimerCross/RandomData.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Demos/PrimerCross/RandomData.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -158,6 +158,7 @@
2: Result := TripletName;
end;
Result[1] := UpCase(Result[1]);
+ Result := Result + ' ' + '\x80 \xE0\xF2\xE8 aa'
end;
function RandomCompanyName: string;
@@ -231,7 +232,7 @@
RandomStr(StreetBeginnings) +
RandomStr(StreetEndings) + ' ' +
RandomStr(StreetTypes) + ' ' +
- IntToStr((Random(499) + 1) div (Random(9) + 1) + 1);
+ IntToStr((Random(499) + 1) div (Random(9) + 1) + 1) + ' ' + '\x80 \xE0\xF2\xE8 aa';
end;
function RandomCity: string;
Added: trunk/Docs/Burst_Load_Modes.txt
===================================================================
--- trunk/Docs/Burst_Load_Modes.txt (rev 0)
+++ trunk/Docs/Burst_Load_Modes.txt 2010-09-16 10:28:36 UTC (rev 918)
@@ -0,0 +1,73 @@
+Burst Load Mode
+Nando Dessena, 14/09/2010
+
+What is it
+----------
+
+Burst Load Mode is an alternative way of retrieving objects in InstantObjects' SQL brokers. This new mode can be selected on a case by case basis by setting the new RequestedLoadMode property of an InstantSelector or InstantQuery to the value lmFullBurst.
+
+What does it do
+---------------
+
+When IO retrieves a set of objects through a SQL broker, the order of operations is as follows:
+1) Execute a select statement (we'll call it the primary query) that retrieves the primary keys of all objects selected by the IQL command.
+2) Fetch all records (up to MaxCount).
+3) For each record accessed, materialize the object. This implies executing one or more select statements to get all object data (main object query), containers and references (accessory queries). External storage implies more queries. The main query joins all the tables for the given class and ancestors.
+
+Burst Load Mode causes these changes:
+1) The primary query retrieves all object data, and not just the primary keys.
+2) All objects are materialized (up to MaxCount) from the obtained data set; this causes the execution of all accessory and external queries that in the standard case are executed at point 3, minus the main query, which is not needed anymore.
+
+This means that Burst Load Mode is much quicker when retrieving a dataset, whereas standard mode is best at getting the first records.
+
+When it is used
+---------------
+
+Burst Load Mode is well suited for all cases in which objects are selected (typically through an IQL command with a WHERE clause) to be processed. If the entire dataset is going to be fetched and all records visited anyway, then it's much quicker to do it in Burst Load Mode.
+
+The standard way is more of the "lazy load" kind, and as such it is more suited for when a list of objects is displayed for browsing, typically in a DBGrid, and not all objects are needed but just one or a few are selected to work with. In this case displaying the first records in the grid is much quicker in standard mode.
+
+Performance notes
+-----------------
+
+Here are some quick benchmarks done with the example queries of PrimerExternal. Operations timed include Open and Last (to ensure full fetching) on a selector. Datasets are small (a couple dozen records). The database is a local Firebird server and the compiler is Delphi 2010. All caches were flushed at each iteration. Three iterations for each test. Times in seconds.
+
+SELECT * FROM TCompany
+
+Burst Standard
+2.1 3.5
+2.0 3.7
+2.4 3.7
+
+SELECT * FROM TPerson
+
+Burst Standard
+4.8 6.7
+4.6 7.0
+4.7 6.8
+
+A further test that fetches and materializes many more objects (in the thousands) shows where the gains are in Burst Load Mode. In this test all records are visited and materialized upon opening the selector (Open; while not Eof do Next;):
+
+SELECT * FROM TCompany
+
+Burst Standard
+54.7 104.0
+
+Without the fetches, that is just opening the selector and letting some 20 materialized objects populate the DBGrid, the results are:
+
+SELECT * FROM TCompany
+
+Burst Standard
+35.0 1.2
+
+This tells us that using burst mode when not appropriate can hurt performance, which suggests to keep it disabled by default and only enable it on request (property BurstLoad: Boolean default False).
+
+Caveats and future improvements
+-------------------------------
+
+- Currently Burst Load Mode is not supported for IQL commands using the ANY keywords. Doing so will require some significant refactorings and was postponed.
+
+- External atPart and all atReference attributes still need separate queries. It is difficult but not impossible to get them in the first query as well, thus reducing fetch time even more.
+
+- A mixture of standard and Burst Load Mode looks interesting, and the work done on Burst Load Mode makes it easier to implement it. This mixture would be a standard mode in which one or more specified attributes are fetched as well as the primary keys in the main query. This would allow to display a list of objects in a DBGrid, or other multi-record control, without materializing them, as quickly as whendoing direct SQL queries. Thought should be given to design details such as when where and how to specify the attributes that should be loaded together with the primary key. The value lmPartialBurst is reserved for this.
+
\ No newline at end of file
Property changes on: trunk/Docs/Burst_Load_Modes.txt
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Property changes on: trunk/Source/Brokers/ADO/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/BDE/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/DBX/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/IBX/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/XML/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Modified: trunk/Source/Brokers/XML/InstantXML.pas
===================================================================
--- trunk/Source/Brokers/XML/InstantXML.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Brokers/XML/InstantXML.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -43,7 +43,7 @@
uses
Classes, DB, Contnrs, InstantPersistence, InstantBrokers, InstantCommand,
- InstantMetadata, InstantTypes;
+ InstantMetadata, InstantTypes, InstantClasses;
const
XML_UTF8_HEADER = '<?xml version="1.0" encoding="UTF-8"?>';
@@ -193,10 +193,10 @@
TInstantAttributeMap;
ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
override;
- procedure InternalRetrieveMap(AObject: TInstantObject; const AObjectId:
- string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction; Info:
- PInstantOperationInfo); override;
+ procedure InternalRetrieveMap(AObject: TInstantObject;
+ const AObjectId: string; Map: TInstantAttributeMap;
+ ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData); override;
procedure InternalStoreMap(AObject: TInstantObject; Map:
TInstantAttributeMap;
ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
@@ -325,7 +325,7 @@
implementation
uses
- SysUtils, InstantConsts, InstantClasses,
+ SysUtils, InstantConsts,
TypInfo, InstantXMLCatalog, InstantXMLConnectionDefEdit, InstantUtils,
{$IFDEF MSWINDOWS}
{$IFNDEF D6+}
@@ -529,11 +529,13 @@
procedure TInstantXMLResolver.InternalRetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
+ ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData);
var
AInfo: TInstantOperationInfo;
LObjectUpdateCount: Integer;
begin
+ // This resolver does not support retrieving from any kind of object data.
if not Assigned(Info) then
begin
Info := @AInfo;
Property changes on: trunk/Source/Catalogs/IBFb/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Catalogs/MSSql/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Catalogs/MySQL/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Core/DXE
___________________________________________________________________
Added: svn:ignore
+ *.dcu
*.local
*.identcache
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantBrokers.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -90,11 +90,11 @@
TInstantNavigationalResolverOperation = procedure(AObject: TInstantObject;
AttributeMetadata: TInstantAttributeMetadata) of object;
-
TInstantCustomRelationalBroker = class(TInstantBroker)
private
FStatementCache: TInstantStatementCache;
FStatementCacheCapacity: Integer;
+ FObjectData: TInstantAbstractObjectData;
procedure DisposeMap(AObject: TInstantObject; const AObjectId: string;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo);
@@ -113,7 +113,7 @@
protected
property StatementCache: TInstantStatementCache read GetStatementCache;
function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver;
- virtual; abstract;
+ virtual; abstract;
function GetDBMSName: string; virtual;
function GetSQLDelimiters: string; virtual;
function GetSQLQuote: Char; virtual;
@@ -121,8 +121,8 @@
function InternalDisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
function InternalRetrieveObject(AObject: TInstantObject;
- const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
- override;
+ const AObjectId: string; ConflictAction: TInstantConflictAction;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean; override;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
public
@@ -262,8 +262,8 @@
Info: PInstantOperationInfo); virtual;
procedure InternalRetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- virtual;
+ ConflictAction: TInstantConflictAction; AInfo: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil); virtual;
procedure InternalStoreMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo); virtual;
@@ -280,7 +280,8 @@
TInstantConflictAction);
procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
+ Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil);
procedure StoreMap(AObject: TInstantObject; Map: TInstantAttributeMap;
ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
procedure StoreObject(AObject: TInstantObject; Conflict:
@@ -350,8 +351,8 @@
Info: PInstantOperationInfo); override;
procedure InternalRetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
+ ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil); override;
procedure InternalStoreMap(AObject: TInstantObject;
Map: TInstantAttributeMap;
ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
@@ -374,8 +375,8 @@
procedure ReadReference(Attribute: TInstantReference); virtual;
procedure ReadReferences(Attribute: TInstantReferences); virtual;
procedure ReadString(Attribute: TInstantString); virtual;
- procedure ResetAttributes(AObject: TInstantObject;
- Map: TInstantAttributeMap);
+ procedure ResetAttributes(const AObject: TInstantObject;
+ const AMap: TInstantAttributeMap);
procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
function TranslateError(AObject: TInstantObject; E: Exception): Exception;
virtual;
@@ -406,7 +407,7 @@
property TableName: string read FTableName;
end;
- //Backwards compatibility
+ // Backward compatibility
TInstantResolver = TInstantNavigationalResolver;
TInstantSQLResolver = class(TInstantCustomResolver)
@@ -444,6 +445,12 @@
function GetSelectExternalPartSQL: string;
function GetDeleteExternalSQL: string;
function GetInsertExternalSQL: string;
+ procedure ResetAttributes(const AObject: TInstantObject;
+ const AMap: TInstantAttributeMap);
+ procedure RetrieveMapFromDataSet(const AObject: TInstantObject;
+ const AObjectId: string; const AMap: TInstantAttributeMap;
+ ConflictAction: TInstantConflictAction; AInfo: PInstantOperationInfo;
+ const ADataSet: TDataSet);
protected
procedure AddAttributeParam(Attribute: TInstantAttribute;
Params: TParams); virtual;
@@ -458,10 +465,10 @@
procedure InternalDisposeMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo); override;
- procedure InternalRetrieveMap(AObject: TInstantObject;
+ procedure InternalRetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- override;
+ ConflictAction: TInstantConflictAction; AInfo: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil); override;
procedure InternalStoreMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo); override;
@@ -768,7 +775,6 @@
procedure TranslateCommand; override;
class function TranslatorClass: TInstantRelationalTranslatorClass; virtual;
public
- function CreateTranslator: TInstantRelationalTranslator;
property Statement: string read GetStatement write SetStatement;
property Connector: TInstantRelationalConnector read GetConnector;
end;
@@ -802,6 +808,8 @@
FTablePathList: TStringList;
FParentContext: TInstantTranslationContext;
FIdDataType: TInstantDataType;
+ FRequestedLoadMode: TInstantLoadMode;
+ FActualLoadMode: TInstantLoadMode;
procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
function GetClassTablePath: string;
function GetChildContext(const AIndex: Integer): TInstantTranslationContext;
@@ -835,16 +843,14 @@
procedure Initialize;
procedure MakeJoins(Path: TInstantIQLPath);
procedure MakeTablePaths(Path: TInstantIQLPath);
- function QuoteString(const Str: string): string;
-
property CriteriaList: TStringList read GetCriteriaList;
property TablePathList: TStringList read GetTablePathList;
public
constructor Create(const AStatement: TInstantIQLObject; const AQuote: Char;
const ADelimiters: string; const AIdDataType: TInstantDataType;
+ const ARequestedLoadMode: TInstantLoadMode;
const AParentContext: TInstantTranslationContext = nil);
destructor Destroy; override;
-
procedure AfterConstruction; override;
procedure Clear;
function AddChildContext(const AContext: TInstantTranslationContext): Integer;
@@ -880,9 +886,19 @@
property TablePathAliases[Index: Integer]: string read GetTablePathAliases;
property TablePathCount: Integer read GetTablePathCount;
property TablePaths[Index: Integer]: string read GetTablePaths;
+ function QuoteString(const Str: string): string;
+ // Use this property to ask for a particular load mode, such as a burst mode
+ // in which objects are retrieved in batches saving roundtrips to the
+ // database. Load modes require specific command translation, that's why
+ // this class is involved. This property is set at creation time. The
+ // requested mode might not be supported: read ActualLoadMode to know which
+ // load mode will actually be used for the statement.
+ property RequestedBurstLoadMode: TInstantLoadMode read FRequestedLoadMode;
+ // Equals the value of RequestedLoadMode if the mode is supported for the
+ // particular IQL query. Otherwise it will contain the fallback mode.
+ property ActualLoadMode: TInstantLoadMode read FActualLoadMode;
end;
-
TInstantRelationalTranslator = class(TInstantQueryTranslator)
private
FContext: TInstantTranslationContext;
@@ -931,7 +947,6 @@
public
property Context: TInstantTranslationContext read FContext;
destructor Destroy; override;
- function QuoteString(const Str: string): string;
property Query: TInstantCustomRelationalQuery read GetQuery;
end;
@@ -975,7 +990,7 @@
property RowNumber: Integer read GetRowNumber write SetRowNumber;
end;
- //Backwards compatibility
+ // Backward compatibility
TInstantRelationalQuery = TInstantNavigationalQuery;
TInstantSQLQuery = class(TInstantCustomRelationalQuery)
@@ -987,7 +1002,7 @@
function GetObjectReferenceCount: Integer;
function GetObjectReferenceList: TInstantObjectReferenceList;
function GetParamsObject: TParams;
- procedure InitObjectReferences(DataSet: TDataSet);
+ procedure InitObjectReferences(const ADataSet: TDataSet);
protected
function GetActive: Boolean; override;
function AcquireDataSet(const AStatement: string; AParams: TParams):
@@ -1034,6 +1049,16 @@
default True;
end;
+ // Holds object data in the current record of a dataset specified upon
+ // creation. Used in burst load mode.
+ TInstantDataSetObjectData = class(TInstantAbstractObjectData)
+ private
+ FDataSet: TDataSet;
+ public
+ constructor CreateAndInit(const ADataSet: TDataSet);
+ property DataSet: TDataSet read FDataSet;
+ end;
+
var
InstantLogProc: procedure (const AString: string) of object;
@@ -1208,10 +1233,19 @@
function TInstantCustomRelationalBroker.InternalRetrieveObject(
AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
+ ConflictAction: TInstantConflictAction;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean;
begin
- Result := PerformOperation(AObject, AObjectId, otRetrieve, RetrieveMap,
- ConflictAction);
+ // RetrieveMap will use this as an implicit argument.
+ // Making it explicit is too cumbersome since no other TInstantBrokerOperation
+ // needs it.
+ FObjectData := AObjectData;
+ try
+ Result := PerformOperation(AObject, AObjectId, otRetrieve, RetrieveMap,
+ ConflictAction);
+ finally
+ FObjectData := nil;
+ end;
end;
function TInstantCustomRelationalBroker.InternalStoreObject(
@@ -1280,7 +1314,7 @@
const AObjectId: string; Map: TInstantAttributeMap;
ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
begin
- EnsureResolver(Map).RetrieveMap(AObject, AObjectId, Map, ConflictAction, Info);
+ EnsureResolver(Map).RetrieveMap(AObject, AObjectId, Map, ConflictAction, Info, FObjectData);
end;
procedure TInstantCustomRelationalBroker.SetStatementCacheCapacity(const Value: Integer);
@@ -1776,7 +1810,8 @@
procedure TInstantCustomResolver.InternalRetrieveMap(
AObject: TInstantObject; const AObjectId: string;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
+ AInfo: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil);
begin
end;
@@ -1801,9 +1836,10 @@
procedure TInstantCustomResolver.RetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
+ ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil);
begin
- InternalRetrieveMap(AObject, AObjectId, Map, ConflictAction, Info);
+ InternalRetrieveMap(AObject, AObjectId, Map, ConflictAction, Info, AObjectData);
end;
procedure TInstantCustomResolver.StoreMap(AObject: TInstantObject;
@@ -2125,10 +2161,12 @@
procedure TInstantNavigationalResolver.InternalRetrieveMap(
AObject: TInstantObject; const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
+ ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil);
var
AInfo: TInstantOperationInfo;
begin
+ // This resolver doesn't support retrieving from any kind of TInstantAbstractObjectData.
if not Assigned(Info) then
Info := @AInfo;
Open;
@@ -2142,7 +2180,8 @@
FieldByName(InstantUpdateCountFieldName).AsInteger);
end;
PerformOperation(AObject, Map, ReadAttribute);
- end else
+ end
+ else
ResetAttributes(AObject, Map);
end;
@@ -2464,10 +2503,10 @@
AObject.AttributeByName(AttributeMetadata.Name).Reset;
end;
-procedure TInstantNavigationalResolver.ResetAttributes(AObject: TInstantObject;
- Map: TInstantAttributeMap);
+procedure TInstantNavigationalResolver.ResetAttributes(
+ const AObject: TInstantObject; const AMap: TInstantAttributeMap);
begin
- PerformOperation(AObject, Map, ResetAttribute);
+ PerformOperation(AObject, AMap, ResetAttribute);
end;
procedure TInstantNavigationalResolver.SetDataSet(Value: TDataset);
@@ -3319,45 +3358,43 @@
end;
end;
+procedure TInstantSQLResolver.ResetAttributes(const AObject: TInstantObject;
+ const AMap: TInstantAttributeMap);
+var
+ I: Integer;
+begin
+ for I := 0 to Pred(AMap.Count) do
+ AObject.AttributeByName(AMap[I].Name).Reset;
+end;
+
procedure TInstantSQLResolver.InternalRetrieveMap(AObject: TInstantObject;
const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-
- procedure ResetAttributes;
- var
- I: Integer;
- begin
- for I := 0 to Pred(Map.Count) do
- AObject.AttributeByName(Map[I].Name).Reset
- end;
-
+ ConflictAction: TInstantConflictAction; AInfo: PInstantOperationInfo;
+ const AObjectData: TInstantAbstractObjectData = nil);
var
- DataSet: TDataSet;
- Params: TParams;
- AInfo: TInstantOperationInfo;
+ LDataSet: TDataSet;
+ LParams: TParams;
begin
- if not Assigned(Info) then
- Info := @AInfo;
- Params := TParams.Create;
- try
- AddBaseParams(Params, AObject.ClassName, AObjectId);
- DataSet := Broker.AcquireDataSet(SelectSQL, Params);
+ // This resolver supports retrieving data from TInstantDataSetObjectData.
+ if Assigned(AObjectData) and (AObjectData is TInstantDataSetObjectData) then
+ RetrieveMapFromDataSet(AObject, AObjectId, Map, ConflictAction, AInfo,
+ TInstantDataSetObjectData(AObjectData).DataSet)
+ else
+ begin
+ LParams := TParams.Create;
try
- DataSet.Open;
- Info.Success := not DataSet.EOF;
- Info.Conflict := not Info.Success;
- if Info.Success then
- begin
- if Map.IsRootMap then
- Broker.SetObjectUpdateCount(AObject, DataSet.FieldByName(InstantUpdateCountFieldName).AsInteger);
- ReadAttributes(AObject, AObjectId, Map, DataSet);
- end else
- ResetAttributes;
+ AddBaseParams(LParams, AObject.ClassName, AObjectId);
+ LDataSet := Broker.AcquireDataSet(SelectSQL, LParams);
+ try
+ LDataSet.Open;
+ RetrieveMapFromDataSet(AObject, AObjectId, Map, ConflictAction,
+ AInfo, LDataSet);
+ finally
+ Broker.ReleaseDataSet(LDataSet);
+ end;
finally
- Broker.ReleaseDataSet(DataSet);
+ LParams.Free;
end;
- finally
- Params.Free;
end;
end;
@@ -3846,6 +3883,31 @@
Params.Delete(Param.Index);
end;
+procedure TInstantSQLResolver.RetrieveMapFromDataSet(const AObject: TInstantObject;
+ const AObjectId: string; const AMap: TInstantAttributeMap;
+ ConflictAction: TInstantConflictAction; AInfo: PInstantOperationInfo;
+ const ADataSet: TDataSet);
+var
+ LInfo: TInstantOperationInfo;
+begin
+ Assert(Assigned(AObject));
+ Assert(Assigned(ADataSet));
+
+ if not Assigned(AInfo) then
+ AInfo := @LInfo;
+
+ AInfo.Success := not ADataSet.Eof;
+ AInfo.Conflict := not AInfo.Success;
+ if AInfo.Success then
+ begin
+ if AMap.IsRootMap then
+ Broker.SetObjectUpdateCount(AObject, ADataSet.FieldByName(InstantUpdateCountFieldName).AsInteger);
+ ReadAttributes(AObject, AObjectId, AMap, ADataSet);
+ end
+ else
+ ResetAttributes(AObject, AMap);
+end;
+
function TInstantSQLResolver.TranslateError(AObject: TInstantObject;
E: Exception): Exception;
begin
@@ -4980,11 +5042,6 @@
{ TInstantCustomRelationalQuery }
-function TInstantCustomRelationalQuery.CreateTranslator: TInstantRelationalTranslator;
-begin
- Result := TranslatorClass.Create(Self);
-end;
-
function TInstantCustomRelationalQuery.GetConnector: TInstantRelationalConnector;
begin
Result := inherited Connector as TInstantRelationalConnector;
@@ -5067,8 +5124,10 @@
begin
LTranslator := TranslatorClass.Create(Self);
try
+ LTranslator.RequestedLoadMode := RequestedLoadMode;
LTranslator.CommandText := Command;
Statement := LTranslator.StatementText;
+ SetActualLoadMode(LTranslator.ActualLoadMode);
finally
LTranslator.Free;
end;
@@ -5119,7 +5178,8 @@
Exit;
FContext := TInstantTranslationContext.Create(Command, Quote,
- Delimiters, Connector.IdDataType);
+ Delimiters, Connector.IdDataType, RequestedLoadMode);
+ SetActualLoadMode(FContext.ActualLoadMode);
end;
procedure TInstantRelationalTranslator.Clear;
@@ -5206,11 +5266,6 @@
((AObject = Command) or (AObject.Owner = Command));
end;
-function TInstantRelationalTranslator.QuoteString(const Str: string): string;
-begin
- Result := InstantQuote(Str, Quote);
-end;
-
function TInstantRelationalTranslator.ReplaceWildcard(
const Str: string): string;
var
@@ -5315,7 +5370,7 @@
begin
S := InstantUnquote(S, S[1]);
S := ReplaceWildCard(S);
- Writer.WriteString(QuoteString(S));
+ Writer.WriteString(Context.QuoteString(S));
Result := True;
end else
Result := False;
@@ -5442,10 +5497,43 @@
end;
end;
+ procedure WriteAllFields(Writer: TInstantIQLWriter;
+ const AContext: TInstantTranslationContext);
+ var
+ LMapIndex, LAttrIndex: Integer;
+ LAttrMeta: TInstantAttributeMetadata;
+ LTablePath, LFieldName: string;
+ begin
+ for LMapIndex := 0 to AContext.ObjectClassMetadata.StorageMaps.Count - 1 do
+ begin
+ for LAttrIndex := 0 to AContext.ObjectClassMetadata.StorageMaps[LMapIndex].Count - 1 do
+ begin
+ LAttrMeta := AContext.ObjectClassMetadata.StorageMaps[LMapIndex][LAttrIndex];
+ if ((LAttrMeta.AttributeType = atPart) and (LAttrMeta.StorageKind = skExternal))
+ or (LAttrMeta.AttributeType = atReference) then
+ begin
+ // External part and reference attribute are treated akin:
+ // select Class and Id fields.
+ if Assigned(AContext.PathToTarget(LAttrMeta.FieldName, LTablePath, LFieldName)) then
+ Writer.WriteString(Format(', %s, %s', [
+ AContext.Qualify(LTablePath, LFieldName + InstantClassFieldName),
+ AContext.Qualify(LTablePath, LFieldName + InstantIdFieldName)]));
+ end
+ else if (LAttrMeta.AttributeType in [atParts, atReferences])
+ and (LAttrMeta.StorageKind = skExternal) then
+ // No fields needed for external containers.
+ else
+ // Select all other fields.
+ Writer.WriteString(Format(', %s', [AContext.QualifyPath(LAttrMeta.FieldName)]));
+ end;
+ end;
+ end;
+
var
ClassQual, IdQual, PathText: string;
LContext: TInstantTranslationContext;
LSubQuery: TInstantIQLSubquery;
+ LTablePath, LDummyFieldName: string;
begin
Result := Assigned(Specifier) and Assigned(Writer);
if Result then
@@ -5459,17 +5547,30 @@
if Specifier.Operand is TInstantIQLPath then
begin
+ // This branch handles SELECT * FROM
PathText := TInstantIQLPath(Specifier.Operand).Text;
ClassQual := LContext.QualifyPath(ConcatPath(PathText, InstantClassFieldName));
IdQual := LContext.QualifyPath(ConcatPath(PathText, InstantIdFieldName));
end else
begin
+ // This branch handles SELECT <attribute> FROM
ClassQual := LContext.QualifyPath(InstantClassFieldName);
IdQual := LContext.QualifyPath(InstantIdFieldName);
end;
Writer.WriteString(Format('%s AS %s, %s AS %s', [ClassQual,
InstantClassFieldName, IdQual, InstantIdFieldName]));
- if IncludeOrderFields then
+
+ // Mind that LContext.ActualBurstLoadMode might be different than
+ // Self.RequestedBurstLoadMode.
+ if LContext.ActualLoadMode = lmFullBurst then
+ begin
+ // Use the Id just to get the table path needed to add the updatecount
+ // field. We could use anything we know is in the main table.
+ LContext.PathToTarget(InstantIdFieldName, LTablePath, LDummyFieldName);
+ Writer.WriteString(Format(', %s', [LContext.Qualify(LTablePath, InstantUpdateCountFieldName)]));
+ WriteAllFields(Writer, LContext);
+ end
+ else if IncludeOrderFields then
WriteOrderFields(Writer);
end;
end;
@@ -5875,30 +5976,50 @@
Result := FStatement;
end;
-procedure TInstantSQLQuery.InitObjectReferences(DataSet: TDataSet);
+procedure TInstantSQLQuery.InitObjectReferences(const ADataSet: TDataSet);
+
+ function IsBurstLoadModeDataSet(const ADataSet: TDataSet): Boolean;
+ begin
+ // A trick to check if the dataset that came from the broker is actually
+ // a burst load mode dataset. Requesting burst load mode does not guarantee
+ // to get it, as not all IQL query types support it yet.
+ Result := Assigned(ADataSet.FindField(InstantUpdateCountFieldName));
+ end;
+
var
- ObjRef: TInstantObjectReference;
+ LObjRef: TInstantObjectReference;
+ LObjData: TInstantDataSetObjectData;
begin
- if Assigned(DataSet) then
+ LObjData := nil;
+ if Assigned(ADataSet) then
begin
- DataSet.DisableControls;
+ ADataSet.DisableControls;
try
- while not DataSet.Eof do
- begin
- ObjRef := ObjectReferenceList.Add;
- try
- ObjRef.ReferenceObject(
- DataSet.FieldByName(InstantClassFieldName).AsString,
- DataSet.FieldByName(InstantIdFieldName).AsString);
- except
- ObjRef.Free;
- raise;
+ if IsBurstLoadModeDataSet(ADataSet) then
+ LObjData := TInstantDataSetObjectData.CreateAndInit(ADataSet);
+ try
+ while not ADataSet.Eof do
+ begin
+ LObjRef := ObjectReferenceList.Add;
+ try
+ LObjRef.ReferenceObject(
+ ADataSet.FieldByName(InstantClassFieldName).AsString,
+ ADataSet.FieldByName(InstantIdFieldName).AsString);
+ if Assigned(LObjData) then
+ LObjRef.RetrieveObjectFromObjectData(LObjData);
+ except
+ LObjRef.Free;
+ raise;
+ end;
+ if (MaxCount > 0) and (ObjectReferenceList.Count = MaxCount) then
+ Break;
+ ADataSet.Next;
end;
- if (MaxCount > 0) and (ObjectReferenceList.Count = MaxCount) then break;
- DataSet.Next;
+ finally
+ FreeAndNil(LObjData);
end;
finally
- DataSet.EnableControls;
+ ADataSet.EnableControls;
end;
end;
end;
@@ -6075,6 +6196,7 @@
constructor TInstantTranslationContext.Create(
const AStatement: TInstantIQLObject; const AQuote: Char;
const ADelimiters: string; const AIdDataType: TInstantDataType;
+ const ARequestedLoadMode: TInstantLoadMode;
const AParentContext: TInstantTranslationContext = nil);
begin
inherited Create;
@@ -6087,6 +6209,7 @@
FQuote := AQuote;
FDelimiters := ADelimiters;
FIdDataType := AIdDataType;
+ FRequestedLoadMode := ARequestedLoadMode;
Initialize;
end;
@@ -6094,8 +6217,15 @@
function TInstantTranslationContext.CreateChildContext(
const AStatement: TInstantIQLObject): TInstantTranslationContext;
begin
+ // Child contexts (such as subqueries) don't translate queries for
+ // burst load modes, for the time being.
+ // That's because subqueries now are only used in the EXISTS() function,
+ // and for this case there's nothing to be gained (and a performance
+ // penalty as well) in constructing a burst load mode enabled subquery.
+ // This decision might be revisited in the future if child contexts
+ // are used for other things.
Result := TInstantTranslationContext.Create(AStatement, Quote, Delimiters,
- IdDataType, Self);
+ IdDataType, lmKeysFirst, Self);
end;
destructor TInstantTranslationContext.Destroy;
@@ -6299,22 +6429,41 @@
end;
var
- TablePath: string;
- Path: TInstantIQLPath;
+ LTablePath: string;
+ LPath: TInstantIQLPath;
+ LClassMeta: TInstantClassMetadata;
begin
if ClassRef.Any then
- TablePath := ObjectClassMetadata.TableName
- else begin
- Path := FindAttributePath;
- if Assigned(Path) then
- TablePath := PathToTablePath(Path.Attributes[0])
+ LTablePath := ObjectClassMetadata.TableName
+ else
+ begin
+ LPath := FindAttributePath;
+ if Assigned(LPath) then
+ LTablePath := PathToTablePath(LPath.Attributes[0])
else
- TablePath := ObjectClassMetadata.TableName;
+ LTablePath := ObjectClassMetadata.TableName;
end;
- AddTablePath(TablePath);
+ AddTablePath(LTablePath);
+ if ActualLoadMode = lmFullBurst then
+ begin
+ // Standard mode only adds the main table when needed, and not always.
+ // A possible optimization would be to add it only if it does actually
+ // have attributes we select. For now let's add it by default as it
+ // covers almost all cases.
+ AddTablePath(TableName);
+ LClassMeta := ObjectClassMetadata.Parent;
+ while Assigned(LClassMeta) do
+ begin
+ AddTablePath(LClassMeta.TableName);
+ LClassMeta := LClassMeta.Parent;
+ end;
+ end;
end;
procedure InitCommandCriterias;
+ var
+ LClassMeta: TInstantClassMetadata;
+ LTableName: string;
begin
if not ClassRef.Any then
AddCriteria(Format('%s = %s',
@@ -6330,6 +6479,20 @@
AddCriteria(Format('%s <> 0',
[QualifyPath(ConcatPath(Specifier.Text, InstantIdFieldName))]));
end;
+ if ActualLoadMode = lmFullBurst then
+ begin
+ LClassMeta := ObjectClassMetadata.Parent;
+ while Assigned(LClassMeta) do
+ begin
+ LTableName := LClassMeta.TableName;
+ if LTableName <> TableName then
+ begin
+ AddJoin(TableName, InstantClassFieldName, LTableName, InstantClassFieldName);
+ AddJoin(TableName, InstantIdFieldName, LTableName, InstantIdFieldName);
+ end;
+ LClassMeta := LClassMeta.Parent;
+ end;
+ end;
end;
var
@@ -6347,6 +6510,18 @@
Specifier := TInstantIQLSubquery(FStatement).Specifier;
end;
+ { TODO : supporting ANY in burst load mode would mean collect
+ all descendant classes in the model and left join to all tables,
+ which is complicated to do and would probably be inefficient as well.
+ A better approach would be to perform N queries, one for each
+ concrete class, and combine the resulting sets. This would require
+ some big refactoring and is left for the future. For now, we don't
+ support burst load mode for ANY statements. }
+ if Classref.Any then
+ FActualLoadMode := lmKeysFirst
+ else
+ FActualLoadMode := FRequestedLoadMode;
+
PathList := TList.Create;
try
CollectPaths(FStatement, PathList);
@@ -6424,8 +6599,7 @@
for I := 0 to Pred(Path.AttributeCount) do
begin
TablePath := PathToTablePath(Path.SubPath[I]);
- if IndexOfTablePath(TablePath) = -1 then
- AddTablePath(TablePath);
+ AddTablePath(TablePath);
end;
end;
@@ -6563,8 +6737,13 @@
function TInstantTranslationContext.TablePathToAlias(
const TablePath: string): string;
+var
+ LIndex: Integer;
begin
- Result := TablePathAliases[IndexOfTablePath(TablePath)];
+ LIndex := IndexOfTablePath(TablePath);
+ if LIndex < 0 then
+ raise EInstantError.CreateFmt(STablePathNotFound, [TablePath]);
+ Result := TablePathAliases[LIndex];
end;
function TInstantTranslationContext.WriteCriterias(Writer: TInstantIQLWriter;
@@ -6601,4 +6780,13 @@
end;
end;
+{ TInstantDataSetObjectData }
+
+constructor TInstantDataSetObjectData.CreateAndInit(const ADataSet: TDataSet);
+begin
+ Assert(Assigned(ADataSet));
+ Create;
+ FDataSet := ADataSet;
+end;
+
end.
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantClasses.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -399,6 +399,8 @@
TInstantAbstractObjectClass = class of TInstantAbstractObject;
+ TInstantAbstractObjectData = class(TInstantStreamable);
+
TInstantAbstractObject = class(TInstantStreamable)
private
FConnector: TComponent;
@@ -407,7 +409,8 @@
procedure SetConnector(AConnector: TComponent);
public
constructor Retrieve(const AObjectId: string; CreateIfMissing: Boolean = False;
- Refresh: Boolean = False; AConnector: TComponent = nil); virtual; abstract;
+ Refresh: Boolean = False; AConnector: TComponent = nil;
+ const AObjectData: TInstantAbstractObjectData = nil); virtual; abstract;
end;
TInstantAbstractAttributeClass = class of TInstantAbstractAttribute;
Modified: trunk/Source/Core/InstantCommand.pas
===================================================================
--- trunk/Source/Core/InstantCommand.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantCommand.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -39,7 +39,8 @@
interface
uses
- Classes, SysUtils, Contnrs, InstantClasses, InstantTextFiler, InstantMetadata;
+ Classes, SysUtils, Contnrs, InstantClasses, InstantTextFiler, InstantMetadata,
+ InstantTypes;
type
TInstantIQLObject = class;
@@ -440,6 +441,8 @@
private
FCommand: TInstantIQLCommand;
FCommandText: string;
+ FRequestedLoadMode: TInstantLoadMode;
+ FActualLoadMode: TInstantLoadMode;
procedure SetCommandText(const Value: string);
function GetCommand: TInstantIQLCommand;
protected
@@ -450,9 +453,19 @@
function CreateCommand: TInstantIQLCommand; virtual;
procedure Translate; virtual;
property Command: TInstantIQLCommand read GetCommand;
+ procedure SetActualLoadMode(const AValue: TInstantLoadMode);
public
+ procedure AfterConstruction; override;
property CommandText: string read FCommandText write SetCommandText;
property ResultClassName: string read GetResultClassName;
+ // Set this property to request a special load mode for the command.
+ // Not all modes are supported for all kinds of IQL commands,
+ // so setting this property is merely a request, and the actual fulfilment
+ // depends on the particular IQL command.
+ property RequestedLoadMode: TInstantLoadMode read FRequestedLoadMode
+ write FRequestedLoadMode default lmKeysFirst;
+ // Returns the actually used load mode.
+ property ActualLoadMode: TInstantLoadMode read FActualLoadMode;
end;
TInstantIQLTranslator = class;
@@ -526,7 +539,7 @@
uses
StrUtils,
- InstantPersistence, InstantUtils, InstantConsts, InstantTypes, InstantBrokers;
+ InstantPersistence, InstantUtils, InstantConsts, InstantBrokers;
const
OperatorTokens: array[TInstantIQLOperatorType] of string = ('=', '>', '<',
@@ -1628,6 +1641,12 @@
{ TInstantIQLTranslator }
+procedure TInstantIQLCommandTranslator.AfterConstruction;
+begin
+ inherited;
+ FRequestedLoadMode := lmKeysFirst;
+end;
+
procedure TInstantIQLCommandTranslator.AfterTranslate;
begin
end;
@@ -1657,6 +1676,12 @@
Result := '';
end;
+procedure TInstantIQLCommandTranslator.SetActualLoadMode(
+ const AValue: TInstantLoadMode);
+begin
+ FActualLoadMode := AValue;
+end;
+
procedure TInstantIQLCommandTranslator.SetCommandText(const Value: string);
begin
if Value <> FCommandText then
@@ -1973,7 +1998,10 @@
if Assigned(FUsingAttribute) then
begin
WriteSpace;
-{ TODO -oAndrea Magni : Maybe it would be better to check also TInstantTranslationContext.CriteriaCount, in order to determine if there is already a where condition used to perform join with other tables }
+ { TODO -oAndrea Magni : Maybe it would be better to check also
+ TInstantTranslationContext.CriteriaCount, in order to determine
+ if there is already a where condition used to perform join with
+ other tables }
if Assigned(FClause) or (not FClassRef.Any) then
WriteKeyword('AND')
else
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantConsts.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -163,6 +163,7 @@
SSplashScreenTitle = 'InstantObjects - Object Persistence Framework';
SSQLStatementIndexOutOfBounds = 'SQL statement index out of bounds.';
SSubqueryMissing = 'Subquery missing';
+ STablePathNotFound = 'Table path %s not found';
STransactionInProgress = 'Transaction in progress';
STrueString = 'True';
SUnableToQueryAttribute = 'Unable to query on attribute %s.%s';
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantPersistence.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -140,6 +140,9 @@
AObjectId: string); overload;
procedure ReferenceObject(AObjectClass: TInstantObjectClass;
const AObjectId: string); overload;
+ // Retrieves the referenced object from the specified data object.
+ // Used in burst load mode to get the data already fetched in a dataset.
+ procedure RetrieveObjectFromObjectData(const AObjectData: TInstantAbstractObjectData);
procedure WriteAsObject(Writer: TInstantWriter); virtual;
property Instance: TInstantObject read GetInstance write SetInstance;
property ObjectClass: TInstantObjectClass read GetObjectClass;
@@ -905,7 +908,8 @@
AConnector: TInstantConnector = nil); overload; virtual;
constructor Create(AConnector: TInstantConnector = nil); virtual;
constructor Retrieve(const AObjectId: string; CreateIfMissing: Boolean = False;
- Refresh: Boolean = False; AConnector: TComponent = nil); override;
+ ARefresh: Boolean = False; AConnector: TComponent = nil;
+ const AObjectData: TInstantAbstractObjectData = nil); override;
function AddObject(AObject: TInstantObject): Integer; overload;
function AddRef: Integer;
procedure Assign(Source: TPersistent); override;
@@ -1070,8 +1074,8 @@
function Find(const AObjectId: string): TInstantObject;
procedure ObjectDestroyed(AObject: TInstantObject);
procedure RefreshObject(AObject: TInstantObject);
- function RetrieveObject(const AObjectId: string; AObject: TInstantObject):
- Boolean;
+ function RetrieveObject(const AObjectId: string; const AObject: TInstantObject;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean;
procedure StoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction);
property Connector: TInstantConnector read FConnector write FConnector;
@@ -1142,6 +1146,9 @@
FCommand: string;
FConnector: TInstantConnector;
FMaxCount: Integer;
+ FRequestedLoadMode: TInstantLoadMode;
+ FActualLoadMode: TInstantLoadMode;
+ FLoadMode: TInstantLoadMode;
function GetConnector: TInstantConnector;
function GetObjectCount: Integer;
function GetObjects(Index: Integer): TObject;
@@ -1167,6 +1174,7 @@
procedure SetParams(Value: TParams); virtual;
procedure TranslateCommand; virtual;
function InternalGetObjectReferenceId(Index: Integer) : string; virtual;
+ procedure SetActualLoadMode(const AValue: TInstantLoadMode);
public
constructor Create(AConnector: TInstantConnector); virtual;
function AddObject(AObject: TObject): Integer;
@@ -1190,6 +1198,9 @@
property ObjectCount: Integer read GetObjectCount;
property Objects[Index: Integer]: TObject read GetObjects;
property Params: TParams read GetParams write SetParams;
+ property RequestedLoadMode: TInstantLoadMode read FLoadMode write FLoadMode
+ default lmKeysFirst;
+ property ActualLoadMode: TInstantLoadMode read FActualLoadMode;
end;
EInstantConflict = class(EInstantError)
@@ -1358,8 +1369,8 @@
function InternalDisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; virtual; abstract;
function InternalRetrieveObject(AObject: TInstantObject;
- const AObjectId: string; ConflictAction: TInstantConflictAction):
- Boolean; virtual; abstract;
+ const AObjectId: string; ConflictAction: TInstantConflictAction;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean; virtual; abstract;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; virtual; abstract;
public
@@ -1392,7 +1403,8 @@
// and calling ReadDatabaseSchema will raise an exception.
function IsCatalogSupported: Boolean;
function RetrieveObject(AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
+ ConflictAction: TInstantConflictAction;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean;
procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
function StoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean;
@@ -1620,7 +1632,7 @@
{$IFDEF D14+}
RTTI, InstantRttiAttributes,
{$ENDIF}
- InstantUtils, {InstantRtti, }InstantDesignHook, InstantCode;
+ InstantUtils, InstantDesignHook, InstantCode;
var
ConnectorClasses: TList;
@@ -2116,7 +2128,7 @@
end;
procedure TInstantObjectReference.DoAssignInstance(AInstance: TInstantObject;
- AOwnsInstance: Boolean);
+ AOwnsInstance: Boolean);
begin
if FInstance <> AInstance then
begin
@@ -2226,6 +2238,21 @@
end;
end;
+procedure TInstantObjectReference.RetrieveObjectFromObjectData(
+ const AObjectData: TInstantAbstractObjectData);
+var
+ LObject: TInstantObject;
+begin
+ Assert(Assigned(AObjectData));
+
+ LObject := ObjectClass.Retrieve(ObjectId, False, False, nil, AObjectData);
+ DoAssignInstance(LObject, True);
+ if Assigned(FInstance) then
+ FInstance.Release
+ else
+ Integer(FInstance) := -1;
+end;
+
procedure TInstantObjectReference.ReferenceObject(
AObjectClass: TInstantObjectClass; const AObjectId: string);
begin
@@ -6730,7 +6757,8 @@
{$O-}
constructor TInstantObject.Retrieve(const AObjectId: string; CreateIfMissing:
- Boolean = False; Refresh: Boolean = False; AConnector: TComponent = nil);
+ Boolean = False; ARefresh: Boolean = False; AConnector: TComponent = nil;
+ const AObjectData: TInstantAbstractObjectData = nil);
procedure RetrieveDenied;
begin
@@ -6743,18 +6771,23 @@
VerificationResult: TInstantVerificationResult;
begin
inherited Create;
+
InstantCheckConnector(TInstantConnector(AConnector));
SetConnector(TInstantConnector(AConnector));
+
Instance := ObjectStore.Find(AObjectId);
if Assigned(Instance) then
begin
inherited FreeInstance;
- Self := Instance;
+ Self := Instance as TInstantObject;
AddRef;
- end else
+ if ARefresh then
+ Refresh;
+ end
+ else
begin
Init;
- Exists := ObjectStore.RetrieveObject(AObjectId, Self);
+ Exists := ObjectStore.RetrieveObject(AObjectId, Self, AObjectData);
VerificationResult := VerifyOperation(otRetrieve);
case VerificationResult of
vrAbort:
@@ -7529,7 +7562,8 @@
end;
function TInstantObjectStore.RetrieveObject(const AObjectId: string;
- AObject: TInstantObject): Boolean;
+ const AObject: TInstantObject;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean;
begin
Result := Assigned(AObject) and AObject.Metadata.IsStored;
if not Result then
@@ -7538,7 +7572,7 @@
try
AObject.DisableChanges;
try
- Result := Broker.RetrieveObject(AObject, AObjectId, caFail);
+ Result := Broker.RetrieveObject(AObject, AObjectId, caFail, AObjectData);
if Result then
AObject.SetPersistentId(AObjectId)
else begin
@@ -7877,6 +7911,11 @@
Close;
end;
+procedure TInstantQuery.SetActualLoadMode(const AValue: TInstantLoadMode);
+begin
+ FActualLoadMode := AValue;
+end;
+
procedure TInstantQuery.SetCommand(const Value: string);
begin
if Value <> FCommand then
@@ -8544,13 +8583,13 @@
function TInstantBroker.IsCatalogSupported: Boolean;
var
- vCatalog: TInstantCatalog;
+ LCatalog: TInstantCatalog;
begin
- vCatalog := CreateCatalog(nil);
+ LCatalog := CreateCatalog(nil);
try
- Result := Assigned(vCatalog);
+ Result := Assigned(LCatalog);
finally
- vCatalog.Free;
+ LCatalog.Free;
end;
end;
@@ -8570,9 +8609,10 @@
end;
function TInstantBroker.RetrieveObject(AObject: TInstantObject;
- const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
+ const AObjectId: string; ConflictAction: TInstantConflictAction;
+ const AObjectData: TInstantAbstractObjectData = nil): Boolean;
begin
- Result := InternalRetrieveObject(AObject, AObjectId, ConflictAction);
+ Result := InternalRetrieveObject(AObject, AObjectId, ConflictAction, AObjectData);
end;
procedure TInstantBroker.SetObjectUpdateCount(AObject: TInstantObject;
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/Source/Core/InstantPresentation.pas 2010-09-16 10:28:36 UTC (rev 918)
@@ -40,7 +40,7 @@
{$ENDIF}
uses
- Classes, DB, InstantPersistence, SysUtils, TypInfo, InstantCode,
+ Classes, DB, InstantPersistence, SysUtils, TypInfo, InstantCode, InstantTypes,
InstantMetadata, InstantUtils;
type
@@ -661,6 +661,7 @@
FParamCheck: Boolean;
FParams: TParams;
FQuery: TInstantQuery;
+ FRequestedLoadMode: TInstantLoadMode;
procedure CommandChanged(Sender: TObject);
procedure DestroyQuery;
function GetCommand: TStringList;
@@ -673,6 +674,7 @@
procedure SetMaxCount(const Value: Integer);
procedure SetParams(Value: TParams);
procedure WriteParamData(Writer: TWriter);
+ function GetActualLoadMode: TInstantLoadMode;
protected
{ IProviderSupport }
procedure PSEndTransaction(Commit: Boolean); override;
@@ -698,8 +700,11 @@
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property ObjectClass;
+ property ActualLoadMode: TInstantLoadMode read GetActualLoadMode;
published
property AutoOpen: Boolean read FAutoOpen write FAutoOpen default False;
+ property RequestedLoadMode: TInstantLoadMode
+ read FRequestedLoadMode write FRequestedLoadMode default lmKeysFirst;
property Command: TStringList read GetCommand write SetCommand;
property Connector: TInstantConnector read GetConnector write SetConnector;
property MaxCount: Integer read FMaxCount write SetMaxCount default 0;
@@ -772,7 +777,7 @@
FmtBcd,
{$ENDIF} InstantClasses,
InstantConsts, InstantRtti, InstantDesignHook, InstantAccessors,
- InstantTypes, DbConsts;
+ DbConsts;
const
SelfFieldName = 'Self';
@@ -4709,6 +4714,7 @@
inherited;
NestedDataSetClass := TInstantExposer;
ParamCheck := True;
+ FRequestedLoadMode := lmKeysFirst;
end;
procedure TInstantSelector.DefineProperties(Filer: TFiler);
@@ -4740,6 +4746,11 @@
FreeAndNil(FQuery);
end;
+function TInstantSelector.GetActualLoadMode: TInstantLoadMode;
+begin
+ Result := Query.ActualLoadMode;
+end;
+
function TInstantSelector.GetCommand: TStringList;
begin
if not Assigned(FCommand) then
@@ -4774,6 +4785,7 @@
else
FQuery := Connector.CreateQuery;
FQuery.MaxCount := MaxCount;
+ FQuery.RequestedLoadMode := RequestedLoadMode;
if not (csReading in ComponentState) then
FQuery.Command := Command.Text;
end;
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2010-09-16 10:07:33 UTC (rev 917)
+++ trunk/S...
[truncated message content] |
