Skip to content

Commit e203d89

Browse files
exilonexilon
committed
Quick.Options improved validations
1 parent 0408d2c commit e203d89

File tree

1 file changed

+71
-22
lines changed

1 file changed

+71
-22
lines changed

Diff for: ‎Quick.Options.pas

+71-22
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
Author : Kike Pérez
88
Version : 1.0
99
Created : 18/10/2019
10-
Modified : 28/11/2019
10+
Modified : 16/12/2019
1111
1212
This file is part of QuickLib: https://github.com/exilon/QuickLib
1313
@@ -90,14 +90,16 @@ TOptions = class;
9090
TOptions = class(TInterfacedObject,IOptionsValidator)
9191
private
9292
fName : string;
93-
procedure ValidateRequired(aProperty : TRttiProperty);
94-
procedure ValidateStringLength(aProperty: TRttiProperty; aValidation : StringLength);
95-
procedure ValidateRange(aProperty : TRttiProperty; aValidation : Range);
93+
procedure ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
94+
procedure ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
95+
procedure ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
9696
procedure DoValidateOptions; virtual;
97+
procedure ValidateObject(aObj : TObject);
98+
procedure ValidateArray(aValue : TValue);
9799
public
98100
constructor Create;
99101
property Name : string read fName write fName;
100-
procedure DefaultValues; virtual; abstract;
102+
procedure DefaultValues; virtual;
101103
function ConfigureOptions<T : TOptions>(aOptionsFunc : TConfigureOptionsProc<T>) : IOptionsValidator;
102104
procedure ValidateOptions;
103105
end;
@@ -122,7 +124,7 @@ TOptionsClass = class of TOptions;
122124
['{A593C8BB-53CF-4AA4-9641-BF974E45CBD1}']
123125
function AddSection(aOption : TOptionsClass; const aOptionsName : string = '') : TOptions;
124126
function GetOptions(aOptionClass : TOptionsClass): TOptions;
125-
function GetSection(aOptionsSection : TOptionsClass; aOptions : TOptions) : Boolean; overload;
127+
function GetSection(aOptionsSection : TOptionsClass; var vOptions : TOptions) : Boolean; overload;
126128
end;
127129

128130
TSectionList = TObjectList<TOptions>;
@@ -167,7 +169,7 @@ TOptionsContainer = class(TInterfacedObject,IOptionsContainer)
167169
procedure SetReloadIfFileChanged(const Value: Boolean);
168170
function GetOptions(aOptionClass : TOptionsClass): TOptions; overload;
169171
function GetOptions(aIndex : Integer) : TOptions; overload;
170-
function GetSection(aOptionsSection : TOptionsClass; aOptions : TOptions) : Boolean; overload;
172+
function GetSection(aOptionsSection : TOptionsClass; var vOptions : TOptions) : Boolean; overload;
171173
public
172174
constructor Create(const aFilename : string; aOptionsSerializer : IOptionsSerializer; aReloadIfFileChanged : Boolean = False);
173175
destructor Destroy; override;
@@ -282,7 +284,7 @@ function TOptionsContainer.GetOptions(aIndex: Integer): TOptions;
282284
Result := fSections[aIndex];
283285
end;
284286

285-
function TOptionsContainer.GetSection(aOptionsSection: TOptionsClass; aOptions: TOptions): Boolean;
287+
function TOptionsContainer.GetSection(aOptionsSection: TOptionsClass; var vOptions: TOptions): Boolean;
286288
var
287289
option : TOptions;
288290
begin
@@ -291,7 +293,7 @@ function TOptionsContainer.GetSection(aOptionsSection: TOptionsClass; aOptions:
291293
begin
292294
if option is TOptionsClass then
293295
begin
294-
aOptions := option as TOptionsClass;
296+
vOptions := option as TOptionsClass;
295297
Exit;
296298
end;
297299
end;
@@ -396,16 +398,27 @@ constructor TOptions.Create;
396398
fName := '';
397399
end;
398400

401+
procedure TOptions.DefaultValues;
402+
begin
403+
//nothing
404+
end;
405+
399406
procedure TOptions.DoValidateOptions;
407+
begin
408+
ValidateObject(Self);
409+
end;
410+
411+
procedure TOptions.ValidateObject(aObj : TObject);
400412
var
401413
ctx : TRttiContext;
402414
rtype : TRttiType;
403415
rprop : TRttiProperty;
404416
attrib : TCustomAttribute;
417+
rvalue : TValue;
405418
begin
406419
ctx := TRttiContext.Create;
407420
try
408-
rtype := ctx.GetType(Self.ClassInfo);
421+
rtype := ctx.GetType(aObj.ClassInfo);
409422
for rprop in rtype.GetProperties do
410423
begin
411424
//check only published properties
@@ -414,9 +427,45 @@ procedure TOptions.DoValidateOptions;
414427
//check validation option attributes
415428
for attrib in rprop.GetAttributes do
416429
begin
417-
if attrib is Required then ValidateRequired(rprop)
418-
else if attrib is StringLength then ValidateStringLength(rprop,StringLength(attrib))
419-
else if attrib is Range then ValidateRange(rprop,Range(attrib));
430+
if attrib is Required then ValidateRequired(aObj,rprop)
431+
else if attrib is StringLength then ValidateStringLength(aObj,rprop,StringLength(attrib))
432+
else if attrib is Range then ValidateRange(aObj,rprop,Range(attrib));
433+
end;
434+
rvalue := rprop.GetValue(aObj);
435+
if not rvalue.IsEmpty then
436+
begin
437+
case rvalue.Kind of
438+
tkClass : ValidateObject(rvalue.AsObject);
439+
tkDynArray : ValidateArray(rvalue);
440+
end;
441+
end;
442+
end;
443+
end;
444+
finally
445+
ctx.Free;
446+
end;
447+
end;
448+
449+
procedure TOptions.ValidateArray(aValue : TValue);
450+
type
451+
PPByte = ^PByte;
452+
var
453+
ctx : TRttiContext;
454+
rDynArray : TRttiDynamicArrayType;
455+
itvalue : TValue;
456+
i : Integer;
457+
begin
458+
ctx := TRttiContext.Create;
459+
try
460+
rDynArray := ctx.GetType(aValue.TypeInfo) as TRTTIDynamicArrayType;
461+
for i := 0 to aValue.GetArrayLength - 1 do
462+
begin
463+
TValue.Make(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType.Handle,itvalue);
464+
if not itvalue.IsEmpty then
465+
begin
466+
case itvalue.Kind of
467+
tkClass : ValidateObject(itvalue.AsObject);
468+
tkDynArray : ValidateArray(itvalue);
420469
end;
421470
end;
422471
end;
@@ -437,19 +486,19 @@ procedure TOptions.ValidateOptions;
437486
end;
438487
end;
439488

440-
procedure TOptions.ValidateRange(aProperty: TRttiProperty; aValidation : Range);
489+
procedure TOptions.ValidateRange(const aInstance : TObject; aProperty: TRttiProperty; aValidation : Range);
441490
var
442491
value : TValue;
443492
msg : string;
444493
begin
445-
value := aProperty.GetValue(Self);
494+
value := aProperty.GetValue(aInstance);
446495
if not value.IsEmpty then
447496
begin
448497
if value.Kind = tkFloat then
449498
begin
450499
if (value.AsExtended < aValidation.Min) or (value.AsExtended > aValidation.Max) then
451500
begin
452-
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option "%s.%s" exceeds predefined range (%2f - %2f)',[Self.Name,aProperty.Name,aValidation.Min,aValidation.Max])
501+
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%2f - %2f)',[Self.Name,aInstance.ClassName,aProperty.Name,aValidation.Min,aValidation.Max])
453502
else msg := aValidation.ErrorMsg;
454503
raise EOptionValidationError.Create(msg);
455504
end;
@@ -458,28 +507,28 @@ procedure TOptions.ValidateRange(aProperty: TRttiProperty; aValidation : Range);
458507
begin
459508
if (value.AsInt64 < aValidation.Min) or (value.AsInt64 > aValidation.Max) then
460509
begin
461-
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option "%s.%s" exceeds predefined range (%d - %d)',[Self.Name,aProperty.Name,Round(aValidation.Min),Round(aValidation.Max)])
510+
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds predefined range (%d - %d)',[Self.Name,aInstance.ClassName,aProperty.Name,Round(aValidation.Min),Round(aValidation.Max)])
462511
else msg := aValidation.ErrorMsg;
463512
raise EOptionValidationError.Create(msg);
464513
end;
465514
end;
466515
end;
467516
end;
468517

469-
procedure TOptions.ValidateRequired(aProperty: TRttiProperty);
518+
procedure TOptions.ValidateRequired(const aInstance : TObject; aProperty: TRttiProperty);
470519
begin
471-
if aProperty.GetValue(Self).IsEmpty then raise EOptionValidationError.CreateFmt('Option "%s.%s" is required',[Self.Name,aProperty.Name]);
520+
if aProperty.GetValue(aInstance).IsEmpty then raise EOptionValidationError.CreateFmt('Option %s "%s.%s" is required',[Self.Name,aInstance.ClassName,aProperty.Name]);
472521
end;
473522

474-
procedure TOptions.ValidateStringLength(aProperty: TRttiProperty; aValidation : StringLength);
523+
procedure TOptions.ValidateStringLength(const aInstance : TObject; aProperty: TRttiProperty; aValidation : StringLength);
475524
var
476525
value : TValue;
477526
msg : string;
478527
begin
479-
value := aProperty.GetValue(Self);
528+
value := aProperty.GetValue(aInstance);
480529
if (not value.IsEmpty) and (value.AsString.Length > aValidation.MaxLength) then
481530
begin
482-
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option "%s.%s" exceeds max length (%d)',[Self.Name,aProperty.Name,aValidation.MaxLength])
531+
if aValidation.ErrorMsg.IsEmpty then msg := Format('Option %s "%s.%s" exceeds max length (%d)',[Self.Name,aInstance.ClassName,aProperty.Name,aValidation.MaxLength])
483532
else msg := aValidation.ErrorMsg;
484533

485534
raise EOptionValidationError.Create(msg);

0 commit comments

Comments
 (0)