Quick.Core.AutoMapper.pas

{ ***************************************************************************

  Copyright (c) 2016-2026 Kike Perez

  Unit        : Quick.Core.AutoMapper
  Description : Core AutoMapper
  Author      : Kike Perez
  Version     : 1.0
  Created     : 07/02/2020
  Modified    : 08/05/2026

  This file is part of QuickCore: https://github.com/exilon/QuickCore

 ***************************************************************************

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.

 *************************************************************************** }

unit Quick.Core.AutoMapper;

{$i QuickCore.inc}

interface

uses
  System.SysUtils,
  typinfo,
  System.Rtti,
  Quick.RTTI.Utils,
  System.Generics.Collections,
  Quick.Value,
  Quick.Core.Mapping.Abstractions;

type

  TMapProc<TSource,TDestination> = reference to procedure(src : TSource; dest : TDestination);
  TValueConverterFunc = reference to function(const aSrcValue : TValue) : TValue;

  TCustomMapping = class
  private
    fMapDictionary : TDictionary<string,string>;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddMap(const aName, aMapName : string);
    function GetMap(const aName : string; out vMapName : string) : Boolean;
    function Count : Integer;
  end;

  TProfileMap = class
  private
    fMap              : TMapProc<TObject,TObject>;
    fCustomMapping    : TCustomMapping;
    fIgnoreOtherMembers   : Boolean;
    fIgnoreAllNonExisting : Boolean;
    fSrcClass         : TClass;
    fDstClass         : TClass;
    fBeforeMap        : TMapProc<TObject,TObject>;
    fAfterMap         : TMapProc<TObject,TObject>;
    fMemberConditions : TDictionary<string, TFunc<TObject,Boolean>>;
    fValueConverters  : TDictionary<string, TValueConverterFunc>;
    fNullSubstitutes  : TDictionary<string, TValue>;
  public
    constructor Create(aMap : TMapProc<TObject,TObject>; aSrcClass : TClass = nil; aDstClass : TClass = nil);
    destructor Destroy; override;
    property Map : TMapProc<TObject,TObject> read fMap;
    function ReverseMap : TProfileMap;
    function IgnoreOtherMembers : TProfileMap;
    function IgnoreAllNonExisting : TProfileMap;
    function ForMember(const aSrcProperty, aTgtProperty : string) : TProfileMap;
    /// <summary>Skip mapping aDstMember when aCondition(src) returns False.</summary>
    function Condition(const aDstMember : string; aCondition : TFunc<TObject,Boolean>) : TProfileMap;
    /// <summary>Apply aConverter to transform the source TValue before assigning to aDstMember.</summary>
    function ConvertUsing(const aDstMember : string; aConverter : TValueConverterFunc) : TProfileMap;
    /// <summary>Use aValue when the mapped source member resolves to null/empty.</summary>
    function NullSubstitute(const aDstMember : string; const aValue : TValue) : TProfileMap;
    /// <summary>Called before the RTTI auto-mapping for the root object.</summary>
    function BeforeMap(aProc : TMapProc<TObject,TObject>) : TProfileMap;
    /// <summary>Called after the RTTI auto-mapping for the root object.</summary>
    function AfterMap(aProc : TMapProc<TObject,TObject>) : TProfileMap;
  end;

  TProfileMapList = TObjectDictionary<string,TProfileMap>;

  TProfile = class
  class var
    fMappings : TProfileMapList;
    fResolveUnmapped : Boolean;
    fDefaultProfileMap : TProfileMap;
    class function GetKey(aSrcObj, aTgtObj : TObject) : string; overload;
    class function GetKey(aSrcObj, aTgtObj: TClass): string; overload;
  public
    class constructor Create;
    class destructor Destroy;
    constructor Create; virtual;
    procedure Configure; virtual;
    function ResolveUnmapped : TProfileMap;
    function CreateMap<TSource,TDestination : class, constructor>(aMapProc : TMapProc<TSource,TDestination> = nil) : TProfileMap;
  end;

  TAutoMapper = class(TInterfacedObject,IMapper)
  private
    fDefaultProfileMap : TProfileMap;
    fResolveUnmapped : Boolean;
    fMappingList : TObjectDictionary<string,TProfileMap>;
    procedure MapInternal(aSrcObj, aTgtObj : TObject; aContext : TMapContext);
    procedure ObjMapper(aSrcObj : TObject; aTgtObj : TObject; aProfileMap : TProfileMap; IsRootClass : Boolean); overload;
    procedure ListMapper(aSrcList, aTgtList : TObject; aProfileMap : TProfileMap);
    procedure ObjListMapper(aSrcObjList, aTgtObjList: TObject; aProfileMap: TProfileMap);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Map(aSrcObj, aTgtObj : TObject); overload;
    function Map<T : class, constructor>(aSrcObj : TObject) : T; overload;
    function Map(aSrcObj : TObject) : TMapTarget; overload;
    function Map(aSrcObj : TObject; aConfigure : TMapOptionsProc) : TMapTarget; overload;
    function Map<T : class, constructor>(aSrcObj : TObject; aConfigure : TMapOptionsProc) : T; overload;
    class procedure RegisterProfile<T : TProfile, constructor>;
    class function CurrentContext : TMapContext;
    /// <summary>Validates all registered mappings. Raises EAutoMapperError if any
    /// destination property has no corresponding source property and the mapping
    /// does not use IgnoreAllNonExisting or IgnoreOtherMembers.</summary>
    procedure AssertConfigurationIsValid;
  end;

  EAutoMapperError = class(Exception);

implementation

threadvar
  vCurrentMapContext : TMapContext;

function IsNullMappingValue(const aValue : TValue) : Boolean;
begin
  Result := aValue.IsEmpty or ((aValue.Kind = tkClass) and aValue.IsObjectInstance and (aValue.AsObject = nil));
end;

function ApplyNullSubstitute(aProfileMap : TProfileMap; const aDstMember : string;
  const aValue : TValue) : TValue;
begin
  Result := aValue;
  if Assigned(aProfileMap) and IsNullMappingValue(Result) then
    if aProfileMap.fNullSubstitutes.ContainsKey(aDstMember) then
      Result := aProfileMap.fNullSubstitutes[aDstMember];
end;

{ TAutoMapper }

constructor TAutoMapper.Create;
begin
  fMappingList := TProfile.fMappings;
  fResolveUnmapped := TProfile.fResolveUnmapped;
  fDefaultProfileMap := TProfile.fDefaultProfileMap;
end;

destructor TAutoMapper.Destroy;
begin
  fDefaultProfileMap := nil;
  inherited;
end;

procedure TAutoMapper.ListMapper(aSrcList, aTgtList: TObject; aProfileMap: TProfileMap);
var
  rtype: TRttiType;
  rtype2 : TRttiType;
  typinfo : PTypeInfo;
  methToArray: TRttiMethod;
  value: TValue;
  valuecop : TValue;
  obj : TObject;
  i : Integer;
  rprop : TRttiProperty;
  ctx : TRttiContext;
begin
  rtype := ctx.GetType(aSrcList.ClassInfo);
  methToArray := rtype.GetMethod('ToArray');
  if Assigned(methToArray) then
  begin
    value := methToArray.Invoke(aSrcList,[]);
    Assert(value.IsArray);

    rtype2 := ctx.GetType(aTgtList.ClassInfo);
    rProp := rtype2.GetProperty('List');
    typinfo := GetTypeData(rProp.PropertyType.Handle).DynArrElType^;

    case typinfo.Kind of
      tkChar, tkString, tkWChar, tkWString : TList<string>(aTgtList).Capacity := value.GetArrayLength;
      tkInteger, tkInt64 : TList<Integer>(aTgtList).Capacity := value.GetArrayLength;
      tkFloat : TList<Extended>(aTgtList).Capacity := value.GetArrayLength;
      tkRecord :
        begin
          ObjMapper(aSrcList,aTgtList,aProfileMap,False);
          exit;
        end;
      else TList<TObject>(aTgtList).Capacity := value.GetArrayLength;
    end;

    for i := 0 to value.GetArrayLength - 1 do
    begin
      if typinfo.Kind = tkClass then
      begin
        obj := typinfo.TypeData.ClassType.Create;
        ObjMapper(value.GetArrayElement(i).AsObject,obj,aProfileMap,False);
        TList<TObject>(aTgtList).Add(obj);
      end
      else
      begin
        valuecop := value.GetArrayElement(i);
        case typinfo.Kind of
          tkChar, tkString, tkWChar, tkWString : TList<string>(aTgtList).Add(valuecop.AsString);
          tkInteger, tkInt64 : TList<Integer>(aTgtList).Add(valuecop.AsInt64);
          tkFloat : TList<Extended>(aTgtList).Add(valuecop.AsExtended);
        end;
      end;
    end;
  end;
end;

class procedure TAutoMapper.RegisterProfile<T>;
var
  profile : T;
begin
  profile := T.Create;
  try
    //only need to call constructor add profilesmap to global TProfile class
  finally
    profile.Free;
  end;
end;

procedure TAutoMapper.Map(aSrcObj, aTgtObj: TObject);
begin
  MapInternal(aSrcObj, aTgtObj, nil);
end;

procedure TAutoMapper.MapInternal(aSrcObj, aTgtObj : TObject; aContext : TMapContext);
var
  profile : TProfileMap;
  oldContext : TMapContext;
begin
  oldContext := vCurrentMapContext;
  vCurrentMapContext := aContext;
  try
  if TProfile.fMappings.TryGetValue(TProfile.GetKey(aSrcObj,aTgtObj),profile) then
  begin
    ObjMapper(aSrcObj,aTgtObj,profile,True);
  end
  else
  begin
    if fResolveUnmapped then ObjMapper(aSrcObj,aTgtObj,fDefaultProfileMap,True)
      else raise EAutoMapperError.CreateFmt('AutoMapper: Not defined profile for %s > %s',[aSrcObj.ClassName,aTgtObj.ClassName]);
  end;
  finally
    vCurrentMapContext := oldContext;
  end;
end;

function TAutoMapper.Map(aSrcObj : TObject): TMapTarget;
begin
  if aSrcObj = nil then raise EAutoMapperError.Create('AutoMapper: Source object cannot be null!');
  Result.Create(aSrcObj,Self.MapInternal);
end;

function TAutoMapper.Map(aSrcObj : TObject; aConfigure : TMapOptionsProc) : TMapTarget;
var
  mapContext : TMapContext;
begin
  if aSrcObj = nil then raise EAutoMapperError.Create('AutoMapper: Source object cannot be null!');
  mapContext := TMapContext.Create;
  if Assigned(aConfigure) then
    aConfigure(mapContext);
  Result.Create(aSrcObj, Self.MapInternal, mapContext);
end;

function TAutoMapper.Map<T>(aSrcObj: TObject): T;
begin
  Result := Map(aSrcObj).AsType<T>;
end;

function TAutoMapper.Map<T>(aSrcObj : TObject; aConfigure : TMapOptionsProc) : T;
begin
  Result := Map(aSrcObj, aConfigure).AsType<T>;
end;

class function TAutoMapper.CurrentContext : TMapContext;
begin
  Result := vCurrentMapContext;
end;

procedure TAutoMapper.ObjMapper(aSrcObj : TObject; aTgtObj : TObject; aProfileMap : TProfileMap; IsRootClass : Boolean);
var
  ctx : TRttiContext;
  rType : TRttiType;
  tgtprop : TRttiProperty;
  mapname : string;
  obj : TObject;
  clname : string;
  objvalue : TValue;
  conditionFn : TFunc<TObject,Boolean>;
  converterFn : TValueConverterFunc;
  srcValue : TValue;
begin
  //if aTgtObj = nil then aTgtObj := GetTypeData(aTgtObj.ClassInfo).classType.Create;
  if aTgtObj = nil then raise EAutoMapperError.Create('TObjMapper: Target Object passed must be created before');
  if not Assigned(aProfileMap) then EAutoMapperError.CreateFmt('AutoMapper: Not defined Profile for %s > %s mapping',[aSrcObj.ClassName,aTgtObj]);

  // BeforeMap hook (AM-04)
  if IsRootClass and Assigned(aProfileMap.fBeforeMap) then aProfileMap.fBeforeMap(aSrcObj,aTgtObj);

  //if exists a map delegate
  if (IsRootClass) and (Assigned(aProfileMap.Map)) then aProfileMap.Map(aSrcObj,aTgtObj);
  //check if need to mapping other members
  if (aProfileMap.fIgnoreOtherMembers) and (not Assigned(aProfileMap.fCustomMapping)) then
  begin
    // AfterMap hook before exit (AM-04)
    if IsRootClass and Assigned(aProfileMap.fAfterMap) then aProfileMap.fAfterMap(aSrcObj,aTgtObj);
    Exit;
  end;
  objvalue := TValue.From(aSrcObj);
  rType := ctx.GetType(aSrcObj.ClassInfo);
  for tgtprop in ctx.GetType(aTgtObj.ClassInfo).GetProperties do
  begin
    if tgtprop.IsWritable then
    begin
      // AM-02: Condition check — skip member if condition returns False
      if aProfileMap.fMemberConditions.TryGetValue(tgtprop.Name, conditionFn) then
        if not conditionFn(aSrcObj) then Continue;

      if not tgtprop.PropertyType.IsInstance then
      begin
        // AM-03: ConvertUsing — apply a registered value converter for this member
        if aProfileMap.fValueConverters.TryGetValue(tgtprop.Name, converterFn) then
        begin
          // resolve source property name (may be remapped via ForMember)
          if not aProfileMap.fCustomMapping.GetMap(tgtprop.Name, mapname) then
            mapname := tgtprop.Name;
          if rType.GetProperty(mapname) <> nil then
          begin
            srcValue := rType.GetProperty(mapname).GetValue(aSrcObj);
            srcValue := ApplyNullSubstitute(aProfileMap, tgtprop.Name, srcValue);
            try
              tgtprop.SetValue(aTgtObj, converterFn(srcValue));
            except
              on E : Exception do raise EAutoMapperError.CreateFmt('ConvertUsing error on property "%s" : %s',[tgtprop.Name, E.Message]);
            end;
          end;
          Continue;
        end;

        if (Assigned(aProfileMap)) and (Assigned(aProfileMap.fCustomMapping)) then
        begin
          if aProfileMap.fCustomMapping.GetMap(tgtprop.Name,mapname) then
          begin
            {$IFNDEF PROPERTYPATH_MODE}
              if rType.GetProperty(mapname) = nil then
              begin
                if not aProfileMap.fIgnoreAllNonExisting then raise EAutoMapperError.CreateFmt('No valid custom mapping (Source: %s - Target: %s)',[mapname,tgtprop.Name]);
                Continue; // source property does not exist — skip this target member
              end;
              try
                srcValue := rType.GetProperty(mapname).GetValue(aSrcObj);
                srcValue := ApplyNullSubstitute(aProfileMap, tgtprop.Name, srcValue);
                tgtprop.SetValue(aTgtObj,srcValue);
              except
                on E : Exception do raise EAutoMapperError.CreateFmt('Error mapping property "%s" : %s',[tgtprop.Name,e.message]);
              end;
            {$ELSE}
              if not TRTTI.PathExists(aSrcObj,mapname) then
              begin
                if not aProfileMap.fIgnoreAllNonExisting then raise EAutoMapperError.CreateFmt('No valid custom mapping (Source: %s - Target: %s)',[mapname,tgtprop.Name]);
                Continue; // source path does not exist — skip this target member
              end;
              TRTTI.SetPathValue(aTgtObj,tgtprop.Name,TRTTI.GetPathValue(aSrcObj,mapname));
            {$ENDIF}
          end
          else
          begin
            //if not ignore others, map equal names
            if (not aProfileMap.fIgnoreOtherMembers) and (rType.GetProperty(tgtprop.Name) <> nil) then
            begin
              try
                srcValue := rType.GetProperty(tgtprop.Name).GetValue(aSrcObj);
                srcValue := ApplyNullSubstitute(aProfileMap, tgtprop.Name, srcValue);
                tgtprop.SetValue(aTgtObj,srcValue);
              except
                on E : Exception do raise EAutoMapperError.CreateFmt('Error mapping property "%s" : %s',[tgtprop.Name,e.message]);
              end;
            end;
          end;
        end;
      end
      else
      begin
        obj := tgtprop.GetValue(aTgtObj).AsObject;
        if obj = nil then
        begin
          if (TRTTI.PropertyExists(aSrcObj.ClassInfo,tgtprop.Name))
            and (TRTTI.PropertyExists(aTgtObj.ClassInfo,tgtprop.Name)) then
          begin
            obj := GetObjectProp(aSrcObj,tgtprop.Name).ClassType.Create// TObject.Create;
          end
          else
          begin
            if (Assigned(aProfileMap)) and (aProfileMap.fIgnoreAllNonExisting) then Continue;
          end;
        end;

        if obj <> nil then
        begin
          try
            if (rType.GetProperty(tgtprop.Name) <> nil)
              and (not rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).IsEmpty) then clname := rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject.ClassName
            else Continue;
          except
            on E : Exception do raise EAutoMapperError.CreateFmt('Error mapping property "%s" : %s',[tgtprop.Name,e.message]);
          end;
          if clname.StartsWith('TList') then ListMapper(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aProfileMap)
          else if clname.StartsWith('TObjectList') then ObjListMapper(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aProfileMap)
            else ObjMapper(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aProfileMap,False)
        end
        else raise EAutoMapperError.CreateFmt('Target object "%s" not autocreated by class',[tgtprop.Name]);
      end;
    end;
  end;
  // AfterMap hook (AM-04)
  if IsRootClass and Assigned(aProfileMap.fAfterMap) then aProfileMap.fAfterMap(aSrcObj,aTgtObj);
end;

procedure TAutoMapper.ObjListMapper(aSrcObjList, aTgtObjList: TObject; aProfileMap: TProfileMap);
var
  rtype: TRttiType;
  rtype2 : TRttiType;
  typinfo : PTypeInfo;
  methToArray: TRttiMethod;
  value: TValue;
  obj : TObject;
  i : Integer;
  rprop : TRttiProperty;
  ctx : TRttiContext;
begin
  rtype := ctx.GetType(aSrcObjList.ClassInfo);
  methToArray := rtype.GetMethod('ToArray');
  if Assigned(methToArray) then
  begin
    value := methToArray.Invoke(aSrcObjList,[]);
    Assert(value.IsArray);

    rtype2 := ctx.GetType(aTgtObjList.ClassInfo);
    rProp := rtype2.GetProperty('List');
    typinfo := GetTypeData(rProp.PropertyType.Handle).DynArrElType^;

    for i := 0 to value.GetArrayLength - 1 do
    begin
      obj := typinfo.TypeData.ClassType.Create;
      ObjMapper(value.GetArrayElement(i).AsObject,obj,aProfileMap,False);
      TObjectList<TObject>(aTgtObjList).Add(obj);
    end;
  end;
end;

{ TProfile }

constructor TProfile.Create;
begin
  inherited;
  Configure;
end;

procedure TProfile.Configure;
begin
  // Base class — override in subclasses to register mappings
end;

class constructor TProfile.Create;
begin
  fMappings := TObjectDictionary<string,TProfileMap>.Create([doOwnsValues]);
  fResolveUnmapped := False;
  fDefaultProfileMap := TProfileMap.Create(nil);
end;

class destructor TProfile.Destroy;
begin
  fMappings.Free;
  if Assigned(fDefaultProfileMap) then fDefaultProfileMap.Free;
  fDefaultProfileMap := nil;
  inherited;
end;

class function TProfile.GetKey(aSrcObj, aTgtObj: TObject): string;
begin
  Result := aSrcObj.ClassName + ':' + aTgtObj.ClassName;
end;

class function TProfile.GetKey(aSrcObj, aTgtObj: TClass): string;
begin
  Result := aSrcObj.ClassName + ':' + aTgtObj.ClassName;
end;

function TProfile.ResolveUnmapped: TProfileMap;
begin
  fResolveUnmapped := True;
  Result := fDefaultProfileMap;
end;

function TProfile.CreateMap<TSource,TDestination>(aMapProc : TMapProc<TSource,TDestination> = nil) : TProfileMap;
var
  profilemap : TProfileMap;
begin
  profilemap := TProfileMap.Create(TMapProc<TObject,TObject>(aMapProc), TClass(TSource), TClass(TDestination));
  fMappings.Add(GetKey(TClass(TSource),TClass(TDestination)),profilemap);
  Result := profilemap;
end;

{ TProfileMap }

constructor TProfileMap.Create(aMap: TMapProc<TObject, TObject>; aSrcClass : TClass = nil; aDstClass : TClass = nil);
begin
  fIgnoreAllNonExisting := False;
  fIgnoreOtherMembers := False;
  fMap := aMap;
  fSrcClass := aSrcClass;
  fDstClass := aDstClass;
  fCustomMapping := TCustomMapping.Create;
  fMemberConditions := TDictionary<string, TFunc<TObject,Boolean>>.Create;
  fValueConverters  := TDictionary<string, TValueConverterFunc>.Create;
  fNullSubstitutes  := TDictionary<string, TValue>.Create;
end;

destructor TProfileMap.Destroy;
begin
  fCustomMapping.Free;
  fMemberConditions.Free;
  fValueConverters.Free;
  fNullSubstitutes.Free;
  inherited;
end;

function TProfileMap.ReverseMap: TProfileMap;
var
  reverseProfileMap : TProfileMap;
  reverseKey : string;
begin
  if (fSrcClass = nil) or (fDstClass = nil) then
    raise EAutoMapperError.Create('ReverseMap: mapping was not created with class type information');
  reverseKey := fDstClass.ClassName + ':' + fSrcClass.ClassName;
  if TProfile.fMappings.ContainsKey(reverseKey) then
  begin
    Result := TProfile.fMappings[reverseKey];
    Exit;
  end;
  reverseProfileMap := TProfileMap.Create(nil, fDstClass, fSrcClass);
  TProfile.fMappings.Add(reverseKey, reverseProfileMap);
  Result := reverseProfileMap;
end;

function TProfileMap.ForMember(const aSrcProperty, aTgtProperty : string): TProfileMap;
begin
  Result := Self;
  fCustomMapping.AddMap(aSrcProperty,aTgtProperty);
end;

function TProfileMap.IgnoreAllNonExisting: TProfileMap;
begin
  Result := Self;
  fIgnoreAllNonExisting := True;
end;

function TProfileMap.Condition(const aDstMember : string; aCondition : TFunc<TObject,Boolean>) : TProfileMap;
begin
  Result := Self;
  fMemberConditions.AddOrSetValue(aDstMember, aCondition);
end;

function TProfileMap.ConvertUsing(const aDstMember : string; aConverter : TValueConverterFunc) : TProfileMap;
begin
  Result := Self;
  fValueConverters.AddOrSetValue(aDstMember, aConverter);
end;

function TProfileMap.NullSubstitute(const aDstMember : string; const aValue : TValue) : TProfileMap;
begin
  Result := Self;
  fNullSubstitutes.AddOrSetValue(aDstMember, aValue);
end;

function TProfileMap.BeforeMap(aProc : TMapProc<TObject,TObject>) : TProfileMap;
begin
  Result := Self;
  fBeforeMap := aProc;
end;

function TProfileMap.AfterMap(aProc : TMapProc<TObject,TObject>) : TProfileMap;
begin
  Result := Self;
  fAfterMap := aProc;
end;

function TProfileMap.IgnoreOtherMembers: TProfileMap;
begin
  Result := Self;
  fIgnoreOtherMembers := True;
end;

{ TCustomMapping }

procedure TCustomMapping.AddMap(const aName, aMapName: string);
begin
  //add map fields
  fMapDictionary.Add(aName,aMapName);
  //add reverse lookup if not same name
  if aName <> aMapName then fMapDictionary.Add(aMapName,aName);
end;

function TCustomMapping.Count: Integer;
begin
  Result := fMapDictionary.Count;
end;

constructor TCustomMapping.Create;
begin
  fMapDictionary := TDictionary<string,string>.Create;
end;

destructor TCustomMapping.Destroy;
begin
  fMapDictionary.Free;
  inherited;
end;

function TCustomMapping.GetMap(const aName: string; out vMapName: string): Boolean;
begin
  Result := fMapDictionary.TryGetValue(aName,vMapName);
end;

{ TAutoMapper - AssertConfigurationIsValid (AM-05) }

procedure TAutoMapper.AssertConfigurationIsValid;
var
  pair    : TPair<string, TProfileMap>;
  profile : TProfileMap;
  ctx     : TRttiContext;
  srcType : TRttiType;
  dstType : TRttiType;
  tgtprop : TRttiProperty;
  mapName : string;
begin
  for pair in fMappingList do
  begin
    profile := pair.Value;
    if (profile.fSrcClass = nil) or (profile.fDstClass = nil) then Continue;
    // No validation needed if we deliberately ignore unmatched
    if profile.fIgnoreAllNonExisting then Continue;
    srcType := ctx.GetType(profile.fSrcClass.ClassInfo);
    dstType := ctx.GetType(profile.fDstClass.ClassInfo);
    for tgtprop in dstType.GetProperties do
    begin
      if not tgtprop.IsWritable then Continue;
      if tgtprop.PropertyType.IsInstance then Continue; // skip object properties
      // If IgnoreOtherMembers: auto-mapping is suppressed, only custom maps matter
      if profile.fIgnoreOtherMembers then
      begin
        // Verify that any registered custom map points to an existing source prop
        if profile.fCustomMapping.GetMap(tgtprop.Name, mapName) then
          if srcType.GetProperty(mapName) = nil then
            raise EAutoMapperError.CreateFmt(
              'AssertConfigurationIsValid: custom mapping "%s" → "%s" not found in source "%s"',
              [tgtprop.Name, mapName, profile.fSrcClass.ClassName]);
        Continue;
      end;
      // ConvertUsing covers the property
      if profile.fValueConverters.ContainsKey(tgtprop.Name) then Continue;
      // Custom ForMember mapping
      if profile.fCustomMapping.GetMap(tgtprop.Name, mapName) then
      begin
        if srcType.GetProperty(mapName) = nil then
          raise EAutoMapperError.CreateFmt(
            'AssertConfigurationIsValid: custom mapping "%s" → "%s" not found in source "%s"',
            [tgtprop.Name, mapName, profile.fSrcClass.ClassName]);
      end
      else
      begin
        // Same-name auto-mapping
        if srcType.GetProperty(tgtprop.Name) = nil then
          raise EAutoMapperError.CreateFmt(
            'AssertConfigurationIsValid: destination property "%s" has no matching source property in "%s". ' +
            'Use ForMember, ConvertUsing, or IgnoreAllNonExisting.',
            [tgtprop.Name, profile.fSrcClass.ClassName]);
      end;
    end;
  end;
end;

end.