Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects:[830] trunk
|
From: <na...@us...> - 2009-08-16 17:00:02
|
Revision: 830
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=830&view=rev
Author: nandod
Date: 2009-08-16 16:59:53 +0000 (Sun, 16 Aug 2009)
Log Message:
-----------
+ New validation framework; initial implementation substitutes TInstantAttributeMatadata.ValidChars; can be extended. Tests added.
- Removed unused TChars support in filers. Limited use of TChars (ANSI-only) to where strictly necessary.
* Fixed: writing to a blob did not always correctly set IsChanged (historical error, probably).
* Fixed: ValidChars was not always correctly applied in blob fields (historical error, probably),
* Removed a few warnings on D2007/D2009.
Modified Paths:
--------------
trunk/Source/Brokers/ADO/InstantADOTools.pas
trunk/Source/Brokers/ADS/InstantADS.pas
trunk/Source/Core/D2007/IOCore.dpk
trunk/Source/Core/D2007/IOCore.dproj
trunk/Source/Core/D2009/IOCore.dpk
trunk/Source/Core/D2009/IOCore.dproj
trunk/Source/Core/D2009/IOCore.res
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantUtils.pas
trunk/Source/Design/InstantModelExpert.pas
trunk/Source/Design/InstantModelImport.pas
trunk/Tests/TestIO.dproj
trunk/Tests/TestIO_D2009.mdr
trunk/Tests/TestIO_D2009.mdrt
trunk/Tests/TestIO_D2009.mdx
trunk/Tests/TestIO_D2009.mdxt
trunk/Tests/TestInstantAttributeMetadata.pas
trunk/Tests/TestInstantBlob.pas
trunk/Tests/TestInstantParts.pas
trunk/Tests/TestInstantReferences.pas
trunk/Tests/TestModel.pas
trunk/Tests/ubmock/src/fpcunit.pas
Added Paths:
-----------
trunk/Source/Core/InstantStandardValidators.pas
trunk/Source/Core/InstantValidation.pas
Property Changed:
----------------
trunk/Source/Brokers/ADO/
trunk/Source/Brokers/ADS/
trunk/Source/Core/D2009/
trunk/Tests/ubmock/src/
Property changes on: trunk/Source/Brokers/ADO
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.~pas
*.~dfm
+ *.dcu
*.~pas
*.~dfm
__history
Modified: trunk/Source/Brokers/ADO/InstantADOTools.pas
===================================================================
--- trunk/Source/Brokers/ADO/InstantADOTools.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Brokers/ADO/InstantADOTools.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -32,7 +32,7 @@
interface
uses
- ADODB, InstantADOJRO, SysUtils;
+ ADODB, InstantADOJRO;
type
TInstantADOSyncType = (stSend, stReceive, stSendReceive);
@@ -51,6 +51,9 @@
implementation
+uses
+ Windows, SysUtils;
+
const
SMSJetProvider = 'Microsoft.Jet.OLEDB.4.0';
Property changes on: trunk/Source/Brokers/ADS
___________________________________________________________________
Added: svn:ignore
+ __history
Modified: trunk/Source/Brokers/ADS/InstantADS.pas
===================================================================
--- trunk/Source/Brokers/ADS/InstantADS.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Brokers/ADS/InstantADS.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -178,13 +178,13 @@
function TInstantADSConnectionDef.GetDatabaseName: string;
const
- ValidChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+ LValidChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
var
I: Integer;
begin
Result := Name;
for I := 1 to Length(Result) do
- if not (Result[I] in ValidChars) then
+ if not (Result[I] in LValidChars) then
Result[I] := '_';
end;
Modified: trunk/Source/Core/D2007/IOCore.dpk
===================================================================
--- trunk/Source/Core/D2007/IOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2007/IOCore.dpk 2009-08-16 16:59:53 UTC (rev 830)
@@ -56,6 +56,8 @@
InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm},
InstantTypes in '..\InstantTypes.pas',
InstantBrokers in '..\InstantBrokers.pas',
- InstantMetadata in '..\InstantMetadata.pas';
+ InstantMetadata in '..\InstantMetadata.pas',
+ InstantStandardValidators in '..\InstantStandardValidators.pas',
+ InstantValidation in '..\InstantValidation.pas';
end.
Modified: trunk/Source/Core/D2007/IOCore.dproj
===================================================================
--- trunk/Source/Core/D2007/IOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2007/IOCore.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -6,7 +6,7 @@
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
- <DCC_DependencyCheckOutputName>..\..\..\..\..\..\..\Documents\RAD Studio\5.0\Bpl\IOCore_D11.bpl</DCC_DependencyCheckOutputName>
+ <DCC_DependencyCheckOutputName>C:\Users\nandod\Documents\RAD Studio\5.0\Bpl\IOCore_D11.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
@@ -24,17 +24,16 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</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><Package_Options><Package_Options Name="PackageDescription">InstantObjects Run-Time Package (Delphi 2007)</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">_D11</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</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">1040</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">www.instantobjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">IOCore.dpk</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><Package_Options><Package_Options Name="PackageDescription">InstantObjects Run-Time Package (Delphi 2007)</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">_D11</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</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">1040</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">www.instantobjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">IOCore.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="IOCore.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
- <DCCReference Include="..\..\PackageGroups\D2007\rtl.dcp" />
- <DCCReference Include="..\..\PackageGroups\D2007\vcl.dcp" />
- <DCCReference Include="..\..\PackageGroups\D2007\vcldb.dcp" />
+ <DCCReference Include="..\..\..\Tests\rtl.dcp" />
+ <DCCReference Include="..\..\..\Tests\vcl.dcp" />
+ <DCCReference Include="..\..\..\Tests\vcldb.dcp" />
<DCCReference Include="..\InstantAccessors.pas" />
<DCCReference Include="..\InstantBrokers.pas" />
<DCCReference Include="..\InstantClasses.pas" />
@@ -64,8 +63,10 @@
<DCCReference Include="..\InstantPresentation.pas" />
<DCCReference Include="..\InstantPump.pas" />
<DCCReference Include="..\InstantRtti.pas" />
+ <DCCReference Include="..\InstantStandardValidators.pas" />
<DCCReference Include="..\InstantTextFiler.pas" />
<DCCReference Include="..\InstantTypes.pas" />
<DCCReference Include="..\InstantUtils.pas" />
+ <DCCReference Include="..\InstantValidation.pas" />
</ItemGroup>
</Project>
\ No newline at end of file
Property changes on: trunk/Source/Core/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
*.identcache
+ *.dcu
*.local
*.identcache
__history
Modified: trunk/Source/Core/D2009/IOCore.dpk
===================================================================
--- trunk/Source/Core/D2009/IOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2009/IOCore.dpk 2009-08-16 16:59:53 UTC (rev 830)
@@ -56,6 +56,8 @@
InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm},
InstantTypes in '..\InstantTypes.pas',
InstantBrokers in '..\InstantBrokers.pas',
- InstantMetadata in '..\InstantMetadata.pas';
+ InstantMetadata in '..\InstantMetadata.pas',
+ InstantStandardValidators in '..\InstantStandardValidators.pas',
+ InstantValidation in '..\InstantValidation.pas';
end.
Modified: trunk/Source/Core/D2009/IOCore.dproj
===================================================================
--- trunk/Source/Core/D2009/IOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2009/IOCore.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -86,6 +86,8 @@
<DCCReference Include="..\InstantTypes.pas"/>
<DCCReference Include="..\InstantBrokers.pas"/>
<DCCReference Include="..\InstantMetadata.pas"/>
+ <DCCReference Include="..\InstantStandardValidators.pas"/>
+ <DCCReference Include="..\InstantValidation.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Modified: trunk/Source/Core/D2009/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -50,11 +50,7 @@
InstantBufferSize = 4096;
type
-{$IFDEF D12+}
- TChars = set of AnsiChar; // Avoid WideChar reduced to byte warning
-{$ELSE}
- TChars = set of Char;
-{$ENDIF}
+ TChars = set of AnsiChar;
{$IFDEF LINUX}
TDate = type TDateTime;
@@ -179,7 +175,6 @@
public
constructor Create(Stream: TStream; BufSize: Integer = InstantBufferSize);
procedure ReadBinary(ReadData: TStreamProc);
- function ReadCharSet: TChars;
function ReadObject(AObject: TPersistent = nil;
Arg: Pointer = nil): TPersistent; virtual;
procedure ReadProperties(AObject: TPersistent);
@@ -195,7 +190,6 @@
public
constructor Create(Stream: TStream; BufSize: Integer = InstantBufferSize);
procedure WriteBinary(WriteData: TStreamProc);
- procedure WriteCharSet(CharSet: TChars);
procedure WriteObject(AObject: TPersistent); virtual;
procedure WriteProperties(AObject: TPersistent);
{$IFNDEF UNICODE}
@@ -976,11 +970,6 @@
end;
end;
-function TInstantReader.ReadCharSet: TChars;
-begin
- Result := InstantStrToCharSet(ReadStr);
-end;
-
function TInstantReader.ReadObject(AObject: TPersistent;
Arg: Pointer): TPersistent;
@@ -1068,11 +1057,6 @@
inherited WriteBinary(WriteData);
end;
-procedure TInstantWriter.WriteCharSet(CharSet: TChars);
-begin
- WriteStr(InstantCharSetToStr(CharSet));
-end;
-
procedure TInstantWriter.WriteObject(AObject: TPersistent);
begin
WriteUTF8Str(AObject.ClassName);
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantCode.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -871,12 +871,12 @@
function GetSubClass(Index: Integer): TInstantCodeClass;
function GetSubClassCount: Integer;
function GetSubClassList: TList;
- function GetUnitName: string;
+ function GetPascalUnitName: string;
procedure SetBaseClass(const Value: TInstantCodeClass);
procedure SetBaseClassName(const Value: string);
procedure SetPersistence(const Value: TInstantPersistence);
procedure SetStorageName(const Value: string);
- procedure SetUnitName(const Value: string);
+ procedure SetPascalUnitName(const Value: string);
procedure RemoveDivision(Division: TInstantCodeDivision);
procedure SetSubClass(Index: Integer; const Value: TInstantCodeClass);
protected
@@ -959,7 +959,7 @@
property BaseClassName: string read GetBaseClassName write SetBaseClassName;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
- property UnitName: string read GetUnitName write SetUnitName;
+ property PascalUnitName: string read GetPascalUnitName write SetPascalUnitName;
end;
TInstantCodeClassList = class(TList)
@@ -1258,7 +1258,7 @@
function GetProgramSection: TInstantCodeProgramSection;
function GetTypeCount: Integer;
function GetTypes(Index: Integer): TInstantCodeType;
- function GetUnitName: string;
+ function GetPascalUnitName: string;
procedure SetModuleTypeName(const Value: string);
protected
function GetModule: TInstantCodeModule; override;
@@ -1291,7 +1291,7 @@
property TypeCount: Integer read GetTypeCount;
property Types[Index: Integer]: TInstantCodeType read GetTypes;
published
- property UnitName: string read GetUnitName;
+ property PascalUnitName: string read GetPascalUnitName;
end;
TInstantCodeProject = class(TInstantCodeObject)
@@ -5251,9 +5251,9 @@
Result := FSubClassList;
end;
-function TInstantCodeClass.GetUnitName: string;
+function TInstantCodeClass.GetPascalUnitName: string;
begin
- Result := Module.UnitName;
+ Result := Module.PascalUnitName;
end;
class function TInstantCodeClass.Identifier: string;
@@ -5439,7 +5439,7 @@
SubClassList[Index] := Value;
end;
-procedure TInstantCodeClass.SetUnitName(const Value: string);
+procedure TInstantCodeClass.SetPascalUnitName(const Value: string);
var
NewModule: TInstantCodeModule;
begin
@@ -6986,7 +6986,7 @@
Result := TInstantCodeType(FTypes[Index]);
end;
-function TInstantCodeModule.GetUnitName: string;
+function TInstantCodeModule.GetPascalUnitName: string;
begin
Result := ChangeFileExt(ExtractFileName(Name), '');
end;
@@ -7006,7 +7006,7 @@
procedure TInstantCodeModule.InternalWrite(Writer: TInstantCodeWriter);
begin
- Writer.WriteLnFmt('%s %s;', [ModuleTypeName, UnitName]);
+ Writer.WriteLnFmt('%s %s;', [ModuleTypeName, PascalUnitName]);
Writer.WriteLn;
InterfaceSection.Write(Writer);
ImplementationSection.Write(Writer);
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantConsts.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -132,7 +132,7 @@
SInitializationFailed = 'Initialization failed for object of class %s: "%s"';
SInvalidArgument = 'Invalid argument for object of class %s. Expected argument of class %s';
SInvalidAttributeValue = 'Invalid value "%s" for attribute %s(''%s'')';
- SInvalidChar = 'Invalid character ''%s'' (#%d) for attribute %s(''%s'')';
+ SInvalidChar = 'Invalid character ''%s'' (#%d). Valid characters are ''%s''';
SInvalidClass = 'Invalid class %s. Expected %s';
SInvalidConnector = 'Invalid connector for object %s(''%s'') in attribute %s(''%s'')';
SInvalidDataType = 'Invalid data type';
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantMetadata.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -40,7 +40,8 @@
interface
-uses Classes, Contnrs, Db, InstantClasses, InstantTypes, InstantConsts;
+uses
+ Classes, Contnrs, Db, InstantClasses, InstantTypes, InstantConsts;
type
TInstantAttributeMap = class;
@@ -430,6 +431,33 @@
write SetItems; default;
end;
+ TInstantValidator = class
+ private
+ FMetadata: TInstantAttributeMetadata;
+ public
+ // A reference to the metadata. Should be set by CreateValidator on
+ // the created instance.
+ property Metadata: TInstantAttributeMetadata read FMetadata write FMetadata;
+ // Creates and returns a validator instance suitable for the specified
+ // metadata, or nil if the class doesn't apply to the metadata.
+ { TODO : extend this to support class-level validation? }
+ class function CreateValidator(const AMetadata: TInstantAttributeMetadata):
+ TInstantValidator; virtual;
+ // Should check the value against the validation settings
+ // that are specific for each derived class, and return
+ // True if the value is valid for the attribute.
+ // Otherwise, this method should return False and set an appropriate
+ // error message in AValidationErrorText.
+ // When this method is called, AAttribute is guaranteed to be assigned.
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean; virtual; abstract;
+ // Raises an exception if the proposed value is not valid for
+ // the attribute.
+ procedure Validate(const AAttribute: TInstantAbstractAttribute; const AValue: string);
+ end;
+
+ TInstantValidatorClass = class of TInstantValidator;
+
TInstantAttributeMetadata = class(TInstantMetadata)
private
FAttributeType: TInstantAttributeType;
@@ -442,9 +470,10 @@
FObjectClassName: string;
FSize: Integer;
FStorageName: string;
- FValidChars: TChars;
+ FValidCharsString: string;
FStorageKind: TInstantStorageKind;
FExternalStorageName: string;
+ FValidator: TInstantValidator;
function GetAttributeClass: TInstantAbstractAttributeClass;
function GetAttributeClassName: string;
function GetAttributeTypeName: string;
@@ -458,7 +487,6 @@
function GetObjectClass: TInstantAbstractObjectClass;
function GetObjectClassMetadata: TInstantClassMetadata;
function GetTableName: string;
- function GetValidChars: TChars;
function GetValidCharsString: string;
procedure SetAttributeClass(const AClass: TInstantAbstractAttributeClass);
procedure SetAttributeClassName(const Value: string);
@@ -466,15 +494,22 @@
procedure SetCollection(Value: TInstantAttributeMetadatas);
procedure SetFieldName(const Value: string);
procedure SetIsDefault(const Value: Boolean);
- procedure SetValidCharsString(const Value: string);
+ procedure SetValidCharsString(const AValue: string);
+ function GetValidator: TInstantValidator;
+ // Should be called whenever a validation-related property,
+ // such as ValidCharsString, changes.
+ procedure FreeValidator;
+ protected
+ property Validator: TInstantValidator read GetValidator;
public
- function CreateAttribute(AObject: TInstantAbstractObject):
- TInstantAbstractAttribute;
+ function CreateAttribute(
+ AObject: TInstantAbstractObject): TInstantAbstractAttribute;
procedure Assign(Source: TPersistent); override;
procedure CheckAttributeClass(AClass: TInstantAbstractAttributeClass);
procedure CheckCategory(ACategory: TInstantAttributeCategory);
procedure CheckIsIndexed;
function IsAttributeClass(AClass: TInstantAbstractAttributeClass): Boolean;
+ destructor Destroy; override;
property AttributeClass: TInstantAbstractAttributeClass
read GetAttributeClass write SetAttributeClass;
property AttributeClassName: string read GetAttributeClassName
@@ -490,7 +525,8 @@
property FieldName: string read GetFieldName write SetFieldName;
property HasValidChars: Boolean read GetHasValidChars;
property TableName: string read GetTableName;
- property ValidChars: TChars read GetValidChars write FValidChars;
+ procedure ValidateAttribute(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string);
published
property AttributeType: TInstantAttributeType read FAttributeType
write FAttributeType default atUnknown;
@@ -535,7 +571,9 @@
implementation
-uses SysUtils, TypInfo, InstantPersistence, InstantUtils;
+uses
+ SysUtils, TypInfo, InstantPersistence, InstantUtils, InstantValidation,
+ InstantStandardValidators {registers the standard validators - do not remove};
const
AttributeClasses: array[TInstantAttributeType] of TInstantAttributeClass = (
@@ -1655,7 +1693,7 @@
Self.FStorageName := FStorageName;
Self.FStorageKind := FStorageKind;
Self.FExternalStorageName := FExternalStorageName;
- Self.FValidChars := FValidChars;
+ Self.FValidCharsString := FValidCharsString;
end;
end;
@@ -1700,6 +1738,17 @@
Result := AClass.Create(TInstantObject(AObject), Self);
end;
+destructor TInstantAttributeMetadata.Destroy;
+begin
+ FreeAndNil(FValidator);
+ inherited;
+end;
+
+procedure TInstantAttributeMetadata.FreeValidator;
+begin
+ FreeAndNil(FValidator);
+end;
+
function TInstantAttributeMetadata.GetAttributeClass:
TInstantAbstractAttributeClass;
begin
@@ -1766,7 +1815,7 @@
function TInstantAttributeMetadata.GetHasValidChars: Boolean;
begin
- Result := FValidChars <> [];
+ Result := FValidCharsString <> '';
end;
function TInstantAttributeMetadata.GetIsDefault: Boolean;
@@ -1798,14 +1847,16 @@
Result := '';
end;
-function TInstantAttributeMetadata.GetValidChars: TChars;
+function TInstantAttributeMetadata.GetValidator: TInstantValidator;
begin
- Result := FValidChars;
+ if not Assigned(FValidator) then
+ FValidator := InstantValidatorFactory.CreateValidator(Self);
+ Result := FValidator;
end;
function TInstantAttributeMetadata.GetValidCharsString: string;
begin
- Result := InstantCharSetToStr(FValidChars);
+ Result := FValidCharsString;
end;
function TInstantAttributeMetadata.IsAttributeClass(AClass:
@@ -1883,11 +1934,21 @@
end;
end;
-procedure TInstantAttributeMetadata.SetValidCharsString(const Value: string);
+procedure TInstantAttributeMetadata.SetValidCharsString(const AValue: string);
begin
- FValidChars := InstantStrToCharSet(Value);
+ if AValue <> FValidCharsString then
+ begin
+ FreeValidator;
+ FValidCharsString := AValue;
+ end;
end;
+procedure TInstantAttributeMetadata.ValidateAttribute(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string);
+begin
+ Validator.Validate(AAttribute, AValue);
+end;
+
constructor TInstantAttributeMetadatas.Create(AOwner: TInstantClassMetadata);
begin
inherited Create(AOwner, TInstantAttributeMetadata);
@@ -1942,5 +2003,23 @@
inherited Items[Index] := Value;
end;
+{ TInstantValidator }
+
+class function TInstantValidator.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+begin
+ Result := Create;
+ Result.Metadata := AMetadata;
+end;
+
+procedure TInstantValidator.Validate(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string);
+var
+ LValidationErrorText: string;
+begin
+ if not IsValid(AAttribute, AValue, LValidationErrorText) then
+ raise EInstantValidationError.Create(LValidationErrorText);
+end;
+
end.
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -196,8 +196,8 @@
procedure SetAsVariant(AValue: Variant); virtual;
procedure SetIsChanged(Value: Boolean);
procedure SetOwner(AOwner: TInstantObject); virtual;
- procedure StringValidationError(InvalidChar: Char);
procedure WriteName(Writer: TInstantWriter);
+ procedure Validate(const AValue: string); virtual;
public
constructor Create(AOwner: TInstantAbstractObject = nil; AMetadata:
TInstantCollectionItem = nil); override;
@@ -1613,23 +1613,6 @@
ObjectNotifiers: TInstantObjectNotifiers;
DefaultConnector: TInstantConnector;
-{ Local Routines }
-
-function ValidateChars(Buffer: PChar; BufferLength: Integer;
- ValidChars: TChars; var InvalidChar: Char): Boolean;
-var
- I: Integer;
-begin
- Result := True;
- for I := 0 to Pred(BufferLength div SizeOf(Char)) do
- if (ValidChars <> []) and not (InstantCharInSet(Buffer[I], ValidChars + [#8, #10, #13])) then
- begin
- Result := False;
- InvalidChar := Buffer[I];
- Break;
- end;
-end;
-
{ Global routines }
procedure AssignInstantStreamFormat(Strings: TStrings);
@@ -2537,15 +2520,15 @@
AsVariant := AValue;
end;
-procedure TInstantAttribute.StringValidationError(InvalidChar: Char);
+procedure TInstantAttribute.Unchanged;
begin
- raise EInstantValidationError.CreateFmt(SInvalidChar,
- [InvalidChar, Ord(InvalidChar), ClassName, Name]);
+ IsChanged := False;
end;
-procedure TInstantAttribute.Unchanged;
+procedure TInstantAttribute.Validate(const AValue: string);
begin
- IsChanged := False;
+ if Assigned(Metadata) then
+ Metadata.ValidateAttribute(Self, AValue);
end;
procedure TInstantAttribute.WriteName(Writer: TInstantWriter);
@@ -3257,12 +3240,8 @@
end;
procedure TInstantString.SetValue(const AValue: string);
-var
- InvalidChar: Char;
begin
- if Assigned(Metadata) and not ValidateChars(PChar(AValue), Length(AValue),
- Metadata.ValidChars, InvalidChar) then
- StringValidationError(InvalidChar);
+ Validate(AValue);
if AValue <> FValue then
begin
FValue:= AValue;
@@ -3590,16 +3569,18 @@
function TInstantBlob.Write(const Buffer; Position, Count: Integer): Integer;
var
- C: Char;
+ LValue: AnsiString;
+ LBufferPointer: {$IFDEF D12+}PByte{$ELSE}PChar{$ENDIF};
function CompareBuffers: Boolean;
var
I: Integer;
+ B: {$IFDEF D12+}Byte{$ELSE}Char{$ENDIF};
begin
Stream.Position := Position;
- for I := 0 to Pred(Count) do
+ for I := Position to Pred(Position + Count) do
begin
- Result := (Stream.Read(C, 1) = 1) and (C = PChar(@Buffer)[I]);
+ Result := (Stream.Read(B, 1) = 1) and (B = {$IFDEF D12+}PByte{$ELSE}PChar{$ENDIF}(@Buffer)[I]);
if not Result then
Exit;
end;
@@ -3607,13 +3588,17 @@
end;
begin
- if not ValidateChars(PChar(@Buffer), Count, Metadata.ValidChars, C) then
- StringValidationError(C);
+ SetLength(LValue, Count);
+ LBufferPointer := @Buffer;
+ Inc(LBufferPointer, Position);
+ StrLCopy(PAnsiChar(LValue), PAnsiChar(LBufferPointer), Count);
+ Validate(string(LValue));
if not CompareBuffers then
begin
Stream.Position := Position;
Result := Stream.Write(Buffer, Count);
- end else
+ end
+ else
Result := 0;
end;
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantPresentation.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -3654,6 +3654,32 @@
Field: TField);
var
Metadata: TInstantAttributeMetadata;
+
+ function InstantStrToCharSet(const Str: AnsiString): TFieldChars;
+ const
+ Dots: array[0..1] of Char = '..';
+ var
+ I, J: Integer;
+ begin
+ Result := [];
+ I := 1;
+ while I <= Length(Str) do
+ begin
+ if CompareMem(@Str[I], @Dots, Length(Dots)) and
+ (I > 1) and (Length(Str) > I + 1) then
+ begin
+ for J := Ord(Str[I - 1]) to Ord(Str[I + 2]) do
+ Result := Result + [Chr(J)];
+ Inc(I, Length(Dots));
+ end
+ else
+ begin
+ Include(Result, Str[I]);
+ Inc(I);
+ end;
+ end;
+ end;
+
begin
if AObject is TInstantObject then
begin
@@ -3663,8 +3689,8 @@
begin
if Field.EditMask <> Metadata.EditMask then
Field.EditMask := Metadata.EditMask;
- if Metadata.ValidChars <> [] then
- Field.ValidChars := Metadata.ValidChars;
+ if Metadata.ValidCharsString <> '' then
+ Field.ValidChars := InstantStrToCharSet(AnsiString(Metadata.ValidCharsString));
end;
end;
end;
@@ -3712,7 +3738,7 @@
FillChar(Buffer^, Field.DataSize, 0);
if not Empty then
begin
- S := Value;
+ S := AnsiString(Value);
Len := Length(S);
if Len >= Field.DataSize then
Len := Pred(Field.DataSize);
Added: trunk/Source/Core/InstantStandardValidators.pas
===================================================================
--- trunk/Source/Core/InstantStandardValidators.pas (rev 0)
+++ trunk/Source/Core/InstantStandardValidators.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -0,0 +1,282 @@
+(*
+ * InstantObjects
+ * Validation framework - standard validators.
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Seleqt InstantObjects
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Nando Dessena
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantStandardValidators;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ Contnrs, InstantClasses, InstantMetadata, InstantValidation;
+
+type
+ // Base class for classes that handle the pieces of a ValidCharsString string.
+ TInstantCharSetPieceValidator = class
+ protected
+ function GetValidCharsAsString: string; virtual;
+ public
+ function IsValidChar(const AChar: Char): Boolean; virtual; abstract;
+ property ValidCharsAsString: string read GetValidCharsAsString;
+ end;
+
+ // Validates a character against a set of distinct characters stored in a string.
+ TInstantCharsPieceValidator = class(TInstantCharSetPieceValidator)
+ private
+ FValidChars: string;
+ protected
+ function GetValidCharsAsString: string; override;
+ public
+ procedure AfterConstruction; override;
+ procedure AddChar(const AChar: Char);
+ procedure RemoveLastChar;
+ function IsValidChar(const AChar: Char): Boolean; override;
+ end;
+
+ // Validates a character against a range of characters.
+ TInstantCharRangePieceValidator = class(TInstantCharSetPieceValidator)
+ private
+ FValidFrom: Char;
+ FValidTo: Char;
+ protected
+ function GetValidCharsAsString: string; override;
+ public
+ procedure SetValidChars(const AValidFrom, AValidTo: Char);
+ function IsValidChar(const AChar: Char): Boolean; override;
+ end;
+
+ // Splits a ValidCharsString string into pieces that hands each to a
+ // different internal instance of TInstantCharSetPieceValidator.
+ TInstantCharSetValidator = class(TInstantValidator)
+ private
+ FPieces: TObjectList;
+ procedure CreatePieceValidators(const AValidChars: string);
+ function IsValidChar(const AChar: Char;
+ out AValidationErrorText: string): Boolean;
+ public
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ class function CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator; override;
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ override;
+ end;
+
+implementation
+
+uses
+ SysUtils, InstantConsts;
+
+{ TInstantCharSetValidator }
+
+procedure TInstantCharSetValidator.AfterConstruction;
+begin
+ inherited;
+ FPieces := TObjectList.Create;
+end;
+
+procedure TInstantCharSetValidator.CreatePieceValidators(
+ const AValidChars: string);
+var
+ I: Integer;
+ LCharsValidator: TInstantCharsPieceValidator;
+ LCharRangeValidator: TInstantCharRangePieceValidator;
+ LChar: Char;
+begin
+ LCharsValidator := TInstantCharsPieceValidator.Create;
+ FPieces.Add(LCharsValidator);
+ I := 1;
+ while I <= Length(AValidChars) do
+ begin
+ LChar := AValidChars[I];
+ // a..b means a range from a to b.
+ if (LChar = '.') and (I > 1) and (I < Length(AValidChars) - 1) and (AValidChars[Succ(I)] = '.') then
+ begin
+ LCharRangeValidator := TInstantCharRangePieceValidator.Create;
+ FPieces.Add(LCharRangeValidator);
+ LCharRangeValidator.SetValidChars(AValidChars[Pred(I)],
+ AValidChars[I + 2]);
+ // no need for the chars validator to take care of the first char in
+ // my range.
+ LCharsValidator.RemoveLastChar;
+ // skip the second dot and the range end char.
+ Inc(I, 2);
+ end
+ // everything else is a simple match.
+ else
+ LCharsValidator.AddChar(LChar);
+ Inc(I);
+ end;
+end;
+
+class function TInstantCharSetValidator.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+begin
+ if Assigned(AMetadata) and (AMetadata.ValidCharsString <> '') then
+ begin
+ Result := Create;
+ try
+ Result.Metadata := AMetadata;
+ TInstantCharSetValidator(Result).CreatePieceValidators(AMetadata.ValidCharsString);
+ except
+ FreeAndNil(Result);
+ raise;
+ end;
+ end
+ else
+ Result := nil;
+end;
+
+destructor TInstantCharSetValidator.Destroy;
+begin
+ FreeAndNil(FPieces);
+ inherited;
+end;
+
+function TInstantCharSetValidator.IsValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := True;
+ for I := 1 to Length(AValue) do
+ begin
+ if not IsValidChar(AValue[I], AValidationErrorText) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+ if not Result then
+ AValidationErrorText := Format(SInvalidAttributeValue, [AValue,
+ AAttribute.ClassName, Metadata.Name]) + sLineBreak +
+ AValidationErrorText;
+end;
+
+function TInstantCharSetValidator.IsValidChar(
+ const AChar: Char; out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := False;
+ AValidationErrorText := '';
+ for I := 0 to FPieces.Count - 1 do
+ begin
+ if TInstantCharSetPieceValidator(FPieces[I]).IsValidChar(AChar) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+ if not Result then
+ AValidationErrorText := Format(SInvalidChar, [AChar, Ord(AChar), Metadata.ValidCharsString]);
+end;
+
+{ TInstantCharSetPieceValidator }
+
+function TInstantCharSetPieceValidator.GetValidCharsAsString: string;
+begin
+ Result := '';
+end;
+
+{ TInstantCharsPieceValidator }
+
+procedure TInstantCharsPieceValidator.AddChar(const AChar: Char);
+begin
+ if Pos(AChar, FValidChars) = 0 then
+ FValidChars := FValidChars + AChar;
+end;
+
+procedure TInstantCharsPieceValidator.AfterConstruction;
+begin
+ inherited;
+ // This is for backward compatibility, as IO has always allowed these
+ // characters in a string or memo when ValidCharsString is not empty.
+ // I don't think this is strictly correct, especially for string fields.
+ FValidChars := #8#10#13;
+end;
+
+function TInstantCharsPieceValidator.GetValidCharsAsString: string;
+begin
+ Result := FValidChars;
+end;
+
+function TInstantCharsPieceValidator.IsValidChar(const AChar: Char): Boolean;
+begin
+ Result := Pos(AChar, FValidChars) > 0;
+end;
+
+procedure TInstantCharsPieceValidator.RemoveLastChar;
+begin
+ if FValidChars <> '' then
+ Delete(FValidChars, Length(FValidChars) , 1);
+end;
+
+{ TInstantCharRangePieceValidator }
+
+function TInstantCharRangePieceValidator.GetValidCharsAsString: string;
+begin
+ Result := FValidFrom + '..' + FValidTo;
+end;
+
+function TInstantCharRangePieceValidator.IsValidChar(const AChar: Char): Boolean;
+begin
+ Result := (AChar >= FValidFrom) and (AChar <= FValidTo);
+end;
+
+procedure TInstantCharRangePieceValidator.SetValidChars(const AValidFrom,
+ AValidTo: Char);
+begin
+ if AValidFrom > AValidTo then
+ begin
+ FValidFrom := AValidTo;
+ FValidTo := AValidFrom;
+ end
+ else
+ begin
+ FValidFrom := AValidFrom;
+ FValidTo := AValidTo;
+ end;
+end;
+
+initialization
+ InstantValidatorFactory.AddValidatorClass(TInstantCharSetValidator);
+
+finalization
+ InstantValidatorFactory.RemoveValidatorClass(TInstantCharSetValidator);
+
+end.
+
Property changes on: trunk/Source/Core/InstantStandardValidators.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Modified: trunk/Source/Core/InstantUtils.pas
===================================================================
--- trunk/Source/Core/InstantUtils.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantUtils.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -50,7 +50,6 @@
Major, Minor, Release, Build: Word;
end;
-function InstantCharSetToStr(C: TChars): string;
function InstantCompareObjects(Obj1, Obj2: TObject; PropName: string;
Options: TInstantCompareOptions): Integer; overload;
function InstantCompareObjects(Obj1, Obj2: TObject; PropNames: TStrings;
@@ -82,7 +81,6 @@
function InstantSameText(const S1, S2: string; IgnoreCase: Boolean): Boolean;
function InstantStrToDate(const Str: string): TDateTime;
function InstantStrToDateTime(const Str: string): TDateTime;
-function InstantStrToCharSet(const Str: AnsiString): TChars;
procedure InstantStrToList(const Str: string; List: TStrings;
Delimiters: TChars);
function InstantStrToTime(const Str: string): TDateTime;
@@ -109,37 +107,6 @@
{$ENDIF}
{$IFDEF D6+}Variants,{$ENDIF} InstantConsts, InstantRtti;
-function InstantCharSetToStr(C: TChars): string;
-var
- I, J, L: Integer;
- S: string;
-begin
- Result := '';
- for I := 0 to 255 do
- if InstantCharInSet(Chr(I), C) then
- S := S + Chr(I);
- I := 1;
- L := Length(S);
- Result := '';
- while I <= L do
- begin
- J := 1;
- Result := Result + S[I];
- while ((I + J) <= L) and (Ord(S[I]) + J = Ord(S[I + J])) do
- Inc(J);
- if J > 3 then
- Result := Result + '..' + S[I + J - 1]
- else
- while J > 1 do
- begin
- Inc(I);
- Dec(J);
- Result := Result + S[I];
- end;
- I := I + J;
- end;
-end;
-
function InstantCompareObjects(Obj1, Obj2: TObject; PropName: string;
Options: TInstantCompareOptions): Integer;
var
@@ -541,31 +508,6 @@
end;
end;
-function InstantStrToCharSet(const Str: AnsiString): TChars;
-const
- Dots: array[0..1] of Char = '..';
-var
- I, J: Integer;
-begin
- Result := [];
- I := 1;
- while I <= Length(Str) do
- begin
- if CompareMem(@Str[I], @Dots, Length(Dots)) and
- (I > 1) and (Length(Str) > I + 1) then
- begin
- for J := Ord(Str[I - 1]) to Ord(Str[I + 2]) do
- Result := Result + [Chr(J)];
- Inc(I, Length(Dots));
- end
- else
- begin
- Include(Result, Str[I]);
- Inc(I);
- end;
- end;
-end;
-
procedure InstantStrToList(const Str: string; List: TStrings;
Delimiters: TChars);
Added: trunk/Source/Core/InstantValidation.pas
===================================================================
--- trunk/Source/Core/InstantValidation.pas (rev 0)
+++ trunk/Source/Core/InstantValidation.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -0,0 +1,230 @@
+(*
+ * InstantObjects
+ * Validation framework
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Seleqt InstantObjects
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Nando Dessena
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantValidation;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ Contnrs, InstantClasses, InstantMetadata, InstantPersistence;
+
+type
+ TInstantValidatorListValidationMode = (vmAll, vmAny);
+
+ // A validator that is a list of validators (composite).
+ // Shouldn't be registered as it's used directly by the
+ // factory as a wrapper for multiple validators and also as a null object,
+ // for when no validators apply. It is also a base class for other
+ // validators.
+ TInstantValidatorList = class(TInstantValidator)
+ private
+ FValidators: TObjectList;
+ FConcatMode: TInstantValidatorListValidationMode;
+ function AllValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ function AnyValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ public
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ override;
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ // Adds a validator to the inner list.
+ procedure Add(const AValidator: TInstantValidator);
+ // Decides whether validators in lists should all pass for a value to be
+ // accepted (vmAll) or if any one of them suffices (vmAny).
+ property ConcatMode: TInstantValidatorListValidationMode
+ read FConcatMode write FConcatMode default vmAll;
+ end;
+
+ // Creates validators based on metadata contents.
+ TInstantValidatorFactory = class
+ private
+ FClasses: TClassList;
+ public
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+
+ procedure AddValidatorClass(const AValidatorClass: TInstantValidatorClass);
+ procedure RemoveValidatorClass(const AValidatorClass: TInstantValidatorClass);
+
+ { TODO : Extend this for class-level validation? }
+ function CreateValidator(const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+ end;
+
+function InstantValidatorFactory: TInstantValidatorFactory;
+
+implementation
+
+uses
+ SysUtils;
+
+var
+ _InstantValidatorFactory: TInstantValidatorFactory;
+
+function InstantValidatorFactory: TInstantValidatorFactory;
+begin
+ if not Assigned(_InstantValidatorFactory) then
+ _InstantValidatorFactory := TInstantValidatorFactory.Create;
+ Result := _InstantValidatorFactory;
+end;
+
+{ TInstantValidatorFactory }
+
+procedure TInstantValidatorFactory.AddValidatorClass(
+ const AValidatorClass: TInstantValidatorClass);
+begin
+ FClasses.Add(AValidatorClass);
+end;
+
+procedure TInstantValidatorFactory.AfterConstruction;
+begin
+ inherited;
+ FClasses := TClassList.Create;
+end;
+
+function TInstantValidatorFactory.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+var
+ I: Integer;
+begin
+ Result := TInstantValidatorList.Create;
+ try
+ for I := 0 to FClasses.Count - 1 do
+ TInstantValidatorList(Result).Add(
+ TInstantValidatorClass(FClasses[I]).CreateValidator(AMetadata));
+ except
+ FreeAndNil(Result);
+ raise;
+ end;
+end;
+
+destructor TInstantValidatorFactory.Destroy;
+begin
+ FreeAndNil(FClasses);
+ inherited;
+end;
+
+procedure TInstantValidatorFactory.RemoveValidatorClass(
+ const AValidatorClass: TInstantValidatorClass);
+begin
+ FClasses.Remove(AValidatorClass);
+end;
+
+{ TInstantValidatorList }
+
+procedure TInstantValidatorList.Add(const AValidator: TInstantValidator);
+begin
+ // It is valid for this method to receive nil and don't do anything.
+ if Assigned(AValidator) then
+ FValidators.Add(AValidator);
+end;
+
+procedure TInstantValidatorList.AfterConstruction;
+begin
+ inherited;
+ FValidators := TObjectList.Create;
+ FConcatMode := vmAll;
+end;
+
+destructor TInstantValidatorList.Destroy;
+begin
+ FreeAndNil(FValidators);
+ inherited;
+end;
+
+function TInstantValidatorList.IsValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+begin
+ if FConcatMode = vmAll then
+ Result := AllValid(AAttribute, AValue, AValidationErrorText)
+ else
+ Result := AnyValid(AAttribute, AValue, AValidationErrorText);
+end;
+
+function TInstantValidatorList.AllValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := True;
+ AValidationErrorText := '';
+ for I := 0 to FValidators.Count - 1 do
+ begin
+ if not TInstantValidator(FValidators[I]).IsValid(AAttribute, AValue, AValidationErrorText) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+end;
+
+function TInstantValidatorList.AnyValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+ LErrorText: string;
+begin
+ Result := False;
+ AValidationErrorText := '';
+ for I := 0 to FValidators.Count - 1 do
+ begin
+ if TInstantValidator(FValidators[I]).IsValid(AAttribute, AValue, LErrorText) then
+ begin
+ Result := True;
+ Break;
+ end
+ else
+ begin
+ if AValidationErrorText = '' then
+ AValidationErrorText := LErrorText
+ else
+ AValidationErrorText := AValidationErrorText + sLineBreak + LErrorText;
+ end;
+ end;
+end;
+
+initialization
+
+finalization
+ FreeAndNil(_InstantValidatorFactory);
+
+end.
+
Property changes on: trunk/Source/Core/InstantValidation.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -504,7 +504,7 @@
Editor: IOTASourceEditor;
OldLen: Integer;
begin
- Module := FIDEInterface.FindModule(AClass.Module.UnitName);
+ Module := FIDEInterface.FindModule(AClass.Module.PascalUnitName);
if not Assigned(Module) then
Exit;
Editor := FIDEInterface.SourceEditor(Module);
Modified: trunk/Source/Design/InstantModelImport.pas
===================================================================
--- trunk/Source/Design/InstantModelImport.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Design/InstantModelImport.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -114,7 +114,7 @@
for I := 0 to FModel.ModuleCount - 1 do
begin
Module := FModel.Modules[I];
- ImportModuleCombo.Items.AddObject(Module.UnitName, Module)
+ ImportModuleCombo.Items.AddObject(Module.PascalUnitName, Module)
end;
end;
Modified: trunk/Tests/TestIO.dproj
===================================================================
--- trunk/Tests/TestIO.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -37,7 +37,8 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
-<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages">vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX</Compiler></Compiler><Parameters><Parameters Name="DebugSourceDirs">..\Source\Core</Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Language><Language Name="RootDir">C:\Program Files\Borland\Delphi7\Bin\</Language></Language><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</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">3081</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">TestIO.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
+<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages">vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX</Compiler></Compiler><Parameters><Parameters Name="DebugSourceDirs">..\Source\Core</Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Language><Language Name="RootDir">C:\Program Files\Borland\Delphi7\Bin\</Language></Language><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</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">3081</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">TestIO.dpr</Source></Source></Delphi.Personality> <ModelSupport>False</ModelSupport>
+</BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
Modified: trunk/Tests/TestIO_D2009.mdr
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO_D2009.mdrt
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO_D2009.mdx
===================================================================
--- trunk/Tests/TestIO_D2009.mdx 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO_D2009.mdx 2009-08-16 16:59:53 UTC (rev 830)
@@ -230,7 +230,7 @@
<AttributeType>atCurrency</AttributeType>
<IsIndexed>FALSE</IsIndexed>
<IsRequired>FALSE</IsRequired>
- <ValidCharsString>,.09?</ValidCharsString>
+ <ValidCharsString>,.0..9€</ValidCharsString>
</TInstantAttributeMetadata>
<TInstantAttributeMetadata>
<Name>Employed</Name>
Modified: trunk/Tests/TestIO_D2009.mdxt
===================================================================
--- trunk/Tests/TestIO_D2009.mdxt 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO_D2009.mdxt 2009-08-16 16:59:53 UTC (rev 830)
@@ -214,7 +214,7 @@
<AttributeType>atCurrency</AttributeType>
<IsIndexed>FALSE</IsIndexed>
<IsRequired>FALSE</IsRequired>
- <ValidCharsString>,.09?</ValidCharsString>
+ <ValidCharsString>,.0..9€</ValidCharsString>
</TInstantAttributeMetadata>
<TInstantAttributeMetadata>
<Name>Employed</Name>
Modified: trunk/Tests/TestInstantAttributeMetadata.pas
===================================================================
--- trunk/Tests/TestInstantAttributeMetadata.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestInstantAttributeMetadata.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -41,6 +41,8 @@
// Extended test methods for class TTestCase
TTestCaseEx = class(TTestCase)
+ private
+ FTempAttr: TInstantAttribute;
public
class procedure AssertException(const AMessage: string;
AExceptionClass: ExceptClass;
@@ -85,6 +87,7 @@
private
FConn: TInstantMockConnector;
FInstantAttributeMetadata: TInstantAttributeMetadata;
+ procedure SetInvalidValueInTempAttr;
public
procedure SetUp; override;
procedure TearDown; override;
@@ -95,6 +98,7 @@
procedure TestCheckCategory;
procedure TestCheckIsIndexed;
procedure TestIsAttributeClass;
+ procedure TestAttributeValidation;
end;
// Test methods for class TInstantAttributeMetadatas
@@ -235,7 +239,7 @@
FInstantAttributeMetadata.StorageName := 'StorageName';
FInstantAttributeMetadata.StorageKind := skEmbedded;
FInstantAttributeMetadata.ExternalStorageName := 'ExternalStorageName';
- FInstantAttributeMetadata.ValidChars := ['a'..'z'];
+ FInstantAttributeMetadata.ValidCharsString := 'a..y0..9\x80 ';
end;
procedure TestTInstantAttributeMetadata.TearDown;
@@ -266,7 +270,7 @@
vSource.StorageName := 'StorageName';
vSource.StorageKind := skEmbedded;
vSource.ExternalStorageName := 'ExternalStorageName';
- vSource.ValidChars := ['a'..'z'];
+ vSource.ValidCharsString := 'a..z';
vDest.Assign(vSource);
vStr := GetEnumName(TypeInfo(TInstantAttributeType),
@@ -286,7 +290,7 @@
AssertEquals('StorageKind incorrect', 'skEmbedded', vStr);
AssertEquals('ExternalStorageName incorrect', 'ExternalStorageName',
vDest.ExternalStorageName);
- AssertTrue('ValidChars incorrect', 'i' in vDest.ValidChars);
+ AssertEquals('ValidChars incorrect', 'a..z', vDest.ValidCharsString);
finally
vSource.Free;
vDest.Free;
@@ -323,11 +327,14 @@
try
vReturnValue := FInstantAttributeMetadata.CreateAttribute(vObject)
as TInstantAttribute;
- AssertNotNull('vReturnValue', vReturnValue);
- AssertEquals('AsString', 'Default', vReturnValue.AsString);
- AssertNotNull('Metadata ', vReturnValue.Metadata);
- AssertEquals('Classname', 'TInstantString', vReturnValue.ClassName);
- vReturnValue.Free;
+ try
+ AssertNotNull('vReturnValue', vReturnValue);
+ AssertEquals('AsString', 'Default', vReturnValue.AsString);
+ AssertNotNull('Metadata ', vReturnValue.Metadata);
+ AssertEquals('Classname', 'TInstantString', vReturnValue.ClassName);
+ finally
+ vReturnValue.Free;
+ end;
finally
vObject.Free;
end;
@@ -343,6 +350,32 @@
AssertTrue('IsAttributeClass error for TInstantMetadata!', vReturnValue);
end;
+procedure TestTInstantAttributeMetadata.TestAttributeValidation;
+var
+ vObject: TInstantObject;
+begin
+ vObject := TInstantObject.Create(FConn);
+ try
+ FTempAttr := FInstantAttributeMetadata.CreateAttribute(vObject)
+ as TInstantAttribute;
+ try
+ FTempAttr.AsString := 'only valid chars';
+ AssertException(EInstantValidationError, SetInvalidValueInTempAttr);
+ AssertEquals('AsString', 'only valid chars', FTempAttr.AsString);
+ finally
+ FreeAndNil(FTempAttr);
+ end;
+ finally
+ vObject.Free;
+ end;
+end;
+
+procedure TestTInstantAttributeMetadata.SetInvalidValueInTempAttr;
+begin
+ Assert(Assigned(FTempAttr));
+ FTempAttr.AsString := 'char z not allowed';
+end;
+
{ TestTInstantAttributeMetadatas }
procedure TestTInstantAttributeMetadatas.SetUp;
Modified: trunk...
[truncated message content] |
