From b26a8d6276c80f0cb5ae9c102a629936380fa906 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Wed, 13 Nov 2024 23:09:28 +0100 Subject: [PATCH] Added GetErrorPageHandler --- ideexpert/DMVC.Expert.CodeGen.Commands.pas | 17 ++- .../custom_exception_handling/WebModuleU.dfm | 1 - .../custom_exception_handling/WebModuleU.pas | 1 + sources/MVCFramework.Commons.pas | 22 +-- ...VCFramework.View.Renderers.TemplatePro.pas | 19 ++- ...VCFramework.View.Renderers.WebStencils.pas | 18 +++ sources/MVCFramework.pas | 134 +++++++----------- 7 files changed, 102 insertions(+), 110 deletions(-) diff --git a/ideexpert/DMVC.Expert.CodeGen.Commands.pas b/ideexpert/DMVC.Expert.CodeGen.Commands.pas index 09726c6a..638cedef 100644 --- a/ideexpert/DMVC.Expert.CodeGen.Commands.pas +++ b/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?') diff --git a/samples/custom_exception_handling/WebModuleU.dfm b/samples/custom_exception_handling/WebModuleU.dfm index ba23103f..fcdbdb4e 100644 --- a/samples/custom_exception_handling/WebModuleU.dfm +++ b/samples/custom_exception_handling/WebModuleU.dfm @@ -1,5 +1,4 @@ object MyWebModule: TMyWebModule - OldCreateOrder = False OnCreate = WebModuleCreate OnDestroy = WebModuleDestroy Actions = <> diff --git a/samples/custom_exception_handling/WebModuleU.pas b/samples/custom_exception_handling/WebModuleU.pas index 9e420292..840c7ad7 100644 --- a/samples/custom_exception_handling/WebModuleU.pas +++ b/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 diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index c69480a3..032745a0 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -52,8 +52,7 @@ uses type - TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpHEAD, httpOPTIONS, - httpTRACE); + TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpHEAD, httpOPTIONS, 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) -// 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); 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 diff --git a/sources/MVCFramework.View.Renderers.TemplatePro.pas b/sources/MVCFramework.View.Renderers.TemplatePro.pas index 8b272bf6..45675011 100644 --- a/sources/MVCFramework.View.Renderers.TemplatePro.pas +++ b/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 then begin Exit(aValue.AsInt64); + end else if aValue.IsType then + begin + Exit(aValue.AsInteger); + end else if aValue.IsType 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; diff --git a/sources/MVCFramework.View.Renderers.WebStencils.pas b/sources/MVCFramework.View.Renderers.WebStencils.pas index ff7a8b93..b0b9f48c 100644 --- a/sources/MVCFramework.View.Renderers.WebStencils.pas +++ b/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 diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 783022ec..4c886046 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -940,7 +940,7 @@ type /// PageFragment ignore header and footer views /// function Page(const AViewNames: TArray; 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; /// /// Page calls GetRenderedView with sensible defaults. @@ -950,25 +950,13 @@ type function Page(const AViewNames: TArray; const JSONModel: TJSONObject; const UseCommonHeadersAndFooters: Boolean = True; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline; - /// - /// PageFragment calls GetRenderedView. - /// PageFragment ignore header and footer views. - /// - function PageFragment(const AViewNames: TArray; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline; - - /// - /// PageFragment calls GetRenderedView. - /// PageFragment ignore header and footer views. - /// - function PageFragment(const AViewNames: TArray; const JSONModel: TJSONObject; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback = nil): string; overload; inline; - /// /// 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. /// - function LoadView(const AViewNames: TArray; const JSONModel: TJSONObject = nil): string; virtual; + //function LoadView(const AViewNames: TArray; const JSONModel: TJSONObject = nil): string; virtual; function SessionAs: 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; const JSONModel: TJSONObject = nil): string; -begin - try - Result := GetRenderedView(AViewNames, JSONModel); - ResponseStream.Append(Result); - except - on E: Exception do - begin - Log.Error('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG); - raise; - end; - end; -end; +//function TMVCController.LoadView(const AViewNames: TArray; const JSONModel: TJSONObject = nil): string; +//begin +// try +// Result := GetRenderedView(AViewNames, JSONModel); +// ResponseStream.Append(Result); +// except +// on E: Exception do +// begin +// Log.Error('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG); +// raise; +// 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); -end; - -function TMVCController.PageFragment(const AViewNames: TArray; - const JSONModel: TJSONObject; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string; -begin - Result := Page(AViewNames, JSONModel, False, OnBeforeRenderCallback); -end; - -function TMVCController.PageFragment(const AViewNames: TArray; const OnBeforeRenderCallback: TMVCSSVBeforeRenderCallback): string; -begin - Result := Page(AViewNames, nil, False); + Result := Page([AViewName], False, OnBeforeRenderCallback); end; function TMVCController.Page(const AViewNames: TArray; 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(