Proof of concept
This commit is contained in:
parent
d050b7bb1c
commit
f0aed6f1e4
|
|
@ -0,0 +1,6 @@
|
|||
__history
|
||||
Win32
|
||||
|
||||
*.local
|
||||
*.identcache
|
||||
*.res
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{CE176D45-2767-4150-B737-D72F170B25C3}</ProjectGuid>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Projects Include="UnitTests\DaintyUnitTests.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
<Projects Include="Packages\DaintyDXE2.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Default.Personality/>
|
||||
</BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="DaintyUnitTests">
|
||||
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj"/>
|
||||
</Target>
|
||||
<Target Name="DaintyUnitTests:Clean">
|
||||
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="DaintyUnitTests:Make">
|
||||
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="DaintyDXE2">
|
||||
<MSBuild Projects="Packages\DaintyDXE2.dproj"/>
|
||||
</Target>
|
||||
<Target Name="DaintyDXE2:Clean">
|
||||
<MSBuild Projects="Packages\DaintyDXE2.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="DaintyDXE2:Make">
|
||||
<MSBuild Projects="Packages\DaintyDXE2.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="DaintyUnitTests;DaintyDXE2"/>
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="DaintyUnitTests:Clean;DaintyDXE2:Clean"/>
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="DaintyUnitTests:Make;DaintyDXE2:Make"/>
|
||||
</Target>
|
||||
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/>
|
||||
</Project>
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
package DaintyDXE2;
|
||||
|
||||
{$R *.res}
|
||||
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
|
||||
{$ALIGN 8}
|
||||
{$ASSERTIONS ON}
|
||||
{$BOOLEVAL OFF}
|
||||
{$DEBUGINFO ON}
|
||||
{$EXTENDEDSYNTAX ON}
|
||||
{$IMPORTEDDATA ON}
|
||||
{$IOCHECKS ON}
|
||||
{$LOCALSYMBOLS ON}
|
||||
{$LONGSTRINGS ON}
|
||||
{$OPENSTRINGS ON}
|
||||
{$OPTIMIZATION OFF}
|
||||
{$OVERFLOWCHECKS OFF}
|
||||
{$RANGECHECKS OFF}
|
||||
{$REFERENCEINFO ON}
|
||||
{$SAFEDIVIDE OFF}
|
||||
{$STACKFRAMES ON}
|
||||
{$TYPEDADDRESS OFF}
|
||||
{$VARSTRINGCHECKS ON}
|
||||
{$WRITEABLECONST OFF}
|
||||
{$MINENUMSIZE 1}
|
||||
{$IMAGEBASE $400000}
|
||||
{$DEFINE DEBUG}
|
||||
{$ENDIF IMPLICITBUILDING}
|
||||
{$RUNONLY}
|
||||
{$IMPLICITBUILD ON}
|
||||
|
||||
requires
|
||||
rtl,
|
||||
dbrtl;
|
||||
|
||||
contains
|
||||
Dainty in '..\Source\Dainty.pas',
|
||||
Dainty.ValueSetter.Default in '..\Source\Dainty.ValueSetter.Default.pas';
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{EFB63B96-967A-4C05-BD7C-50D48E7E8E43}</ProjectGuid>
|
||||
<MainSource>DaintyDXE2.dpk</MainSource>
|
||||
<ProjectVersion>13.4</ProjectVersion>
|
||||
<FrameworkType>None</FrameworkType>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||
<TargetedPlatforms>1</TargetedPlatforms>
|
||||
<AppType>Package</AppType>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||
<Base_Win32>true</Base_Win32>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||
<Cfg_2>true</Cfg_2>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<RuntimeOnlyPackage>true</RuntimeOnlyPackage>
|
||||
<VerInfo_Locale>1043</VerInfo_Locale>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
<DCC_BplOutput>$(DELPHIBIN)</DCC_BplOutput>
|
||||
<DCC_DcpOutput>$(DELPHIBIN)</DCC_DcpOutput>
|
||||
<DCC_CBuilderOutput>All</DCC_CBuilderOutput>
|
||||
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
|
||||
<GenPackage>true</GenPackage>
|
||||
<GenDll>true</GenDll>
|
||||
<DCC_DcuOutput>$(DELPHILIB)</DCC_DcuOutput>
|
||||
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||
<DCC_Optimize>false</DCC_Optimize>
|
||||
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="$(MainSource)">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="rtl.dcp"/>
|
||||
<DCCReference Include="dbrtl.dcp"/>
|
||||
<DCCReference Include="..\Source\Dainty.pas"/>
|
||||
<DCCReference Include="..\Source\Dainty.ValueSetter.Default.pas"/>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Debug">
|
||||
<Key>Cfg_1</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Source>
|
||||
<Source Name="MainSource">DaintyDXE2.dpk</Source>
|
||||
</Source>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">True</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">1043</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
</Delphi.Personality>
|
||||
<Deployment/>
|
||||
<Platforms>
|
||||
<Platform value="Win64">False</Platform>
|
||||
<Platform value="Win32">True</Platform>
|
||||
</Platforms>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||
</Project>
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
{
|
||||
Dainty
|
||||
Simple object mapper for Delphi
|
||||
|
||||
Copyright (c) 2020 M. van Renswoude
|
||||
https://github.com/MvRens/Dainty
|
||||
|
||||
|
||||
This is free and unencumbered software released into the public domain.
|
||||
|
||||
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||
distribute this software, either in source code form or as a compiled
|
||||
binary, for any purpose, commercial or non-commercial, and by any
|
||||
means.
|
||||
|
||||
In jurisdictions that recognize copyright laws, the author or authors
|
||||
of this software dedicate any and all copyright interest in the
|
||||
software to the public domain. We make this dedication for the benefit
|
||||
of the public at large and to the detriment of our heirs and
|
||||
successors. We intend this dedication to be an overt act of
|
||||
relinquishment in perpetuity of all present and future rights to this
|
||||
software under copyright law.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||
OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
For more information, please refer to <http://unlicense.org/>
|
||||
}
|
||||
unit Dainty.ValueSetter.Default;
|
||||
|
||||
interface
|
||||
implementation
|
||||
uses
|
||||
Data.DB,
|
||||
System.Rtti,
|
||||
System.TypInfo,
|
||||
|
||||
Dainty;
|
||||
|
||||
|
||||
type
|
||||
TDaintyDefaultValueSetterFactory = class(TDaintyAbstractValueSetterFactory)
|
||||
public
|
||||
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyDefaultValueSetterFactory }
|
||||
class function TDaintyDefaultValueSetterFactory.Construct(AMember: TDaintyRttiMember): TDaintyValueSetter;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
case AMember.RttiType.TypeKind of
|
||||
tkString,
|
||||
tkLString,
|
||||
tkWString,
|
||||
tkUString,
|
||||
tkChar,
|
||||
tkWChar:
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsString);
|
||||
end;
|
||||
|
||||
tkInteger:
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsInteger);
|
||||
end;
|
||||
|
||||
tkEnumeration:
|
||||
if AMember.RttiType.Handle = TypeInfo(Boolean) then
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsBoolean);
|
||||
end
|
||||
else
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsInteger);
|
||||
end;
|
||||
|
||||
tkInt64:
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsLargeInt);
|
||||
end;
|
||||
|
||||
tkFloat:
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, AField.AsFloat);
|
||||
end;
|
||||
|
||||
tkVariant:
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
begin
|
||||
AMember.SetValue(AInstance, TValue.FromVariant(AField.Value));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TDaintyDefaultValueSetterFactory);
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,845 @@
|
|||
{
|
||||
Dainty
|
||||
Simple object mapper for Delphi
|
||||
|
||||
Copyright (c) 2020 M. van Renswoude
|
||||
https://github.com/MvRens/Dainty
|
||||
|
||||
|
||||
This is free and unencumbered software released into the public domain.
|
||||
|
||||
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||
distribute this software, either in source code form or as a compiled
|
||||
binary, for any purpose, commercial or non-commercial, and by any
|
||||
means.
|
||||
|
||||
In jurisdictions that recognize copyright laws, the author or authors
|
||||
of this software dedicate any and all copyright interest in the
|
||||
software to the public domain. We make this dedication for the benefit
|
||||
of the public at large and to the detriment of our heirs and
|
||||
successors. We intend this dedication to be an overt act of
|
||||
relinquishment in perpetuity of all present and future rights to this
|
||||
software under copyright law.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||
OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
For more information, please refer to <http://unlicense.org/>
|
||||
}
|
||||
unit Dainty;
|
||||
|
||||
interface
|
||||
uses
|
||||
Data.DB,
|
||||
System.Generics.Collections,
|
||||
System.Rtti,
|
||||
System.SysUtils,
|
||||
|
||||
Dainty.ValueSetter.Default;
|
||||
|
||||
|
||||
type
|
||||
TDaintyMapper<T: class> = class;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Annotates a field or property to change it's field name in the DataSet
|
||||
/// as used for the Dainty methods.
|
||||
/// </summary>
|
||||
FieldName = class(TCustomAttribute)
|
||||
private
|
||||
FFieldName: string;
|
||||
public
|
||||
constructor Create(const AFieldName: string);
|
||||
|
||||
property FieldName: string read FFieldName;
|
||||
end;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Allows for direct calls to TDainty methods from any DataSet instance, for example
|
||||
/// DataSet.Rows<> or DataSet.GetFirstOrDefault<>.
|
||||
/// </summary>
|
||||
/// <remarks>
|
||||
/// Because class helpers are not exactly extension methods and only one can apply,
|
||||
/// if you're having conflicts you can call TDainty.Rows<>(DataSet) instead.
|
||||
/// </remarks>
|
||||
TDaintyDataSetHelper = class helper for TDataSet
|
||||
public
|
||||
/// <summary>
|
||||
/// Returns a typed enumerable which iterates the DataSet and returns the mapped
|
||||
/// object for each row.
|
||||
/// </summary>
|
||||
/// <remarks>
|
||||
/// Note that the DataSet is not reset to First and will instead start at the current record.
|
||||
/// </remarks>
|
||||
function Rows<T: class>: TEnumerable<T>;
|
||||
|
||||
/// <summary>
|
||||
/// Provides access to the mapper which allows control over the DataSet loop.
|
||||
/// </summary>
|
||||
function GetMapper<T: class>: TDaintyMapper<T>;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||
/// row is active.
|
||||
/// </summary>
|
||||
function GetFirst<T: class>: T;
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Returns the value of
|
||||
/// ADefault if no row is active.
|
||||
/// </summary>
|
||||
function GetFirstOrDefault<T: class>(const ADefault: T): T;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||
/// row is active or if more than one row is remaining.
|
||||
/// </summary>
|
||||
function GetSingle<T: class>: T;
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Returns the value of
|
||||
/// ADefault if no row is active or if more than one row is remaining.
|
||||
/// </summary>
|
||||
function GetSingleOrDefault<T: class>(const ADefault: T): T;
|
||||
end;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Provides row to object mapping functionality. Usually accessed using the TDaintyDataSetHelper.
|
||||
/// </summary>
|
||||
TDainty = class
|
||||
public
|
||||
/// <summary>
|
||||
/// Returns a typed enumerable which iterates the DataSet and returns the mapped
|
||||
/// object for each row.
|
||||
/// </summary>
|
||||
/// <remarks>
|
||||
/// Note that the DataSet is not reset to First and will instead start at the current record.
|
||||
/// </remarks>
|
||||
class function Rows<T: class>(ADataSet: TDataSet): TEnumerable<T>;
|
||||
|
||||
/// <summary>
|
||||
/// Provides access to the mapper which allows control over the DataSet loop.
|
||||
/// </summary>
|
||||
class function GetMapper<T: class>(ADataSet: TDataSet): TDaintyMapper<T>;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||
/// row is active.
|
||||
/// </summary>
|
||||
class function GetFirst<T: class>(ADataSet: TDataSet): T;
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Returns the value of
|
||||
/// ADefault if no row is active.
|
||||
/// </summary>
|
||||
class function GetFirstOrDefault<T: class>(ADataSet: TDataSet; const ADefault: T): T;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||
/// row is active or if more than one row is remaining.
|
||||
/// </summary>
|
||||
class function GetSingle<T: class>(ADataSet: TDataSet): T;
|
||||
|
||||
/// <summary>
|
||||
/// Returns the current row mapped to the specified class. Returns the value of
|
||||
/// ADefault if no row is active or if more than one row is remaining.
|
||||
/// </summary>
|
||||
class function GetSingleOrDefault<T: class>(ADataSet: TDataSet; const ADefault: T): T;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Performs the mapping of the current row to the specified type.
|
||||
/// </summary>
|
||||
TDaintyMapper<T: class> = class
|
||||
public
|
||||
function MapRow: T; virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Enumerates over the rows of a DataSet and returns the mapped objects.
|
||||
/// Returned by the Rows<> method.
|
||||
/// </summary>
|
||||
TDaintyEnumerable<T: class> = class(TEnumerable<T>)
|
||||
private
|
||||
FMapper: TDaintyMapper<T>;
|
||||
FDataSet: TDataSet;
|
||||
protected
|
||||
function DoGetEnumerator: TEnumerator<T>; override;
|
||||
public
|
||||
constructor Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||
end;
|
||||
|
||||
|
||||
/// <summary>
|
||||
/// Internal enumerator returned by TDaintyEnumerable.
|
||||
/// </summary>
|
||||
/// <remarks>
|
||||
/// For internal use only. It's only in the interface section to prevent "Method of parameterized type declared in interface section must not use local symbol" error.
|
||||
/// </remarks>
|
||||
TDaintyEnumerator<T: class> = class(TEnumerator<T>)
|
||||
private
|
||||
FMapper: TDaintyMapper<T>;
|
||||
FDataSet: TDataSet;
|
||||
FCurrent: T;
|
||||
protected
|
||||
function DoGetCurrent: T; override;
|
||||
function DoMoveNext: Boolean; override;
|
||||
public
|
||||
constructor Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||
end;
|
||||
|
||||
|
||||
TDaintyValueSetter = reference to procedure(AInstance: TObject; AField: TField);
|
||||
|
||||
|
||||
TDaintyRttiFieldNameMapping = record
|
||||
FieldName: string;
|
||||
ValueSetter: TDaintyValueSetter;
|
||||
|
||||
constructor Create(const AFieldName: string; const AValueSetter: TDaintyValueSetter);
|
||||
end;
|
||||
|
||||
TDaintyRttiClassMapping = class
|
||||
private
|
||||
FConstruct: TFunc<TObject>;
|
||||
FFieldNameMapping: TList<TDaintyRttiFieldNameMapping>;
|
||||
public
|
||||
constructor Create(AConstruct: TFunc<TObject>);
|
||||
destructor Destroy; override;
|
||||
|
||||
property Construct: TFunc<TObject> read FConstruct;
|
||||
property FieldNameMapping: TList<TDaintyRttiFieldNameMapping> read FFieldNameMapping;
|
||||
end;
|
||||
|
||||
TDaintyRttiFieldMapping = record
|
||||
Field: TField;
|
||||
ValueSetter: TDaintyValueSetter;
|
||||
|
||||
constructor Create(const AField: TField; const AValueSetter: TDaintyValueSetter);
|
||||
end;
|
||||
|
||||
|
||||
TDaintyRttiMapper<T: class> = class(TDaintyMapper<T>)
|
||||
private
|
||||
FConstruct: TFunc<TObject>;
|
||||
FFieldMapping: TList<TDaintyRttiFieldMapping>;
|
||||
public
|
||||
constructor Create(AClassMapping: TDaintyRttiClassMapping; ADataSet: TDataSet);
|
||||
|
||||
function MapRow: T; override;
|
||||
end;
|
||||
|
||||
|
||||
TDaintyRttiMember = class
|
||||
private
|
||||
FRttiMember: TRttiMember;
|
||||
protected
|
||||
function GetRttiType: TRttiType; virtual; abstract;
|
||||
public
|
||||
constructor Create(ARttiMember: TRttiMember);
|
||||
|
||||
procedure SetValue(AInstance: TObject; const AValue: TValue); virtual; abstract;
|
||||
|
||||
property RttiMember: TRttiMember read FRttiMember;
|
||||
property RttiType: TRttiType read GetRttiType;
|
||||
end;
|
||||
|
||||
|
||||
TDaintyRttiFieldMember = class(TDaintyRttiMember)
|
||||
private
|
||||
FField: TRttiField;
|
||||
protected
|
||||
function GetRttiType: TRttiType; override;
|
||||
public
|
||||
constructor Create(AField: TRttiField);
|
||||
|
||||
procedure SetValue(AInstance: TObject; const AValue: TValue); override;
|
||||
end;
|
||||
|
||||
TDaintyRttiPropertyMember = class(TDaintyRttiMember)
|
||||
private
|
||||
FProperty: TRttiProperty;
|
||||
protected
|
||||
function GetRttiType: TRttiType; override;
|
||||
public
|
||||
constructor Create(AProperty: TRttiProperty);
|
||||
|
||||
procedure SetValue(AInstance: TObject; const AValue: TValue); override;
|
||||
end;
|
||||
|
||||
|
||||
TDaintyAbstractValueSetterFactoryClass = class of TDaintyAbstractValueSetterFactory;
|
||||
|
||||
TDaintyAbstractValueSetterFactory = class
|
||||
public
|
||||
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
TDaintyRttiMapperFactory = class
|
||||
private type
|
||||
TValueSetterRegistration = record
|
||||
Factory: TDaintyAbstractValueSetterFactoryClass;
|
||||
Priority: Integer;
|
||||
|
||||
constructor Create(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||
end;
|
||||
private class var
|
||||
SContext: TRttiContext;
|
||||
SClassMappingCacheLock: TMultiReadExclusiveWriteSynchronizer;
|
||||
SClassMappingCache: TDictionary<Pointer, TDaintyRttiClassMapping>;
|
||||
SValueSettersLock: TMultiReadExclusiveWriteSynchronizer;
|
||||
SValueSetters: TList<TValueSetterRegistration>;
|
||||
SMembers: TObjectList<TDaintyRttiMember>;
|
||||
private
|
||||
class function GetClassMapping<T: class>: TDaintyRttiClassMapping;
|
||||
class function GetFieldName(AMember: TRttiNamedObject): string;
|
||||
class function GetValueSetter(AMember: TRttiMember): TDaintyValueSetter;
|
||||
protected
|
||||
class procedure Initialize;
|
||||
class procedure Finalize;
|
||||
public
|
||||
class function Construct<T: class>(ADataSet: TDataSet): TDaintyRttiMapper<T>;
|
||||
|
||||
class procedure RegisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer = 0);
|
||||
class procedure UnregisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
System.TypInfo;
|
||||
|
||||
|
||||
{ TDaintyDataSetHelper }
|
||||
function TDaintyDataSetHelper.Rows<T>: TEnumerable<T>;
|
||||
begin
|
||||
Result := TDainty.Rows<T>(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyDataSetHelper.GetMapper<T>: TDaintyMapper<T>;
|
||||
begin
|
||||
Result := TDainty.GetMapper<T>(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyDataSetHelper.GetFirst<T>: T;
|
||||
begin
|
||||
Result := TDainty.GetFirst<T>(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyDataSetHelper.GetFirstOrDefault<T>(const ADefault: T): T;
|
||||
begin
|
||||
Result := TDainty.GetFirstOrDefault<T>(Self, ADefault);
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyDataSetHelper.GetSingle<T>: T;
|
||||
begin
|
||||
Result := TDainty.GetSingle<T>(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyDataSetHelper.GetSingleOrDefault<T>(const ADefault: T): T;
|
||||
begin
|
||||
Result := TDainty.GetSingleOrDefault<T>(Self, ADefault);
|
||||
end;
|
||||
|
||||
|
||||
{ TDainty }
|
||||
class function TDainty.Rows<T>(ADataSet: TDataSet): TEnumerable<T>;
|
||||
var
|
||||
mapper: TDaintyMapper<T>;
|
||||
|
||||
begin
|
||||
mapper := GetMapper<T>(ADataSet);
|
||||
Result := TDaintyEnumerable<T>.Create(mapper, ADataSet);
|
||||
end;
|
||||
|
||||
|
||||
class function TDainty.GetMapper<T>(ADataSet: TDataSet): TDaintyMapper<T>;
|
||||
begin
|
||||
Result := TDaintyRttiMapperFactory.Construct<T>(ADataSet);
|
||||
end;
|
||||
|
||||
|
||||
class function TDainty.GetFirst<T>(ADataSet: TDataSet): T;
|
||||
var
|
||||
enumerator: TEnumerator<T>;
|
||||
|
||||
begin
|
||||
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||
try
|
||||
if not enumerator.MoveNext then
|
||||
raise EDatabaseError.Create('Expected at least 1 record but none found');
|
||||
|
||||
Result := enumerator.Current;
|
||||
finally
|
||||
FreeAndNil(enumerator);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class function TDainty.GetFirstOrDefault<T>(ADataSet: TDataSet; const ADefault: T): T;
|
||||
var
|
||||
enumerator: TEnumerator<T>;
|
||||
|
||||
begin
|
||||
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||
try
|
||||
if enumerator.MoveNext then
|
||||
Result := enumerator.Current
|
||||
else
|
||||
Result := ADefault;
|
||||
finally
|
||||
FreeAndNil(enumerator);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class function TDainty.GetSingle<T>(ADataSet: TDataSet): T;
|
||||
var
|
||||
enumerator: TEnumerator<T>;
|
||||
|
||||
begin
|
||||
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||
try
|
||||
if not enumerator.MoveNext then
|
||||
raise EDatabaseError.Create('Expected 1 record but none found');
|
||||
|
||||
Result := enumerator.Current;
|
||||
|
||||
if enumerator.MoveNext then
|
||||
raise EDatabaseError.Create('Expected 1 record but more found');
|
||||
finally
|
||||
FreeAndNil(enumerator);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class function TDainty.GetSingleOrDefault<T>(ADataSet: TDataSet; const ADefault: T): T;
|
||||
var
|
||||
enumerator: TEnumerator<T>;
|
||||
|
||||
begin
|
||||
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||
try
|
||||
if not enumerator.MoveNext then
|
||||
Exit(ADefault);
|
||||
|
||||
Result := enumerator.Current;
|
||||
|
||||
if enumerator.MoveNext then
|
||||
Exit(ADefault);
|
||||
finally
|
||||
FreeAndNil(enumerator);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyEnumerable<T> }
|
||||
constructor TDaintyEnumerable<T>.Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FMapper := AMapper;
|
||||
FDataSet := ADataSet;
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyEnumerable<T>.DoGetEnumerator: TEnumerator<T>;
|
||||
begin
|
||||
Result := TDaintyEnumerator<T>.Create(FMapper, FDataSet);
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyEnumerator<T> }
|
||||
constructor TDaintyEnumerator<T>.Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FMapper := AMapper;
|
||||
FDataSet := ADataSet;
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyEnumerator<T>.DoGetCurrent: T;
|
||||
begin
|
||||
Result := FCurrent;
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyEnumerator<T>.DoMoveNext: Boolean;
|
||||
begin
|
||||
if FDataSet.Eof then
|
||||
Exit(False);
|
||||
|
||||
FCurrent := FMapper.MapRow;
|
||||
Result := True;
|
||||
|
||||
FDataSet.Next;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiMapper<T> }
|
||||
constructor TDaintyRttiMapper<T>.Create(AClassMapping: TDaintyRttiClassMapping; ADataSet: TDataSet);
|
||||
var
|
||||
fieldNameMapping: TDaintyRttiFieldNameMapping;
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FConstruct := AClassMapping.Construct;
|
||||
FFieldMapping := TList<TDaintyRttiFieldMapping>.Create;
|
||||
|
||||
for fieldNameMapping in AClassMapping.FieldNameMapping do
|
||||
FFieldMapping.Add(TDaintyRttiFieldMapping.Create(ADataSet.FieldByName(fieldNameMapping.FieldName), fieldNameMapping.ValueSetter));
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiMember }
|
||||
constructor TDaintyRttiMember.Create(ARttiMember: TRttiMember);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FRttiMember := ARttiMember;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiFieldMember }
|
||||
constructor TDaintyRttiFieldMember.Create(AField: TRttiField);
|
||||
begin
|
||||
inherited Create(AField);
|
||||
|
||||
FField := AField;
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyRttiFieldMember.GetRttiType: TRttiType;
|
||||
begin
|
||||
Result := FField.FieldType;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyRttiFieldMember.SetValue(AInstance: TObject; const AValue: TValue);
|
||||
begin
|
||||
FField.SetValue(AInstance, AValue);
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiPropertyMember }
|
||||
constructor TDaintyRttiPropertyMember.Create(AProperty: TRttiProperty);
|
||||
begin
|
||||
inherited Create(AProperty);
|
||||
|
||||
FProperty := AProperty;
|
||||
end;
|
||||
|
||||
|
||||
function TDaintyRttiPropertyMember.GetRttiType: TRttiType;
|
||||
begin
|
||||
Result := FProperty.PropertyType;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyRttiPropertyMember.SetValue(AInstance: TObject; const AValue: TValue);
|
||||
begin
|
||||
FProperty.SetValue(AInstance, AValue);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TDaintyRttiMapperFactory }
|
||||
class procedure TDaintyRttiMapperFactory.Initialize;
|
||||
begin
|
||||
if Assigned(SClassMappingCache) then
|
||||
Exit;
|
||||
|
||||
SContext := TRttiContext.Create;
|
||||
SClassMappingCacheLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
||||
SClassMappingCache := TObjectDictionary<Pointer, TDaintyRttiClassMapping>.Create([doOwnsValues]);
|
||||
SValueSettersLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
||||
SValueSetters := TList<TValueSetterRegistration>.Create;
|
||||
SMembers := TObjectList<TDaintyRttiMember>.Create;
|
||||
end;
|
||||
|
||||
|
||||
class procedure TDaintyRttiMapperFactory.RegisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||
var
|
||||
registration: TValueSetterRegistration;
|
||||
registrationIndex: Integer;
|
||||
|
||||
begin
|
||||
{ Initialization for Dainty.ValueSetter.Default runs before ours, make sure we are initialized }
|
||||
Initialize;
|
||||
|
||||
SValueSettersLock.BeginWrite;
|
||||
try
|
||||
registration := TValueSetterRegistration.Create(AFactory, APriority);
|
||||
|
||||
for registrationIndex := 0 to Pred(SValueSetters.Count) do
|
||||
if SValueSetters[registrationIndex].Priority <= APriority then
|
||||
begin
|
||||
SValueSetters.Insert(registrationIndex, registration);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SValueSetters.Add(registration);
|
||||
finally
|
||||
SValueSettersLock.EndWrite;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class procedure TDaintyRttiMapperFactory.UnregisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass);
|
||||
var
|
||||
registrationIndex: Integer;
|
||||
|
||||
begin
|
||||
SValueSettersLock.BeginWrite;
|
||||
try
|
||||
for registrationIndex := Pred(SValueSetters.Count) downto 0 do
|
||||
if SValueSetters[registrationIndex].Factory = AFactory then
|
||||
SValueSetters.Delete(registrationIndex);
|
||||
finally
|
||||
SValueSettersLock.EndWrite;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class procedure TDaintyRttiMapperFactory.Finalize;
|
||||
begin
|
||||
FreeAndNil(SValueSetters);
|
||||
FreeAndNil(SValueSettersLock);
|
||||
FreeAndNil(SClassMappingCache);
|
||||
FreeAndNil(SClassMappingCacheLock);
|
||||
SContext.Free;
|
||||
end;
|
||||
|
||||
|
||||
class function TDaintyRttiMapperFactory.Construct<T>(ADataSet: TDataSet): TDaintyRttiMapper<T>;
|
||||
var
|
||||
mapping: TDaintyRttiClassMapping;
|
||||
|
||||
begin
|
||||
mapping := GetClassMapping<T>;
|
||||
Result := TDaintyRttiMapper<T>.Create(mapping, ADataSet);
|
||||
end;
|
||||
|
||||
|
||||
class function TDaintyRttiMapperFactory.GetClassMapping<T>: TDaintyRttiClassMapping;
|
||||
var
|
||||
typeInfoHandle: Pointer;
|
||||
classInfo: TRttiType;
|
||||
method: TRttiMethod;
|
||||
instanceClassType: TClass;
|
||||
fieldInfo: TRttiField;
|
||||
propertyInfo: TRttiProperty;
|
||||
valueSetter: TProc<TObject, TField>;
|
||||
|
||||
begin
|
||||
SClassMappingCacheLock.BeginRead;
|
||||
try
|
||||
typeInfoHandle := TypeInfo(T);
|
||||
if SClassMappingCache.TryGetValue(typeInfoHandle, Result) then
|
||||
Exit;
|
||||
|
||||
SClassMappingCacheLock.BeginWrite;
|
||||
try
|
||||
{ Between the call to BeginWrite and actually acquiring the lock the state
|
||||
may have changed. Check again to be sure. }
|
||||
if SClassMappingCache.TryGetValue(typeInfoHandle, Result) then
|
||||
Exit;
|
||||
|
||||
classInfo := SContext.GetType(typeInfoHandle);
|
||||
Result := nil;
|
||||
|
||||
for method in classInfo.GetMethods do
|
||||
begin
|
||||
if method.IsConstructor and (Length(method.GetParameters) = 0) then
|
||||
begin
|
||||
instanceClassType := classInfo.AsInstance.MetaclassType;
|
||||
Result := TDaintyRttiClassMapping.Create(
|
||||
function: TObject
|
||||
begin
|
||||
Result := method.Invoke(instanceClassType, []).AsObject;
|
||||
end);
|
||||
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not Assigned(Result) then
|
||||
raise ENoConstructException.Create('A constructor with no parameter is required for Dainty');
|
||||
|
||||
|
||||
for fieldInfo in classInfo.GetFields do
|
||||
begin
|
||||
if not (fieldInfo.Visibility in [mvPublic, mvPublished]) then
|
||||
Continue;
|
||||
|
||||
Result.FieldNameMapping.Add(TDaintyRttiFieldNameMapping.Create(GetFieldName(fieldInfo), GetValueSetter(fieldInfo)));
|
||||
end;
|
||||
|
||||
|
||||
for propertyInfo in classInfo.GetProperties do
|
||||
begin
|
||||
if not (propertyInfo.Visibility in [mvPublic, mvPublished]) then
|
||||
Continue;
|
||||
|
||||
if not propertyInfo.IsWritable then
|
||||
Continue;
|
||||
|
||||
Result.FieldNameMapping.Add(TDaintyRttiFieldNameMapping.Create(GetFieldName(propertyInfo), GetValueSetter(propertyInfo)));
|
||||
end;
|
||||
|
||||
SClassMappingCache.Add(typeInfoHandle, Result);
|
||||
finally
|
||||
SClassMappingCacheLock.EndWrite;
|
||||
end;
|
||||
finally
|
||||
SClassMappingCacheLock.EndRead;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class function TDaintyRttiMapperFactory.GetFieldName(AMember: TRttiNamedObject): string;
|
||||
var
|
||||
attribute: TCustomAttribute;
|
||||
|
||||
begin
|
||||
for attribute in AMember.GetAttributes do
|
||||
begin
|
||||
if attribute is FieldName then
|
||||
Exit(FieldName(attribute).FieldName);
|
||||
end;
|
||||
|
||||
Result := AMember.Name;
|
||||
end;
|
||||
|
||||
|
||||
class function TDaintyRttiMapperFactory.GetValueSetter(AMember: TRttiMember): TDaintyValueSetter;
|
||||
var
|
||||
member: TDaintyRttiMember;
|
||||
registration: TValueSetterRegistration;
|
||||
|
||||
begin
|
||||
if AMember is TRttiField then
|
||||
member := TDaintyRttiFieldMember.Create(TRttiField(AMember))
|
||||
else if AMember is TRttiProperty then
|
||||
member := TDaintyRttiPropertyMember.Create(TRttiProperty(AMember))
|
||||
else
|
||||
raise EInvalidOpException.CreateFmt('Member type not supported: %s', [AMember.ClassName]);
|
||||
|
||||
SValueSettersLock.BeginRead;
|
||||
try
|
||||
for registration in SValueSetters do
|
||||
begin
|
||||
Result := registration.Factory.Construct(member);
|
||||
if Assigned(Result) then
|
||||
begin
|
||||
SMembers.Add(member);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
SValueSettersLock.EndRead;
|
||||
end;
|
||||
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
FreeAndNil(member);
|
||||
raise ENotSupportedException.CreateFmt('Member %s has unsupported type for Dainty: %d', [AMember.Name, Ord(member.RttiType.TypeKind)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiMapperFactory.TValueSetterRegistration }
|
||||
constructor TDaintyRttiMapperFactory.TValueSetterRegistration.Create(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||
begin
|
||||
Factory := AFactory;
|
||||
Priority := APriority;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiMapper<T> }
|
||||
function TDaintyRttiMapper<T>.MapRow: T;
|
||||
var
|
||||
fieldMapping: TDaintyRttiFieldMapping;
|
||||
|
||||
begin
|
||||
Result := FConstruct() as T;
|
||||
|
||||
for fieldMapping in FFieldMapping do
|
||||
fieldMapping.ValueSetter(Result, fieldMapping.Field);
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiFieldNameMapping }
|
||||
constructor TDaintyRttiFieldNameMapping.Create(const AFieldName: string; const AValueSetter: TDaintyValueSetter);
|
||||
begin
|
||||
FieldName := AFieldName;
|
||||
ValueSetter := AValueSetter;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiFieldMapping }
|
||||
constructor TDaintyRttiFieldMapping.Create(const AField: TField; const AValueSetter: TDaintyValueSetter);
|
||||
begin
|
||||
Field := AField;
|
||||
ValueSetter := AValueSetter;
|
||||
end;
|
||||
|
||||
|
||||
{ TDaintyRttiClassMapping }
|
||||
constructor TDaintyRttiClassMapping.Create(AConstruct: TFunc<TObject>);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FConstruct := AConstruct;
|
||||
FFieldNameMapping := TList<TDaintyRttiFieldNameMapping>.Create;
|
||||
end;
|
||||
|
||||
|
||||
destructor TDaintyRttiClassMapping.Destroy;
|
||||
begin
|
||||
FreeAndNil(FFieldNameMapping);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
{ FieldName }
|
||||
constructor FieldName.Create(const AFieldName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FFieldName := AFieldName;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
TDaintyRttiMapperFactory.Initialize;
|
||||
|
||||
finalization
|
||||
TDaintyRttiMapperFactory.Finalize;
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,316 @@
|
|||
unit DaintyTests;
|
||||
|
||||
interface
|
||||
uses
|
||||
Data.DB,
|
||||
Datasnap.DBClient,
|
||||
MidasLib,
|
||||
TestFramework,
|
||||
|
||||
Dainty;
|
||||
|
||||
|
||||
type
|
||||
TDaintyTest = class(TTestCase)
|
||||
private
|
||||
FDataSet: TClientDataSet;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
|
||||
procedure FillTestData(ARowCount: Integer);
|
||||
|
||||
property DataSet: TClientDataSet read FDataSet;
|
||||
published
|
||||
procedure SimpleTypes;
|
||||
|
||||
procedure GetFirst;
|
||||
procedure GetFirstMultipleRows;
|
||||
procedure GetFirstNoData;
|
||||
procedure GetFirstOrDefault;
|
||||
|
||||
procedure GetSingle;
|
||||
procedure GetSingleMultipleRows;
|
||||
procedure GetSingleNoData;
|
||||
procedure GetSingleOrDefaultMultipleRows;
|
||||
procedure GetSingleOrDefaultNoData;
|
||||
|
||||
procedure FieldNameAttribute;
|
||||
procedure FieldNameAttributeProperty;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
|
||||
{ TDaintyTest }
|
||||
procedure TDaintyTest.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
|
||||
FDataSet := TClientDataSet.Create(nil);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.TearDown;
|
||||
begin
|
||||
FreeAndNil(FDataSet);
|
||||
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TSimpleTypesRecord = class
|
||||
StringField: string;
|
||||
IntegerField: Integer;
|
||||
DateTimeField: TDateTime;
|
||||
BooleanField: Boolean;
|
||||
FloatField: Double;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.SimpleTypes;
|
||||
|
||||
procedure AddRow(const AStringValue: string; AIntegerValue: Integer; ADateTimeValue: TDateTime; ABooleanValue: Boolean; AFloatValue: Double);
|
||||
begin
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('STRINGFIELD').AsString := AStringValue;
|
||||
DataSet.FieldByName('INTEGERFIELD').AsInteger := AIntegerValue;
|
||||
DataSet.FieldByName('DATETIMEFIELD').AsDateTime := ADateTimeValue;
|
||||
DataSet.FieldByName('BOOLEANFIELD').AsBoolean := ABooleanValue;
|
||||
DataSet.FieldByName('FLOATFIELD').AsFloat := AFloatValue;
|
||||
DataSet.Post;
|
||||
end;
|
||||
|
||||
var
|
||||
row: TSimpleTypesRecord;
|
||||
rowIndex: Integer;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||
DataSet.FieldDefs.Add('INTEGERFIELD', ftInteger);
|
||||
DataSet.FieldDefs.Add('DATETIMEFIELD', ftDate);
|
||||
DataSet.FieldDefs.Add('BOOLEANFIELD', ftBoolean);
|
||||
DataSet.FieldDefs.Add('FLOATFIELD', ftFloat);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
AddRow('Hello', 42, EncodeDate(2020, 9, 7), True, 3.1415);
|
||||
AddRow('world!', 69, EncodeDate(2006, 1, 1), False, 1.618);
|
||||
|
||||
|
||||
DataSet.First;
|
||||
rowIndex := 0;
|
||||
|
||||
for row in DataSet.Rows<TSimpleTypesRecord> do
|
||||
begin
|
||||
case rowIndex of
|
||||
0:
|
||||
begin
|
||||
CheckEquals('Hello', row.StringField, 'StringField');
|
||||
CheckEquals(42, row.IntegerField, 'IntegerField');
|
||||
CheckEquals(EncodeDate(2020, 9, 7), row.DateTimeField, 0.9, 'DateTimeField');
|
||||
CheckEquals(True, row.BooleanField, 'BooleanField');
|
||||
CheckEquals(3.1415, row.FloatField, 0.0001, 'FloatField');
|
||||
end;
|
||||
|
||||
1:
|
||||
begin
|
||||
CheckEquals('world!', row.StringField);
|
||||
CheckEquals(69, row.IntegerField, 'IntegerField');
|
||||
CheckEquals(EncodeDate(2006, 1, 1), row.DateTimeField, 0.9, 'DateTimeField');
|
||||
CheckEquals(False, row.BooleanField, 'BooleanField');
|
||||
CheckEquals(1.618, row.FloatField, 0.0001, 'FloatField');
|
||||
end;
|
||||
end;
|
||||
|
||||
Inc(rowIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TTestRow = class
|
||||
RowNumber: Integer;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.FillTestData(ARowCount: Integer);
|
||||
var
|
||||
rowNumber: Integer;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('ROWNUMBER', ftInteger);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
for rowNumber := 1 to ARowCount do
|
||||
begin
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('ROWNUMBER').AsInteger := rowNumber;
|
||||
DataSet.Post;
|
||||
end;
|
||||
|
||||
DataSet.First;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetFirst;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(1);
|
||||
row := DataSet.GetFirst<TTestRow>;
|
||||
|
||||
CheckEquals(1, row.RowNumber);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetFirstMultipleRows;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(2);
|
||||
row := DataSet.GetFirst<TTestRow>;
|
||||
|
||||
CheckEquals(1, row.RowNumber);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetFirstNoData;
|
||||
begin
|
||||
FillTestData(0);
|
||||
ExpectedException := EDatabaseError;
|
||||
DataSet.GetFirst<TTestRow>;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetFirstOrDefault;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(0);
|
||||
row := DataSet.GetFirstOrDefault<TTestRow>(nil);
|
||||
CheckNull(row);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetSingle;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(1);
|
||||
row := DataSet.GetSingle<TTestRow>;
|
||||
CheckEquals(1, row.RowNumber);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetSingleMultipleRows;
|
||||
begin
|
||||
ExpectedException := EDatabaseError;
|
||||
FillTestData(2);
|
||||
DataSet.GetSingle<TTestRow>;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetSingleNoData;
|
||||
begin
|
||||
ExpectedException := EDatabaseError;
|
||||
FillTestData(0);
|
||||
DataSet.GetSingle<TTestRow>;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetSingleOrDefaultMultipleRows;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(2);
|
||||
row := DataSet.GetSingleOrDefault<TTestRow>(nil);
|
||||
CheckNull(row);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.GetSingleOrDefaultNoData;
|
||||
var
|
||||
row: TTestRow;
|
||||
|
||||
begin
|
||||
FillTestData(0);
|
||||
row := DataSet.GetSingleOrDefault<TTestRow>(nil);
|
||||
CheckNull(row);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TAttributeTestRow = class
|
||||
[FieldName('STRING_FIELD')]
|
||||
StringField: string;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.FieldNameAttribute;
|
||||
var
|
||||
row: TAttributeTestRow;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('STRING_FIELD', ftString, 50);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('STRING_FIELD').AsString := 'Hello world!';
|
||||
DataSet.Post;
|
||||
|
||||
row := DataSet.GetFirst<TAttributeTestRow>;
|
||||
CheckEquals('Hello world!', row.StringField);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TPropertyAttributeTestRow = class
|
||||
private
|
||||
FStringField: string;
|
||||
public
|
||||
[FieldName('STRING_FIELD')]
|
||||
property StringField: string read FStringField write FStringField;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyTest.FieldNameAttributeProperty;
|
||||
var
|
||||
row: TPropertyAttributeTestRow;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('STRING_FIELD', ftString, 50);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('STRING_FIELD').AsString := 'Hello world!';
|
||||
DataSet.Post;
|
||||
|
||||
row := DataSet.GetFirst<TPropertyAttributeTestRow>;
|
||||
CheckEquals('Hello world!', row.StringField);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest(TDaintyTest.Suite);
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
program DaintyUnitTests;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
uses
|
||||
GUITestRunner,
|
||||
Dainty in '..\Source\Dainty.pas',
|
||||
DaintyTests in 'DaintyTests.pas',
|
||||
Dainty.ValueSetter.Default in '..\Source\Dainty.ValueSetter.Default.pas',
|
||||
DaintyValueSetterTests in 'DaintyValueSetterTests.pas';
|
||||
|
||||
begin
|
||||
RunRegisteredTests;
|
||||
end.
|
||||
|
|
@ -0,0 +1,142 @@
|
|||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{79A2C681-52DB-432C-B68F-67E68341B6C3}</ProjectGuid>
|
||||
<ProjectVersion>13.4</ProjectVersion>
|
||||
<FrameworkType>None</FrameworkType>
|
||||
<MainSource>DaintyUnitTests.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||
<TargetedPlatforms>1</TargetedPlatforms>
|
||||
<AppType>Console</AppType>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||
<Base_Win64>true</Base_Win64>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||
<Base_Win32>true</Base_Win32>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||
<Cfg_2>true</Cfg_2>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
|
||||
<DCC_UsePackage>DBXInterBaseDriver;DataSnapServer;DataSnapCommon;DbxCommonDriver;dbxcds;CustomIPTransport;dsnap;IndyCore;FmxTeeUI;IPIndyImpl;bindcompfmx;dbrtl;bindcomp;inetdb;xmlrtl;ibxpress;soaprtl;FMXTee;bindengine;DBXInformixDriver;DBXFirebirdDriver;inet;DBXSybaseASADriver;dbexpress;fmx;IndySystem;DataSnapClient;DataSnapProviderClient;DBXOracleDriver;inetdbxpress;rtl;DbxClientDriver;IndyProtocols;DBXMySQLDriver;DataSnapIndy10ServerTransport;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
|
||||
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||
<DCC_UsePackage>dxTileControlRS16;cxLibraryRS16;dxPsPrVwAdvRS16;dxRibbonCustomizationFormRS16;dxPSCoreRS16;dxRichEditInplaceRS16;dxPScxTLLnkRS16;dxPSdxSpreadSheetLnkRS16;cxPageControlRS16;dxPScxGridLnkRS16;vclimg;dxComnRS16;vcldb;dxOfficeCoreRS16;dxBarExtDBItemsRS16;dxSpreadSheetInplaceRichEditRS16;dxSpreadSheetCoreRS16;cxDataRS16;dxDockingRS16;dxPSDBTeeChartRS16;dxSpreadSheetReportDesignerRS16;dxBarExtItemsRS16;dxPSLnksRS16;dxPSdxPDFViewerLnkRS16;dxPSTeeChartRS16;dxPSdxLCLnkRS16;cxVerticalGridRS16;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;dxNavBarRS16;dxSpreadSheetCoreDialogsRS16;dxSpreadSheetCoreConditionalFormattingDialogsRS16;cxSchedulerTreeBrowserRS16;DBXOdbcDriver;dxdbtrRS16;dxRichEditCoreRS16;dxPSdxDBTVLnkRS16;vclactnband;dxPScxSchedulerLnkRS16;dxServerModeRS16;bindcompvcl;vclie;dsnapcon;dxHttpIndyRequestRS16;vclx;dxFlowChartRS16;dxGDIPlusRS16;dxdborRS16;dxPDFViewerRS16;dxEMFRS16;dxLayoutControlRS16;dxSpreadSheetRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;dxPScxVGridLnkRS16;cxExportRS16;dxPSdxMapControlLnkRS16;dxBarRS16;TeeDB;dxDBXServerModeRS16;cxTreeListdxBarPopupMenuRS16;dxPSdxGaugeControlLnkRS16;dxRibbonRS16;DBXSybaseASEDriver;dxSpreadSheetConditionalFormattingDialogsRS16;cxTreeListRS16;vcldsnap;dxGaugeControlRS16;DBXDb2Driver;vcl;DBXMSSQLDriver;cxSchedulerGridRS16;dxRichEditControlCoreRS16;webdsnap;dxtrmdRS16;adortl;dxRichEditControlRS16;dxRichEditDocumentModelRS16;dxPSdxDBOCLnkRS16;Tee;cxPivotGridChartRS16;dxmdsRS16;dxSpellCheckerRS16;dxMapControlRS16;cxGridRS16;dxPScxCommonRS16;dxPSPrVwRibbonRS16;cxEditorsRS16;TeeUI;cxPivotGridRS16;cxSchedulerRibbonStyleEventEditorRS16;cxSchedulerRS16;vcltouch;websnap;dxFlowChartAdvancedCustomizeFormRS16;VclSmp;dxTabbedMDIRS16;dxPSRichEditControlLnkRS16;dxPSdxOCLnkRS16;dxPSdxFCLnkRS16;dxThemeRS16;dxPScxPCProdRS16;dxBarDBNavRS16;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||
<DCC_UsePackage>dxTileControlRS16;JvGlobus;JvMM;cxLibraryRS16;JvManagedThreads;JvCrypt;rbDIDE1516;dxPsPrVwAdvRS16;dxRibbonCustomizationFormRS16;rbTCUI1516;dxPSCoreRS16;dxRichEditInplaceRS16;dxPScxTLLnkRS16;dxPSdxSpreadSheetLnkRS16;JvNet;cxPageControlRS16;dxPScxGridLnkRS16;JvDotNetCtrls;vclimg;rbDAD1516;dxComnRS16;JvXPCtrls;rbRCL1516;vcldb;dxOfficeCoreRS16;dxBarExtDBItemsRS16;rbIBE1516;dxSpreadSheetInplaceRichEditRS16;dclRBIBE1516;dclRBADO1516;dxSpreadSheetCoreRS16;CloudService;rbRAP1516;cxDataRS16;dxDockingRS16;dxPSDBTeeChartRS16;JvDB;JvRuntimeDesign;dxSpreadSheetReportDesignerRS16;X2CLMB;dxBarExtItemsRS16;dxPSLnksRS16;dxPSdxPDFViewerLnkRS16;JclDeveloperTools;dxPSTeeChartRS16;dxPSdxLCLnkRS16;cxVerticalGridRS16;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;vcldbx;rbDBDE1516;dxNavBarRS16;dclRBE1516;dxSpreadSheetCoreDialogsRS16;rbIDE1516;JvPluginSystem;dxSpreadSheetCoreConditionalFormattingDialogsRS16;cxSchedulerTreeBrowserRS16;DBXOdbcDriver;JvCmp;dxdbtrRS16;madDisAsm_;dxRichEditCoreRS16;JvTimeFramework;dxPSdxDBTVLnkRS16;vclactnband;dxPScxSchedulerLnkRS16;dxServerModeRS16;bindcompvcl;Jcl;vclie;madExcept_;dsnapcon;dxHttpIndyRequestRS16;JvPascalInterpreter;vclx;rbDBE1516;dxFlowChartRS16;dxGDIPlusRS16;JvBDE;dxdborRS16;dxPDFViewerRS16;dxEMFRS16;dxLayoutControlRS16;dxSpreadSheetRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;dxPScxVGridLnkRS16;cxExportRS16;dxPSdxMapControlLnkRS16;dxBarRS16;JvDlgs;cxSchedulerWebServiceStorageRS16;TeeDB;dxDBXServerModeRS16;cxTreeListdxBarPopupMenuRS16;dxPSdxGaugeControlLnkRS16;vclib;inetdbbde;dxRibbonRS16;DBXSybaseASEDriver;dxSpreadSheetConditionalFormattingDialogsRS16;rbTC1516;cxTreeListRS16;vcldsnap;X2CLGL;dxGaugeControlRS16;DBXDb2Driver;dclRBBDE1516;rbDB1516;JvCore;vcl;DBXMSSQLDriver;JvAppFrm;cxSchedulerGridRS16;dxRichEditControlCoreRS16;webdsnap;dxtrmdRS16;rbRIDE1516;JvDocking;adortl;JvWizards;dxRichEditControlRS16;rbADO1516;madBasic_;JvHMI;dxRichEditDocumentModelRS16;JvBands;dxPSdxDBOCLnkRS16;Tee;rbUSERDesign1516;JvSystem;svnui;cxPivotGridChartRS16;JvControls;dxmdsRS16;dxSpellCheckerRS16;dxMapControlRS16;cxGridRS16;dxPScxCommonRS16;dxPSPrVwRibbonRS16;cxEditorsRS16;TeeUI;cxPivotGridRS16;rbUSER1516;JvJans;JvPrintPreview;JvPageComps;dclRBDBE1516;JvStdCtrls;JvCustom;cxSchedulerRibbonStyleEventEditorRS16;rbBDE1516;cxSchedulerRS16;vcltouch;websnap;dxFlowChartAdvancedCustomizeFormRS16;VclSmp;dxTabbedMDIRS16;dxPSRichEditControlLnkRS16;DataSnapConnectors;dxPSdxOCLnkRS16;dxPSdxFCLnkRS16;dxThemeRS16;JclVcl;dxPScxPCProdRS16;rbCIDE1516;svn;bdertl;VirtualTreesR;dxAuthorizationAgentsRS16;dxBarDBNavRS16;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||
<DCC_Optimize>false</DCC_Optimize>
|
||||
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||
<DCC_DebugDCUs>true</DCC_DebugDCUs>
|
||||
<Manifest_File>None</Manifest_File>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="$(MainSource)">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\Source\Dainty.pas"/>
|
||||
<DCCReference Include="DaintyTests.pas"/>
|
||||
<DCCReference Include="..\Source\Dainty.ValueSetter.Default.pas"/>
|
||||
<DCCReference Include="DaintyValueSetterTests.pas"/>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Debug">
|
||||
<Key>Cfg_1</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<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">1043</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">DaintyUnitTests.dpr</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
<Deployment/>
|
||||
<Platforms>
|
||||
<Platform value="Win64">False</Platform>
|
||||
<Platform value="Win32">True</Platform>
|
||||
</Platforms>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||
</Project>
|
||||
|
|
@ -0,0 +1,171 @@
|
|||
unit DaintyValueSetterTests;
|
||||
|
||||
interface
|
||||
uses
|
||||
Data.DB,
|
||||
DataSnap.DBClient,
|
||||
MidasLib,
|
||||
TestFramework,
|
||||
|
||||
Dainty;
|
||||
|
||||
|
||||
type
|
||||
TDaintyValueSetterTest = class(TTestCase)
|
||||
private
|
||||
FDataSet: TClientDataSet;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
|
||||
property DataSet: TClientDataSet read FDataSet;
|
||||
published
|
||||
procedure CustomRecordMapping;
|
||||
procedure GenericCustomRecordMapping;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
System.Rtti,
|
||||
System.SysUtils,
|
||||
System.TypInfo,
|
||||
System.Variants;
|
||||
|
||||
|
||||
{ TDaintyValueSetterTest }
|
||||
procedure TDaintyValueSetterTest.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
|
||||
FDataSet := TClientDataSet.Create(nil);
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyValueSetterTest.TearDown;
|
||||
begin
|
||||
FreeAndNil(FDataSet);
|
||||
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TCustomRecord = record
|
||||
Value: string;
|
||||
end;
|
||||
|
||||
TCustomRecordRow = class
|
||||
StringField: TCustomRecord;
|
||||
end;
|
||||
|
||||
|
||||
{ Mimics our proprietary implementation of generic nullables, which is based on:
|
||||
https://community.embarcadero.com/blogs/entry/a-andquotnullableandquot-post-38869 }
|
||||
TGenericCustomRecord<T> = record
|
||||
Value: T;
|
||||
end;
|
||||
|
||||
TGenericCustomRecordRow = class
|
||||
StringField: TGenericCustomRecord<string>;
|
||||
end;
|
||||
|
||||
|
||||
TCustomRecordValueSetterFactory = class(TDaintyAbstractValueSetterFactory)
|
||||
public
|
||||
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomRecordValueSetterFactory }
|
||||
class function TCustomRecordValueSetterFactory.Construct(AMember: TDaintyRttiMember): TDaintyValueSetter;
|
||||
begin
|
||||
if AMember.RttiType.TypeKind <> tkRecord then
|
||||
Exit(nil);
|
||||
|
||||
if AMember.RttiType.Handle = TypeInfo(TCustomRecord) then
|
||||
begin
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
var
|
||||
customRecord: TCustomRecord;
|
||||
|
||||
begin
|
||||
customRecord.Value := AField.AsString;
|
||||
AMember.SetValue(AInstance, TValue.From(customRecord));
|
||||
end;
|
||||
|
||||
{ Unfortunately I have not found a way to make this generic, if you do let me know!
|
||||
The workaround is to handle all types you want to support explicitly, which is
|
||||
good enough for our use case with nullable implementations. }
|
||||
end else if AMember.RttiType.Handle = TypeInfo(TGenericCustomRecord<string>) then
|
||||
begin
|
||||
Result :=
|
||||
procedure(AInstance: TObject; AField: TField)
|
||||
var
|
||||
value: TGenericCustomRecord<string>;
|
||||
|
||||
begin
|
||||
value.Value := AField.AsString;
|
||||
AMember.SetValue(AInstance, TValue.From(value));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyValueSetterTest.CustomRecordMapping;
|
||||
var
|
||||
row: TCustomRecordRow;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('STRINGFIELD').AsString := 'Hello world!';
|
||||
DataSet.Post;
|
||||
|
||||
|
||||
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TCustomRecordValueSetterFactory, 1);
|
||||
try
|
||||
DataSet.First;
|
||||
row := DataSet.GetFirst<TCustomRecordRow>;
|
||||
|
||||
CheckEquals('Hello world!', row.StringField.Value);
|
||||
finally
|
||||
TDaintyRttiMapperFactory.UnregisterValueSetterFactory(TCustomRecordValueSetterFactory);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDaintyValueSetterTest.GenericCustomRecordMapping;
|
||||
var
|
||||
row: TGenericCustomRecordRow;
|
||||
|
||||
begin
|
||||
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||
DataSet.CreateDataSet;
|
||||
DataSet.LogChanges := False;
|
||||
|
||||
DataSet.Append;
|
||||
DataSet.FieldByName('STRINGFIELD').AsString := 'Hello world!';
|
||||
DataSet.Post;
|
||||
|
||||
|
||||
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TCustomRecordValueSetterFactory, 1);
|
||||
try
|
||||
DataSet.First;
|
||||
row := DataSet.GetFirst<TGenericCustomRecordRow>;
|
||||
|
||||
CheckEquals('Hello world!', row.StringField.Value);
|
||||
finally
|
||||
TDaintyRttiMapperFactory.UnregisterValueSetterFactory(TCustomRecordValueSetterFactory);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest(TDaintyValueSetterTest.Suite);
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue