MycLib/Src/Myc.DataRecord.pas

unit Myc.DataRecord;

interface

uses
    System.SysUtils,
    System.Generics.Collections,
    System.Rtti,
    System.TypInfo;

type
    TDataFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);

    TDataRecord = record
    public
        type
            TField = record
            private
                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 AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);

                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;

                property FieldType: TDataFieldType read FFieldType;
                property Name: string read FName;
            end;

            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: TLayout;
        FBuffer: TBytes;

    public
        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);

        property Layout: TLayout read FLayout;
    end;

implementation

uses
    System.Classes,
    Myc.DataRecord.Impl;

constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
begin
    FLayout := ALayout;
    FBuffer := ABuffer;
end;

procedure TDataRecord.CopyFrom<T>(const Src: T);
begin
    var ctx := TRttiContext.Create;
    var rttiType := ctx.GetType(TypeInfo(T));
    var rttiFields := rttiType.GetFields;
    var fields: TArray<TField>;

    for var i := 0 to High(rttiFields) do
    begin
        var rf := rttiFields[i];
        var idx := FLayout.IndexOf(rf.Name);

        if (idx >= 0) then
        begin
            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;

class function TDataRecord.CreateFrom(const Layout: TLayout): TDataRecord;
begin
    var buf: TBytes;
    SetLength(buf, Layout.GetBufferSize);
    Result.Create(Layout, buf);
end;

{ TDataRecord }

class function TDataRecord.CreateFrom<T>: TDataRecord;
begin
    Result := CreateFrom(TLayout.CreateFrom<T>);
end;

class function TDataRecord.CreateFrom<T>(const Src: T): TDataRecord;
begin
    Result := CreateFrom<T>;
    Result.CopyFrom<T>(Src);
end;

procedure TDataRecord.GetValue(Idx: Integer; out Value);
begin
    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;

procedure TDataRecord.SetValue(Idx: Integer; const Value);
begin
    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
    for var i := 0 to High(Dest.FLayout.Fields) do
        Dest.FLayout.Fields[i].Finalize(@Dest.FBuffer[Dest.FLayout.Fields[i].Offset]);
end;

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;
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.