Dataset-zu-Objekt Mapping für ungewöhnliche Altstrukturen: stabil, debugbar, ohne ORM-Magie

unit Legacy.DatasetMapper;

interface

uses
  System.SysUtils,
  System.Variants,
  System.TypInfo,
  System.Generics.Collections,
  Data.DB;

type
  EDataMappingError = class(Exception)
  private
    FFieldNames: string;
    FTarget: string;
    FDataType: string;
    FRawValue: string;
  public
    constructor Create(const ATarget, AFieldNames, ADataType, ARawValue, AMsg: string);
    property Target: string read FTarget;
    property FieldNames: string read FFieldNames;
    property DataType: string read FDataType;
    property RawValue: string read FRawValue;
  end;

  TMapRequired = (mrOptional, mrRequired);

  TMapDebugEvent = reference to procedure(
    const TargetMember: string;
    const SourceField: string;
    const SourceType: TFieldType;
    const SourceValue: Variant);

  // Konverter: Variant rein, Variant raus. Null-Semantik wird hier zentralisiert.
  TFieldConverter = reference to function(const V: Variant): Variant;

  TFieldSpec = record
    TargetMember: string;
    SourceCandidates: TArray<string>;
    Required: TMapRequired;
    Converter: TFieldConverter;
    class function Create(const ATarget: string; const ACandidates: array of string;
      ARequired: TMapRequired; const AConverter: TFieldConverter): TFieldSpec; static;
  end;

  TLegacyDatasetMapper = class
  private
    FOnDebug: TMapDebugEvent;
    function FindFieldByCandidates(DS: TDataSet; const Candidates: TArray<string>): TField;
    function FieldTypeToString(FT: TFieldType): string;
    function VariantToDiag(const V: Variant): string;
    function JoinCandidates(const C: TArray<string>): string;
  public
    property OnDebug: TMapDebugEvent read FOnDebug write FOnDebug;

    procedure MapOne(DS: TDataSet; const Specs: TArray<TFieldSpec>;
      const Assign: TProc<string, Variant>);
  end;

// Beispiel-Konverter
function C_TrimToNull: TFieldConverter;
function C_ZeroToNull: TFieldConverter;
function C_StrictInt: TFieldConverter;
function C_StrictIsoDateOrNull: TFieldConverter;

implementation

{ EDataMappingError }

constructor EDataMappingError.Create(const ATarget, AFieldNames, ADataType, ARawValue, AMsg: string);
begin
  inherited Create(AMsg);
  FTarget := ATarget;
  FFieldNames := AFieldNames;
  FDataType := ADataType;
  FRawValue := ARawValue;
end;

{ TFieldSpec }

class function TFieldSpec.Create(const ATarget: string; const ACandidates: array of string;
  ARequired: TMapRequired; const AConverter: TFieldConverter): TFieldSpec;
var
  I: Integer;
begin
  Result.TargetMember := ATarget;
  SetLength(Result.SourceCandidates, Length(ACandidates));
  for I := 0 to High(ACandidates) do
    Result.SourceCandidates[I] := ACandidates[I];
  Result.Required := ARequired;
  Result.Converter := AConverter;
end;

{ TLegacyDatasetMapper }

function TLegacyDatasetMapper.FieldTypeToString(FT: TFieldType): string;
begin
  Result := GetEnumName(TypeInfo(TFieldType), Ord(FT));
end;

function TLegacyDatasetMapper.VariantToDiag(const V: Variant): string;
begin
  if VarIsNull(V) then Exit('NULL');
  if VarIsEmpty(V) then Exit('EMPTY');
  try
    Result := VarToStr(V);
  except
    Result := '<unprintable variant>';
  end;
end;

function TLegacyDatasetMapper.JoinCandidates(const C: TArray<string>): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to High(C) do
  begin
    if I > 0 then Result := Result + ', ';
    Result := Result + C[I];
  end;
end;

function TLegacyDatasetMapper.FindFieldByCandidates(DS: TDataSet; const Candidates: TArray<string>): TField;
var
  Name: string;
begin
  Result := nil;
  for Name in Candidates do
  begin
    Result := DS.FindField(Name); // keine Exception bei „Spalte fehlt“
    if Result <> nil then
      Exit;
  end;
end;

procedure TLegacyDatasetMapper.MapOne(DS: TDataSet; const Specs: TArray<TFieldSpec>;
  const Assign: TProc<string, Variant>);
var
  Spec: TFieldSpec;
  F: TField;
  Raw, Val: Variant;
  FT, Cand: string;
begin
  if DS = nil then
    raise EArgumentNilException.Create('DS');
  if not DS.Active then
    raise EInvalidOperation.Create('Dataset ist nicht aktiv.');

  for Spec in Specs do
  begin
    F := FindFieldByCandidates(DS, Spec.SourceCandidates);
    if F = nil then
    begin
      if Spec.Required = mrRequired then
      begin
        Cand := JoinCandidates(Spec.SourceCandidates);
        raise EDataMappingError.Create(
          Spec.TargetMember, Cand, 'n/a', 'n/a',
          Format('Required-Mapping fehlt: %s. Kandidaten: [%s]', [Spec.TargetMember, Cand]));
      end;
      Continue; // optional: Feld ist nicht Teil des Resultsets
    end;

    Raw := F.Value;
    if Assigned(FOnDebug) then
      FOnDebug(Spec.TargetMember, F.FieldName, F.DataType, Raw);

    try
      if Assigned(Spec.Converter) then
        Val := Spec.Converter(Raw)
      else
        Val := Raw;

      if (Spec.Required = mrRequired) and VarIsNull(Val) then
      begin
        FT := FieldTypeToString(F.DataType);
        raise EDataMappingError.Create(
          Spec.TargetMember, F.FieldName, FT, VariantToDiag(Raw),
          Format('Required ist NULL nach Konvertierung: %s aus %s (%s), Rohwert=%s',
            [Spec.TargetMember, F.FieldName, FT, VariantToDiag(Raw)]));
      end;

      Assign(Spec.TargetMember, Val);

    except
      on E: EDataMappingError do
        raise;
      on E: Exception do
      begin
        FT := FieldTypeToString(F.DataType);
        raise EDataMappingError.Create(
          Spec.TargetMember, F.FieldName, FT, VariantToDiag(Raw),
          Format('Mapping-Fehler: %s aus %s (%s), Rohwert=%s: %s',
            [Spec.TargetMember, F.FieldName, FT, VariantToDiag(Raw), E.Message]));
      end;
    end;
  end;
end;

{ Konverter }

function C_TrimToNull: TFieldConverter;
begin
  Result := function(const V: Variant): Variant
  var
    S: string;
  begin
    if VarIsNull(V) or VarIsEmpty(V) then Exit(Null);
    S := Trim(VarToStr(V));
    if S = '' then
      Result := Null
    else
      Result := S;
  end;
end;

function C_ZeroToNull: TFieldConverter;
begin
  Result := function(const V: Variant): Variant
  var
    N: Int64;
  begin
    if VarIsNull(V) or VarIsEmpty(V) then Exit(Null);
    N := StrToInt64(Trim(VarToStr(V))); // toleriert auch '0'
    if N = 0 then Result := Null else Result := N;
  end;
end;

function C_StrictInt: TFieldConverter;
begin
  Result := function(const V: Variant): Variant
  begin
    if VarIsNull(V) or VarIsEmpty(V) then Exit(Null);
    Result := StrToInt(Trim(VarToStr(V))); // bewusst strikt
  end;
end;

function C_StrictIsoDateOrNull: TFieldConverter;
begin
  Result := function(const V: Variant): Variant
  var
    S: string;
    D: TDateTime;
  begin
    if VarIsNull(V) or VarIsEmpty(V) then Exit(Null);
    S := Trim(VarToStr(V));
    if (S = '') or (S = '1899-12-30') then Exit(Null);

    // Erwartet ISO-8601. Wenn Ihr Legacy-Format anders ist: hier zentral anpassen.
    D := ISO8601ToDate(S, False);
    Result := D;
  end;
end;

end.

type
  TCustomer = class
  public
    Id: Integer;
    ExternalNo: string;
    DisplayName: string;
    BirthDate: TDateTime; // optional
  end;

function MapCustomer(DS: TDataSet; Mapper: TLegacyDatasetMapper): TCustomer;
var
  C: TCustomer;
  Specs: TArray<TFieldSpec>;
begin
  C := TCustomer.Create;
  try
    Specs := [
      TFieldSpec.Create('Id', ['CUSTOMER_ID', 'ID', 'C_ID'], mrRequired, C_StrictInt),
      TFieldSpec.Create('ExternalNo', ['EXT_NO', 'CUSTOMERNO'], mrOptional, C_TrimToNull),
      TFieldSpec.Create('DisplayName', ['NAME', 'DISPLAYNAME', 'C_NAME'], mrRequired, C_TrimToNull),
      TFieldSpec.Create('BirthDate', ['BIRTHDATE', 'DOB'], mrOptional, C_StrictIsoDateOrNull)
    ];

    Mapper.MapOne(DS, Specs,
      procedure(const Target: string; const V: Variant)
      begin
        if Target = 'Id' then
          C.Id := V
        else if Target = 'ExternalNo' then
          C.ExternalNo := VarToStrDef(V, '')
        else if Target = 'DisplayName' then
          C.DisplayName := VarToStr(V)
        else if Target = 'BirthDate' then
        begin
          if VarIsNull(V) then
            C.BirthDate := 0
          else
            C.BirthDate := V;
        end
        else
          raise EInvalidOperation.Create('Unbekanntes TargetMember: ' + Target);
      end);

    Result := C;
  except
    C.Free;
    raise;
  end;
end;