Menu
▾
▴
instantobjects-cvscommit
|
From: <car...@us...> - 2008-09-02 13:52:15
|
Revision: 783
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=783&view=rev
Author: carlobar
Date: 2008-09-02 13:52:26 +0000 (Tue, 02 Sep 2008)
Log Message:
-----------
fixed a bug in TInstantNavigationalResolver.WriteCurrency
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2008-08-25 13:28:15 UTC (rev 782)
+++ trunk/Source/Core/InstantBrokers.pas 2008-09-02 13:52:26 UTC (rev 783)
@@ -2549,9 +2549,9 @@
Clear
else
{$IFDEF FPC}
- AsFloat := Value;
+ AsFloat := Attribute.Value;
{$ELSE}
- AsCurrency := Value;
+ AsCurrency := Attribute.Value;
{$ENDIF}
end;
|
|
From: <na...@us...> - 2010-01-27 08:34:46
|
Revision: 892
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=892&view=rev
Author: nandod
Date: 2010-01-27 08:34:40 +0000 (Wed, 27 Jan 2010)
Log Message:
-----------
* Fixed bug #1503475.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-01-27 08:33:07 UTC (rev 891)
+++ trunk/Source/Core/InstantBrokers.pas 2010-01-27 08:34:40 UTC (rev 892)
@@ -801,7 +801,7 @@
FStatement: TInstantIQLObject;
FTablePathList: TStringList;
FParentContext: TInstantTranslationContext;
-
+ FIdDataType: TInstantDataType;
procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
function GetClassTablePath: string;
function GetChildContext(const AIndex: Integer): TInstantTranslationContext;
@@ -840,7 +840,8 @@
property TablePathList: TStringList read GetTablePathList;
public
constructor Create(const AStatement: TInstantIQLObject; const AQuote: Char;
- const ADelimiters: string; const AParentContext: TInstantTranslationContext = nil);
+ const ADelimiters: string; const AIdDataType: TInstantDataType;
+ const AParentContext: TInstantTranslationContext = nil);
destructor Destroy; override;
procedure AfterConstruction; override;
@@ -866,6 +867,7 @@
property CriteriaCount: Integer read GetCriteriaCount;
property Criterias[Index: Integer]: string read GetCriterias;
property Delimiters: string read FDelimiters;
+ property IdDataType: TInstantDataType read FIdDataType;
property ObjectClassName: string read FObjectClassName write SetObjectClassName;
property ObjectClassMetadata: TInstantClassMetadata read GetObjectClassMetadata;
property ParentContext: TInstantTranslationContext read FParentContext;
@@ -932,7 +934,7 @@
public
property Context: TInstantTranslationContext read FContext;
destructor Destroy; override;
- function QuoteString(const Str: string): string; // funzione non membro
+ function QuoteString(const Str: string): string;
property Query: TInstantCustomRelationalQuery read GetQuery;
end;
@@ -5165,7 +5167,8 @@
if not Assigned(Command.ClassRef) then
Exit;
- FContext := TInstantTranslationContext.Create(Command, Quote, Delimiters);
+ FContext := TInstantTranslationContext.Create(Command, Quote,
+ Delimiters, Connector.IdDataType);
end;
procedure TInstantRelationalTranslator.Clear;
@@ -6139,7 +6142,8 @@
constructor TInstantTranslationContext.Create(
const AStatement: TInstantIQLObject; const AQuote: Char;
- const ADelimiters: string; const AParentContext: TInstantTranslationContext = nil);
+ const ADelimiters: string; const AIdDataType: TInstantDataType;
+ const AParentContext: TInstantTranslationContext = nil);
begin
inherited Create;
FParentContext := AParentContext;
@@ -6157,7 +6161,8 @@
function TInstantTranslationContext.CreateChildContext(
const AStatement: TInstantIQLObject): TInstantTranslationContext;
begin
- Result := TInstantTranslationContext.Create(AStatement, Quote, Delimiters, Self);
+ Result := TInstantTranslationContext.Create(AStatement, Quote, Delimiters,
+ IdDataType, Self);
end;
destructor TInstantTranslationContext.Destroy;
@@ -6383,9 +6388,15 @@
[Qualify(ClassTablePath, InstantClassFieldName),
QuoteString(ClassRef.ObjectClassName)]));
if Specifier.IsPath then
- AddCriteria(Format('%s <> %s%s',
- [QualifyPath(ConcatPath(Specifier.Text, InstantIdFieldName)),
- Quote, Quote]));
+ begin
+ if IdDataType in [dtString, dtMemo, dtBlob] then
+ AddCriteria(Format('%s <> %s%s',
+ [QualifyPath(ConcatPath(Specifier.Text, InstantIdFieldName)),
+ Quote, Quote]))
+ else
+ AddCriteria(Format('%s <> 0',
+ [QualifyPath(ConcatPath(Specifier.Text, InstantIdFieldName))]));
+ end;
end;
var
@@ -6403,8 +6414,6 @@
Specifier := TInstantIQLSubquery(FStatement).Specifier;
end;
- // da TInstantIQLRelationalTranslator.BeforeTranslate
-
PathList := TList.Create;
try
CollectPaths(FStatement, PathList);
|
|
From: <dav...@us...> - 2010-01-29 04:25:03
|
Revision: 893
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=893&view=rev
Author: davidvtaylor
Date: 2010-01-29 04:24:56 +0000 (Fri, 29 Jan 2010)
Log Message:
-----------
* Fix blob update error with AnyDAC/MSSQL for blob sizes exceeding 8000 bytes. Blob parameter values were being assigned with AsBytes rather than AsBlob for Unicode version of Delphi.
* Remove obsolete blob/memo code left over from the Unicode porting process
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-01-27 08:34:40 UTC (rev 892)
+++ trunk/Source/Core/InstantBrokers.pas 2010-01-29 04:24:56 UTC (rev 893)
@@ -2805,26 +2805,6 @@
var
FieldName: string;
- (* No longer used. To be removed when things stabilize with D2009.
- procedure AddBlobParam(const AFieldName, Value: string);
- var
- Param: TParam;
- begin
- Param := AddParam(Params, AFieldName, ftBlob);
- if Value <> '' then
- Param.AsMemo := Value
- end;
-
- procedure AddMemoParam(const AFieldName, Value: string);
- var
- Param: TParam;
- begin
- Param := AddParam(Params, AFieldName, ftMemo);
- if Value <> '' then
- Param.AsMemo := Value
- end;
- *)
-
procedure AddBlobAttributeParam;
var
LParam: TParam;
@@ -2834,7 +2814,7 @@
LParam.Clear
else
{$IFDEF D12+}
- LParam.AsBytes := (Attribute as TInstantBlob).Bytes;
+ LParam.AsBlob := (Attribute as TInstantBlob).Bytes;
{$ELSE}
LParam.AsBlob := (Attribute as TInstantBlob).Value;
{$ENDIF}
|
|
From: <na...@us...> - 2010-08-12 08:37:34
|
Revision: 899
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=899&view=rev
Author: nandod
Date: 2010-08-12 08:37:28 +0000 (Thu, 12 Aug 2010)
Log Message:
-----------
* Fixed a bug that prevented loading of embedded part/parts attributes on MBCS databases (WideMemo) in D2009+. Tested under Delphi 2010 against a Firebird database with UTF-8 charset.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-07-12 11:25:42 UTC (rev 898)
+++ trunk/Source/Core/InstantBrokers.pas 2010-08-12 08:37:28 UTC (rev 899)
@@ -1750,10 +1750,6 @@
function TInstantCustomResolver.CreateEmbeddedObjectInputStream(
const AConnector: TInstantConnector; const AField: TField): TStream;
-{$IFDEF D12+}
-var
- LEncoding: TEncoding;
-{$ENDIF}
begin
Assert(Assigned(AConnector));
Assert(Assigned(AField));
@@ -1762,13 +1758,8 @@
if AConnector.BlobStreamFormat = sfBinary then
Result := TBytesStream.Create(AField.AsBytes)
else
- begin
- TEncoding.GetBufferEncoding(AField.AsBytes, LEncoding);
- Result := TInstantStringStream.Create(LEncoding.GetString(AField.AsBytes));
- end;
- {$ELSE}
- Result := TInstantStringStream.Create(AField.AsString);
{$ENDIF}
+ Result := TInstantStringStream.Create(AField.AsString);
end;
function TInstantCustomResolver.CreateEmbeddedObjectOutputStream(
|
|
From: <na...@us...> - 2010-09-12 06:21:45
|
Revision: 907
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=907&view=rev
Author: nandod
Date: 2010-09-12 06:21:39 +0000 (Sun, 12 Sep 2010)
Log Message:
-----------
* Intentation fixed.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-09-12 06:20:52 UTC (rev 906)
+++ trunk/Source/Core/InstantBrokers.pas 2010-09-12 06:21:39 UTC (rev 907)
@@ -3004,7 +3004,7 @@
if Broker.Connector.UseUnicode then
AddWideMemoAttributeParam
else
- AddMemoAttributeParam;
+ AddMemoAttributeParam;
atPart:
AddPartAttributeParam;
atParts:
|
|
From: <na...@us...> - 2010-09-12 08:52:28
|
Revision: 911
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=911&view=rev
Author: nandod
Date: 2010-09-12 08:52:21 +0000 (Sun, 12 Sep 2010)
Log Message:
-----------
* Fixed: Id fields were erroneously treated always as integers in some generated SQL, causing errors on some databases.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-09-12 08:29:52 UTC (rev 910)
+++ trunk/Source/Core/InstantBrokers.pas 2010-09-12 08:52:21 UTC (rev 911)
@@ -6080,12 +6080,13 @@
inherited Create;
FParentContext := AParentContext;
- if Assigned(FParentContext) then
+ if Assigned(FParentContext) then
FParentContext.AddChildContext(Self);
FStatement := AStatement;
FQuote := AQuote;
FDelimiters := ADelimiters;
+ FIdDataType := AIdDataType;
Initialize;
end;
|
|
From: <na...@us...> - 2010-09-17 17:39:37
|
Revision: 923
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=923&view=rev
Author: nandod
Date: 2010-09-17 17:39:31 +0000 (Fri, 17 Sep 2010)
Log Message:
-----------
* Fixes for burst load mode.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-09-17 07:45:58 UTC (rev 922)
+++ trunk/Source/Core/InstantBrokers.pas 2010-09-17 17:39:31 UTC (rev 923)
@@ -5240,7 +5240,8 @@
const AObject: TInstantIQLObject;
out ASubQuery: TInstantIQLSubquery): Boolean;
begin
- if AObject is TInstantIQLSubquery then begin
+ if AObject is TInstantIQLSubquery then
+ begin
Result := True;
ASubQuery := TInstantIQLSubquery(AObject);
end
@@ -5276,7 +5277,8 @@
S := StringReplace(Str, '%%', #1, [rfReplaceAll]);
S := StringReplace(S, '%', WildCard, [rfReplaceAll]);
Result := StringReplace(S, #1, '%', [rfReplaceAll]);
- end else
+ end
+ else
Result := Str;
end;
@@ -5514,7 +5516,7 @@
begin
// External part and reference attribute are treated akin:
// select Class and Id fields.
- if Assigned(AContext.PathToTarget(LAttrMeta.FieldName, LTablePath, LFieldName)) then
+ if Assigned(AContext.PathToTarget(LAttrMeta.Name, LTablePath, LFieldName)) then
Writer.WriteString(Format(', %s, %s', [
AContext.Qualify(LTablePath, LFieldName + InstantClassFieldName),
AContext.Qualify(LTablePath, LFieldName + InstantIdFieldName)]));
@@ -5524,7 +5526,7 @@
// No fields needed for external containers.
else
// Select all other fields.
- Writer.WriteString(Format(', %s', [AContext.QualifyPath(LAttrMeta.FieldName)]));
+ Writer.WriteString(Format(', %s', [AContext.QualifyPath(LAttrMeta.Name)]));
end;
end;
end;
@@ -6454,7 +6456,8 @@
LClassMeta := ObjectClassMetadata.Parent;
while Assigned(LClassMeta) do
begin
- AddTablePath(LClassMeta.TableName);
+ if LClassMeta.IsStored then
+ AddTablePath(LClassMeta.TableName);
LClassMeta := LClassMeta.Parent;
end;
end;
@@ -6484,11 +6487,14 @@
LClassMeta := ObjectClassMetadata.Parent;
while Assigned(LClassMeta) do
begin
- LTableName := LClassMeta.TableName;
- if LTableName <> TableName then
+ if LClassMeta.IsStored then
begin
- AddJoin(TableName, InstantClassFieldName, LTableName, InstantClassFieldName);
- AddJoin(TableName, InstantIdFieldName, LTableName, InstantIdFieldName);
+ LTableName := LClassMeta.TableName;
+ if (LTableName <> TableName) and LClassMeta.IsStored then
+ begin
+ AddJoin(TableName, InstantClassFieldName, LTableName, InstantClassFieldName);
+ AddJoin(TableName, InstantIdFieldName, LTableName, InstantIdFieldName);
+ end;
end;
LClassMeta := LClassMeta.Parent;
end;
|
|
From: <na...@us...> - 2010-11-16 21:52:04
|
Revision: 938
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=938&view=rev
Author: nandod
Date: 2010-11-16 21:51:58 +0000 (Tue, 16 Nov 2010)
Log Message:
-----------
* Fixed a burst load mode related regression that caused errors when writing to the database with the statement cache enabled.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-11-16 21:50:22 UTC (rev 937)
+++ trunk/Source/Core/InstantBrokers.pas 2010-11-16 21:51:58 UTC (rev 938)
@@ -1478,10 +1478,7 @@
end;
end
else
- begin
AssignDataSetParams(Result, AParams);
- Result.Open;
- end;
end;
end;
if not Assigned(Result) then
|
|
From: <na...@us...> - 2010-12-26 17:25:38
|
Revision: 939
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=939&view=rev
Author: nandod
Date: 2010-12-26 17:25:31 +0000 (Sun, 26 Dec 2010)
Log Message:
-----------
* Burst load modes: fix for a bug that would prevent retrieving a list made of only one object with some brokers (some datasets have Eof = True even when the buffer is pointing to valid record data and there's only one record).
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-11-16 21:51:58 UTC (rev 938)
+++ trunk/Source/Core/InstantBrokers.pas 2010-12-26 17:25:31 UTC (rev 939)
@@ -1,4 +1,4 @@
- (*
+(*
* InstantObjects
* Broker and Connector Classes
*)
@@ -449,7 +449,6 @@
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;
@@ -3421,7 +3420,9 @@
if Assigned(AObjectData) and (AObjectData is TInstantDataSetObjectData)
and TInstantDataSetObjectData(AObjectData).Locate(AObjectId) then
begin
- RetrieveMapFromDataSet(AObject, AObjectId, Map, ConflictAction, AInfo,
+ AInfo.Success := True;
+ AInfo.Conflict := not AInfo.Success;
+ RetrieveMapFromDataSet(AObject, AObjectId, Map,
TInstantDataSetObjectData(AObjectData).DataSet);
end
else
@@ -3432,8 +3433,12 @@
LDataSet := Broker.AcquireDataSet(SelectSQL, LParams);
try
LDataSet.Open;
- RetrieveMapFromDataSet(AObject, AObjectId, Map, ConflictAction,
- AInfo, LDataSet);
+ AInfo.Success := not LDataSet.Eof;
+ AInfo.Conflict := not AInfo.Success;
+ if AInfo.Success then
+ RetrieveMapFromDataSet(AObject, AObjectId, Map, LDataSet)
+ else
+ ResetAttributes(AObject, Map);
finally
Broker.ReleaseDataSet(LDataSet);
end;
@@ -3925,29 +3930,16 @@
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;
+procedure TInstantSQLResolver.RetrieveMapFromDataSet(
+ const AObject: TInstantObject; const AObjectId: string;
+ const AMap: TInstantAttributeMap; const ADataSet: TDataSet);
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);
+ if AMap.IsRootMap then
+ Broker.SetObjectUpdateCount(AObject, ADataSet.FieldByName(InstantUpdateCountFieldName).AsInteger);
+ ReadAttributes(AObject, AObjectId, AMap, ADataSet);
end;
function TInstantSQLResolver.TranslateError(AObject: TInstantObject;
|
|
From: <na...@us...> - 2012-02-14 15:19:15
|
Revision: 958
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=958&view=rev
Author: nandod
Date: 2012-02-14 15:19:08 +0000 (Tue, 14 Feb 2012)
Log Message:
-----------
* Ability to generate both INNER and OUTER SQL joins. Fixes #3487574.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2012-01-29 04:09:48 UTC (rev 957)
+++ trunk/Source/Core/InstantBrokers.pas 2012-02-14 15:19:08 UTC (rev 958)
@@ -799,6 +799,43 @@
property Query: TInstantQuery read GetQuery;
end;
+ // A table path with its list of join clauses.
+ // Helper class used by TInstantTranslationContext.
+ TInstantTablePath = class
+ private
+ FJoinClauses: TStrings;
+ FIsOuterJoin: Boolean;
+ FName: string;
+ function GetCount: Integer;
+ function GetJoinClause(I: Integer): string;
+ public
+ constructor Create(const AName: string);
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ property Name: string read FName write FName;
+ property IsOuterJoin: Boolean read FIsOuterJoin write FIsOuterJoin;
+ function AddJoinClause(const AJoinClause: string): Integer;
+ property JoinClauses[I: Integer]: string read GetJoinClause; default;
+ property Count: Integer read GetCount;
+ end;
+
+ // A list of table paths. Helper class used by TInstantTranslationContext.
+ TInstantTablePathList = class
+ private
+ FPaths: TObjectList;
+ function GetPath(I: Integer): TInstantTablePath;
+ function GetCount: Integer;
+ public
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ property Paths[I: Integer]: TInstantTablePath read GetPath; default;
+ property Count: Integer read GetCount;
+ function IndexOfName(const ATablePathName: string): Integer;
+ function Add(const ATablePathName: string): Integer;
+ function AddJoinClause(const ATablePathName, AJoinClause: string;
+ const AIsOuterJoin: Boolean): Integer;
+ end;
+
// 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.
@@ -813,12 +850,13 @@
FQuote: Char;
FSpecifier: TInstantIQLSpecifier;
FStatement: TInstantIQLObject;
- FTablePathList: TStringList;
+ FTablePathList: TInstantTablePathList;
FParentContext: TInstantTranslationContext;
FIdDataType: TInstantDataType;
FRequestedLoadMode: TInstantLoadMode;
FActualLoadMode: TInstantLoadMode;
- procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
+ procedure AddJoin(const FromPath, FromField, ToPath, ToField: string;
+ const IsOuter: Boolean);
function GetClassTablePath: string;
function GetChildContext(const AIndex: Integer): TInstantTranslationContext;
function GetChildContextCount: Integer;
@@ -830,7 +868,7 @@
function GetTableName: string;
function GetTablePathAliases(Index: Integer): string;
function GetTablePathCount: Integer;
- function GetTablePathList: TStringList;
+ function GetTablePathList: TInstantTablePathList;
function GetTablePaths(Index: Integer): string;
function PathToTablePath(const PathText: string): string;
function PathToTarget(const PathText: string;
@@ -842,6 +880,7 @@
function GetChildContextIndex: Integer;
function GetChildContextLevel: Integer;
function RootAttribToFieldName(const AttribName: string): string;
+ function IsRequiredAttribute(const AAttributeName: string): Boolean;
protected
function AddCriteria(const Criteria: string): Integer;
function AddTablePath(const TablePath: string): Integer;
@@ -852,7 +891,7 @@
procedure MakeJoins(Path: TInstantIQLPath);
procedure MakeTablePaths(Path: TInstantIQLPath);
property CriteriaList: TStringList read GetCriteriaList;
- property TablePathList: TStringList read GetTablePathList;
+ property TablePathList: TInstantTablePathList read GetTablePathList;
public
constructor Create(const AStatement: TInstantIQLObject; const AQuote: Char;
const ADelimiters: string; const AIdDataType: TInstantDataType;
@@ -1323,7 +1362,7 @@
begin
Map := StorageMaps[I];
if (Map <> RootMap) and (Info.Conflict or OperationRequired(Map)) then
- Operation(AObject, AObjectId, Map);
+ Operation(AObject, AObjectId, Map, ConflictAction, @Info);
end;
end;
end;
@@ -5590,8 +5629,8 @@
Writer.WriteString(Format('%s AS %s, %s AS %s', [ClassQual,
InstantClassFieldName, IdQual, InstantIdFieldName]));
- // Mind that LContext.ActualBurstLoadMode might be different than
- // Self.RequestedBurstLoadMode.
+ // Mind that LContext.ActualLoadMode might be different than
+ // Self.RequestedLoadMode.
if IsBurstLoadMode(LContext.ActualLoadMode) then
begin
// Use the Id just to get the table path needed to add the updatecount
@@ -6200,10 +6239,10 @@
end;
procedure TInstantTranslationContext.AddJoin(const FromPath, FromField, ToPath,
- ToField: string);
+ ToField: string; const IsOuter: Boolean);
begin
- AddCriteria(Format('%s = %s', [Qualify(FromPath, FromField),
- Qualify(ToPath, ToField)]));
+ TablePathList.AddJoinClause(ToPath, Format('%s = %s', [Qualify(FromPath, FromField),
+ Qualify(ToPath, ToField)]), IsOuter);
end;
function TInstantTranslationContext.AddTablePath(
@@ -6416,16 +6455,16 @@
Result := TablePathList.Count;
end;
-function TInstantTranslationContext.GetTablePathList: TStringList;
+function TInstantTranslationContext.GetTablePathList: TInstantTablePathList;
begin
if not Assigned(FTablePathList) then
- FTablePathList := TStringList.Create;
+ FTablePathList := TInstantTablePathList.Create;
Result := FTablePathList;
end;
function TInstantTranslationContext.GetTablePaths(Index: Integer): string;
begin
- Result := TablePathList[Index];
+ Result := TablePathList[Index].Name;
end;
function TInstantTranslationContext.HasParentContext: Boolean;
@@ -6448,7 +6487,7 @@
function TInstantTranslationContext.IndexOfTablePath(
const TablePath: string): Integer;
begin
- Result := TablePathList.IndexOf(TablePath);
+ Result := TablePathList.IndexOfName(TablePath);
end;
procedure TInstantTranslationContext.Initialize;
@@ -6530,8 +6569,8 @@
LTableName := LClassMeta.TableName;
if (LTableName <> TableName) and LClassMeta.IsStored then
begin
- AddJoin(TableName, InstantClassFieldName, LTableName, InstantClassFieldName);
- AddJoin(TableName, InstantIdFieldName, LTableName, InstantIdFieldName);
+ AddJoin(TableName, InstantClassFieldName, LTableName, InstantClassFieldName, False);
+ AddJoin(TableName, InstantIdFieldName, LTableName, InstantIdFieldName, False);
end;
end;
LClassMeta := LClassMeta.Parent;
@@ -6581,12 +6620,30 @@
end;
end;
+function TInstantTranslationContext.IsRequiredAttribute(const AAttributeName: string): Boolean;
+var
+ LClassMetadata: TInstantClassMetadata;
+ LAttributeMetadata: TInstantAttributeMetadata;
+begin
+ Assert(AAttributeName <> '');
+ Assert(Assigned(ClassRef));
+
+ Result := False;
+ LClassMetadata := InstantModel.ClassMetadatas.Find(ClassRef.ObjectClassName);
+ if Assigned(LClassMetadata) then begin
+ LAttributeMetadata := LClassMetadata.AttributeMetadatas.Find(AAttributeName);
+ if Assigned(LAttributeMetadata) then
+ Result := LAttributeMetadata.IsRequired;
+ end;
+end;
+
procedure TInstantTranslationContext.MakeJoins(Path: TInstantIQLPath);
procedure MakePathJoins(Path: TInstantIQLPath);
var
I: Integer;
PathText, FromPath, ToPath, FromField, ToField: string;
+ LIsRequiredAttribute: Boolean;
begin
if Path.AttributeCount > 1 then
begin
@@ -6597,10 +6654,11 @@
if not IsRootAttribute(ExtractTarget(PathText)) then
begin
PathToTarget(PathText, ToPath, ToField);
+ LIsRequiredAttribute := IsRequiredAttribute(FromField);
AddJoin(FromPath, FromField + InstantClassFieldName, ToPath,
- InstantClassFieldName);
+ InstantClassFieldName, not LIsRequiredAttribute);
AddJoin(FromPath, FromField + InstantIdFieldName, ToPath,
- InstantIdFieldName);
+ InstantIdFieldName, not LIsRequiredAttribute);
FromPath := ToPath;
FromField := ToField;
end;
@@ -6618,9 +6676,9 @@
if TablePath <> ClassTablePath then
begin
AddJoin(ClassTablePath, InstantClassFieldName,
- TablePath, InstantClassFieldName);
+ TablePath, InstantClassFieldName, False);
AddJoin(ClassTablePath, InstantIdFieldName,
- TablePath, InstantIdFieldName);
+ TablePath, InstantIdFieldName, False);
end;
end;
end;
@@ -6813,14 +6871,26 @@
procedure TInstantTranslationContext.WriteTables(Writer: TInstantIQLWriter);
var
- I: Integer;
+ I, J: Integer;
begin
for I := 0 to Pred(TablePathCount) do
begin
- if I > 0 then
- Writer.WriteString(', ');
+ if I > 0 then begin
+ if TablePathList[I].IsOuterJoin then
+ Writer.WriteString(' LEFT OUTER');
+ Writer.WriteString(' JOIN ');
+ end;
Writer.WriteString(Format('%s %s',[InstantEmbrace(
ExtractTarget(TablePaths[I]), Delimiters), TablePathAliases[I]]));
+ if (I > 0) and (TablePathList[I].Count > 0) then begin
+ Writer.WriteString(' ON (');
+ for J := 0 to TablePathList[I].Count - 1 do begin
+ if J > 0 then
+ Writer.WriteString(' AND ');
+ Writer.WriteString(TablePathList[I][J]);
+ end;
+ Writer.WriteString(')');
+ end;
end;
end;
@@ -6855,4 +6925,94 @@
FDataSet := nil;
end;
+{ TInstantTablePathList }
+
+function TInstantTablePathList.Add(const ATablePathName: string): Integer;
+begin
+ Result := IndexOfName(ATablePathName);
+ if Result < 0 then
+ Result := FPaths.Add(TInstantTablePath.Create(ATablePathName));
+end;
+
+function TInstantTablePathList.AddJoinClause(const ATablePathName,
+ AJoinClause: string; const AIsOuterJoin: Boolean): Integer;
+begin
+ Result := Add(ATablePathName);
+ Paths[Result].AddJoinClause(AJoinClause);
+ Paths[Result].IsOuterJoin := AIsOuterJoin;
+end;
+
+procedure TInstantTablePathList.AfterConstruction;
+begin
+ inherited;
+ FPaths := TObjectList.Create(True);
+end;
+
+destructor TInstantTablePathList.Destroy;
+begin
+ FreeAndNil(FPaths);
+ inherited;
+end;
+
+function TInstantTablePathList.GetCount: Integer;
+begin
+ Result := FPaths.Count;
+end;
+
+function TInstantTablePathList.GetPath(I: Integer): TInstantTablePath;
+begin
+ Result := TInstantTablePath(FPaths[I]);
+end;
+
+function TInstantTablePathList.IndexOfName(
+ const ATablePathName: string): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ for I := 0 to Count - 1 do begin
+ if Paths[I].Name = ATablePathName then begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+{ TInstantTablePath }
+
+function TInstantTablePath.AddJoinClause(const AJoinClause: string): Integer;
+begin
+ Result := FJoinClauses.IndexOf(AJoinClause);
+ if Result < 0 then
+ Result := FJoinClauses.Add(AJoinClause);
+end;
+
+procedure TInstantTablePath.AfterConstruction;
+begin
+ inherited;
+ FJoinClauses := TStringList.Create;
+end;
+
+constructor TInstantTablePath.Create(const AName: string);
+begin
+ inherited Create;
+ FName := AName;
+end;
+
+destructor TInstantTablePath.Destroy;
+begin
+ FreeAndNil(FJoinClauses);
+ inherited;
+end;
+
+function TInstantTablePath.GetCount: Integer;
+begin
+ Result := FJoinClauses.Count;
+end;
+
+function TInstantTablePath.GetJoinClause(I: Integer): string;
+begin
+ Result := FJoinClauses[I];
+end;
+
end.
|
|
From: <dav...@us...> - 2012-12-05 03:36:32
|
Revision: 964
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=964&view=rev
Author: davidvtaylor
Date: 2012-12-05 03:36:25 +0000 (Wed, 05 Dec 2012)
Log Message:
-----------
* Fix to keep empty strings attributes from being converted to null when UseNull is false
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2012-11-27 19:51:24 UTC (rev 963)
+++ trunk/Source/Core/InstantBrokers.pas 2012-12-05 03:36:25 UTC (rev 964)
@@ -3060,7 +3060,8 @@
begin
LParam := AddStringParam(Params, FieldName, (Attribute as TInstantString).Value);
if Attribute.IsNull then
- LParam.Clear;
+ LParam.Clear else
+ LParam.AsString := (Attribute as TInstantString).Value;
end;
begin
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X