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

7ziplistfile.txt

@@ -11,3 +11,4 @@
 .\samples\**\*.js
 .\samples\**\*.css
 .\samples\**\myproj*
+.\samples\**\*.htmx

sources/MVCFramework.ActiveRecordController.pas

@@ -241,6 +241,7 @@ var
   lARClass: TMVCActiveRecordClass;
   lProcessor: IMVCEntityProcessor;
   lHandled: Boolean;
+  lResponse: IMVCResponse;
 begin
   lProcessor := nil;
   if ActiveRecordMappingRegistry.FindProcessorByURLSegment(entityname, lProcessor) then
@@ -267,12 +268,20 @@ begin
 
     if lAR.LoadByPK(id) then
     begin
-      Render(ObjectDict(false).Add('data', lAR));
+      lResponse := MVCResponseBuilder
+          .StatusCode(HTTP_STATUS.OK)
+          .Body(ObjectDict(false).Add('data', lAR))
+          .Build;
     end
     else
     begin
-      Render(TMVCErrorResponse.Create(http_status.NotFound, entityname.ToLower + ' not found'));
+      lResponse := MVCResponseBuilder
+          .StatusCode(HTTP_STATUS.NotFound)
+          .Body(entityname.ToLower + ' not found')
+          .Build;
+      //Render(TMVCErrorResponse.Create(http_status.NotFound, entityname.ToLower + ' not found'));
     end;
+    TMVCRenderer.InternalRenderMVCResponse(Self, TMVCResponse(lResponse));
   finally
     lAR.Free;
   end;
@@ -362,7 +371,7 @@ begin
     Context.Response.CustomHeaders.Values['X-REF'] := Context.Request.PathInfo + '/' + lAR.GetPK.AsInt64.ToString;
     if Context.Request.QueryStringParam('refresh').ToLower = 'true' then
     begin
-      RenderStatusMessage(http_status.Created, entityname.ToLower + ' created', '', lAR);
+      RenderStatusMessage(http_status.Created, entityname.ToLower + ' created', '', lAR, False);
     end
     else
     begin
@@ -411,7 +420,7 @@ begin
     Context.Response.CustomHeaders.Values['X-REF'] := Context.Request.PathInfo;
     if Context.Request.QueryStringParam('refresh').ToLower = 'true' then
     begin
-      RenderStatusMessage(http_status.OK, entityname.ToLower + ' updated', '', lAR);
+      RenderStatusMessage(http_status.OK, entityname.ToLower + ' updated', '', lAR, False);
     end
     else
     begin

sources/MVCFramework.View.Renderers.Mustache.pas

@@ -27,11 +27,11 @@ unit MVCFramework.View.Renderers.Mustache;
 {$IFDEF LINUX}
 This unit is not compatible with Linux
 {$ENDIF}
-  interface
+interface
 
-  uses
+uses
-  MVCFramework, System.SysUtils,
+  MVCFramework, System.SysUtils, System.Generics.Collections,
-  MVCFramework.Commons, System.IOUtils, System.Classes, Data.DB;
+  MVCFramework.Commons, System.IOUtils, System.Classes, Data.DB, SynMustache;
 
 type
   { This class implements the mustache view engine for server side views }
@@ -39,17 +39,21 @@ type
   strict private
     procedure PrepareModels;
   private
-    FJSONModel: string;
+    class var fPartials: TSynMustachePartials;
+    var FJSONModel: string;
+    procedure LoadPartials;
   public
-    procedure Execute(const ViewName: string; const OutputStream: TStream);
+    procedure Execute(const ViewName: string; const OutputStream: TStream); override;
-      override;
+    constructor Create(const AEngine: TMVCEngine; const AWebContext: TWebContext;
+      const AViewModel: TMVCViewDataObject;
+      const AViewDataSets: TObjectDictionary<string, TDataSet>;
+      const AContentType: string); override;
+    class destructor Destroy;
   end;
 
 implementation
 
 uses
-  System.Generics.Collections,
-  SynMustache,
   SynCommons,
   JsonDataObjects,
   MVCFramework.Serializer.Defaults,
@@ -65,42 +69,74 @@ type
   TSynMustacheAccess = class(TSynMustache)
   end;
 
+var
+  gPartialsLoaded : Boolean = False;
+
+constructor TMVCMustacheViewEngine.Create(const AEngine: TMVCEngine;
+  const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject;
+  const AViewDataSets: TObjectDictionary<string, TDataSet>;
+  const AContentType: string);
+begin
+  inherited;
+  LoadPartials;
+end;
+
+class destructor TMVCMustacheViewEngine.Destroy;
+begin
+  fPartials.Free;
+end;
+
 procedure TMVCMustacheViewEngine.Execute(const ViewName: string; const OutputStream: TStream);
 var
-  I: Integer;
-  lPartialName: string;
   lViewFileName: string;
   lViewTemplate: RawUTF8;
   lViewEngine: TSynMustache;
   lSW: TStreamWriter;
-  lPartials: TSynMustachePartials;
 begin
   PrepareModels;
   lViewFileName := GetRealFileName(ViewName);
   if not FileExists(lViewFileName) then
     raise EMVCFrameworkViewException.CreateFmt('View [%s] not found', [ViewName]);
   lViewTemplate := StringToUTF8(TFile.ReadAllText(lViewFileName, TEncoding.UTF8));
-
   lViewEngine := TSynMustache.Parse(lViewTemplate);
   lSW := TStreamWriter.Create(OutputStream);
-  lPartials := TSynMustachePartials.Create;
   try
-    for I := 0 to Length(TSynMustacheAccess(lViewEngine).fTags) - 1 do
+    lSW.Write(UTF8Tostring(lViewEngine.RenderJSON(FJSONModel, fPartials, nil, nil)));
-    begin
-      if TSynMustacheAccess(lViewEngine).fTags[I].Kind = mtPartial then
-      begin
-        lPartialName := TSynMustacheAccess(lViewEngine).fTags[I].Value;
-        lViewFileName := GetRealFileName(lPartialName);
-        if not FileExists(lViewFileName) then
-          raise EMVCFrameworkViewException.CreateFmt('Partial View [%s] not found', [lPartialName]);
-        lViewTemplate := StringToUTF8(TFile.ReadAllText(lViewFileName, TEncoding.UTF8));
-        lPartials.Add(lPartialName, lViewTemplate);
-      end;
-    end;
-    lSW.Write(UTF8Tostring(lViewEngine.RenderJSON(FJSONModel, lPartials, nil, nil)));
   finally
     lSW.Free;
-    lPartials.Free;
+  end;
+end;
+
+procedure TMVCMustacheViewEngine.LoadPartials;
+var
+  lViewsExtension: string;
+  lViewPath: string;
+  lPartialFileNames: TArray<string>;
+  I: Integer;
+begin
+  if gPartialsLoaded then
+  begin
+    Exit
+  end
+  else
+  begin
+    TMonitor.Enter(gLock);
+    try
+      if not gPartialsLoaded then
+      begin
+        lViewsExtension := Config[TMVCConfigKey.DefaultViewFileExtension];
+        lViewPath := Config[TMVCConfigKey.ViewPath];
+        lPartialFileNames := TDirectory.GetFiles(lViewPath, '*.' + lViewsExtension);
+        fPartials := TSynMustachePartials.Create;
+        for I := 0 to High(lPartialFileNames) do
+        begin
+          fPartials.Add(TPath.GetFileNameWithoutExtension(lPartialFileNames[i]), TFile.ReadAllText(lPartialFileNames[i]));
+        end;
+        gPartialsLoaded := True;
+      end;
+    finally
+      TMonitor.Exit(gLock);
+    end;
   end;
 end;
 

sources/MVCFramework.pas

@@ -668,6 +668,7 @@ type
     function GetContext: TWebContext;
     procedure Redirect(const AUrl: string); virtual;
     procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); virtual;
+    class procedure InternalRenderMVCResponse(const Controller: TMVCRenderer; const MVCResponse: TMVCResponse);
     /// <summary>
     /// HTTP Status 201 indicates that as a result of HTTP POST request, one or more new resources have been successfully created on server.
     /// The response may contain URI in Location header field in HTTP headers list, which can have reference to the newly created resource. Also, response payload also may include an entity containing a list of resource characteristics and location(s) from which the user or user agent can choose the one most appropriate.
@@ -724,7 +725,8 @@ type
     procedure Render(const AStatusCode: Integer; AObject: TObject; const AOwns: Boolean;
       const ASerializationAction: TMVCSerializationAction = nil; const AIgnoredFields: TMVCIgnoredList = nil); overload;
     procedure Render(const AObject: IInterface;
-      const ASerializationAction: TMVCSerializationAction = nil); overload;
+      const ASerializationAction: TMVCSerializationAction = nil;
+      const AIgnoredFields: TMVCIgnoredList = nil); overload;
     procedure Render(const AStatusCode: Integer; const AObject: IInterface;
       const ASerializationAction: TMVCSerializationAction = nil); overload;
     procedure Render<T: record>(const AStatusCode: Integer; var ARecord: T); overload;
@@ -743,7 +745,7 @@ type
     procedure Render(const ATextWriter: TTextWriter; const AOwns: Boolean = True); overload;
     procedure Render(const AStream: TStream; const AOwns: Boolean = True); overload;
     procedure RenderStatusMessage(const AStatusCode: Integer; const AReasonMessage: string = '';
-      const AErrorClassName: string = ''; const ADataObject: TObject = nil); overload;
+      const AErrorClassName: string = ''; const ADataObject: TObject = nil; const AOwns: Boolean = True); overload;
     procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil;
       const AOwns: Boolean = True); overload;
     procedure Render(const AResponse: TMVCResponse; const AOwns: Boolean = True); overload;
@@ -978,7 +980,6 @@ type
       const AResponse: TWebResponse); virtual;
     function ExecuteAction(const ASender: TObject; const ARequest: TWebRequest;
       const AResponse: TWebResponse): Boolean; virtual;
-    procedure InternalRenderMVCResponse(const Controller: TMVCController; const MVCResponse: TMVCResponse);
   public
     class function GetCurrentSession(const ASessionId: string;
       const ARaiseExceptionIfExpired: Boolean = True): TMVCWebSession; static;
@@ -1094,7 +1095,8 @@ type
     fObjectDictionary: IMVCObjectDictionary;
     fHeaders: TStringList;
     fReasonString: String;
-
+    fOwnsData: Boolean;
+    procedure SetOwnsData(const Value: Boolean);
   protected
     function GetData: TObject; override;
     function GetMessage: string; override;
@@ -1108,6 +1110,8 @@ type
     procedure SetReasonString(const Value: string); override;
     procedure SetHeaders(const Value: TStringList); override;
     function GetHeaders: TStringList; override;
+    //do not expose this property through interface
+    property OwnsData: Boolean read fOwnsData write SetOwnsData;
   protected
     function HasHeaders: Boolean; override;
     function HasBody: Boolean; override;
@@ -1115,7 +1119,7 @@ type
     constructor Create; overload; virtual;
     constructor Create(const StatusCode: Integer; const Message: String); overload;
     destructor Destroy; override;
-    function GetIgnoredList: TMVCIgnoredList; virtual;
+    function GetIgnoredList: TMVCIgnoredList; override;
     [MVCDoNotSerialize]
     property StatusCode: Integer read GetStatusCode write SetStatusCode;
     [MVCDoNotSerialize]
@@ -1185,7 +1189,7 @@ type
     ['{10210D72-AFAE-4919-936D-EB08AA16C01C}']
     function StatusCode(const StatusCode: Integer): IMVCResponseBuilder;
     function Header(const Name: String; const Value: String): IMVCResponseBuilder;
-    function Body(const Data: TObject): IMVCResponseBuilder; overload;
+    function Body(const Data: TObject; const Owns: Boolean = True): IMVCResponseBuilder; overload;
     function Body(const Message: String): IMVCResponseBuilder; overload;
     function Body(const ObjDictionary: IMVCObjectDictionary): IMVCResponseBuilder; overload;
     function Build: IMVCResponse;
@@ -1221,6 +1225,7 @@ type
   private
     fBuilt: Boolean;
     fHeaders: TStringList;
+    fOwnsData: Boolean;
   protected
     fStatusCode: Integer;
     fMessage: String;
@@ -1229,7 +1234,7 @@ type
     function HasHeaders: Boolean;
     function StatusCode(const StatusCode: Integer): IMVCResponseBuilder;
     function Message(const Message: String): IMVCResponseBuilder;
-    function Body(const Data: TObject): IMVCResponseBuilder; overload;
+    function Body(const Data: TObject; const Owns: Boolean): IMVCResponseBuilder; overload;
     function Body(const MessageText: String): IMVCResponseBuilder; overload;
     function Body(const ObjDictionary: IMVCObjectDictionary): IMVCResponseBuilder; overload;
     function Header(const Name: String; const Value: String): IMVCResponseBuilder;
@@ -2614,7 +2619,7 @@ begin
                             begin
                               if Supports(lInvokeResult.AsInterface, IMVCResponse) then
                               begin
-                                InternalRenderMVCResponse(lSelectedController, TMVCResponse(lInvokeResult.AsInterface));
+                                TMVCRenderer.InternalRenderMVCResponse(lSelectedController, TMVCResponse(lInvokeResult.AsInterface));
                               end
                               else
                               begin
@@ -2640,7 +2645,7 @@ begin
                                 end
                                 else if lResponseObject is TMVCResponse then
                                 begin
-                                  InternalRenderMVCResponse(lSelectedController, TMVCResponse(lResponseObject));
+                                  TMVCRenderer.InternalRenderMVCResponse(lSelectedController, TMVCResponse(lResponseObject));
                                 end
                                 else if (not lResponseObject.InheritsFrom(TJsonBaseObject)) and TDuckTypedList.CanBeWrappedAsList(lResponseObject, lObjList) then
                                 begin
@@ -3237,22 +3242,6 @@ begin
     ': ' + AReasonString);
 end;
 
-procedure TMVCEngine.InternalRenderMVCResponse(const Controller: TMVCController; const MVCResponse: TMVCResponse);
-begin
-  if MVCResponse.HasHeaders then
-  begin
-    Controller.Context.Response.CustomHeaders.AddStrings(MVCResponse.fHeaders);
-  end;
-  if MVCResponse.HasBody then
-  begin
-    Controller.Render(MVCResponse.StatusCode, MVCResponse, False, nil, MVCResponse.GetIgnoredList);
-  end
-  else
-  begin
-    Controller.ResponseStatus(MVCResponse.StatusCode);
-  end;
-end;
-
 procedure TMVCEngine.SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
   const AReasonString: string; const AClassName: string);
 var
@@ -3722,6 +3711,26 @@ begin
   Result := GetContext.Response.StatusCode;
 end;
 
+class procedure TMVCRenderer.InternalRenderMVCResponse(
+  const Controller: TMVCRenderer; const MVCResponse: TMVCResponse);
+begin
+begin
+  if MVCResponse.HasHeaders then
+  begin
+    Controller.FContext.Response.CustomHeaders.AddStrings(MVCResponse.fHeaders);
+  end;
+  if MVCResponse.HasBody then
+  begin
+    Controller.Render(MVCResponse.StatusCode, MVCResponse, False, nil, MVCResponse.GetIgnoredList);
+  end
+  else
+  begin
+    Controller.ResponseStatus(MVCResponse.StatusCode);
+  end;
+end;
+
+end;
+
 function TMVCController.GetViewData(const aModelName: string): TObject;
 begin
   if not FViewModel.TryGetValue(aModelName, Result) then
@@ -4041,21 +4050,17 @@ end;
 procedure TMVCRenderer.RenderStatusMessage(
   const AStatusCode: Integer;
   const AReasonMessage, AErrorClassName: string;
-  const ADataObject: TObject);
+  const ADataObject: TObject;
+  const AOwns: Boolean);
 var
-  R: TMVCErrorResponse;
+  lResponse: IMVCResponse;
 begin
-  ResponseStatus(AStatusCode, AReasonMessage);
+  lResponse := MVCResponseBuilder
-  R := TMVCErrorResponse.Create;
+      .StatusCode(AStatusCode)
-  try
+      .Body(AReasonMessage)
-    R.StatusCode := AStatusCode;
+      .Body(ADataObject, AOwns)
-    R.Message := AReasonMessage;
+      .Build;
-    R.Classname := AErrorClassName;
+  TMVCRenderer.InternalRenderMVCResponse(Self, TMVCResponse(lResponse));
-    R.Data := ADataObject;
-    Render(R, False, stProperties, nil);
-  finally
-    R.Free;
-  end;
 end;
 
 procedure TMVCRenderer.RenderStream(const AStream: TStream; const AOwns,
@@ -4114,10 +4119,11 @@ end;
 
 procedure TMVCRenderer.Render(
   const AObject: IInterface;
-  const ASerializationAction: TMVCSerializationAction);
+  const ASerializationAction: TMVCSerializationAction;
+  const AIgnoredFields: TMVCIgnoredList);
 begin
   {TODO -oDanieleT -cGeneral : Handle StatusCode}
-  Render(TObject(AObject), False, ASerializationAction);
+  Render(TObject(AObject), False, ASerializationAction, AIgnoredFields);
 end;
 
 procedure TMVCRenderer.Render(const AStatusCode: Integer; AObject: TObject; const AOwns: Boolean;
@@ -4390,6 +4396,7 @@ end;
 constructor TMVCResponse.Create;
 begin
   inherited Create;
+  fOwnsData := True;
   fData := nil;
   fMessage := '';
   fObjectDictionary := nil;
@@ -4411,7 +4418,10 @@ end;
 
 destructor TMVCResponse.Destroy;
 begin
+  if FOwnsData then
+  begin
     fData.Free;
+  end;
   inherited;
 end;
 
@@ -4505,6 +4515,11 @@ begin
   fObjectDictionary := Value;
 end;
 
+procedure TMVCResponse.SetOwnsData(const Value: Boolean);
+begin
+  fOwnsData := Value;
+end;
+
 procedure TMVCResponse.SetReasonString(const Value: string);
 begin
   fReasonString := Value;
@@ -4671,6 +4686,7 @@ function TMVCResponseBuilder.Build: IMVCResponse;
 begin
   Result := TMVCResponse.Create;
   Result.Data := fData;
+  TMVCResponse(Result).OwnsData := fOwnsData;
   Result.Message := fMessage;
   Result.ObjectDictionary := fObjectDict;
   Result.StatusCode := fStatusCode;
@@ -4681,18 +4697,20 @@ end;
 constructor TMVCResponseBuilder.Create;
 begin
   inherited;
+  fOwnsData := True;
   fBuilt := False;
   fStatusCode := HTTP_STATUS.OK;
   fHeaders := nil;
 end;
 
-function TMVCResponseBuilder.Body(const Data: TObject): IMVCResponseBuilder;
+function TMVCResponseBuilder.Body(const Data: TObject; const Owns: Boolean): IMVCResponseBuilder;
 begin
   if fData <> nil then
   begin
     raise EMVCResponseBuilderException.Create('Body already contains a "Data" node - To add two or more "Data" nodes use "ObjectDict"');
   end;
   fData := Data;
+  fOwnsData := Owns;
   Result := Self;
 end;
 

sources/dmvcframeworkbuildconsts.inc

@@ -1,2 +1,2 @@
 const
-  DMVCFRAMEWORK_VERSION = '3.4.0-neon';
+  DMVCFRAMEWORK_VERSION = '3.4.1-sodium-beta';

tasks.py

@@ -79,7 +79,6 @@ def build_delphi_project(
         + project_filename
         + '"'
     )
-    #print("\n" + "".join(cmdline))
     r = ctx.run(cmdline, hide=True, warn=True)
     if r.failed:
         print(r.stdout)
@@ -325,9 +324,12 @@ def tests32(ctx, delphi_version=DEFAULT_DELPHI_VERSION):
 
     print("\nExecuting tests...")
     subprocess.Popen([r"unittests\general\TestServer\bin\TestServer.exe"], shell=True)
+    r = None
+    try:
         r = subprocess.run([r"unittests\general\Several\bin32\DMVCFrameworkTests.exe"])
         if r.returncode != 0:
-        return Exit("Compilation failed: \n" + str(r.stdout))
+            return Exit("Cannot run unit test client: \n" + str(r.stdout))
+    finally:
         subprocess.run(["taskkill", "/f", "/im", "TestServer.exe"])
     if r.returncode > 0:
         print(r)
@@ -357,9 +359,12 @@ def tests64(ctx, delphi_version=DEFAULT_DELPHI_VERSION):
 
     print("\nExecuting tests...")
     subprocess.Popen([r"unittests\general\TestServer\bin\TestServer.exe"], shell=True)
+    r = None
+    try:
         r = subprocess.run([r"unittests\general\Several\bin64\DMVCFrameworkTests.exe"])
         if r.returncode != 0:
-        return Exit("Compilation failed: \n" + str(r.stdout))
+            return Exit("Cannot run unit test client: \n" + str(r.stdout))
+    finally:
         subprocess.run(["taskkill", "/f", "/im", "TestServer.exe"])
     if r.returncode > 0:
         print(r)

unittests/general/Several/LiveServerTestU.pas

@@ -2941,14 +2941,11 @@ var
 begin
   lRes := RESTClient.Accept(TMVCMediaType.TEXT_PLAIN).Get('/website/list');
   Assert.areEqual(HTTP_STATUS.OK, lRes.StatusCode, lRes.Content);
-  var
+  var lLines := lRes.Content.Split([sLineBreak]);
-  lLines := lRes.Content.Split([sLineBreak]);
+  var lCount: Integer := 1001;
-  var
-    lCount: Integer := 1001;
   for var lLine in lLines do
   begin
-    var
+    var lLinePieces := lLine.Split(['|']);
-    lLinePieces := lLine.Split(['|']);
     if Length(lLinePieces) = 1 then
     begin
       lCount := 1001;

unittests/general/TestServer/WebModuleUnit.pas

@@ -69,7 +69,7 @@ uses
   {$ENDIF}
   MVCFramework.Middleware.Compression,
   MVCFramework.Middleware.StaticFiles, FireDAC.Comp.Client,
-  MVCFramework.ActiveRecord, FDConnectionConfigU;
+  MVCFramework.ActiveRecord, FDConnectionConfigU, System.IOUtils;
 
 procedure TMainWebModule.WebModuleCreate(Sender: TObject);
 begin
@@ -79,7 +79,7 @@ begin
       // no config here
       Config[TMVCConfigKey.SessionTimeout] := '0'; // setting cookie
       Config[TMVCConfigKey.PathPrefix] := '';
-      Config[TMVCConfigKey.ViewPath] := '..\templates';
+      Config[TMVCConfigKey.ViewPath] := TPath.Combine(AppPath, '..\templates');
       Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
     end, nil);
   MVCEngine