Custom Exception Handler based on OnException controller method

samples/custom_exception_handling/custom_exception_handling.dproj

@@ -1,7 +1,7 @@
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
     <PropertyGroup>
         <ProjectGuid>{EDD78707-A0BE-4217-9B4E-919CCEDF5CF6}</ProjectGuid>
-        <ProjectVersion>20.1</ProjectVersion>
+        <ProjectVersion>20.2</ProjectVersion>
         <FrameworkType>VCL</FrameworkType>
         <MainSource>custom_exception_handling.dpr</MainSource>
         <Base>True</Base>
@@ -122,7 +122,7 @@
                     <Excluded_Packages Name="$(BDSBIN)\dclofficexp250.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
                 </Excluded_Packages>
             </Delphi.Personality>
-            <Deployment Version="4">
+            <Deployment Version="5">
                 <DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule"/>
                 <DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule"/>
                 <DeployFile LocalName="$(BDS)\Redist\osx32\libcgsqlite3.dylib" Class="DependencyModule"/>
@@ -136,16 +136,6 @@
                         <Operation>0</Operation>
                     </Platform>
                 </DeployClass>
-                <DeployClass Name="AndroidClasses">
-                    <Platform Name="Android">
-                        <RemoteDir>classes</RemoteDir>
-                        <Operation>64</Operation>
-                    </Platform>
-                    <Platform Name="Android64">
-                        <RemoteDir>classes</RemoteDir>
-                        <Operation>64</Operation>
-                    </Platform>
-                </DeployClass>
                 <DeployClass Name="AndroidFileProvider">
                     <Platform Name="Android">
                         <RemoteDir>res\xml</RemoteDir>

samples/custom_exception_handling_using_controller/MyControllerU.pas

@@ -0,0 +1,116 @@
+unit MyControllerU;
+
+interface
+
+uses
+  MVCFramework,
+  MVCFramework.Commons,
+  System.SysUtils;
+
+type
+
+  [MVCPath('/')]
+  TMyController = class(TMVCController)
+  protected
+    procedure OnException(const aContext: TWebContext; const aException: Exception; var aHandled: Boolean); override;
+  public
+    [MVCPath('/')]
+    [MVCHTTPMethod([httpGET])]
+    procedure Index;
+
+    [MVCPath('/customers/($ID)')]
+    [MVCHTTPMethod([httpGET])]
+    procedure GetCustomer(const ID: Integer);
+
+    [MVCPath('/error')]
+    [MVCHTTPMethod([httpGET])]
+    procedure Error;
+  end;
+
+  TMyExceptionSeverity = (Fatal, Error, Warning, Information);
+
+  EMyException = class(Exception)
+  private
+    FSeverity: TMyExceptionSeverity;
+    FCode: Integer;
+    FDetails: string;
+    FDiagnostics: string;
+    FExpression: string;
+  public
+    constructor Create(Msg: string; ASeverity: TMyExceptionSeverity; ACode: Integer; ADetails, ADiagnostics, AExpression: string);
+    property Severity: TMyExceptionSeverity read FSeverity write FSeverity;
+    property Code: Integer read FCode write FCode;
+    property Details: string read FDetails write FDetails;
+    property Diagnostics: string read FDiagnostics write FDiagnostics;
+    property Expression: string read FExpression write FExpression;
+  end;
+
+implementation
+
+uses
+  MVCFramework.Logger, System.NetEncoding;
+
+procedure TMyController.GetCustomer(const ID: Integer);
+begin
+  Render204NoContent();
+end;
+
+procedure TMyController.Index;
+begin
+  raise EMyException.Create('My Custom Error', Fatal, 25, 'some real problem', 'Ensure Patient resource is valid',
+    'Patient/Identifier/value');
+end;
+
+procedure TMyController.OnException(const aContext: TWebContext; const aException: Exception; var aHandled: Boolean);
+var
+  lColor: string;
+begin
+  inherited;
+  StatusCode := HTTP_STATUS.InternalServerError;
+  ContentType := TMVCMediaType.TEXT_HTML;
+  aContext.Response.Content := 'This is an error: ' + aException.Message;
+  aContext.Response.StatusCode := HTTP_STATUS.InternalServerError;
+  if aException is EMyException then
+  begin
+    case EMyException(aException).Severity of
+      Fatal, TMyExceptionSeverity.Error:
+        lColor := 'red';
+      Warning:
+        lColor := 'yellow';
+      Information:
+        lColor := 'blue';
+    else
+      lColor := 'black';
+    end;
+    aContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
+    aContext.Response.Content := '<html><body><h1>Error occurred</h1>' + Format('<h2 style="color: %s">', [lColor]) +
+      TNetEncoding.HTML.Encode(EMyException(aException).ToString) + '</h2>' +
+      '<p>your truly custom controller exception handler...</p>' + '</body></html>';
+    aHandled := True;
+  end
+  else if aException is EMVCException then
+  begin
+    aContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
+    aContext.Response.Content := '<html><body><h1>Error occurred</h1>' + Format('<h2 style="color: red">', [lColor]) +
+      TNetEncoding.HTML.Encode(aException.Message) + '</h2>' + '<p>your truly custom controller exception handler...</p>' + '</body></html>';
+    aHandled := True;
+  end;
+
+end;
+
+procedure TMyController.Error;
+begin
+  raise Exception.Create('Standard Error');
+end;
+
+constructor EMyException.Create(Msg: string; ASeverity: TMyExceptionSeverity; ACode: Integer; ADetails, ADiagnostics, AExpression: string);
+begin
+  inherited Create(Msg);
+  FSeverity := ASeverity;
+  FCode := ACode;
+  FDetails := ADetails;
+  FDiagnostics := ADiagnostics;
+  FExpression := AExpression;
+end;
+
+end.

samples/custom_exception_handling_using_controller/WebModuleU.dfm

@@ -0,0 +1,7 @@
+object MyWebModule: TMyWebModule
+  OnCreate = WebModuleCreate
+  OnDestroy = WebModuleDestroy
+  Actions = <>
+  Height = 512
+  Width = 654
+end

samples/custom_exception_handling_using_controller/WebModuleU.pas

@@ -0,0 +1,64 @@
+unit WebModuleU;
+
+interface
+
+uses
+  System.SysUtils,
+  System.Classes,
+  MVCFramework,
+  Web.HTTPApp,
+  System.NetEncoding;
+
+type
+  TMyWebModule = class(TWebModule)
+    procedure WebModuleCreate(Sender: TObject);
+    procedure WebModuleDestroy(Sender: TObject);
+  private
+    FMVC: TMVCEngine;
+  public
+    { Public declarations }
+  end;
+
+var
+  WebModuleClass: TComponentClass = TMyWebModule;
+
+implementation
+
+{$R *.dfm}
+
+
+uses
+  MyControllerU,
+  MVCFramework.Commons,
+  MVCFramework.Middleware.StaticFiles,
+  System.Rtti, System.IOUtils;
+
+procedure TMyWebModule.WebModuleCreate(Sender: TObject);
+begin
+  FMVC := TMVCEngine.Create(Self,
+    procedure(Config: TMVCConfig)
+    begin
+      // session timeout (0 means session cookie)
+      Config[TMVCConfigKey.SessionTimeout] := '0';
+      // default content-type
+      Config[TMVCConfigKey.DefaultContentType] := TMVCConstants.DEFAULT_CONTENT_TYPE;
+      // default content charset
+      Config[TMVCConfigKey.DefaultContentCharset] := TMVCConstants.DEFAULT_CONTENT_CHARSET;
+      // unhandled actions are permitted?
+      Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
+      // default view file extension
+      Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
+      // view path
+      Config[TMVCConfigKey.ViewPath] := 'templates';
+      // Enable Server Signature in response
+      Config[TMVCConfigKey.ExposeServerSignature] := 'true';
+    end);
+  FMVC.AddController(TMyController);
+end;
+
+procedure TMyWebModule.WebModuleDestroy(Sender: TObject);
+begin
+  FMVC.Free;
+end;
+
+end.

samples/custom_exception_handling_using_controller/exception_handling_with_controller.dpr

@@ -0,0 +1,66 @@
+program exception_handling_with_controller;
+
+{$APPTYPE CONSOLE}
+
+
+uses
+  System.SysUtils,
+  MVCFramework.Logger,
+  MVCFramework.Commons,
+  {$IFDEF MSWINDOWS}
+  Winapi.ShellAPI,
+  Winapi.Windows,
+  {$ENDIF }
+  ReqMulti,
+  Web.WebReq,
+  Web.WebBroker,
+  IdHTTPWebBrokerBridge,
+  MyControllerU in 'MyControllerU.pas',
+  WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule};
+
+{$R *.res}
+
+
+procedure RunServer(APort: Integer);
+var
+  LServer: TIdHTTPWebBrokerBridge;
+begin
+  Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
+  Writeln(Format('Starting HTTP Server on port %d', [APort]));
+  LServer := TIdHTTPWebBrokerBridge.Create(nil);
+  try
+    LServer.DefaultPort := APort;
+    LServer.Active := True;
+    LogI(Format('Server started on port 8080', [APort]));
+    { more info about MaxConnections
+      http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_MaxConnections.html }
+    LServer.MaxConnections := 0;
+    { more info about ListenQueue
+      http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html }
+    LServer.ListenQueue := 200;
+    { Comment the next line to avoid the default browser startup }
+{$IFDEF MSWINDOWS}
+    ShellExecute(0, 'open', PChar('http://localhost:' + inttostr(APort)), nil, nil,
+      SW_SHOWMAXIMIZED);
+{$ENDIF}
+    Writeln('Press RETURN to stop the server');
+    ReadLn;
+  finally
+    LServer.Free;
+  end;
+end;
+
+begin
+  ReportMemoryLeaksOnShutdown := True;
+  IsMultiThread := True;
+  try
+    if WebRequestHandler <> nil then
+      WebRequestHandler.WebModuleClass := WebModuleClass;
+    WebRequestHandlerProc.MaxConnections := 1024;
+    RunServer(8080);
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+
+end.