https://github.com/danieleteti/delphimvcframework/issues/564

README.md

@@ -703,6 +703,8 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg
 
 - Fix https://github.com/danieleteti/delphimvcframework/issues/335 (thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
 
+- Fix https://github.com/danieleteti/delphimvcframework/issues/564
+
 - Merged [PR#543](https://github.com/danieleteti/delphimvcframework/pull/543) (Now the `PathInfo` is trimmed so the router convert this "http://myserver.com/one " to this "http://myserver.com/one")
 
 - Fix for nil objects in lists during serialization

samples/activerecord_restful_crud/Entities.pas

@@ -11,7 +11,7 @@ interface
 
 type
 
-  [MVCNameCase(ncLowerCase)]
+  [MVCNameCase(ncCamelCase)]
   [MVCTable('people')]
   [MVCEntityActions([eaCreate, eaRetrieve, eaUpdate, eaDelete])]
   TPerson = class(TMVCActiveRecord)
@@ -52,7 +52,9 @@   TPerson = class(TMVCActiveRecord)
     constructor Create; override;
     destructor Destroy; override;
     property ID: Int64 read fID write SetID;
+    [MVCNameAs('person_surname')]
     property LastName: string read fLastName write SetLastName;
+    [MVCNameAs('person_name')]
     property FirstName: string read fFirstName write SetFirstName;
     property Age: NullableInt32 read fAge;
     property DOB: NullableTDate read fDOB write SetDOB;

samples/activerecord_restful_crud/WebModuleU.dfm

@@ -1,5 +1,4 @@
 object MyWebModule: TMyWebModule
-  OldCreateOrder = False
   OnCreate = WebModuleCreate
   OnDestroy = WebModuleDestroy
   Actions = <>

samples/activerecord_restful_crud/WebModuleU.pas

@@ -82,23 +82,7 @@ procedure TMyWebModule.WebModuleCreate(Sender: TObject);
   FMVC.AddController(TMVCActiveRecordController,
     function: TMVCController
     begin
-      Result := TMVCActiveRecordController.Create(
-        function: TFDConnection
-        begin
-          Result := TFDConnection.Create(nil);
-          Result.ConnectionDefName := ConnectionDefinitionName;
-        end,
-        function(aContext: TWebContext; aClass: TMVCActiveRecordClass; aAction: TMVCActiveRecordAction): Boolean
-        begin
-          if aContext.LoggedUser.IsValid then
-          begin
-            Result := True;
-          end
-          else
-          begin
-            Result := True; // not(aAction in [TMVCActiveRecordAction.Delete]);
-          end;
-        end);
+      Result := TMVCActiveRecordController.Create(ConnectionDefinitionName);
     end, '/api/entities');
 end;
 

samples/activerecord_restful_crud/activerecord_restful_crud.dpr

@@ -14,12 +14,13 @@ uses
   Web.WebReq,
   Web.WebBroker,
   IdHTTPWebBrokerBridge,
+  MVCFramework.Signal,
   MVCFramework.SQLGenerators.PostgreSQL,
   MVCFramework.SQLGenerators.Firebird,
   MVCFramework.SQLGenerators.Interbase,
   MVCFramework.SQLGenerators.MSSQL,
   MVCFramework.SQLGenerators.MySQL,
-  WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule},
+  WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} ,
   Entities in 'Entities.pas',
   MVCFramework.ActiveRecordController in '..\..\sources\MVCFramework.ActiveRecordController.pas',
   MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
@@ -41,76 +42,33 @@ begin
   if ParamCount >= 1 then
     lCmd := ParamStr(1)
   else
-    lCmd := 'start';
+    lCmd := '/firebird';
 
-  lCustomHandler :=
-      function(const Value: string; const Server: TIdHTTPWebBrokerBridge;
-      out Handled: Boolean): THandleCommandResult
-    begin
-      Handled := False;
-      Result := THandleCommandResult.Continue;
-      if (Value = '/firebird') then
-      begin
-        REPLEmit('Using FirebirdSQL');
-        Result := THandleCommandResult.Continue;
-        CreateFirebirdPrivateConnDef(True);
-        Handled := True;
-        Server.Active := True;
-        Writeln('Server listening on port ', Server.DefaultPort);
-      end
-      else if (Value = '/mysql') then
-      begin
-        REPLEmit('Using MySQL');
-        Result := THandleCommandResult.Continue;
-        CreateMySQLPrivateConnDef(True);
-        Handled := True;
-        Server.Active := True;
-        Writeln('Server listening on port ', Server.DefaultPort);
-      end
-      else if (Value = 'start') or (Value = '/postgresql') then
-      begin
-        REPLEmit('Using PostgreSQL');
-        Result := THandleCommandResult.Continue;
-        CreatePostgreSQLPrivateConnDef(True);
-        Handled := True;
-        Server.Active := True;
-        Writeln('Server listening on port ', Server.DefaultPort);
-      end;
-    end;
+  if (lCmd = '/firebird') then
+  begin
+    CreateFirebirdPrivateConnDef(True);
+  end
+  else if (lCmd = '/mysql') then
+  begin
+    CreateMySQLPrivateConnDef(True);
+  end
+  else if (lCmd = '/postgresql') then
+  begin
+    CreatePostgreSQLPrivateConnDef(True);
+  end
+  else
+  begin
+    CreateFirebirdPrivateConnDef(True);
+  end;
 
   lServer := TIdHTTPWebBrokerBridge.Create(nil);
   try
     lServer.DefaultPort := APort;
     lServer.MaxConnections := 0;
     lServer.ListenQueue := 200;
-
-    Writeln('Write "quit" or "exit" to shutdown the server');
-    repeat
-      if lCmd.IsEmpty then
-      begin
-        write('-> ');
-        ReadLn(lCmd)
-      end;
-      try
-        case HandleCommand(lCmd.ToLower, lServer, lCustomHandler) of
-          THandleCommandResult.Continue:
-            begin
-              Continue;
-            end;
-          THandleCommandResult.Break:
-            begin
-              Break;
-            end;
-          THandleCommandResult.Unknown:
-            begin
-              REPLEmit('Unknown command: ' + lCmd);
-            end;
-        end;
-      finally
-        lCmd := '';
-      end;
-    until False;
-
+    lServer.Active := True;
+    Write('CTRL+C to Quit');
+    WaitForTerminationSignal;
   finally
     lServer.Free;
   end;

samples/activerecord_restful_crud/activerecord_restful_crud.dproj

@@ -138,6 +138,7 @@
     </PropertyGroup>
     <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
         <Icon_MainIcon>activerecord_crud_Icon.ico</Icon_MainIcon>
+        <Debugger_RunParams>/postgresql</Debugger_RunParams>
     </PropertyGroup>
     <ItemGroup>
         <DelphiCompile Include="$(MainSource)">

samples/activerecord_showcase/FDConnectionConfigU.pas

@@ -95,7 +95,7 @@ procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean);
 begin
   LParams := TStringList.Create;
   try
-    LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..', 'data\ACTIVERECORDDB.FDB')));
+    LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..', 'data\ACTIVERECORDDB.FDB')));
     LParams.Add('Protocol=TCPIP');
     LParams.Add('Server=localhost');
     LParams.Add('User_Name=sysdba');

sources/MVCFramework.ActiveRecord.pas

@@ -1427,16 +1427,29 @@ function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
 var
   lPair: TPair<TRTTIField, TFieldInfo>;
   I: Integer;
+  lPropFromField: TRttiProperty;
+  lParentType: TRttiType;
+  lTmp: String;
 begin
   { TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
   { TODO -oDanieleT -cGeneral : Add NameAs in the TFieldInfo because the user needs to use the property name he see }
   if Length(fMapping) = 0 then
   begin
     if not fPrimaryKeyFieldName.IsEmpty then
     begin
+      lParentType := fPrimaryKey.Parent;
       SetLength(fMapping, fMap.Count + 1);
       fMapping[0].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
       fMapping[0].DatabaseFieldName := fPrimaryKeyFieldName;
+      lPropFromField := lParentType.GetProperty(fPrimaryKey.Name.Substring(1));
+      if Assigned(lPropFromField) then
+      begin
+        lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
+        if not SameText(lTmp, fMapping[0].InstanceFieldName) then
+        begin
+          fMapping[0].Alias := lTmp;
+        end;
+      end;
       I := 1;
     end
     else
@@ -1447,8 +1460,19 @@ function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
 
     for lPair in fMap do
     begin
+      lParentType := lPair.Key.Parent;
       fMapping[I].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
       fMapping[I].DatabaseFieldName := lPair.Value.FieldName;
+
+      lPropFromField := lParentType.GetProperty(lPair.Key.Name.Substring(1));
+      if Assigned(lPropFromField) then
+      begin
+        lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
+        if not SameText(lTmp, fMapping[I].InstanceFieldName) then
+        begin
+          fMapping[I].Alias := lTmp;
+        end;
+      end;
       Inc(I);
     end;
   end;

sources/MVCFramework.Commons.pas

@@ -583,6 +583,7 @@   TMVCStreamHelper = class helper for TStream
   TMVCFieldMap = record
     InstanceFieldName: string;
     DatabaseFieldName: string;
+    Alias: String; // allows to use "MVCNameAs" attribute in RQL queries
   end;
 
   TMVCCustomRouter = class abstract

sources/MVCFramework.RQL.Parser.pas

@@ -1203,6 +1203,15 @@ function TRQLCompiler.GetDatabaseFieldName(
     if lField.InstanceFieldName = lRQLProperty then
       Exit(GetFieldNameForSQL(lField.DatabaseFieldName));
   end;
+
+  //if no propert foundwith this name, let's look in the aliases
+  for lField in fMapping do
+  begin
+    if SameText(lField.Alias, lRQLProperty) then
+      Exit(GetFieldNameForSQL(lField.DatabaseFieldName));
+  end;
+
+
   { TODO -oDanieleT -cGeneral : Here we should consider also MVCNameAs attribute to find the name }
   if UsePropertyNameIfAttributeDoesntExists then
     Exit(GetFieldNameForSQL(RQLPropertyName))

unittests/general/Several/ActiveRecordTestsU.pas

@@ -74,6 +74,8 @@   TTestActiveRecordBase = class(TObject)
     [Test]
     procedure TestRQL;
     [Test]
+    procedure TestRQLWithMVCNameAsAttribute;
+    [Test]
     procedure TestRQLWithBoolean;
     [Test]
     procedure TestRQLWithDateTime;
@@ -1672,6 +1674,29 @@ procedure TTestActiveRecordBase.TestRQLWithGUID;
   Assert.AreEqual(Int64(0), TMVCActiveRecord.Count<TCustomerWithGUID>(RQL1));
 end;
 
+procedure TTestActiveRecordBase.TestRQLWithMVCNameAsAttribute;
+var
+  lCustomers: TObjectList<TCustomer>;
+const
+  //this RQL contains aliases defined using MVCNameAs attribute
+  RQL1 = 'and(or(eq(CityName, "Rome"),eq(City, "London")),ne(CustomerCode,"INVALID"))';
+begin
+  Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(TCustomer));
+  LoadData;
+  lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>(RQL1, MAXINT);
+  try
+    Assert.AreEqual(240, lCustomers.Count);
+    for var lCustomer in lCustomers do
+    begin
+      Assert.IsMatch('^(Rome|London)$', lCustomer.City);
+    end;
+  finally
+    lCustomers.Free;
+  end;
+  TMVCActiveRecord.DeleteRQL(TCustomer, RQL1);
+  Assert.AreEqual(Int64(0), TMVCActiveRecord.Count<TCustomer>(RQL1));
+end;
+
 procedure TTestActiveRecordBase.TestSelectWithExceptions;
 var
   lCustomer: TCustomer;

unittests/general/Several/BOs.pas

@@ -124,8 +124,10 @@   TCustomer = class(TMVCActiveRecord)
     function Clone: TCustomer;
     function ToString: String; override;
     property ID: NullableInt32 read fID write fID;
+    [MVCNameAs('CustomerCode')]
     property Code: NullableString read fCode write fCode;
     property CompanyName: NullableString read fCompanyName write fCompanyName;
+    [MVCNameAs('CityName')]
     property City: string read fCity write fCity;
     property Rating: NullableInt32 read fRating write fRating;
     property CreationTime: NullableTTime read fCreationTime write fCreationTime;