Added GetErrorPageHandler

ideexpert/DMVC.Expert.CodeGen.Commands.pas

@@ -770,8 +770,12 @@ procedure TUnitWebModuleDeclarationCommand.ExecuteImplementation(
 var
   activerecord_con_def_name: string;
   activerecord_con_def_filename: string;
+  default_media_type: string;
 begin
   inherited;
+
+  default_media_type := 'TMVCConstants.DEFAULT_CONTENT_TYPE';
+
   Section
     .AppendLine
     .AppendLine('implementation')
@@ -790,23 +794,28 @@ begin
     .AppendLine('  System.IOUtils,')
     .AppendLine('  MVCFramework.Commons,');
 
+
+
   if Model.B[TConfigKey.program_ssv_templatepro] then
   begin
     Section
-      .AppendLine('  MVCFramework.View.Renderers.TemplatePro,')
+      .AppendLine('  MVCFramework.View.Renderers.TemplatePro,');
+    default_media_type := 'TMVCMediaType.TEXT_HTML';
   end;
 
   if Model.B[TConfigKey.program_ssv_webstencils] then
   begin
     Section
-      .AppendLine('  MVCFramework.View.Renderers.WebStencils,')
+      .AppendLine('  MVCFramework.View.Renderers.WebStencils,');
+    default_media_type := 'TMVCMediaType.TEXT_HTML';
   end;
 
 
   if Model.B[TConfigKey.program_ssv_mustache] then
   begin
     Section
-      .AppendLine('  MVCFramework.View.Renderers.Mustache,')
+      .AppendLine('  MVCFramework.View.Renderers.Mustache,');
+    default_media_type := 'TMVCMediaType.TEXT_HTML';
   end;
 
   Section
@@ -826,7 +835,7 @@ begin
     .AppendLine('      // session timeout (0 means session cookie)')
     .AppendLine('      Config[TMVCConfigKey.SessionTimeout] := dotEnv.Env(''dmvc.session_timeout'', ''0'');')
     .AppendLine('      //default content-type')
-    .AppendLine('      Config[TMVCConfigKey.DefaultContentType] := dotEnv.Env(''dmvc.default.content_type'', TMVCConstants.DEFAULT_CONTENT_TYPE);')
+    .AppendLine('      Config[TMVCConfigKey.DefaultContentType] := dotEnv.Env(''dmvc.default.content_type'', ' + default_media_type  + ');')
     .AppendLine('      //default content charset')
     .AppendLine('      Config[TMVCConfigKey.DefaultContentCharset] := dotEnv.Env(''dmvc.default.content_charset'', TMVCConstants.DEFAULT_CONTENT_CHARSET);')
     .AppendLine('      //unhandled actions are permitted?')

samples/custom_exception_handling/WebModuleU.dfm

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

samples/custom_exception_handling/WebModuleU.pas

@@ -46,6 +46,7 @@ begin
     var
       lColor: string;
     begin
+      WebContext.Response.StatusCode := HTTP_STATUS.InternalServerError;
       if E is EMyException then
       begin
         case EMyException(E).Severity of

sources/MVCFramework.Commons.pas

@@ -52,8 +52,7 @@ uses
 
 type
 
-  TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpHEAD, httpOPTIONS,
+  TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpHEAD, httpOPTIONS, httpTRACE);
-    httpTRACE);
 
   TMVCHTTPMethods = set of TMVCHTTPMethodType;
 
@@ -167,6 +166,7 @@ type
     MaxRequestSize = 'max_request_size'; // bytes
     HATEOSPropertyName = 'hateos';
     LoadSystemControllers = 'load_system_controllers';
+    ErrorPageURL = 'error_page_url';
   end;
 
   TMVCHostingFrameworkType = (hftUnknown, hftIndy, hftApache, hftISAPI);
@@ -557,15 +557,6 @@ type
     function AddPair(const Key, Value: String): TMVCStringPairList;
   end;
 
-//  TMVCViewDataSet = class(TObjectDictionary<string, TDataset>)
-//  private
-//    { private declarations }
-//  protected
-//    { protected declarations }
-//  public
-//    constructor Create;
-//  end;
-
   TMVCCriticalSectionHelper = class helper for TCriticalSection
   public
     procedure DoWithLock(const AAction: TProc);
@@ -844,13 +835,15 @@ procedure dotEnvConfigure(const dotEnvDelegate: TFunc<IMVCDotEnv>);
 implementation
 
 uses
+  MVCFramework,
   IdCoder3to4,
   System.NetEncoding,
   System.Character,
   MVCFramework.Serializer.JsonDataObjects,
   MVCFramework.Utils,
   System.RegularExpressions,
-  MVCFramework.Logger, MVCFramework.Serializer.Commons;
+  MVCFramework.Logger,
+  MVCFramework.Serializer.Commons;
 
 var
   GlobalAppName, GlobalAppPath, GlobalAppExe: string;
@@ -944,11 +937,6 @@ begin
       Exit(True);
 end;
 
-// function IP2Long(const AIP: string): UInt32;
-// begin
-// Result := IdGlobal.IPv4ToUInt32(AIP);
-// end;
-
 function B64Encode(const aValue: string): string; overload;
 begin
   // Do not use TNetEncoding

sources/MVCFramework.View.Renderers.TemplatePro.pas

@@ -43,11 +43,10 @@ uses
   MVCFramework.Serializer.Defaults,
   MVCFramework.Serializer.Intf,
   MVCFramework.DuckTyping,
-  MVCFramework.Cache,
-  TemplatePro,
   Data.DB,
   System.Rtti,
-  JsonDataObjects;
+  JsonDataObjects,
+  TemplatePro;
 
 {$WARNINGS OFF}
 
@@ -94,11 +93,21 @@ function DumpAsJSONString(const aValue: TValue; const aParameters: TArray<string
 var
   lWrappedList: IMVCList;
 begin
-  if not aValue.IsObject then
+  if aValue.IsEmpty then
+  begin
+    Exit('');
+  end
+  else if not aValue.IsObject then
   begin
     if aValue.IsType<Int64> then
     begin
       Exit(aValue.AsInt64);
+    end else if aValue.IsType<Integer> then
+    begin
+      Exit(aValue.AsInteger);
+    end else if aValue.IsType<string> then
+    begin
+      Exit(aValue.AsString);
     end;
     Exit('(Error: Cannot serialize non-object as JSON)');
   end;
@@ -178,7 +187,7 @@ begin
     begin
       for lPair in ViewModel do
       begin
-        lCompiledTemplate.SetData(lPair.Key, ViewModel[lPair.Key]);
+        lCompiledTemplate.SetData(lPair.Key, lPair.Value);
       end;
       lCompiledTemplate.SetData('LoggedUserName', WebContext.LoggedUser.UserName);
     end;

sources/MVCFramework.View.Renderers.WebStencils.pas

@@ -45,6 +45,7 @@ type
   protected
     procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
     procedure OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
+    procedure OnGetFile(Sender: TObject; const AFilename: string; var AText: string; var AHandled: Boolean);
   public
     class function GetTValueVarAsString(const Value: TValue; const VarName: string; const Processor: TWebStencilsProcessor): String;
     procedure Execute(const ViewName: string; const Builder: TStringBuilder); override;
@@ -152,6 +153,20 @@ begin
     end);
 end;
 
+procedure TMVCWebStencilsViewEngine.OnGetFile(Sender: TObject; const AFilename: string; var AText: string; var AHandled: Boolean);
+var
+  lFName: String;
+begin
+  AHandled := False;
+  if TPath.IsRelativePath(AFilename) then
+  begin
+    lFName := TPath.Combine(FViewPath, AFilename);
+    lFName := TPath.ChangeExtension(lfname, FDefaultViewFileExtension);
+    lFName := TPath.Combine(AppPath, lfname);
+    AText := TFile.ReadAllText(lfname);
+    AHandled := True;
+  end;
+end;
 
 procedure TMVCWebStencilsViewEngine.OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
 var
@@ -229,6 +244,8 @@ begin
       lWebStencilsProcessor.InputFileName := lViewFileName;
       lWebStencilsProcessor.PathTemplate := Config[TMVCConfigKey.ViewPath];
       lWebStencilsProcessor.WebRequest := WebContext.Request.RawWebRequest;
+      lWebStencilsProcessor.OnFile := OnGetFile;
+
       if Assigned(ViewModel) then
       begin
         for lPair in ViewModel do
@@ -239,6 +256,7 @@ begin
       end;
       if Assigned(WebContext.LoggedUser) then
       begin
+        lWebStencilsProcessor.UserLoggedIn := True;
         lWebStencilsProcessor.UserRoles := WebContext.LoggedUser.Roles.ToString;
       end;
       if Assigned(FBeforeRenderCallback) then

sources/MVCFramework.pas

@@ -940,7 +940,7 @@ type
     ///   PageFragment ignore header and footer views
     /// </summary>
     function Page(const AViewNames: TArray<string>; const UseCommonHeadersAndFooters: Boolean = True; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
-    function Page(const AViewName: string; const UseCommonHeadersAndFooters: Boolean = True; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
+    function Page(const AViewName: string; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
 
     /// <summary>
     ///   Page calls GetRenderedView with sensible defaults.
@@ -950,25 +950,13 @@ type
     function Page(const AViewNames: TArray<string>; const JSONModel: TJSONObject;
       const UseCommonHeadersAndFooters: Boolean = True; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
 
-    /// <summary>
-    ///   PageFragment calls GetRenderedView.
-    ///   PageFragment ignore header and footer views.
-    /// </summary>
-    function PageFragment(const AViewNames: TArray<string>; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
-
-    /// <summary>
-    ///   PageFragment calls GetRenderedView.
-    ///   PageFragment ignore header and footer views.
-    /// </summary>
-    function PageFragment(const AViewNames: TArray<string>; const JSONModel: TJSONObject; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline;
-
     /// <summary>
     /// Load mustache view located in TMVCConfigKey.ViewsPath
     /// returns the rendered views and generates output using
     /// models pushed using Push* methods.
-    /// Do not use thie method directly. Use Page and PageFragment, instead.
+    /// Do not use thie method directly. Use Page, instead.
     /// </summary>
-    function LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string; virtual;
+    //function LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string; virtual;
 
     function SessionAs<T: TMVCWebSession>: T;
     procedure RaiseSessionExpired; virtual;
@@ -1297,6 +1285,8 @@ type
     FOutput: string;
     FController: TMVCController;
   protected
+    FViewPath: string;
+    FDefaultViewFileExtension: string;
     FUseViewCache: Boolean;
     FJSONModel: TJSONObject;
     FBeforeRenderCallback: TMVCSSVBeforeRenderCallback;
@@ -1329,6 +1319,7 @@ type
 
 function IsShuttingDown: Boolean;
 procedure EnterInShutdownState;
+function GetErrorPageHandler(const ErrorPageURL: String): TMVCExceptionHandlerProc;
 
 type
   IMVCResponseBuilder = interface
@@ -1404,6 +1395,30 @@ begin
   gIsShuttingDown := True;
 end;
 
+
+function GetErrorPageHandler(const ErrorPageURL: String): TMVCExceptionHandlerProc;
+begin
+  Result := procedure(E: Exception; SelectedController: TMVCController; WebContext: TWebContext; var ExceptionHandled: Boolean)
+            var
+              lRedirectionURL: String;
+            begin
+              if E is EMVCException then
+              begin
+                WebContext.Response.Content :=
+                  Format('HTTP %d - %s: %s', [EMVCException(E).HTTPStatusCode, E.ClassName, E.Message]);
+              end
+              else
+              begin
+               WebContext.Response.Content :=
+                  Format('HTTP %d - %s: %s', [HTTP_STATUS.InternalServerError, E.ClassName, E.Message]);
+              end;
+              WebContext.Response.StatusCode := HTTP_STATUS.Found;
+              lRedirectionURL := ErrorPageURL + '?class=' + URLEncode(E.ClassName) + '&error=' + URLEncode(E.Message);
+              WebContext.Response.SetCustomHeader('location', lRedirectionURL);
+              ExceptionHandled := True;
+            end;
+end;
+
 function GetRequestShortDescription(const AWebRequest: TWebRequest): String;
 begin
   Result := Format('%s %s%s', [AWebRequest.Method, AWebRequest.PathInfo,
@@ -3010,24 +3025,6 @@ begin
               end; // end-execute-routing
             end; // if not handled by beforerouting
           except
-            on ESess: EMVCSessionExpiredException do
-            begin
-              if not CustomExceptionHandling(ESess, lSelectedController, lContext) then
-              begin
-                Log.Error('[%s] %s [PathInfo "%s"] - %d %s (Custom message: "%s")',
-                  [
-                    ESess.Classname,
-                    ESess.Message,
-                    GetRequestShortDescription(ARequest),
-                    ESess.HTTPStatusCode,
-                    HTTP_STATUS.ReasonStringFor(ESess.HTTPStatusCode),
-                    ESess.DetailedMessage
-                  ], LOGGERPRO_TAG);
-                lContext.SessionStop;
-                lSelectedController.ResponseStatus(ESess.HTTPStatusCode);
-                lSelectedController.Render(ESess);
-              end;
-            end;
             on E: EMVCException do
             begin
               if not CustomExceptionHandling(E, lSelectedController, lContext) then
@@ -3041,6 +3038,10 @@ begin
                     HTTP_STATUS.ReasonStringFor(E.HTTPStatusCode),
                     E.DetailedMessage
                   ], LOGGERPRO_TAG);
+                if lContext.SessionStarted then
+                begin
+                  lContext.SessionStop;
+                end;
                 if Assigned(lSelectedController) then
                 begin
                   lSelectedController.ResponseStatus(E.HTTPStatusCode);
@@ -3052,30 +3053,6 @@ begin
                 end;
               end;
             end;
-            on EIO: EInvalidOp do
-            begin
-              if not CustomExceptionHandling(EIO, lSelectedController, lContext) then
-              begin
-                Log.Error('[%s] %s [PathInfo "%s"] - %d %s (Custom message: "%s")',
-                  [
-                    EIO.Classname,
-                    EIO.Message,
-                    GetRequestShortDescription(ARequest),
-                    HTTP_STATUS.InternalServerError,
-                    HTTP_STATUS.ReasonStringFor(HTTP_STATUS.InternalServerError),
-                    'Invalid Op'], LOGGERPRO_TAG);
-                if Assigned(lSelectedController) then
-                begin
-                  lSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
-                  lSelectedController.Render(EIO);
-                end
-                else
-                begin
-                  SendHTTPStatus(lContext, HTTP_STATUS.InternalServerError,
-                    Format('[%s] %s', [EIO.Classname, EIO.Message]), EIO.Classname);
-                end;
-              end;
-            end;
             on Ex: Exception do
             begin
               if Ex is ESqidsException then
@@ -4422,19 +4399,19 @@ begin
   Result := FViewModel;
 end;
 
-function TMVCController.LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string;
+//function TMVCController.LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string;
-begin
+//begin
-  try
+//  try
-    Result := GetRenderedView(AViewNames, JSONModel);
+//    Result := GetRenderedView(AViewNames, JSONModel);
-    ResponseStream.Append(Result);
+//    ResponseStream.Append(Result);
-  except
+//  except
-    on E: Exception do
+//    on E: Exception do
-    begin
+//    begin
-      Log.Error('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG);
+//      Log.Error('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG);
-      raise;
+//      raise;
-    end;
+//    end;
-  end;
+//  end;
-end;
+//end;
 
 procedure TMVCController.MVCControllerAfterCreate;
 begin
@@ -4469,20 +4446,9 @@ begin
     Result := GetRenderedView(AViewNames, JSONModel, OnBeforeRenderCallback)
 end;
 
-function TMVCController.Page(const AViewName: string; const UseCommonHeadersAndFooters: Boolean; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string;
+function TMVCController.Page(const AViewName: string; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string;
 begin
-  Result := Page([AViewName], UseCommonHeadersAndFooters, OnBeforeRenderCallback);
+  Result := Page([AViewName], False, OnBeforeRenderCallback);
-end;
-
-function TMVCController.PageFragment(const AViewNames: TArray<string>;
-  const JSONModel: TJSONObject; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string;
-begin
-  Result := Page(AViewNames, JSONModel, False, OnBeforeRenderCallback);
-end;
-
-function TMVCController.PageFragment(const AViewNames: TArray<string>; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string;
-begin
-  Result := Page(AViewNames, nil, False);
 end;
 
 function TMVCController.Page(const AViewNames: TArray<string>; const UseCommonHeadersAndFooters: Boolean; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string;
@@ -5291,6 +5257,8 @@ begin
   FContentType := AContentType;
   FOutput := EmptyStr;
   FUseViewCache := Engine.fConfigCache_UseViewCache;
+  FViewPath :=  Engine.Config[TMVCConfigKey.ViewPath];
+  FDefaultViewFileExtension := WebContext.Config[TMVCConfigKey.DefaultViewFileExtension];
 end;
 
 constructor TMVCBaseViewEngine.Create(