Refactoring DataFlow, 1st Generic Data records working
This commit is contained in:
Michael Schimmel
+269
-214
@@ -4,280 +4,335 @@ interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
System.Rtti,
|
||||
System.TypInfo;
|
||||
|
||||
type
|
||||
// A record that provides field-level access to managed data, stored in a byte buffer.
|
||||
TDataFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
|
||||
|
||||
TDataRecord = record
|
||||
public
|
||||
type
|
||||
IField = interface
|
||||
procedure GetRaw(Dst: Pointer);
|
||||
procedure SetRaw(Src: Pointer);
|
||||
end;
|
||||
|
||||
IField<T> = interface(IField)
|
||||
{$region 'private'}
|
||||
function GetValue: T;
|
||||
procedure SetValue(const Value: T);
|
||||
{$endregion}
|
||||
property Value: T read GetValue write SetValue;
|
||||
end;
|
||||
|
||||
TFieldLayout = record
|
||||
Name: string;
|
||||
Offset: Integer;
|
||||
Size: Integer;
|
||||
TypeInfo: PTypeInfo;
|
||||
end;
|
||||
|
||||
// The interface helper record that provides the generic AddField<T> method.
|
||||
TBuilder = record
|
||||
type
|
||||
IBuilder = interface
|
||||
procedure AddField(const Name: String; const Value: TValue); overload;
|
||||
procedure SetupRecord(out Layout: TArray<TFieldLayout>; out Buffer: TBytes);
|
||||
end;
|
||||
|
||||
TField = record
|
||||
private
|
||||
FBuilder: IBuilder;
|
||||
FFieldType: TDataFieldType;
|
||||
FName: string;
|
||||
FOffset: Integer;
|
||||
FSize: Integer;
|
||||
|
||||
procedure Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
procedure Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
procedure Finalize(P: Pointer);
|
||||
property Offset: Integer read FOffset;
|
||||
property Size: Integer read FSize;
|
||||
|
||||
public
|
||||
constructor Create(const ABuilder: IBuilder);
|
||||
constructor Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
|
||||
class operator Implicit(const AValue: IBuilder): TBuilder; overload;
|
||||
class operator Implicit(const AValue: TBuilder): IBuilder; overload;
|
||||
class function From<T>(const AName: string; Offset: Integer): TField; overload; static;
|
||||
class function From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField; overload; static;
|
||||
|
||||
procedure AddField<T>(const Name: String); overload; inline;
|
||||
procedure AddField<T>(const Name: String; const Value: T); overload; inline;
|
||||
property FieldType: TDataFieldType read FFieldType;
|
||||
property Name: string read FName;
|
||||
end;
|
||||
|
||||
function CreateRec: TDataRecord; inline;
|
||||
TLayout = record
|
||||
private
|
||||
FFields: TArray<TField>;
|
||||
public
|
||||
constructor Create(const AFields: TArray<TField>);
|
||||
class function CreateFrom<T>: TLayout; static;
|
||||
function GetBufferSize: Integer;
|
||||
function IndexOf(const Name: String): Integer;
|
||||
property Fields: TArray<TField> read FFields;
|
||||
end;
|
||||
|
||||
private
|
||||
FLayout: TArray<TFieldLayout>;
|
||||
FLayout: TLayout;
|
||||
FBuffer: TBytes;
|
||||
|
||||
public
|
||||
class operator Initialize(out Dest: TDataRecord);
|
||||
constructor Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
|
||||
class function CreateFrom<T>: TDataRecord; overload; static;
|
||||
class function CreateFrom<T>(const Src: T): TDataRecord; overload; static;
|
||||
class function CreateFrom(const Layout: TLayout): TDataRecord; overload; static;
|
||||
procedure CopyFrom<T>(const Src: T);
|
||||
|
||||
procedure SetValue<T>(const Name: String; const Value: T); overload;
|
||||
procedure SetValue(Idx: Integer; const Value); overload;
|
||||
|
||||
function GetValue<T>(const Name: String): T; overload;
|
||||
procedure GetValue(Idx: Integer; out Value); overload;
|
||||
|
||||
class operator Finalize(var Dest: TDataRecord);
|
||||
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
||||
|
||||
class function CreateBuilder: TBuilder; static;
|
||||
|
||||
class function CreateFrom<T>(const Rec: T): TDataRecord; static;
|
||||
procedure AssignTo<T>(var Rec: T);
|
||||
function FitsRecord<T>: Boolean;
|
||||
|
||||
function IndexOf(const Name: String): Integer;
|
||||
function GetField(const Name: String): IField; overload;
|
||||
function GetField<T>(const Name: String): IField<T>; overload;
|
||||
|
||||
property Layout: TArray<TFieldLayout> read FLayout;
|
||||
property Layout: TLayout read FLayout;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.DataRecord.Impl;
|
||||
|
||||
{ TDataRecord.TBuilder }
|
||||
|
||||
constructor TDataRecord.TBuilder.Create(const ABuilder: IBuilder);
|
||||
constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
|
||||
begin
|
||||
FBuilder := ABuilder;
|
||||
FLayout := ALayout;
|
||||
FBuffer := ABuffer;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TBuilder.AddField<T>(const Name: String; const Value: T);
|
||||
procedure TDataRecord.CopyFrom<T>(const Src: T);
|
||||
begin
|
||||
FBuilder.AddField(Name, TValue.From<T>(Value));
|
||||
end;
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
var rttiFields := rttiType.GetFields;
|
||||
var fields: TArray<TField>;
|
||||
|
||||
procedure TDataRecord.TBuilder.AddField<T>(const Name: String);
|
||||
begin
|
||||
AddField<T>(Name, Default(T));
|
||||
end;
|
||||
|
||||
function TDataRecord.TBuilder.CreateRec: TDataRecord;
|
||||
begin
|
||||
FBuilder.SetupRecord(Result.FLayout, Result.FBuffer);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.TBuilder.Implicit(const AValue: IBuilder): TBuilder;
|
||||
begin
|
||||
Result.FBuilder := AValue;
|
||||
end;
|
||||
|
||||
class operator TDataRecord.TBuilder.Implicit(const AValue: TBuilder): IBuilder;
|
||||
begin
|
||||
Result := AValue.FBuilder;
|
||||
end;
|
||||
|
||||
{ TDataRecord }
|
||||
|
||||
function TDataRecord.GetField<T>(const Name: String): IField<T>;
|
||||
var
|
||||
idx: Integer;
|
||||
begin
|
||||
idx := IndexOf(Name);
|
||||
if idx < 0 then
|
||||
exit;
|
||||
if TypeInfo(T) <> FLayout[idx].TypeInfo then
|
||||
exit;
|
||||
Result := TGenericField<T>.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateBuilder: TBuilder;
|
||||
begin
|
||||
// Create the implementation class and wrap it in the helper record.
|
||||
Result := TDataRecord.TBuilder.Create(TDataRecordBuilder.Create);
|
||||
end;
|
||||
|
||||
class function TDataRecord.CreateFrom<T>(const Rec: T): TDataRecord;
|
||||
var
|
||||
ctx: TRttiContext;
|
||||
rttiType: TRttiType;
|
||||
builder: TBuilder.IBuilder;
|
||||
begin
|
||||
// Create a builder to construct the TDataRecord
|
||||
builder := CreateBuilder;
|
||||
|
||||
// Use RTTI to iterate over the fields of the source record/object
|
||||
ctx := TRttiContext.Create;
|
||||
rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
// Add each field and its value to the builder
|
||||
for var field in rttiType.GetFields do
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
builder.AddField(field.Name, field.GetValue(Pointer(@Rec)));
|
||||
end;
|
||||
var rf := rttiFields[i];
|
||||
var idx := FLayout.IndexOf(rf.Name);
|
||||
|
||||
// Create the final TDataRecord from the builder
|
||||
builder.SetupRecord(Result.FLayout, Result.FBuffer);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.AssignTo<T>(var Rec: T);
|
||||
var
|
||||
ctx: TRttiContext;
|
||||
rttiType: TRttiType;
|
||||
fieldValue: TValue;
|
||||
fieldIndex: Integer;
|
||||
layout: TFieldLayout;
|
||||
begin
|
||||
Assert(FitsRecord<T>);
|
||||
|
||||
// Use RTTI to iterate over the fields of the destination record/object
|
||||
ctx := TRttiContext.Create;
|
||||
rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
for var rttiField in rttiType.GetFields do
|
||||
begin
|
||||
// Find the corresponding field in the TDataRecord by name
|
||||
fieldIndex := IndexOf(rttiField.Name);
|
||||
if fieldIndex >= 0 then
|
||||
if (idx >= 0) then
|
||||
begin
|
||||
layout := FLayout[fieldIndex];
|
||||
// Create a TValue from the data in our buffer
|
||||
TValue.Make(@FBuffer[layout.Offset], layout.TypeInfo, fieldValue);
|
||||
// Assign the value to the destination record's field
|
||||
rttiField.SetValue(Pointer(@Rec), fieldValue);
|
||||
var fld := FLayout.Fields[idx];
|
||||
|
||||
var S: PByte := @Src;
|
||||
inc(S, rf.Offset);
|
||||
var P := @FBuffer[FLayout.Fields[idx].Offset];
|
||||
|
||||
fld.Write(rf.FieldType.Handle, S^, P);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataRecord.FitsRecord<T>: Boolean;
|
||||
class function TDataRecord.CreateFrom(const Layout: TLayout): TDataRecord;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
|
||||
for var rttiField in rttiType.GetFields do
|
||||
begin
|
||||
// Find the corresponding field in the TDataRecord by name
|
||||
var fieldIndex := IndexOf(rttiField.Name);
|
||||
if fieldIndex < 0 then
|
||||
exit(false);
|
||||
|
||||
if rttiField.DataType.Handle <> FLayout[fieldIndex].TypeInfo then
|
||||
exit(false);
|
||||
end;
|
||||
exit(true);
|
||||
var buf: TBytes;
|
||||
SetLength(buf, Layout.GetBufferSize);
|
||||
Result.Create(Layout, buf);
|
||||
end;
|
||||
|
||||
function TDataRecord.GetField(const Name: String): IField;
|
||||
var
|
||||
idx: Integer;
|
||||
{ TDataRecord }
|
||||
|
||||
class function TDataRecord.CreateFrom<T>: TDataRecord;
|
||||
begin
|
||||
idx := IndexOf(Name);
|
||||
if idx < 0 then
|
||||
exit;
|
||||
var typeInfo := FLayout[idx].TypeInfo;
|
||||
case typeInfo.Kind of
|
||||
tkInteger: Result := TIntegerField.Create(FBuffer, FLayout[idx]);
|
||||
tkFloat:
|
||||
case GetTypeData(typeInfo).FloatType of
|
||||
ftSingle: Result := TSingleField.Create(FBuffer, FLayout[idx]);
|
||||
ftDouble: Result := TDoubleField.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
tkInt64: Result := TInt64Field.Create(FBuffer, FLayout[idx]);
|
||||
tkString: Result := TStringField.Create(FBuffer, FLayout[idx]);
|
||||
end;
|
||||
if not Assigned(Result) then
|
||||
Result := TField.Create(FBuffer, FLayout[idx]);
|
||||
Result := CreateFrom(TLayout.CreateFrom<T>);
|
||||
end;
|
||||
|
||||
function TDataRecord.IndexOf(const Name: String): Integer;
|
||||
var
|
||||
dummyLayout: TFieldLayout;
|
||||
class function TDataRecord.CreateFrom<T>(const Src: T): TDataRecord;
|
||||
begin
|
||||
dummyLayout.Name := Name;
|
||||
if not TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, Result, TFieldLayoutComparer.DefaultComparer) then
|
||||
Result := -1;
|
||||
Result := CreateFrom<T>;
|
||||
Result.CopyFrom<T>(Src);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
|
||||
procedure TDataRecord.GetValue(Idx: Integer; out Value);
|
||||
begin
|
||||
Finalize(Dest);
|
||||
|
||||
Dest.FLayout := Src.FLayout;
|
||||
SetLength(Dest.FBuffer, Length(Src.FBuffer));
|
||||
for var i := 0 to High(Dest.FLayout) do
|
||||
begin
|
||||
Assert(Dest.FLayout[i].Name = Src.Layout[i].Name);
|
||||
Assert(Dest.FLayout[i].Offset = Src.Layout[i].Offset);
|
||||
Assert(Dest.FLayout[i].Size = Src.Layout[i].Size);
|
||||
Assert(Dest.FLayout[i].TypeInfo = Src.Layout[i].TypeInfo);
|
||||
|
||||
var ofs := Dest.FLayout[i].Offset;
|
||||
var P: PByte := @Dest.FBuffer[ofs];
|
||||
var Q: PByte := @Src.FBuffer[ofs];
|
||||
var Val: TValue;
|
||||
TValue.Make(Q, Dest.FLayout[i].TypeInfo, val);
|
||||
val.ExtractRawData(P);
|
||||
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
||||
case FLayout.Fields[Idx].FieldType of
|
||||
dfFloat: Double(Value) := PDouble(P)^;
|
||||
dfInteger: Int64(Value) := PInt64(Value)^;
|
||||
dfString: String(Value) := PString(Value)^;
|
||||
dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Initialize(out Dest: TDataRecord);
|
||||
procedure TDataRecord.SetValue(Idx: Integer; const Value);
|
||||
begin
|
||||
Dest.FLayout := nil;
|
||||
Dest.FBuffer := nil;
|
||||
var P := @FBuffer[FLayout.Fields[Idx].Offset];
|
||||
case FLayout.Fields[Idx].FieldType of
|
||||
dfFloat: PDouble(P)^ := Double(Value);
|
||||
dfInteger: PInt64(P)^ := Int64(Value);
|
||||
dfString: PString(P)^ := String(Value);
|
||||
dfTimestamp: PDateTime(P)^ := TDateTime(Value);
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataRecord.GetValue<T>(const Name: String): T;
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Read(@FBuffer[FLayout.Fields[idx].Offset], TypeInfo(T), Result);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
|
||||
begin
|
||||
var idx := FLayout.IndexOf(Name);
|
||||
if (idx >= 0) then
|
||||
FLayout.Fields[idx].Write(TypeInfo(T), Value, @FBuffer[FLayout.Fields[idx].Offset]);
|
||||
end;
|
||||
|
||||
class operator TDataRecord.Finalize(var Dest: TDataRecord);
|
||||
begin
|
||||
if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
|
||||
Exit;
|
||||
for var i := 0 to High(Dest.FLayout.Fields) do
|
||||
Dest.FLayout.Fields[i].Finalize(@Dest.FBuffer[Dest.FLayout.Fields[i].Offset]);
|
||||
end;
|
||||
|
||||
for var layout in Dest.FLayout do
|
||||
begin
|
||||
var P: PByte := @Dest.FBuffer[layout.Offset];
|
||||
var Val: TValue;
|
||||
// IsMoved has to be false, because we want the local TValue to own the field and destroy it when it looses scope!
|
||||
TValue.MakeWithoutCopy(P, layout.TypeInfo, val, false);
|
||||
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
|
||||
begin
|
||||
FName := AName;
|
||||
FFieldType := AFieldType;
|
||||
FOffset := AOffset;
|
||||
FSize := ASize;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Finalize(P: Pointer);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat: PDouble(P)^ := 0;
|
||||
dfInteger: PInt64(P)^ := 0;
|
||||
dfString: PString(P)^ := '';
|
||||
dfTimestamp: PDateTime(P)^ := 0;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
Dest.FLayout := nil;
|
||||
Dest.FBuffer := nil;
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Write(SrcType: PTypeInfo; const Src; P: Pointer);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
case GetTypeData(SrcType).FloatType of
|
||||
ftSingle: PDouble(P)^ := PSingle(@Src)^;
|
||||
ftDouble: PDouble(P)^ := PDouble(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfInteger:
|
||||
begin
|
||||
case SrcType.Kind of
|
||||
tkInteger: PInt64(P)^ := PInteger(@Src)^;
|
||||
tkInt64: PInt64(P)^ := PInt64(@Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfString:
|
||||
begin
|
||||
Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]);
|
||||
PString(P)^ := PString(@Src)^;
|
||||
end;
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
PDateTime(P)^ := PDateTime(@Src)^;
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField;
|
||||
begin
|
||||
case rttiType.TypeKind of
|
||||
tkInteger, tkInt64: Result.Create(AName, dfInteger, Offset, sizeof(Int64));
|
||||
tkFloat:
|
||||
if (rttiType.Name = 'TDateTime') then
|
||||
Result.Create(AName, dfTimestamp, Offset, sizeof(TDateTime))
|
||||
else
|
||||
Result.Create(AName, dfFloat, Offset, sizeof(Double));
|
||||
tkString, tkWString, tkLString, tkUString: Result.Create(AName, dfString, Offset, sizeof(String));
|
||||
else
|
||||
raise Exception.Create('Type not supported');
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataRecord.TField.From<T>(const AName: string; Offset: Integer): TField;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
Result := From(AName, ctx.GetType(TypeInfo(T)), Offset);
|
||||
end;
|
||||
|
||||
procedure TDataRecord.TField.Read(Src: Pointer; DstType: PTypeInfo; var Dst);
|
||||
begin
|
||||
case FFieldType of
|
||||
dfFloat:
|
||||
begin
|
||||
Assert(DstType.Kind = tkFloat);
|
||||
case GetTypeData(DstType).FloatType of
|
||||
ftSingle: PSingle(@Dst)^ := PDouble(Src)^;
|
||||
ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfInteger:
|
||||
begin
|
||||
case DstType.Kind of
|
||||
tkInteger: PInteger(@Dst)^ := PInt64(Src)^;
|
||||
tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
dfString:
|
||||
begin
|
||||
Assert(DstType.Kind in [tkString, tkLString, tkUString, tkWString]);
|
||||
PString(@Dst)^ := PString(Src)^;
|
||||
end;
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(DstType.Kind = tkFloat);
|
||||
PDateTime(@Dst)^ := PDateTime(Src)^;
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
|
||||
begin
|
||||
FFields := AFields;
|
||||
end;
|
||||
|
||||
{ TLayout }
|
||||
|
||||
class function TDataRecord.TLayout.CreateFrom<T>: TLayout;
|
||||
begin
|
||||
var ctx := TRttiContext.Create;
|
||||
var rttiType := ctx.GetType(TypeInfo(T));
|
||||
var rttiFields := rttiType.GetFields;
|
||||
var fields: TArray<TField>;
|
||||
|
||||
// Add each field and its value to the builder
|
||||
var ofs := 0;
|
||||
SetLength(fields, Length(rttiFields));
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
var rf := rttiFields[i];
|
||||
fields[i] := TField.From(rf.Name, rf.FieldType, ofs);
|
||||
inc(ofs, fields[i].Size);
|
||||
ofs := (ofs + 7) and not 7;
|
||||
end;
|
||||
|
||||
Result.Create(fields);
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.GetBufferSize: Integer;
|
||||
begin
|
||||
if (Length(FFields) = 0) then
|
||||
exit(0);
|
||||
|
||||
var n := High(FFields);
|
||||
Result := FFields[n].FOffset + FFields[n].Size;
|
||||
Result := (Result + 7) and not 7;
|
||||
end;
|
||||
|
||||
function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
|
||||
begin
|
||||
for var i := 0 to High(FFields) do
|
||||
if (FFields[i].Name = Name) then
|
||||
exit(i);
|
||||
exit(-1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user