Skip to content

Commit b8b1c6a

Browse files
Al-MuhandisAl-Muhandis
committed
Fix refactor and new unit tests
1 parent fd61175 commit b8b1c6a

10 files changed

Lines changed: 2471 additions & 74 deletions

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,3 +38,4 @@ lib/
3838
# Application bundle for Mac OS
3939
*.app/
4040
*.conf
41+
demos/relations/relations_demo.sqlite3

‎core/dopfrelations.pas‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -215,7 +215,10 @@ procedure TdRelationalEntity.SetRelationValue(const APropertyName: string; AValu
215215
begin
216216
Index := FRelationValues.IndexOf(APropertyName);
217217
if Index >= 0 then
218+
begin
219+
FRelationValues.Objects[Index].Free; //? Recheck. Frees old one before assigning
218220
FRelationValues.Objects[Index] := AValue
221+
end
219222
else
220223
FRelationValues.AddObject(APropertyName, AValue);
221224
end;
@@ -601,7 +604,7 @@ function TdGRelationalEntityOpf.GetRelatedObject(aEntity: T3; const ARelationNam
601604

602605
function TdGRelationalEntityOpf.GetRelatedObjectList(const ARelationName: string): TObjectList;
603606
begin
604-
GetRelatedObjectList(FEntity, ARelationName);
607+
Result:=GetRelatedObjectList(FEntity, ARelationName);
605608
end;
606609

607610
function TdGRelationalEntityOpf.GetRelatedObjectList(aEntity: T3; const ARelationName: string): TObjectList;

‎core/dopfrelationshelpers.pas‎

Lines changed: 70 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -38,14 +38,11 @@ TdRelationCache = class(TdObject)
3838
{ TdRelationQueryBuilder - Query builder for relations }
3939
TdRelationQueryBuilder = class(TdObject)
4040
public
41-
class function BuildOneToOneQuery(const ATargetTable, AForeignKey: string;
42-
const ALocalValue: Variant): string;
43-
class function BuildOneToManyQuery(const ATargetTable, AForeignKey: string;
44-
const ALocalValue: Variant): string;
45-
class function BuildManyToOneQuery(const ATargetTable, ALocalKey: string;
46-
const AForeignValue: Variant): string;
47-
class function BuildManyToManyQuery(const ATargetTable, AMappingTable,
48-
AForeignKey, ALocalKey: string; const ALocalValue: Variant): string;
41+
class function BuildOneToOneQuery(const aTargetTable, aForeignKey: string; const aLocalValue: Variant): string;
42+
class function BuildOneToManyQuery(const aTargetTable, aForeignKey: string; const aLocalValue: Variant): string;
43+
class function BuildManyToOneQuery(const aTargetTable, aLocalKey: string; const aForeignValue: Variant): string;
44+
class function BuildManyToManyQuery(const aTargetTable, aMappingTable, aForeignKey, aLocalKey: string;
45+
const aLocalValue: Variant): string;
4946
end;
5047

5148
{ TdRelationFactory - Factory for creating related objects }
@@ -58,9 +55,9 @@ TdRelationFactory = class(TdObject)
5855
{ TdRelationValidator - Relation validator }
5956
TdRelationValidator = class(TdObject)
6057
public
61-
class function ValidateRelation(ARelation: TdRelationInfo): Boolean;
62-
class function ValidateEntity(AEntity: TObject): Boolean;
63-
class function GetValidationErrors(ARelation: TdRelationInfo): TStringList;
58+
class function ValidateRelation(aRelation: TdRelationInfo): Boolean;
59+
class function ValidateEntity(aEntity: TObject): Boolean;
60+
class function GetValidationErrors(aRelation: TdRelationInfo): TStringList;
6461
end;
6562

6663
{ TdAdvancedRelationalEntity - Extended version of the base class }
@@ -78,7 +75,7 @@ TdAdvancedRelationalEntity = class(TdRelationalEntity)
7875

7976
// Extended relation management methods
8077
procedure ClearRelationCache(const ARelationName: string = '');
81-
procedure PreloadRelation(const ARelationName: string);
78+
procedure PreloadRelation(const {%H-}ARelationName: string);
8279
procedure SetAutoLoad(AValue: Boolean);
8380

8481
// Checking relation status
@@ -91,7 +88,16 @@ TdAdvancedRelationalEntity = class(TdRelationalEntity)
9188
implementation
9289

9390
uses
94-
Variants, TypInfo;
91+
Variants, TypInfo
92+
;
93+
94+
function VariantToSQLValueWithOperator(aValue: Variant): String;
95+
begin
96+
if VarIsNull(aValue) then
97+
Result:='IS NULL'
98+
else
99+
Result:='= '+QuotedStr(VarToStr(aValue));
100+
end;
95101

96102
{ TdRelationCache }
97103

@@ -112,33 +118,36 @@ destructor TdRelationCache.Destroy;
112118

113119
procedure TdRelationCache.Store(const AKey: string; AValue: TObject);
114120
var
115-
Index: Integer;
121+
aIndex: Integer;
116122
begin
117-
Index := FCache.IndexOf(AKey);
118-
if Index >= 0 then
119-
FCache.Objects[Index] := AValue
123+
aIndex := FCache.IndexOf(AKey);
124+
if aIndex >= 0 then
125+
begin
126+
FCache.Objects[aIndex].Free; // vs mem leak? FCache owns its items
127+
FCache.Objects[aIndex] := AValue;
128+
end
120129
else
121130
FCache.AddObject(AKey, AValue);
122131
end;
123132

124133
function TdRelationCache.Retrieve(const AKey: string): TObject;
125134
var
126-
Index: Integer;
135+
aIndex: Integer;
127136
begin
128-
Index := FCache.IndexOf(AKey);
129-
if Index >= 0 then
130-
Result := FCache.Objects[Index]
137+
aIndex := FCache.IndexOf(AKey);
138+
if aIndex >= 0 then
139+
Result := FCache.Objects[aIndex]
131140
else
132141
Result := nil;
133142
end;
134143

135144
procedure TdRelationCache.Remove(const AKey: string);
136145
var
137-
Index: Integer;
146+
aIndex: Integer;
138147
begin
139-
Index := FCache.IndexOf(AKey);
140-
if Index >= 0 then
141-
FCache.Delete(Index);
148+
aIndex := FCache.IndexOf(AKey);
149+
if aIndex >= 0 then
150+
FCache.Delete(aIndex);
142151
end;
143152

144153
procedure TdRelationCache.Clear;
@@ -153,44 +162,50 @@ function TdRelationCache.HasKey(const AKey: string): Boolean;
153162

154163
{ TdRelationQueryBuilder }
155164

156-
class function TdRelationQueryBuilder.BuildOneToOneQuery(const ATargetTable,
157-
AForeignKey: string; const ALocalValue: Variant): string;
165+
class function TdRelationQueryBuilder.BuildOneToOneQuery(const aTargetTable, aForeignKey: string;
166+
const aLocalValue: Variant): string;
167+
var
168+
aValue: String;
158169
begin
159-
Result := Format('SELECT * FROM %s WHERE %s = %s',
160-
[ATargetTable, AForeignKey, QuotedStr(VarToStr(ALocalValue))]);
170+
aValue:=VariantToSQLValueWithOperator(aLocalValue);
171+
Result:=Format('SELECT * FROM %s WHERE %s %s', [aTargetTable, aForeignKey, aValue]);
161172
end;
162173

163-
class function TdRelationQueryBuilder.BuildOneToManyQuery(const ATargetTable,
164-
AForeignKey: string; const ALocalValue: Variant): string;
174+
class function TdRelationQueryBuilder.BuildOneToManyQuery(const aTargetTable, aForeignKey: string;
175+
const aLocalValue: Variant): string;
176+
var
177+
aValue: String;
165178
begin
166-
Result := Format('SELECT * FROM %s WHERE %s = %s ORDER BY id',
167-
[ATargetTable, AForeignKey, QuotedStr(VarToStr(ALocalValue))]);
179+
aValue:=VariantToSQLValueWithOperator(aLocalValue);
180+
Result:=Format('SELECT * FROM %s WHERE %s %s ORDER BY id', [aTargetTable, aForeignKey, aValue]);
168181
end;
169182

170-
class function TdRelationQueryBuilder.BuildManyToOneQuery(const ATargetTable,
171-
ALocalKey: string; const AForeignValue: Variant): string;
183+
class function TdRelationQueryBuilder.BuildManyToOneQuery(const aTargetTable, aLocalKey: string;
184+
const aForeignValue: Variant): string;
185+
var
186+
aValue: String;
172187
begin
173-
Result := Format('SELECT * FROM %s WHERE %s = %s',
174-
[ATargetTable, ALocalKey, QuotedStr(VarToStr(AForeignValue))]);
188+
aValue:=VariantToSQLValueWithOperator(aForeignValue);
189+
Result:=Format('SELECT * FROM %s WHERE %s %s', [aTargetTable, aLocalKey, aValue]);
175190
end;
176191

177-
class function TdRelationQueryBuilder.BuildManyToManyQuery(const ATargetTable,
178-
AMappingTable, AForeignKey, ALocalKey: string; const ALocalValue: Variant): string;
192+
class function TdRelationQueryBuilder.BuildManyToManyQuery(const aTargetTable, aMappingTable, aForeignKey,
193+
aLocalKey: string; const aLocalValue: Variant): string;
194+
var
195+
aValue: String;
179196
begin
180-
Result := Format(
181-
'SELECT t.* FROM %s t ' +
182-
'INNER JOIN %s m ON t.%s = m.%s_target ' +
183-
'WHERE m.%s_local = %s ' +
184-
'ORDER BY t.id',
185-
[ATargetTable, AMappingTable, ALocalKey, AForeignKey,
186-
ALocalKey, QuotedStr(VarToStr(ALocalValue))]);
197+
aValue:=VariantToSQLValueWithOperator(aLocalValue);
198+
Result:=Format(
199+
'SELECT t.* FROM %s t INNER JOIN %s m ON t.%s = m.%s_target WHERE m.%s_local %s ORDER BY t.id',
200+
[aTargetTable, aMappingTable, aLocalKey, aForeignKey, aLocalKey, aValue]
201+
);
187202
end;
188203

189204
{ TdRelationFactory }
190205

191206
class function TdRelationFactory.CreateEntity(AClass: TClass): TObject;
192207
begin
193-
Result := AClass.Create;
208+
Result:=AClass.Create;
194209
end;
195210

196211
class function TdRelationFactory.CreateEntityList: TObjectList;
@@ -200,7 +215,7 @@ class function TdRelationFactory.CreateEntityList: TObjectList;
200215

201216
{ TdRelationValidator }
202217

203-
class function TdRelationValidator.ValidateRelation(ARelation: TdRelationInfo): Boolean;
218+
class function TdRelationValidator.ValidateRelation(aRelation: TdRelationInfo): Boolean;
204219
begin
205220
Result := True;
206221

@@ -219,25 +234,25 @@ class function TdRelationValidator.ValidateRelation(ARelation: TdRelationInfo):
219234
Result := False;
220235
end;
221236

222-
class function TdRelationValidator.ValidateEntity(AEntity: TObject): Boolean;
237+
class function TdRelationValidator.ValidateEntity(aEntity: TObject): Boolean;
223238
begin
224-
Result := (AEntity <> nil) and Supports(AEntity, IdRelationalEntity);
239+
Result := (aEntity <> nil) and Supports(aEntity, IdRelationalEntity);
225240
end;
226241

227-
class function TdRelationValidator.GetValidationErrors(ARelation: TdRelationInfo): TStringList;
242+
class function TdRelationValidator.GetValidationErrors(aRelation: TdRelationInfo): TStringList;
228243
begin
229244
Result := TStringList.Create;
230245

231-
if ARelation.PropertyName = '' then
246+
if aRelation.PropertyName = '' then
232247
Result.Add('Property name is required');
233248

234-
if ARelation.ForeignKey = '' then
249+
if aRelation.ForeignKey = '' then
235250
Result.Add('Foreign key is required');
236251

237-
if ARelation.TargetClass = nil then
252+
if aRelation.TargetClass = nil then
238253
Result.Add('Target class is required');
239254

240-
if (ARelation.RelationType = rtManyToMany) and (ARelation.MappingTable = '') then
255+
if (aRelation.RelationType = rtManyToMany) and (aRelation.MappingTable = '') then
241256
Result.Add('Mapping table is required for Many-to-Many relations');
242257
end;
243258

‎core/dopftableregistry.pas‎

Lines changed: 25 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ TdTableRegistry = class(TdObject)
1717
private
1818
FRegistry: TStringList;
1919
class var FInstance: TdTableRegistry;
20+
procedure Clear;
2021
public
2122
constructor Create;
2223
destructor Destroy; override;
@@ -25,8 +26,9 @@ TdTableRegistry = class(TdObject)
2526
class procedure RegisterTable(AClass: TClass; const ATableName: string);
2627
class function GetTableName(AClass: TClass): string;
2728
class function IsRegistered(AClass: TClass): Boolean;
29+
class procedure ClearRegistry;
2830

29-
procedure RegisterClass(AClass: TClass; const ATableName: string);
31+
procedure RegisterClass(aClass: TClass; const aTableName: string);
3032
function GetTableForClass(AClass: TClass): string;
3133
function HasClass(AClass: TClass): Boolean;
3234
end;
@@ -40,6 +42,11 @@ implementation
4042

4143
{ TdTableRegistry }
4244

45+
procedure TdTableRegistry.Clear;
46+
begin
47+
FreeAndNil(FInstance);
48+
end;
49+
4350
constructor TdTableRegistry.Create;
4451
begin
4552
inherited Create;
@@ -69,31 +76,38 @@ class procedure TdTableRegistry.RegisterTable(AClass: TClass; const ATableName:
6976
class function TdTableRegistry.GetTableName(AClass: TClass): string;
7077
begin
7178
Result := Instance.GetTableForClass(AClass);
72-
if Result = '' then
79+
if Result.IsEmpty then
80+
begin
7381
Result := LowerCase(AClass.ClassName); // fallback to class name
82+
Result := Copy(Result, 2, Length(Result) - 1);
83+
end;
7484
end;
7585

7686
class function TdTableRegistry.IsRegistered(AClass: TClass): Boolean;
7787
begin
7888
Result := Instance.HasClass(AClass);
7989
end;
8090

81-
procedure TdTableRegistry.RegisterClass(AClass: TClass; const ATableName: string);
91+
class procedure TdTableRegistry.ClearRegistry;
92+
begin
93+
Instance.Clear;
94+
end;
95+
96+
procedure TdTableRegistry.RegisterClass(aClass: TClass; const aTableName: string);
8297
var
83-
Index: Integer;
98+
aIndex: Integer;
8499
begin
85-
Index := FRegistry.IndexOf(AClass.ClassName);
86-
if Index >= 0 then
87-
FRegistry.ValueFromIndex[Index] := ATableName
88-
else
89-
FRegistry.Values[AClass.ClassName] := ATableName;
100+
aIndex := FRegistry.IndexOfName(AClass.ClassName);
101+
if aIndex >= 0 then
102+
FRegistry.Delete(aIndex);
103+
FRegistry.Values[AClass.ClassName] := ATableName;
90104
end;
91105

92106
function TdTableRegistry.GetTableForClass(AClass: TClass): string;
93107
var
94108
Index: Integer;
95109
begin
96-
Index := FRegistry.IndexOf(AClass.ClassName);
110+
Index := FRegistry.IndexOfName(AClass.ClassName);
97111
if Index >= 0 then
98112
Result := FRegistry.ValueFromIndex[Index]
99113
else
@@ -102,7 +116,7 @@ function TdTableRegistry.GetTableForClass(AClass: TClass): string;
102116

103117
function TdTableRegistry.HasClass(AClass: TClass): Boolean;
104118
begin
105-
Result := FRegistry.IndexOf(AClass.ClassName) >= 0;
119+
Result := FRegistry.IndexOfName(AClass.ClassName) >= 0;
106120
end;
107121

108122
{ Global functions for convenience }

‎tests/gui.lpi‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,21 @@
135135
<IsPartOfProject Value="True"/>
136136
<UnitName Value="dOpfRelationsHelpers"/>
137137
</Unit>
138+
<Unit>
139+
<Filename Value="test_dopftableregistry.pas"/>
140+
<IsPartOfProject Value="True"/>
141+
<UnitName Value="test_dOpfTableRegistry"/>
142+
</Unit>
143+
<Unit>
144+
<Filename Value="test_dopfrelations_extended.pas"/>
145+
<IsPartOfProject Value="True"/>
146+
<UnitName Value="test_dOpfRelations_Extended"/>
147+
</Unit>
148+
<Unit>
149+
<Filename Value="test_dopfrelationshelpers.pas"/>
150+
<IsPartOfProject Value="True"/>
151+
<UnitName Value="test_dOpfRelationsHelpers"/>
152+
</Unit>
138153
</Units>
139154
</ProjectOptions>
140155
<CompilerOptions>
@@ -170,6 +185,9 @@
170185
<Item>
171186
<Name Value="EFOpenError"/>
172187
</Item>
188+
<Item>
189+
<Name Value="EdOpf"/>
190+
</Item>
173191
</Exceptions>
174192
</Debugging>
175193
</CONFIG>

‎tests/gui.lpr‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
{$mode objfpc}{$H+}
44

55
uses
6-
Interfaces, Forms, GuiTestRunner, test_insertbuilder, test_dOpfRelations
6+
Interfaces, Forms, GuiTestRunner, test_insertbuilder, test_dOpfRelations, test_dOpfTableRegistry,
7+
test_dOpfRelations_Extended, test_dOpfRelationsHelpers
78
;
89

910
{$R *.res}

‎tests/test_dopfrelations.pas‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -384,13 +384,13 @@ procedure TTestRelationCache.TestHasKey;
384384

385385
procedure TTestRelationQueryBuilder.TestBuildOneToOneQuery;
386386
var
387-
Query: string;
387+
aQuery: string;
388388
begin
389-
Query := TdRelationQueryBuilder.BuildOneToOneQuery('profiles', 'person_id', 123);
390-
AssertTrue('Should contain table name', Pos('profiles', Query) > 0);
391-
AssertTrue('Should contain foreign key', Pos('person_id', Query) > 0);
392-
AssertTrue('Should contain value', Pos('123', Query) > 0);
393-
AssertTrue('Should contain WHERE clause', Pos('WHERE', Query) > 0);
389+
aQuery := TdRelationQueryBuilder.BuildOneToOneQuery('profiles', 'person_id', 123);
390+
AssertTrue('Should contain table name', Pos('profiles', aQuery) > 0);
391+
AssertTrue('Should contain foreign key', Pos('person_id', aQuery) > 0);
392+
AssertTrue('Should contain value', Pos('123', aQuery) > 0);
393+
AssertTrue('Should contain WHERE clause', Pos('WHERE', aQuery) > 0);
394394
end;
395395

396396
procedure TTestRelationQueryBuilder.TestBuildOneToManyQuery;

0 commit comments

Comments
 (0)