AutoMapper TList and TObjectList

Quick.AutoMapper.pas

@@ -5,9 +5,9 @@
   Unit        : Quick.AutoMapper
   Description : Auto Mapper object properties
   Author      : Kike Pérez
-  Version     : 1.0
+  Version     : 1.1
   Created     : 25/08/2018
-  Modified    : 30/08/2018
+  Modified    : 23/09/2018
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -36,9 +36,9 @@ interface
 uses
   SysUtils,
   Generics.Collections,
-  {$IFDEF FPC}
+  //{$IFDEF FPC}
   typinfo,
-  {$ENDIF}
+  //{$ENDIF}
   RTTI;
 
 type
@@ -58,6 +58,16 @@ type
     class procedure Map(aSrcObj : TObject; aTgtObj : TObject; aCustomMapping: TCustomMapping = nil);
   end;
 
+  TListMapper = class
+  public
+    class procedure Map(aSrcList, aTgtList: TObject; aCustomMapping: TCustomMapping);
+  end;
+
+  TObjListMapper = class
+  public
+    class procedure Map(aSrcObjList : TObject; aTgtObjList : TObject; aCustomMapping : TCustomMapping = nil);
+  end;
+
   TMapper<T : class, constructor> = class
   public
     class function Map(aSrcObj : TObject; aCustomMapping: TCustomMapping = nil): T; overload;
@@ -93,16 +103,19 @@ var
   tgtprop : TRttiProperty;
   mapname : string;
   obj : TObject;
+  clname : string;
 begin
-  if aTgtObj = nil then aTgtObj := aTgtObj.ClassType.Create;
+  if aTgtObj = nil then aTgtObj := GetTypeData(aTgtObj.ClassInfo).classType.Create;
 
+  rType := ctx.GetType(aSrcObj.ClassInfo);
   for tgtprop in ctx.GetType(aTgtObj.ClassInfo).GetProperties do
   begin
     if tgtprop.IsWritable then
     begin
+      if tgtprop.Name = 'Agent'
+        then Sleep(0);
       if not tgtprop.PropertyType.IsInstance then
       begin
-        rType := ctx.GetType(aSrcObj.ClassInfo);
         if Assigned(aCustomMapping) then
         begin
           if aCustomMapping.GetMap(tgtprop.Name,mapname) then
@@ -153,7 +166,10 @@ begin
         if obj <> nil then
         begin
           {$IFNDEF FPC}
-          TObjMapper.Map(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aCustomMapping);
+          clname := rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject.ClassName;
+          if clname.StartsWith('TObjectList') then TObjListMapper.Map(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aCustomMapping)
+            else if clname.StartsWith('TList') then TListMapper.Map(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aCustomMapping)
+              else TObjMapper.Map(rType.GetProperty(tgtprop.Name).GetValue(aSrcObj).AsObject,obj,aCustomMapping)
           {$ELSE}
           TObjMapper.Map(GetObjectProp(aSrcObj,tgtprop.Name),obj,aCustomMapping);
           SetObjectProp(aTgtObj,tgtprop.Name,obj);
@@ -192,7 +208,6 @@ begin
   inherited;
 end;
 
-{}
 function TAutoMapper<TClass1, TClass2>.Map(aSrcObj: TClass1): TClass2;
 begin
   Result := TMapper<TClass2>.Map(aSrcObj,fCustomMapping);
@@ -233,4 +248,104 @@ begin
   Result := fMapDictionary.TryGetValue(aName,vMapName);
 end;
 
+{ TListMapper }
+
+class procedure TListMapper.Map(aSrcList, aTgtList: TObject; aCustomMapping: TCustomMapping);
+{$IFNDEF FPC}
+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^;
+
+    for i := 0 to value.GetArrayLength - 1 do
+    begin
+      if typinfo.Kind = tkClass then
+      begin
+        obj := typinfo.TypeData.ClassType.Create;
+        TObjMapper.Map(value.GetArrayElement(i).AsObject,obj,aCustomMapping);
+        TList<TObject>(aTgtList).Add(obj);
+      end
+      else if typinfo.Kind = tkRecord then
+      begin
+        valuecop := value.GetArrayElement(i);
+        //??
+      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;
+{$ELSE}
+begin
+
+end;
+{$ENDIF}
+
+
+{ TObjListMapper }
+
+class procedure TObjListMapper.Map(aSrcObjList, aTgtObjList: TObject; aCustomMapping: TCustomMapping);
+{$IFNDEF FPC}
+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;
+      TObjMapper.Map(value.GetArrayElement(i).AsObject,obj,aCustomMapping);
+      TObjectList<TObject>(aTgtObjList).Add(obj);
+    end;
+  end;
+end;
+{$ELSE}
+begin
+
+end;
+
+{$ENDIF}
+
 end.