Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects:[782] trunk
|
From: <na...@us...> - 2008-08-25 13:28:10
|
Revision: 782
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=782&view=rev
Author: nandod
Date: 2008-08-25 13:28:15 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
+ new IQL function EXISTS().
Modified Paths:
--------------
trunk/Demos/PrimerCross/Primer.dproj
trunk/Demos/PrimerCross/PrimerExternal.dpr
trunk/Demos/PrimerCross/PrimerExternal.dproj
trunk/Demos/PrimerCross/QueryView.dfm
trunk/Demos/PrimerCross/QueryView.pas
trunk/Source/Brokers/XML/InstantXML.pas
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantCommand.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantUtils.pas
trunk/Source/PackageGroups/D2007/AllPackages.groupproj
Modified: trunk/Demos/PrimerCross/Primer.dproj
===================================================================
--- trunk/Demos/PrimerCross/Primer.dproj 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Demos/PrimerCross/Primer.dproj 2008-08-25 13:28:15 UTC (rev 782)
@@ -1,4 +1,5 @@
-<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+<?xml version="1.0" encoding="utf-8"?>
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{d197a2d4-31b9-43b1-8070-3f804d86e53f}</ProjectGuid>
<MainSource>Primer.dpr</MainSource>
@@ -20,7 +21,7 @@
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
- <DCC_Define>DEBUG</DCC_Define>
+ <DCC_Define>DEBUG;IO_STATEMENT_LOGGING</DCC_Define>
<DCC_UnitSearchPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_UnitSearchPath>
<DCC_ResourcePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ResourcePath>
<DCC_ObjPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ObjPath>
@@ -30,7 +31,8 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
-<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1030</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">InstantObjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Primer Demo</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">MPL public license</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">Primer.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
+<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1030</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">InstantObjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Primer Demo</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">MPL public license</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">Primer.dpr</Source></Source></Delphi.Personality> <ModelSupport>False</ModelSupport>
+</BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
Modified: trunk/Demos/PrimerCross/PrimerExternal.dpr
===================================================================
--- trunk/Demos/PrimerCross/PrimerExternal.dpr 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Demos/PrimerCross/PrimerExternal.dpr 2008-08-25 13:28:15 UTC (rev 782)
@@ -62,10 +62,10 @@
ContactSort in 'ContactSort.pas' {ContactSortForm},
CategoryBrowse in 'CategoryBrowse.pas' {CategoryBrowseForm},
HelpView in 'HelpView.pas' {HelpViewForm: TFrame},
- QueryView in 'QueryView.pas' {QueryViewForm: TFrame},
RandomData in 'RandomData.pas',
Stopwatch in 'Stopwatch.pas',
- Utility in 'Utility.pas';
+ Utility in 'Utility.pas',
+ QueryView in 'QueryView.pas' {QueryViewForm: TFrame};
{$R *.res}
{$R *.mdr} {Model}
Modified: trunk/Demos/PrimerCross/PrimerExternal.dproj
===================================================================
--- trunk/Demos/PrimerCross/PrimerExternal.dproj 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Demos/PrimerCross/PrimerExternal.dproj 2008-08-25 13:28:15 UTC (rev 782)
@@ -3,7 +3,7 @@
<PropertyGroup>
<ProjectGuid>{0d607f9b-9c2b-445d-84fd-7072bc53deff}</ProjectGuid>
<MainSource>PrimerExternal.dpr</MainSource>
- <Configuration Condition=" '$(Configuration)' == '' ">Release</Configuration>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>PrimerExternal.exe</DCC_DependencyCheckOutputName>
@@ -13,25 +13,25 @@
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
- <DCC_Define>RELEASE</DCC_Define>
- <DCC_UnitSearchPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_UnitSearchPath>
- <DCC_ResourcePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_ResourcePath>
- <DCC_ObjPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_ObjPath>
- <DCC_IncludePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_IncludePath>
+ <DCC_Define>RELEASE;IO_STATEMENT_LOGGING</DCC_Define>
+ <DCC_UnitSearchPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_UnitSearchPath>
+ <DCC_ResourcePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ResourcePath>
+ <DCC_ObjPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ObjPath>
+ <DCC_IncludePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_IncludePath>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
- <DCC_Define>DEBUG</DCC_Define>
- <DCC_UnitSearchPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_UnitSearchPath>
- <DCC_ResourcePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_ResourcePath>
- <DCC_ObjPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_ObjPath>
- <DCC_IncludePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql</DCC_IncludePath>
+ <DCC_Define>DEBUG;IO_STATEMENT_LOGGING</DCC_Define>
+ <DCC_UnitSearchPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_UnitSearchPath>
+ <DCC_ResourcePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ResourcePath>
+ <DCC_ObjPath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_ObjPath>
+ <DCC_IncludePath>..\..\Source\Core;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\DBX;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML;..\..\Source\Catalogs\IBFb;..\..\Source\Catalogs\MSSql;..\..\Source\Catalogs\MySql</DCC_IncludePath>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
-<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages"></Compiler></Compiler><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">1</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">2057</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">InstantObjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Primer Demo</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">MPL public license</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.1</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">PrimerExternal.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
+<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages"></Compiler></Compiler><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1030</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">InstantObjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">Primer Demo</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">MPL public license</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">PrimerExternal.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
@@ -46,6 +46,7 @@
</DCCReference>
<DCCReference Include="BasicView.pas">
<Form>BasicViewForm</Form>
+ <DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="CategoryBrowse.pas">
<Form>CategoryBrowseForm</Form>
@@ -70,6 +71,7 @@
</DCCReference>
<DCCReference Include="ContactView.pas">
<Form>ContactViewForm</Form>
+ <DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="CountryBrowse.pas">
<Form>CountryBrowseForm</Form>
@@ -80,16 +82,19 @@
</DCCReference>
<DCCReference Include="HelpView.pas">
<Form>HelpViewForm</Form>
+ <DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="Main.pas">
<Form>MainForm</Form>
</DCCReference>
<DCCReference Include="MainData.pas">
<Form>MainDataModule</Form>
+ <DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="ModelExternal\Model.pas" />
<DCCReference Include="PerformanceView.pas">
<Form>PerformanceViewForm</Form>
+ <DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="PersonBrowse.pas">
<Form>PersonBrowseForm</Form>
@@ -99,6 +104,7 @@
</DCCReference>
<DCCReference Include="QueryView.pas">
<Form>QueryViewForm</Form>
+ <DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="RandomData.pas" />
<DCCReference Include="Stopwatch.pas" />
Modified: trunk/Demos/PrimerCross/QueryView.dfm
===================================================================
--- trunk/Demos/PrimerCross/QueryView.dfm 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Demos/PrimerCross/QueryView.dfm 2008-08-25 13:28:15 UTC (rev 782)
@@ -1,10 +1,10 @@
inherited QueryViewForm: TQueryViewForm
- Width = 600
+ Width = 772
Height = 320
object Splitter: TSplitter
Left = 0
Top = 147
- Width = 600
+ Width = 772
Height = 6
Cursor = crVSplit
Align = alTop
@@ -12,7 +12,7 @@
object CommandPanel: TPanel
Left = 0
Top = 0
- Width = 600
+ Width = 772
Height = 147
Align = alTop
BevelOuter = bvNone
@@ -35,7 +35,7 @@
FocusControl = ExampleComboBox
end
object NumberLabel: TLabel
- Left = 443
+ Left = 614
Top = 126
Width = 77
Height = 13
@@ -47,7 +47,7 @@
object CommandEdit: TMemo
Left = 30
Top = 30
- Width = 540
+ Width = 712
Height = 87
Align = alClient
Font.Charset = ANSI_CHARSET
@@ -69,15 +69,16 @@
object ExampleComboBox: TComboBox
Left = 168
Top = 121
- Width = 281
+ Width = 461
Height = 21
Style = csDropDownList
+ DropDownCount = 11
ItemHeight = 13
TabOrder = 1
OnClick = ExampleComboBoxClick
end
object MaxCountEdit: TMaskEdit
- Left = 524
+ Left = 695
Top = 122
Width = 44
Height = 21
@@ -87,31 +88,53 @@
Text = '0 '
end
end
- object ResultPanel: TPanel
+ object ResultPageControl: TPageControl
Left = 0
Top = 153
- Width = 600
+ Width = 772
Height = 167
+ ActivePage = ResultTabSheet
Align = alClient
- BevelOuter = bvNone
TabOrder = 1
- object ResultGrid: TDBGrid
- Left = 0
- Top = 0
- Width = 600
- Height = 167
- Align = alClient
- DataSource = TestSource
- TabOrder = 0
- TitleFont.Charset = DEFAULT_CHARSET
- TitleFont.Color = clWindowText
- TitleFont.Height = -11
- TitleFont.Name = 'MS Sans Serif'
- TitleFont.Style = []
+ object ResultTabSheet: TTabSheet
+ Caption = 'Result'
+ object ResultGrid: TDBGrid
+ Left = 0
+ Top = 0
+ Width = 764
+ Height = 139
+ Align = alClient
+ DataSource = TestSource
+ TabOrder = 0
+ TitleFont.Charset = DEFAULT_CHARSET
+ TitleFont.Color = clWindowText
+ TitleFont.Height = -11
+ TitleFont.Name = 'MS Sans Serif'
+ TitleFont.Style = []
+ end
end
+ object TranslatedQueryTabSheet: TTabSheet
+ Caption = 'Translated Query'
+ ImageIndex = 1
+ object TranslatedQueryMemo: 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
+ AfterClose = TestSelectorAfterClose
Left = 32
Top = 192
end
Modified: trunk/Demos/PrimerCross/QueryView.pas
===================================================================
--- trunk/Demos/PrimerCross/QueryView.pas 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Demos/PrimerCross/QueryView.pas 2008-08-25 13:28:15 UTC (rev 782)
@@ -18,7 +18,7 @@
QGraphics, QControls, QForms, QDialogs, QMask,
QGrids, QDBGrids, QStdCtrls, QExtCtrls, QActnList, QMenus, QButtons,
{$ENDIF}
- BasicView, Db, InstantPresentation;
+ BasicView, Db, InstantPresentation, ComCtrls;
type
TQueryViewForm = class(TBasicViewForm)
@@ -31,29 +31,42 @@
ExecuteAction: TAction;
ExecuteButton: TButton;
ResultGrid: TDBGrid;
- ResultPanel: TPanel;
+ ResultPageControl: TPageControl;
Splitter: TSplitter;
TestSelector: TInstantSelector;
TestSource: TDataSource;
MaxCountEdit: TMaskEdit;
NumberLabel: TLabel;
+ ResultTabSheet: TTabSheet;
+ TranslatedQueryTabSheet: TTabSheet;
+ TranslatedQueryMemo: TMemo;
procedure ExecuteActionExecute(Sender: TObject);
procedure ExampleComboBoxClick(Sender: TObject);
procedure TestSelectorAfterScroll(DataSet: TDataSet);
procedure ActionsUpdate(Action: TBasicAction; var Handled: Boolean);
+ procedure TestSelectorAfterClose(DataSet: TDataSet);
+ private
+ procedure LogStatement(const AString: string);
+ procedure UpdateTabSheets;
protected
procedure LoadExamples;
public
procedure FormCreate(Sender: TObject); override;
+ procedure FormShow(Sender: TObject); override;
procedure Disconnect; override;
+ procedure Connect; override;
+ destructor Destroy; override;
end;
implementation
{$R *.dfm}
+uses
+ InstantPersistence, InstantBrokers, InstantConsts;
+
const
- Examples: array[0..9, 0..1] of string = (
+ Examples: array[0..10, 0..1] of string = (
('All contacts',
'SELECT * FROM ANY TContact'),
('All companies',
@@ -73,9 +86,19 @@
('Corporations ordered descending by city',
'SELECT * FROM TCompany WHERE Name LIKE "%Corp%" ORDER BY City DESC'),
('Employees from same city as their employer',
- 'SELECT * FROM TPerson WHERE City = Employer.City')
+ 'SELECT * FROM TPerson WHERE City = Employer.City'),
+ ('Categories of contacts in cities with names starting by A',
+ 'SELECT DISTINCT * FROM TCategory WHERE EXISTS(SELECT * FROM ANY TContact WHERE City LIKE ''A%'' USING Category)'),
+ ('Companies with at least one employee living in San Diego',
+ 'SELECT * FROM TCompany WHERE EXISTS(SELECT * FROM TPerson WHERE City = ''San Diego'' USING Employer)')
);
+destructor TQueryViewForm.Destroy;
+begin
+ InstantLogProc := nil;
+ inherited;
+end;
+
procedure TQueryViewForm.Disconnect;
begin
TestSelector.Close;
@@ -104,8 +127,17 @@
begin
Caption := 'Query';
LoadExamples;
+ ResultPageControl.ActivePage := ResultTabSheet;
end;
+procedure TQueryViewForm.LogStatement(const AString: string);
+begin
+ //Log only first statement
+ if TranslatedQueryMemo.Lines.Count = 0 then
+ TranslatedQueryMemo.Lines.Text :=
+ Copy(AString, Length(InstantLogStatementBefore) + 1, MaxInt);
+end;
+
procedure TQueryViewForm.LoadExamples;
var
I: Integer;
@@ -135,4 +167,33 @@
ExecuteAction.Enabled := IsConnected and (CommandEdit.Text <> '') and Visible;
end;
+procedure TQueryViewForm.FormShow(Sender: TObject);
+begin
+ inherited;
+ UpdateTabSheets;
+end;
+
+procedure TQueryViewForm.UpdateTabSheets;
+begin
+{$IFDEF IO_STATEMENT_LOGGING}
+ TranslatedQueryTabSheet.TabVisible := Assigned(Connector) and (Connector.Broker is TInstantSQLBroker);
+ InstantLogProc := LogStatement;
+{$ELSE}
+ TranslatedQueryTabSheet.TabVisible := False;
+ InstantLogProc := nil;
+{$ENDIF}
+end;
+
+procedure TQueryViewForm.Connect;
+begin
+ inherited;
+ UpdateTabSheets;
+end;
+
+procedure TQueryViewForm.TestSelectorAfterClose(DataSet: TDataSet);
+begin
+ inherited;
+ TranslatedQueryMemo.Clear;
+end;
+
end.
Modified: trunk/Source/Brokers/XML/InstantXML.pas
===================================================================
--- trunk/Source/Brokers/XML/InstantXML.pas 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Source/Brokers/XML/InstantXML.pas 2008-08-25 13:28:15 UTC (rev 782)
@@ -22,7 +22,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Marco Cant\xF9,
- * Steven Mitchell
+ * Steven Mitchell, Andrea Magni
*
* ***** END LICENSE BLOCK ***** *)
@@ -63,11 +63,11 @@
FConnected: Boolean;
FRootFolder: string;
FXMLFileFormat: TXMLFileFormat;
- procedure CreateStorageDir(const AStorageName: string);
function GetRootFolder: string;
procedure SetRootFolder(const AValue: string);
function ObjectUpdateCountFromFileName(const AFileName: string): Integer;
protected
+ procedure CreateStorageDir(const AStorageName: string);
procedure DoConnect; override;
procedure DoDisconnect; override;
function GetConnected: Boolean; override;
@@ -109,7 +109,7 @@
function CheckConflict(AObject: TInstantObject;
const AStorageName, AObjectId: string): Boolean;
procedure LoadFileList(const AFileList: TStringList;
- const AStorageNames: TStrings);
+ const AStorageNames: TStrings); virtual;
published
property RootFolder: string read GetRootFolder write SetRootFolder;
property XMLFileFormat: TXMLFileFormat
@@ -259,6 +259,7 @@
procedure SetParams(Value: TParams); override;
function ObjectFetched(Index: Integer): Boolean; override;
procedure SetStatement(const Value: string); override;
+ function InternalGetObjectReferenceId(Index: Integer) : string; override;
property ObjectReferenceCount: Integer read GetObjectReferenceCount;
property ObjectReferenceList: TObjectList read GetObjectReferenceList;
property ObjectReferences[Index: Integer]: TInstantObjectReference read
@@ -312,6 +313,8 @@
property TableMetadata: TInstantTableMetadata read GetTableMetadata;
end;
+procedure GlobalLoadFileList(const Path: string; FileList: TStringList);
+
implementation
uses
@@ -922,6 +925,13 @@
Result := ObjectReferenceCount;
end;
+function TInstantXMLQuery.InternalGetObjectReferenceId(
+ Index: Integer): string;
+begin
+ Result := inherited InternalGetObjectReferenceId(Index)+
+ '['+TInstantObjectReference(ObjectReferenceList[Index]).ObjectId+']';
+end;
+
function TInstantXMLQuery.InternalGetObjects(Index: Integer): TObject;
begin
Result := ObjectReferences[Index].Dereference(Connector);
@@ -1245,9 +1255,9 @@
I: Integer;
begin
Result := inherited TranslateClassRef(ClassRef, Writer);
- if TablePathCount > 0 then
+ if Context.TablePathCount > 0 then
begin
- (Query as TInstantXMLQuery).StorageNames.Text := TablePaths[0];
+ (Query as TInstantXMLQuery).StorageNames.Text := Context.TablePaths[0];
(Query as TInstantXMLQuery).ObjectClassNames.Text := ClassRef.ObjectClassName;
if ClassRef.Any then
begin
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2008-07-08 07:01:41 UTC (rev 781)
+++ trunk/Source/Core/InstantBrokers.pas 2008-08-25 13:28:15 UTC (rev 782)
@@ -26,7 +26,7 @@
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
* Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
+ * Riceball Lee, David Moorhouse, Andrea Magni
*
* ***** END LICENSE BLOCK ***** *)
@@ -778,60 +778,126 @@
property Query: TInstantQuery read GetQuery;
end;
- TInstantRelationalTranslator = class(TInstantQueryTranslator)
+ // Holds all information pertaining to a class used in a command. A command
+ // may use several classes (because of subqueries), and a relational translator
+ // has a tree of class context objects.
+ TInstantTranslationContext = class
private
+ FChildContexts: TObjectList;
+ FClassRef: TInstantIQLClassRef;
FCriteriaList: TStringList;
+ FDelimiters: string;
+ FObjectClassName: string;
+ FObjectClassMetadata: TInstantClassMetadata;
+ FQuote: Char;
+ FSpecifier: TInstantIQLSpecifier;
+ FStatement: TInstantIQLObject;
FTablePathList: TStringList;
+ FParentContext: TInstantTranslationContext;
+
procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
- function ConcatPath(const APathText, AttribName: string): string;
- procedure DestroyCriteriaList;
- procedure DestroyTablePathList;
- function ExtractTarget(const PathStr: string): string;
- function RootAttribToFieldName(const AttribName: string): string;
function GetClassTablePath: string;
+ function GetChildContext(const AIndex: Integer): TInstantTranslationContext;
+ function GetChildContextCount: Integer;
function GetCriteriaCount: Integer;
function GetCriteriaList: TStringList;
function GetCriterias(Index: Integer): string;
function GetObjectClassMetadata: TInstantClassMetadata;
- function GetQuery: TInstantCustomRelationalQuery;
+ function GetTableAlias: string;
+ function GetTableName: string;
function GetTablePathAliases(Index: Integer): string;
function GetTablePathCount: Integer;
function GetTablePathList: TStringList;
function GetTablePaths(Index: Integer): string;
function PathToTablePath(const PathText: string): string;
function PathToTarget(const PathText: string;
- out TablePath, FieldName: string): TInstantAttributeMetadata;
+ out TablePath, FieldName: string; const AClassMetadata: TInstantClassMetadata = nil): TInstantAttributeMetadata;
+ procedure SetClassRef(const Value: TInstantIQLClassRef);
+ procedure SetObjectClassName(const Value: string);
+ procedure SetSpecifier(const Value: TInstantIQLSpecifier);
+ function TablePathToAlias(const TablePath: string): string;
+ function GetChildContextIndex: Integer;
+ function GetChildContextLevel: Integer;
+ protected
+ function AddCriteria(const Criteria: string): Integer;
+ function AddTablePath(const TablePath: string): Integer;
+ procedure CollectPaths(AObject: TInstantIQLObject; APathList: TList);
+ function IndexOfCriteria(const Criteria: string): Integer;
+ function IndexOfTablePath(const TablePath: string): Integer;
+ 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 AParentContext: TInstantTranslationContext = nil);
+ destructor Destroy; override;
+
+ procedure AfterConstruction; override;
+ procedure Clear;
+ function AddChildContext(const AContext: TInstantTranslationContext): Integer;
+ function CreateChildContext(const AStatement: TInstantIQLObject): TInstantTranslationContext;
+ function FindAttributeMetadata(const PathText: string): TInstantAttributeMetadata;
+ function GetTablePathAlias(const ATablePath: string): string;
+ function GetSubqueryContext(const ASubQuery: TInstantIQLSubquery): TInstantTranslationContext;
+ function HasParentContext: Boolean;
+ function IndexOfChildContext(const AChildContext: TInstantTranslationContext): Integer;
function Qualify(const TablePath, FieldName: string): string;
function QualifyPath(const PathText: string): string;
+ function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean): Boolean;
+ procedure WriteTables(Writer: TInstantIQLWriter);
+
+ property ChildContext[const AIndex: Integer]: TInstantTranslationContext read GetChildContext;
+ property ChildContextCount: Integer read GetChildContextCount;
+ property ChildContextIndex: Integer read GetChildContextIndex;
+ property ChildContextLevel: Integer read GetChildContextLevel;
+ property ClassRef: TInstantIQLClassRef read FClassRef write SetClassRef;
+ property ClassTablePath: string read GetClassTablePath;
+ property CriteriaCount: Integer read GetCriteriaCount;
+ property Criterias[Index: Integer]: string read GetCriterias;
+ property Delimiters: string read FDelimiters;
+ property ObjectClassName: string read FObjectClassName write SetObjectClassName;
+ property ObjectClassMetadata: TInstantClassMetadata read GetObjectClassMetadata;
+ property ParentContext: TInstantTranslationContext read FParentContext;
+ property Quote: Char read FQuote;
+ property Specifier: TInstantIQLSpecifier read FSpecifier write SetSpecifier;
+ property Statement: TInstantIQLObject read FStatement;
+ property TableName: string read GetTableName;
+ property TableAlias: string read GetTableAlias;
+ property TablePathAliases[Index: Integer]: string read GetTablePathAliases;
+ property TablePathCount: Integer read GetTablePathCount;
+ property TablePaths[Index: Integer]: string read GetTablePaths;
+ end;
+
+
+ TInstantRelationalTranslator = class(TInstantQueryTranslator)
+ private
+ FContext: TInstantTranslationContext;
+ function GetQuery: TInstantCustomRelationalQuery;
function ReplaceWildcard(const Str: string): string;
- function TablePathToAlias(const TablePath: string): string;
- procedure WriteAnd(Writer: TInstantIQLWriter);
- function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean):
- Boolean;
- procedure WriteTables(Writer: TInstantIQLWriter);
- property CriteriaList: TStringList read GetCriteriaList;
- property TablePathList: TStringList read GetTablePathList;
function GetConnector: TInstantRelationalConnector;
protected
- function AddCriteria(const Criteria: string): Integer;
- function AddTablePath(const TablePath: string): Integer;
procedure BeforeTranslate; override;
procedure Clear; override;
procedure CollectObjects(AObject: TInstantIQLObject;
- AClassType: TInstantIQLObjectClass; AList: TList);
- procedure CollectPaths(AObject: TInstantIQLObject; APathList: TList);
+ AClassType: TInstantIQLObjectClass; AList: TList;
+ const AStopClassTypes: array of TInstantIQLObjectClass);
function GetDelimiters: string; virtual;
function GetQuote: Char; virtual;
function GetWildcard: string; virtual;
function HasConnector: Boolean;
function IncludeOrderFields: Boolean; virtual;
- function IndexOfCriteria(const Criteria: string): Integer;
- function IndexOfTablePath(const TablePath: string): Integer;
function InternalGetObjectClassMetadata: TInstantClassMetadata; virtual;
- function IsRootAttribute(const AttributeName: string): Boolean;
+ function InSubquery(const AObject: TInstantIQLObject; out ASubQuery: TInstantIQLSubquery): Boolean;
+ // Returns True if the given attribute is a "root" attribute. Root
+ // attributes are Class and Id.
+ function IsRootAttribute(const AttributeName: string): Boolean; // funzione non membro
function IsPrimary(AObject: TInstantIQLObject): Boolean;
- procedure MakeJoins(Path: TInstantIQLPath);
- procedure MakeTablePaths(Path: TInstantIQLPath);
+ function TranslateObject(AObject: TInstantIQLObject;
+ Writer: TInstantIQLWriter): Boolean; override;
function TranslateClassRef(ClassRef: TInstantIQLClassRef;
Writer: TInstantIQLWriter): Boolean; virtual;
function TranslateClause(Clause: TInstantIQLClause;
@@ -840,31 +906,26 @@
Writer: TInstantIQLWriter): Boolean; virtual;
function TranslateFunction(AFunction: TInstantIQLFunction;
Writer: TInstantIQLWriter): Boolean; virtual;
+ function TranslateSubqueryFunction(ASubqueryFunction: TInstantIQLSubqueryFunction;
+ Writer: TInstantIQLWriter): Boolean; virtual;
function TranslateFunctionName(const FunctionName: string;
Writer: TInstantIQLWriter): Boolean; virtual;
+ function TranslateSubqueryFunctionName(const ASubqueryFunctionName: string;
+ Writer: TInstantIQLWriter): Boolean; virtual;
function TranslateKeyword(const Keyword: string; Writer: TInstantIQLWriter):
Boolean; override;
- function TranslateObject(AObject: TInstantIQLObject;
- Writer: TInstantIQLWriter): Boolean; override;
function TranslatePath(Path: TInstantIQLPath; Writer: TInstantIQLWriter):
Boolean; virtual;
function TranslateSpecifier(Specifier: TInstantIQLSpecifier;
Writer: TInstantIQLWriter): Boolean; virtual;
- property ClassTablePath: string read GetClassTablePath;
property Connector: TInstantRelationalConnector read GetConnector;
- property CriteriaCount: Integer read GetCriteriaCount;
- property Criterias[Index: Integer]: string read GetCriterias;
property Delimiters: string read GetDelimiters;
- property ObjectClassMetadata: TInstantClassMetadata
- read GetObjectClassMetadata;
property Quote: Char read GetQuote;
- property TablePathAliases[Index: Integer]: string read GetTablePathAliases;
- property TablePathCount: Integer read GetTablePathCount;
- property TablePaths[Index: Integer]: string read GetTablePaths;
property Wildcard: string read GetWildcard;
public
+ property Context: TInstantTranslationContext read FContext;
destructor Destroy; override;
- function QuoteString(const Str: string): string;
+ function QuoteString(const Str: string): string; // funzione non membro
property Query: TInstantCustomRelationalQuery read GetQuery;
end;
@@ -967,9 +1028,18 @@
default True;
end;
+ function ConcatPath(const APathText, AttribName: string): string;
+ function ExtractTarget(const PathStr: string): string;
+ function RootAttribToFieldName(const AttribName: string): string;
+ function IsRootAttribute(const AttributeName: string): Boolean;
+ procedure CollectObjects(
+ AObject: TInstantIQLObject; AClassType: TInstantIQLObjectClass; AList: TList;
+ const AStopClassTypes: array of TInstantIQLObjectClass);
+ procedure WriteAnd(Writer: TInstantIQLWriter);
+
var
InstantLogProc: procedure (const AString: string) of object;
-
+
implementation
uses
@@ -1033,6 +1103,71 @@
end;
end;
+
+function ConcatPath(const APathText, AttribName: string): string;
+begin
+ Result := Format('%s%s%s', [APathText, InstantDot, AttribName]);
+end;
+
+function ExtractTarget(const PathStr: string): string;
+var
+ I: Integer;
+begin
+ I := InstantRightPos(InstantDot, PathStr);
+ Result := Copy(PathStr, I + 1, Length(PathStr) - I)
+end;
+
+function RootAttribToFieldName(const AttribName: string): string;
+begin
+ if SameText(AttribName, InstantClassFieldName) then
+ Result := InstantClassFieldName
+ else if SameText(AttribName, InstantIdFieldName) then
+ Result := InstantIdFieldName;
+end;
+
+function IsRootAttribute(const AttributeName: string): Boolean;
+begin
+ Result := SameText(AttributeName, InstantClassFieldName) or
+ SameText(AttributeName, InstantIdFieldName);
+end;
+
+procedure CollectObjects(
+ AObject: TInstantIQLObject; AClassType: TInstantIQLObjectClass; AList: TList;
+ const AStopClassTypes: array of TInstantIQLObjectClass);
+var
+ I: Integer;
+ LObject: TInstantIQLObject;
+
+ function IsStopClassType(const AClassType: TClass): Boolean;
+ var
+ LClassTypeIndex: Integer;
+ begin
+ Result := True;
+ for LClassTypeIndex := Low(AStopClassTypes) to High(AStopClassTypes) do
+ if AClassType = AStopClassTypes[LClassTypeIndex] then
+ Exit;
+ Result := False;
+ end;
+
+begin
+ if not (Assigned(AObject) and Assigned(AList)) then
+ Exit;
+ for I := 0 to Pred(AObject.ObjectCount) do
+ begin
+ LObject := AObject[I];
+ if IsStopClassType(LObject.ClassType) then
+ Continue;
+ if LObject is AClassType then
+ AList.Add(LObject);
+ CollectObjects(LObject, AClassType, AList, AStopClassTypes)
+ end;
+end;
+
+procedure WriteAnd(Writer: TInstantIQLWriter);
+begin
+ Writer.WriteString(' AND ');
+end;
+
{ TInstantCustomRelationalBroker }
constructor TInstantCustomRelationalBroker.Create(AConnector: TInstantConnector);
@@ -1295,7 +1430,7 @@
CachedStatement: TInstantStatement;
begin
{$IFDEF IO_STATEMENT_LOGGING}
- InstantLogStatement('Before: ', AStatement, AParams);
+ InstantLogStatement(InstantLogStatementBefore, AStatement, AParams);
{$ENDIF}
Result := nil;
if FStatementCacheCapacity <> 0 then
@@ -4925,164 +5060,59 @@
destructor TInstantRelationalTranslator.Destroy;
begin
- DestroyTablePathList;
- DestroyCriteriaList;
+ FreeAndNil(FContext);
inherited;
end;
{ TInstantRelationalTranslator }
-function TInstantRelationalTranslator.AddCriteria(
- const Criteria: string): Integer;
-begin
- if IndexOfCriteria(Criteria) = -1 then
- Result := CriteriaList.Add(Criteria)
- else
- Result := -1;
-end;
-
-procedure TInstantRelationalTranslator.AddJoin(const FromPath, FromField,
- ToPath, ToField: string);
-begin
- AddCriteria(Format('%s = %s', [Qualify(FromPath, FromField),
- Qualify(ToPath, ToField)]));
-end;
-
-function TInstantRelationalTranslator.AddTablePath(
- const TablePath: string): Integer;
-begin
- if IndexOfTablePath(TablePath) = -1 then
- Result := TablePathList.Add(TablePath)
- else
- Result := -1;
-end;
-
procedure TInstantRelationalTranslator.BeforeTranslate;
-
- procedure InitClassTablePath(List: TList);
-
- function FindAttributePath: TInstantIQLPath;
- var
- I: Integer;
- begin
- for I := 0 to Pred(List.Count) do
- begin
- Result := List[I];
- if not IsRootAttribute(Result.Text) then
- Exit;
- end;
- Result := nil;
- end;
-
- var
- TablePath: string;
- Path: TInstantIQLPath;
- begin
- if Command.ClassRef.Any then
- TablePath := ObjectClassMetadata.TableName
- else begin
- Path := FindAttributePath;
- if Assigned(Path) then
- TablePath := PathToTablePath(Path.Attributes[0])
- else
- TablePath := ObjectClassMetadata.TableName;
- end;
- AddTablePath(TablePath);
- end;
-
- procedure InitCommandCriterias;
- begin
- if not Command.ClassRef.Any then
- AddCriteria(Format('%s = %s',
- [Qualify(ClassTablePath, InstantClassFieldName),
- QuoteString(Command.ClassRef.ObjectClassName)]));
- if Command.Specifier.IsPath then
- AddCriteria(Format('%s <> %s%s',
- [QualifyPath(ConcatPath(Command.Specifier.Text, InstantIdFieldName)),
- Quote, Quote]));
- end;
-
-var
- I: Integer;
- PathList: TList;
begin
if not Assigned(Command.ClassRef) then
Exit;
- PathList := TList.Create;
- try
- CollectPaths(Command, PathList);
- InitClassTablePath(PathList);
- for I := 0 to Pred(PathList.Count) do
- begin
- MakeTablePaths(PathList[I]);
- MakeJoins(PathList[I]);
- end;
- InitCommandCriterias;
- finally
- PathList.Free;
- end;
+
+ FContext := TInstantTranslationContext.Create(Command, Quote, Delimiters);
end;
procedure TInstantRelationalTranslator.Clear;
begin
inherited;
- DestroyTablePathList;
- DestroyCriteriaList;
+ if Assigned(Context) then
+ Context.Clear;
end;
procedure TInstantRelationalTranslator.CollectObjects(
- AObject: TInstantIQLObject; AClassType: TInstantIQLObjectClass; AList: TList);
+ AObject: TInstantIQLObject; AClassType: TInstantIQLObjectClass; AList: TList;
+ const AStopClassTypes: array of TInstantIQLObjectClass);
var
I: Integer;
- Obj: TInstantIQLObject;
+ LObject: TInstantIQLObject;
+
+ function IsStopClassType(const AClassType: TClass): Boolean;
+ var
+ LClassTypeIndex: Integer;
+ begin
+ Result := True;
+ for LClassTypeIndex := Low(AStopClassTypes) to High(AStopClassTypes) do
+ if AClassType = AStopClassTypes[LClassTypeIndex] then
+ Exit;
+ Result := False;
+ end;
+
begin
if not (Assigned(AObject) and Assigned(AList)) then
Exit;
for I := 0 to Pred(AObject.ObjectCount) do
begin
- Obj := AObject[I];
- if Obj is AClassType then
- AList.Add(Obj);
- CollectObjects(Obj, AClassType, AList)
+ LObject := AObject[I];
+ if IsStopClassType(LObject.ClassType) then
+ Continue;
+ if LObject is AClassType then
+ AList.Add(LObject);
+ CollectObjects(LObject, AClassType, AList, AStopClassTypes)
end;
end;
-procedure TInstantRelationalTranslator.CollectPaths(
- AObject: TInstantIQLObject; APathList: TList);
-begin
- CollectObjects(AObject, TInstantIQLPath, APathList);
-end;
-
-function TInstantRelationalTranslator.ConcatPath(const APathText,
- AttribName: string): string;
-begin
- Result := Format('%s%s%s', [APathText, InstantDot, AttribName]);
-end;
-
-procedure TInstantRelationalTranslator.DestroyCriteriaList;
-begin
- FreeAndNil(FCriteriaList);
-end;
-
-procedure TInstantRelationalTranslator.DestroyTablePathList;
-begin
- FreeAndNil(FTablePathList)
-end;
-
-function TInstantRelationalTranslator.ExtractTarget(
- const PathStr: string): string;
-var
- I: Integer;
-begin
- I := InstantRightPos(InstantDot, PathStr);
- Result := Copy(PathStr, I + 1, Length(PathStr) - I)
-end;
-
-function TInstantRelationalTranslator.GetClassTablePath: string;
-begin
- Result := TablePaths[0];
-end;
-
function TInstantRelationalTranslator.GetConnector: TInstantRelationalConnector;
begin
if HasConnector then
@@ -5091,23 +5121,6 @@
Result := nil;
end;
-function TInstantRelationalTranslator.GetCriteriaCount: Integer;
-begin
- Result := CriteriaList.Count;
-end;
-
-function TInstantRelationalTranslator.GetCriteriaList: TStringList;
-begin
- if not Assigned(FCriteriaList) then
- FCriteriaList := TStringList.Create;
- Result := FCriteriaList;
-end;
-
-function TInstantRelationalTranslator.GetCriterias(Index: Integer): string;
-begin
- Result := CriteriaList.Strings[Index];
-end;
-
function TInstantRelationalTranslator.GetDelimiters: string;
begin
if HasConnector then
@@ -5116,14 +5129,6 @@
Result := '';
end;
-function TInstantRelationalTranslator.GetObjectClassMetadata: TInstantClassMetadata;
-begin
- Result := InternalGetObjectClassMetadata;
- if not Assigned(Result) then
- raise EInstantError.CreateFmt(SUnassignedClassMetadata,
- [Command.ObjectClassName]);
-end;
-
function TInstantRelationalTranslator.GetQuery: TInstantCustomRelationalQuery;
begin
Result := inherited Query as TInstantCustomRelationalQuery;
@@ -5137,33 +5142,6 @@
Result := '"';
end;
-function TInstantRelationalTranslator.GetTablePathAliases(
- Index: Integer): string;
-begin
- if Index < TablePathList.Count then
- Result := Format('t%d', [Succ(Index)])
- else
- Result := '';
-end;
-
-function TInstantRelationalTranslator.GetTablePathCount: Integer;
-begin
- Result := TablePathList.Count;
-end;
-
-function TInstantRelationalTranslator.GetTablePathList: TStringList;
-begin
- if not Assigned(FTablePathList) then
- FTablePathList := TStringList.Create;
- Result := FTablePathList;
-end;
-
-function TInstantRelationalTranslator.GetTablePaths(
- Index: Integer): string;
-begin
- Result := TablePathList[Index];
-end;
-
function TInstantRelationalTranslator.GetWildcard: string;
begin
if HasConnector then
@@ -5182,16 +5160,19 @@
Result := False;
end;
-function TInstantRelationalTranslator.IndexOfCriteria(
- const Criteria: string): Integer;
+function TInstantRelationalTranslator.InSubquery(
+ const AObject: TInstantIQLObject;
+ out ASubQuery: TInstantIQLSubquery): Boolean;
begin
- Result := CriteriaList.IndexOf(Criteria);
-end;
+ if AObject is TInstantIQLSubquery then begin
+ Result := True;
+ ASubQuery := TInstantIQLSubquery(AObject);
+ end
+ else
+ Result := False;
-function TInstantRelationalTranslator.IndexOfTablePath(
- const TablePath: string): Integer;
-begin
- Result := TablePathList.IndexOf(TablePath);
+ if not Result and Assigned(AObject.Owner) then
+ Result := InSubquery(AObject.Owner, ASubQuery);
end;
function TInstantRelationalTranslator.InternalGetObjectClassMetadata: TInstantClassMetadata;
@@ -5216,160 +5197,6 @@
SameText(AttributeName, InstantIdFieldName);
end;
-procedure TInstantRelationalTranslator.MakeJoins(Path: TInstantIQLPath);
-
- procedure MakePathJoins(Path: TInstantIQLPath);
- var
- I: Integer;
- PathText, FromPath, ToPath, FromField, ToField: string;
- begin
- if Path.AttributeCount > 1 then
- begin
- PathToTarget(Path.SubPath[0], FromPath, FromField);
- for I := 1 to Pred(Path.AttributeCount) do
- begin
- PathText := Path.SubPath[I];
- if not IsRootAttribute(ExtractTarget(PathText)) then
- begin
- PathToTarget(PathText, ToPath, ToField);
- AddJoin(FromPath, FromField + InstantClassFieldName, ToPath,
- InstantClassFieldName);
- AddJoin(FromPath, FromField + InstantIdFieldName, ToPath,
- InstantIdFieldName);
- FromPath := ToPath;
- FromField := ToField;
- end;
- end;
- end;
- end;
-
- procedure MakeClassJoin(Path: TInstantIQLPath);
- var
- TablePath: string;
- begin
- if Path.HasAttributes then
- begin
- TablePath := PathToTablePath(Path.SubPath[0]);
- if TablePath <> ClassTablePath then
- begin
- AddJoin(ClassTablePath, InstantClassFieldName,
- TablePath, InstantClassFieldName);
- AddJoin(ClassTablePath, InstantIdFieldName,
- TablePath, InstantIdFieldName);
- end;
- end;
- end;
-
-begin
- if not Assigned(Path) then
- Exit;
- MakeClassJoin(Path);
- MakePathJoins(Path);
-end;
-
-procedure TInstantRelationalTranslator.MakeTablePaths(Path: TInstantIQLPath);
-var
- I: Integer;
- TablePath: string;
-begin
- if not Assigned(Path) or IsRootAttribute(Path.Text) then
- Exit;
- for I := 0 to Pred(Path.AttributeCount) do
- begin
- TablePath := PathToTablePath(Path.SubPath[I]);
- if IndexOfTablePath(TablePath) = -1 then
- AddTablePath(TablePath);
- end;
-end;
-
-function TInstantRelationalTranslator.PathToTablePath(
- const PathText: string): string;
-var
- FieldName: string;
-begin
- PathToTarget(Pathtext, Result, FieldName);
-end;
-
-function TInstantRelationalTranslator.PathToTarget(const PathText: string;
- out TablePath, FieldName: string): TInstantAttributeMetadata;
-var
- I: Integer;
- AttribList: TStringList;
- ClassMeta: TInstantClassMetadata;
- AttribName: string;
- Map: TInstantAttributeMap;
-begin
- Result := nil;
- if IsRootAttribute(PathText) then
- begin
- TablePath := ClassTablePath;
- FieldName := RootAttribToFieldName(PathText);
- end else
- begin
- ClassMeta := ObjectClassMetadata;
- AttribList := TStringList.Create;
- try
- InstantStrToList(PathText, AttribList, [InstantDot]);
- for I := 0 to Pred(AttribList.Count) do
- begin
- AttribName := AttribList[I];
- if IsRootAttribute(AttribName) then
- begin
- if Assigned(Result) and
- not Result.IsAttributeClass(TInstantReference) then
- raise EInstantError.CreateFmt(SUnableToQueryAttribute,
- [Result.ClassMetadataName, Result.Name]);
- FieldName := FieldName + RootAttribToFieldName(AttribName);
- end else
- begin
- Result := ClassMeta.MemberMap.Find(AttribName);
- if Assigned(Result) then
- begin
- while Assigned(ClassMeta) and not ClassMeta.IsStored do
- ClassMeta := ClassMeta.Parent;
- if Assigned(ClassMeta) then
- begin
- Map := ClassMeta.StorageMaps.FindMap(AttribName);
- if Assigned(Map) then
- begin
- if I > 0 then
- TablePath := TablePath + InstantDot;
- TablePath := TablePath + Map.Name;
- FieldName := Result.FieldName;
- ClassMeta := Result.ObjectClassMetadata;
- end else
- raise EInstantError.CreateFmt(SAttributeNotQueryable,
- [Result.ClassName, Result.Name, Result.ClassMetadataName]);
- end else
- raise EInstantError.CreateFmt(SClassNotQueryable,
- [Result.ClassMetadataName]);
- end else
- raise EInstantError.CreateFmt(SAttributeNotFound,
- [AttribName, ClassMeta.Name]);
- end;
- end;
- finally
- AttribList.Free;
- end;
- end;
-end;
-
-function TInstantRelationalTranslator.Qualify(const TablePath,
- FieldName: string): string;
-begin
- Result := Format('%s.%s', [TablePathToAlias(TablePath),
- InstantEmbrace(FieldName, Delimiters)]);
-end;
-
-function TInstantRelationalTranslator.QualifyPath(const
- PathText: string): string;
-var
- TablePath, FieldName: string;
-begin
- PathToTarget(PathText, TablePath, FieldName);
- Result := Qualify(TablePath, FieldName);
-end;
-
function TInstantRelationalTranslator.QuoteString(const Str: string): string;
begin
Result := InstantQuote(Str, Quote);
@@ -5389,51 +5216,70 @@
Result := Str;
end;
-function TInstantRelationalTranslator.RootAttribToFieldName(
- const AttribName: string): string;
-begin
- if SameText(AttribName, InstantClassFieldName) then
- Result := InstantClassFieldName
- else if SameText(AttribName, InstantIdFieldName) then
- Result := InstantIdFieldName;
-end;
-
-function TInstantRelationalTranslator.TablePathToAlias(
- const TablePath: string): string;
-begin
- Result := TablePathAliases[IndexOfTablePath(TablePath)];
-end;
-
function TInstantRelationalTranslator.TranslateClassRef(
ClassRef: TInstantIQLClassRef; Writer: TInstantIQLWriter): Boolean;
+var
+ LSubContext: TInstantTranslationContext;
+ LSubQuery: TInstantIQLSubquery;
begin
- Result := Assigned(ClassRef) and IsPrimary(ClassRef) and Assigned(Writer);
+ Result := Assigned(ClassRef) and Assigned(Writer);
if Result then
- begin
- WriteTables(Writer);
- if not Assigned(Command.Clause) then
- WriteCriterias(Writer, True);
- end;
+ if IsPrimary(ClassRef) then
+ begin
+ Context.WriteTables(Writer);
+ if not Assigned(Command.Clause) then
+ Context.WriteCriterias(Writer, True);
+ end
+ else if Assigned(ClassRef.Owner) and (ClassRef.Owner is TInstantIQLSubquery) then
+ begin
+ LSubQuery := TInstantIQLSubQuery(ClassRef.Owner);
+ LSubContext := Context.GetSubqueryContext(LSubQuery);
+
+ LSubContext.WriteTables(Writer);
+ if not Assigned(LSubQuery.Clause) then
+ LSubContext.WriteCriterias(Writer, True);
+ end
+ else
+ Result := False;
end;
function TInstantRelationalTranslator.TranslateClause(
Clause: TInstantIQLClause; Writer: TInstantIQLWriter): Boolean;
+var
+ LSubQuery: TInstantIQLSubquery;
+ LSubContext: TInstantTranslationContext;
begin
- Result := Assigned(Clause) and IsPrimary(Clause) and Assigned(Writer);
+ Result := Assigned(Clause) and Assigned(Writer);
if Result then
begin
- if WriteCriterias(Writer, False) then
- WriteAnd(Writer);
- Writer.WriteString('(');
- WriteObject(Clause, Writer);
- Writer.WriteString(')');
- end
+ if IsPrimary(Clause) then begin
+ if Context.WriteCriterias(Writer, False) then
+ WriteAnd(Writer);
+ Writer.WriteString('(');
+ WriteObject(Clause, Writer);
+ Writer.WriteString(')');
+ end
+ else if Assigned(Clause.Owner) and (Clause.Owner is TInstantIQLSubquery) then begin
+ LSubQuery := TInstantIQLSubQuery(Clause.Owner);
+ LSubContext := Context.GetSubqueryContext(LSubQuery);
+
+ if LSubContext.WriteCriterias(Writer, False) then
+ WriteAnd(Writer);
+ Writer.WriteString('(');
+ WriteObject(Clause, Writer);
+ Writer.WriteString(')');
+ end
+ else
+ Result := False;
+ end;
end;
function TInstantRelationalTranslator.TranslateConstant(
Constant: TInstantIQLConstant; Writer: TInstantIQLWriter): Boolean;
var
S: string;
+ LSubContext: TInstantTranslationContext;
+ LSubQuery: TInstantIQLSubquery;
begin
if Assigned(Constant) and Assigned(Writer) then
begin
@@ -5444,8 +5290,18 @@
Result := True;
end else if SameText(S, 'SELF') then
begin
- Writer.WriteString(Qualify(ClassTablePath, InstantIdFieldName));
- Result := True;
+ if InSubquery(Constant, LSubQuery) then
+ begin
+ LSubContext := Context.GetSubqueryContext(LSubQuery);
+ Writer.WriteString(LSubContext.Qualify(LSubContext.ClassTablePath, InstantIdFieldName));
+ Result := True;
+ end
+ else
+ begin
+ Writer.WriteString(Context.Qualify(Context.ClassTablePath, InstantIdFieldName));
+ Result := True;
+ end
+
end else if (Length(S) > 0) and (S[1] = '"') then
begin
S := InstantUnquote(S, S[1]);
@@ -5498,6 +5354,10 @@
Result := TranslatePath(TInstantIQLPath(AObject), Writer)
else if AObject is TInstantIQLConstant then
Result := TranslateConstant(TInstantIQLConstant(AObject), Writer)
+{ else if AObject is TInstantIQLSubquery then
+ Result := TranslateSubquery(TInstantIQLSubquery(AObject), Writer)}
+ else if AObject is TInstantIQLSubqueryFunction then
+ Result := TranslateSubqueryFunction(TInstantIQLSubqueryFunction(AObject), Writer)
else if AObject is TInstantIQLFunction then
Result := TranslateFunction(TInstantIQLFunction(AObject), Writer)
else
@@ -5509,16 +5369,24 @@
var
PathText, TablePath, FieldName: string;
AttribMeta: TInstantAttributeMetadata;
+ LSubQuery: TInstantIQLSubquery;
+ LContext: TInstantTranslationContext;
begin
Result := Assigned(Path) and Assigned(Writer);
if Result then
begin
PathText := Path.Text;
- AttribMeta := PathToTarget(PathText, TablePath, FieldName);
+ if InSubquery(Path, LSubQuery) then
+ LContext := Context.GetSubqueryContext(LSubQuery)
+ else
+ LContext := Context;
+
+ AttribMeta := LContext.PathToTarget(PathText, TablePath, FieldName);
+
if Assigned(AttribMeta) and (AttribMeta.Category = acElement) and
not IsRootAttribute(ExtractTarget(PathText)) then
FieldName := FieldName + InstantIdFieldName;
- Writer.WriteString(Qualify(TablePath, FieldName));
+ Writer.WriteString(LContext.Qualify(TablePath, FieldName));
end;
end;
@@ -5547,7 +5415,7 @@
begin
PathList := TList.Create;
try
- CollectObjects(Command.Order, TInstantIQLOperand, PathList);
+ CollectObjects(Command.Order, TInstantIQLOperand, PathList, [TInstantIQLSubquery]);
for I := 0 to Pred(PathList.Count) do
begin
Operand := PathList[I];
@@ -5567,19 +5435,28 @@
var
ClassQual, IdQual, PathText: string;
+ LContext: TInstantTranslationContext;
+ LSubQuery: TInstantIQLSubquery;
begin
- Result := Assigned(Specifier) and IsPrimary(Specifier) and Assigned(Writer);
+ Result := Assigned(Specifier) and Assigned(Writer);
if Result then
begin
+ LContext := Context;
+ if (not IsPrimary(Specifier)) and Assigned(Specifier.Owner) and (Specifier.Owner is TInstantIQLSubquery) then
+ begin
+ LSubQuery := TInstantIQLSubQuery(Specifier.Owner);
+ LContext := Context.GetSubqueryContext(LSubQuery);
+ end;
+
if Specifier.Operand is TInstantIQLPath then
begin
PathText := TInstantIQLPath(Specifier.Operand).Text;
- ClassQual := QualifyPath(ConcatPath(PathText, InstantClassFieldName));
- IdQual := QualifyPath(ConcatPath(PathText, InstantIdFieldName));
+ ClassQual := LContext.QualifyPath(ConcatPath(PathText, InstantClassFieldName));
+ IdQual := LContext.QualifyPath(ConcatPath(PathText, InstantIdFieldName));
end else
begin
- ClassQual := QualifyPath(InstantClassFieldName);
- IdQual := QualifyPath(InstantIdFieldName);
+ ClassQual := LContext.Qual...
[truncated message content] |
