מיפוי מערך נתונים לאובייקט עבור מבני-מורשת לא שגרתיים: יציב, ניתן לניפוי שגיאות, ללא קסמי ORM

unit Legacy.DatasetMapper;

interface

uses
  System.SysUtils, System.Variants, 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);

  // המירה מקבלת Variant ומחזירה Variant (למשל Null, Integer, String, TDateTime כ-Double)
  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;
  public
    property OnDebug: TMapDebugEvent read FOnDebug write FOnDebug;

    // MapOne: קורא Setter עבור כל Spec. אין RTTI: הקצאה מפורשת ניתנת לדיבג טוב יותר.
    procedure MapOne(DS: TDataSet; const Specs: TArray<TFieldSpec>;
      const Assign: TProc<string, Variant>);
  end;

// ממירי עזר
function C_TrimToNull: TFieldConverter;
function C_ZeroToNull: TFieldConverter;
function C_StrictInt: TFieldConverter;
function C_DateFromStringOrNull: 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.FindFieldByCandidates(DS: TDataSet; const Candidates: TArray<string>): TField;
var
  Name: string;
begin
  Result := nil;
  for Name in Candidates do
  begin
    // FindField במקום FieldByName: אפשרות אופציונלית, ללא Exception
    Result := DS.FindField(Name);
    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;
  CandidatesJoined: string;
  I: Integer;
  FT: string;
begin
  if (DS = nil) then
    raise EArgumentNilException.Create('DS');
  if not DS.Active then
    raise EInvalidOperation.Create('ה-Dataset אינו פעיל.');

  for Spec in Specs do
  begin
    F := FindFieldByCandidates(DS, Spec.SourceCandidates);

    if (F = nil) then
    begin
      if Spec.Required = mrRequired then
      begin
        CandidatesJoined := '';
        for I := 0 to High(Spec.SourceCandidates) do
        begin
          if I > 0 then CandidatesJoined := CandidatesJoined + ', ';
          CandidatesJoined := CandidatesJoined + Spec.SourceCandidates[I];
        end;
        raise EDataMappingError.Create(
          Spec.TargetMember,
          CandidatesJoined,
          'n/a',
          'n/a',
          Format('שגיאת מיפוי: שדה Required עבור %s לא נמצא. מועמדים: [%s]',
            [Spec.TargetMember, CandidatesJoined]));
      end
      else
        Continue; // אופציונלי: לדלג בפשטות
    end;

    Raw := F.Value; // Variant; מתייחס ל-Null
    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;

      // Required: Null אחרי המרה הוא שגיאה (נפוץ יותר ממה שאומרים)
      if (Spec.Required = mrRequired) and VarIsNull(Val) then
      begin
        FT := FieldTypeToString(F.DataType);
        raise EDataMappingError.Create(
          Spec.TargetMember,
          F.FieldName,
          FT,
          VariantToDiag(Raw),
          Format('שגיאת מיפוי: %s מסומן כ-Required, אך הערך הוא NULL לאחר המרה. שדה %s (%s), ערך גולמי=%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('שגיאת מיפוי ב-%s מתוך שדה %s (%s), ערך גולמי=%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);
    // סובל גם '0' כמחרוזת
    N := StrToInt64(Trim(VarToStr(V)));
    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)));
  end;
end;

function C_DateFromStringOrNull: 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);

    // נוקשה בכוונה: אין 'Try' שיתפח את איכות הנתונים.
    // הפורמט עלול להשתנות בהתאם ל-Legacy; אם צריך ניתן לפרמטר זאת כאן דרך TFormatSettings.
    D := ISO8601ToDate(S, False);
    Result := D;
  end;
end;

end.

type
  TCustomer = class
  public
    Id: Integer;
    ExternalNo: string;
    DisplayName: string;
    BirthDate: TDateTime; // optional in Legacy
  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_DateFromStringOrNull)
    ];

    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;