mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
Refactoring and Removing Dependencies
This commit is contained in:
Ezequiel Juliano Müller
parent
45595ee144
commit
ee9659762b
@ -26,54 +26,63 @@ unit MVCFramework.ApplicationSession;
|
||||
|
||||
interface
|
||||
|
||||
uses System.SysUtils, System.Generics.Collections;
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.DateUtils,
|
||||
System.Generics.Collections;
|
||||
|
||||
type
|
||||
TWebApplicationSession = class abstract
|
||||
strict protected
|
||||
function GetItems(const Key: string): string; virtual; abstract;
|
||||
procedure SetItems(const Key, Value: string); virtual; abstract;
|
||||
|
||||
TWebApplicationSession = class abstract
|
||||
private
|
||||
{ private declarations }
|
||||
protected
|
||||
function GetItems(const AKey: string): string; virtual; abstract;
|
||||
procedure SetItems(const AKey, AValue: string); virtual; abstract;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
function ToString: string; override;
|
||||
property Items[const Key: string]: string read GetItems
|
||||
write SetItems; default;
|
||||
|
||||
property Items[const AKey: string]: string read GetItems write SetItems; default;
|
||||
end;
|
||||
|
||||
TWebApplicationSessionClass = class of TWebApplicationSession;
|
||||
|
||||
TWebApplicationSessionMemory = class(TWebApplicationSession)
|
||||
strict protected
|
||||
private
|
||||
FData: TDictionary<string, string>;
|
||||
function GetItems(const Key: String): String; override;
|
||||
procedure SetItems(const Key, Value: String); override;
|
||||
protected
|
||||
function GetItems(const AKey: String): String; override;
|
||||
procedure SetItems(const AKey, AValue: String); override;
|
||||
|
||||
property Data: TDictionary<string, string> read FData;
|
||||
public
|
||||
function ToString: String; override;
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function ToString: String; override;
|
||||
end;
|
||||
|
||||
TMVCApplicationSessionFactory = class sealed
|
||||
private
|
||||
{ private declarations }
|
||||
protected
|
||||
FRegisteredApplicationSessionTypes: TDictionary<String, TWebApplicationSessionClass>;
|
||||
class var FInstance: TMVCApplicationSessionFactory;
|
||||
constructor Create;
|
||||
public
|
||||
procedure RegisterSessionType(const AName: String;
|
||||
AWebApplicationSessionClass: TWebApplicationSessionClass);
|
||||
class function GetInstance: TMVCApplicationSessionFactory;
|
||||
function CreateNewByType(const AName: String): TWebApplicationSession;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure RegisterSessionType(const AName: String; AWebApplicationSessionClass: TWebApplicationSessionClass);
|
||||
function CreateNewByType(const AName: String): TWebApplicationSession;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.dateutils;
|
||||
|
||||
constructor TWebApplicationSession.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -101,22 +110,22 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TWebApplicationSessionMemory.GetItems(const Key: String): String;
|
||||
function TWebApplicationSessionMemory.GetItems(const AKey: String): String;
|
||||
begin
|
||||
TMonitor.Enter(self);
|
||||
try
|
||||
if not FData.TryGetValue(Key, Result) then
|
||||
if not FData.TryGetValue(AKey, Result) then
|
||||
Result := '';
|
||||
finally
|
||||
TMonitor.Exit(self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWebApplicationSessionMemory.SetItems(const Key, Value: String);
|
||||
procedure TWebApplicationSessionMemory.SetItems(const AKey, AValue: String);
|
||||
begin
|
||||
TMonitor.Enter(self);
|
||||
try
|
||||
FData.AddOrSetValue(Key, Value);
|
||||
FData.AddOrSetValue(AKey, AValue);
|
||||
finally
|
||||
TMonitor.Exit(self);
|
||||
end;
|
||||
@ -124,14 +133,14 @@ end;
|
||||
|
||||
function TWebApplicationSessionMemory.ToString: String;
|
||||
var
|
||||
Key: String;
|
||||
LKey: String;
|
||||
begin
|
||||
TMonitor.Enter(self);
|
||||
try
|
||||
Result := '';
|
||||
for Key in FData.Keys do
|
||||
for LKey in FData.Keys do
|
||||
begin
|
||||
Result := Key + ' = ' + QuotedStr(FData.Items[Key]) + sLineBreak;
|
||||
Result := LKey + ' = ' + QuotedStr(FData.Items[LKey]) + sLineBreak;
|
||||
end;
|
||||
finally
|
||||
TMonitor.Exit(self);
|
||||
@ -165,7 +174,7 @@ class
|
||||
function TMVCApplicationSessionFactory.GetInstance: TMVCApplicationSessionFactory;
|
||||
begin
|
||||
if not Assigned(FInstance) then
|
||||
// doesnt require double-check because used for the first time at the unit initialization
|
||||
// doesnt require double-check because used for the first time at the unit initialization
|
||||
FInstance := TMVCApplicationSessionFactory.Create;
|
||||
Result := FInstance;
|
||||
end;
|
||||
@ -178,8 +187,7 @@ end;
|
||||
|
||||
initialization
|
||||
|
||||
TMVCApplicationSessionFactory.GetInstance.RegisterSessionType('memory',
|
||||
TWebApplicationSessionMemory);
|
||||
TMVCApplicationSessionFactory.GetInstance.RegisterSessionType('memory', TWebApplicationSessionMemory);
|
||||
|
||||
finalization
|
||||
|
||||
|
||||
@ -331,7 +331,7 @@ type
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
TMVCDataObjects = class(TObjectDictionary<string, TJSONValue>) { TODO -oEzequiel -cRefactoring : Replace for custom serializers }
|
||||
TMVCViewDataObject = class(TObjectDictionary<string, string>)
|
||||
private
|
||||
{ private declarations }
|
||||
protected
|
||||
@ -490,9 +490,9 @@ begin
|
||||
FAppErrorCode := 0;
|
||||
end;
|
||||
|
||||
{ TMVCDataObjects }
|
||||
{ TMVCViewDataObject }
|
||||
|
||||
constructor TMVCDataObjects.Create;
|
||||
constructor TMVCViewDataObject.Create;
|
||||
begin
|
||||
inherited Create([doOwnsValues]);
|
||||
end;
|
||||
|
||||
@ -124,7 +124,7 @@ begin
|
||||
ContentCharset := '';
|
||||
end;
|
||||
lStatusPieces := string(lOutput.Items[4]).Split([':']);
|
||||
ResponseStatusCode(StrToInt(lStatusPieces[0]), lStatusPieces[1]);
|
||||
ResponseStatus(StrToInt(lStatusPieces[0]), lStatusPieces[1]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -28,55 +28,65 @@ interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
EncdDecd,
|
||||
IdHMAC;
|
||||
|
||||
type
|
||||
EMVCHMACException = class(Exception)
|
||||
|
||||
EMVCHMACException = class(Exception)
|
||||
private
|
||||
{ private declarations }
|
||||
protected
|
||||
{ protected declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
THMACClass = class of TIdHMAC;
|
||||
|
||||
function HMAC(const Algorithm: String; const Input, Key: string): TBytes;
|
||||
procedure RegisterHMACAlgorithm(const Algorithm: String; Clazz: THMACClass);
|
||||
procedure UnRegisterHMACAlgorithm(const Algorithm: String);
|
||||
function HMAC(const AAlgorithm: String; const AInput, AKey: string): TBytes;
|
||||
procedure RegisterHMACAlgorithm(const AAlgorithm: String; AClazz: THMACClass);
|
||||
procedure UnRegisterHMACAlgorithm(const AAlgorithm: String);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
IdSSLOpenSSL, IdHash, IdGlobal, IdHMACMD5,
|
||||
IdHMACSHA1, System.Generics.Collections;
|
||||
IdSSLOpenSSL,
|
||||
IdHash,
|
||||
IdGlobal,
|
||||
IdHMACMD5,
|
||||
IdHMACSHA1;
|
||||
|
||||
var
|
||||
GHMACRegistry: TDictionary<string, THMACClass>;
|
||||
|
||||
function HMAC(const Algorithm: String; const Input, Key: string): TBytes;
|
||||
function HMAC(const AAlgorithm: String; const AInput, AKey: string): TBytes;
|
||||
var
|
||||
lHMAC: TIdHMAC;
|
||||
LHMAC: TIdHMAC;
|
||||
begin
|
||||
if not GHMACRegistry.ContainsKey(Algorithm) then
|
||||
raise EMVCHMACException.CreateFmt('Unknown HMAC algorithm [%s]', [Algorithm]);
|
||||
if not GHMACRegistry.ContainsKey(AAlgorithm) then
|
||||
raise EMVCHMACException.CreateFmt('Unknown HMAC algorithm [%s]', [AAlgorithm]);
|
||||
|
||||
lHMAC := GHMACRegistry[Algorithm].Create;
|
||||
LHMAC := GHMACRegistry[AAlgorithm].Create;
|
||||
try
|
||||
lHMAC.Key := ToBytes(Key);
|
||||
Result := TBytes(lHMAC.HashValue(ToBytes(Input)));
|
||||
LHMAC.Key := ToBytes(AKey);
|
||||
Result := TBytes(LHMAC.HashValue(ToBytes(AInput)));
|
||||
finally
|
||||
lHMAC.Free;
|
||||
LHMAC.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure RegisterHMACAlgorithm(const Algorithm: String; Clazz: THMACClass);
|
||||
procedure RegisterHMACAlgorithm(const AAlgorithm: String; AClazz: THMACClass);
|
||||
begin
|
||||
if GHMACRegistry.ContainsKey(Algorithm) then
|
||||
if GHMACRegistry.ContainsKey(AAlgorithm) then
|
||||
raise EMVCHMACException.Create('Algorithm already registered');
|
||||
GHMACRegistry.Add(Algorithm, Clazz);
|
||||
GHMACRegistry.Add(AAlgorithm, AClazz);
|
||||
end;
|
||||
|
||||
procedure UnRegisterHMACAlgorithm(const Algorithm: String);
|
||||
procedure UnRegisterHMACAlgorithm(const AAlgorithm: String);
|
||||
begin
|
||||
GHMACRegistry.Remove(Algorithm);
|
||||
GHMACRegistry.Remove(AAlgorithm);
|
||||
end;
|
||||
|
||||
initialization
|
||||
@ -85,7 +95,7 @@ Assert(IdSSLOpenSSL.LoadOpenSSLLibrary, 'HMAC requires OpenSSL libraries');
|
||||
|
||||
GHMACRegistry := TDictionary<string, THMACClass>.Create;
|
||||
|
||||
//registering based on hash function
|
||||
// registering based on hash function
|
||||
RegisterHMACAlgorithm('md5', TIdHMACMD5);
|
||||
RegisterHMACAlgorithm('sha1', TIdHMACSHA1);
|
||||
RegisterHMACAlgorithm('sha224', TIdHMACSHA224);
|
||||
@ -93,8 +103,7 @@ RegisterHMACAlgorithm('sha256', TIdHMACSHA256);
|
||||
RegisterHMACAlgorithm('sha384', TIdHMACSHA384);
|
||||
RegisterHMACAlgorithm('sha512', TIdHMACSHA512);
|
||||
|
||||
|
||||
//the same using the JWT naming
|
||||
// the same using the JWT naming
|
||||
RegisterHMACAlgorithm('HS256', TIdHMACSHA256);
|
||||
RegisterHMACAlgorithm('HS384', TIdHMACSHA384);
|
||||
RegisterHMACAlgorithm('HS512', TIdHMACSHA512);
|
||||
|
||||
@ -295,7 +295,7 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
lJObj := Context.Request.BodyAsJSONObject;
|
||||
lJObj := TJSONObject.ParseJSONValue(Context.Request.Body) as TJSONObject;
|
||||
if not Assigned(lJObj) then
|
||||
begin
|
||||
Handled := true;
|
||||
|
||||
@ -27,68 +27,66 @@ unit MVCFramework.Middleware.CORS;
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCFramework;
|
||||
System.StrUtils,
|
||||
MVCFramework,
|
||||
MVCFramework.Commons;
|
||||
|
||||
type
|
||||
|
||||
TCORSMiddleware = class(TInterfacedObject, IMVCMiddleware)
|
||||
private
|
||||
FAllowedOriginURL: string;
|
||||
FAllowsCredentials: string;
|
||||
protected
|
||||
{ protected declarations }
|
||||
public
|
||||
constructor Create(const AllowedOriginURL: string = '*';
|
||||
const AllowsCredentials: Boolean = true); virtual;
|
||||
procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
|
||||
procedure OnAfterControllerAction(Context: TWebContext;
|
||||
const AActionNAme: string; const Handled: Boolean);
|
||||
procedure OnBeforeControllerAction(Context: TWebContext;
|
||||
const AControllerQualifiedClassName: string; const AActionNAme: string;
|
||||
var Handled: Boolean);
|
||||
constructor Create(const AllowedOriginURL: string = '*'; const AllowsCredentials: Boolean = true); virtual;
|
||||
|
||||
procedure OnBeforeRouting(AContext: TWebContext; var AHandled: Boolean);
|
||||
procedure OnAfterControllerAction(AContext: TWebContext; const AActionName: string; const AHandled: Boolean);
|
||||
procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.StrUtils, MVCFramework.Commons;
|
||||
|
||||
{ TCORSMiddleware }
|
||||
|
||||
constructor TCORSMiddleware.Create(const AllowedOriginURL: string;
|
||||
const AllowsCredentials: Boolean);
|
||||
constructor TCORSMiddleware.Create(const AllowedOriginURL: string; const AllowsCredentials: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
FAllowedOriginURL := AllowedOriginURL;
|
||||
FAllowsCredentials := ifthen(AllowsCredentials, 'true', 'false');
|
||||
end;
|
||||
|
||||
procedure TCORSMiddleware.OnAfterControllerAction(Context: TWebContext;
|
||||
const AActionNAme: string; const Handled: Boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCORSMiddleware.OnBeforeControllerAction(Context: TWebContext;
|
||||
const AControllerQualifiedClassName, AActionNAme: string;
|
||||
var Handled: Boolean);
|
||||
procedure TCORSMiddleware.OnAfterControllerAction(
|
||||
AContext: TWebContext;
|
||||
const AActionName: string;
|
||||
const AHandled: Boolean);
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TCORSMiddleware.OnBeforeRouting(Context: TWebContext;
|
||||
var Handled: Boolean);
|
||||
procedure TCORSMiddleware.OnBeforeControllerAction(
|
||||
AContext: TWebContext;
|
||||
const AControllerQualifiedClassName,
|
||||
AActionName: string;
|
||||
var AHandled: Boolean);
|
||||
begin
|
||||
Context.Response.RawWebResponse.CustomHeaders.Values
|
||||
['Access-Control-Allow-Origin'] := FAllowedOriginURL;
|
||||
Context.Response.RawWebResponse.CustomHeaders.Values
|
||||
['Access-Control-Allow-Methods'] :=
|
||||
'POST, GET, OPTIONS, PUT, DELETE';
|
||||
Context.Response.RawWebResponse.CustomHeaders.Values
|
||||
['Access-Control-Allow-Headers'] := 'Content-Type, Accept, jwtusername, jwtpassword';
|
||||
Context.Response.RawWebResponse.CustomHeaders.Values
|
||||
['Access-Control-Allow-Credentials'] := FAllowsCredentials;
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
if Context.Request.HTTPMethod = httpOPTIONS then
|
||||
procedure TCORSMiddleware.OnBeforeRouting(AContext: TWebContext; var AHandled: Boolean);
|
||||
begin
|
||||
AContext.Response.RawWebResponse.CustomHeaders.Values['Access-Control-Allow-Origin'] := FAllowedOriginURL;
|
||||
AContext.Response.RawWebResponse.CustomHeaders.Values['Access-Control-Allow-Methods'] := 'POST, GET, OPTIONS, PUT, DELETE';
|
||||
AContext.Response.RawWebResponse.CustomHeaders.Values['Access-Control-Allow-Headers'] := 'Content-Type, Accept, jwtusername, jwtpassword';
|
||||
AContext.Response.RawWebResponse.CustomHeaders.Values['Access-Control-Allow-Credentials'] := FAllowsCredentials;
|
||||
|
||||
if (AContext.Request.HTTPMethod = httpOPTIONS) then
|
||||
begin
|
||||
Context.Response.StatusCode := 200;
|
||||
Handled := true;
|
||||
AContext.Response.StatusCode := 200;
|
||||
AHandled := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -34,16 +34,24 @@ uses
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.Logger,
|
||||
MVCFramework.JWT,
|
||||
MVCFramework.TypesAliases,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
System.DateUtils, System.SysUtils;
|
||||
System.DateUtils,
|
||||
System.SysUtils;
|
||||
|
||||
type
|
||||
|
||||
TJWTClaimsSetup = reference to procedure(const JWT: TJWT);
|
||||
|
||||
TMVCJwtAuthenticationMiddleware = class(TInterfacedObject, IMVCMiddleware)
|
||||
strict private
|
||||
FMVCAuthenticationHandler: IMVCAuthenticationHandler;
|
||||
|
||||
procedure InternalRender(AJSONValue: TJSONValue;
|
||||
AContentType, AContentEncoding: string; AContext: TWebContext;
|
||||
AInstanceOwner: Boolean);
|
||||
|
||||
procedure Render(const aErrorCode: UInt16; const aErrorMessage: string; aContext: TWebContext;
|
||||
const aErrorClassName: string = ''); overload;
|
||||
private
|
||||
@ -73,19 +81,21 @@ implementation
|
||||
|
||||
uses
|
||||
MVCFramework.Session
|
||||
{$IFDEF SYSTEMJSON}
|
||||
, System.JSON
|
||||
{$ELSE}
|
||||
, Data.DBXJSON
|
||||
{$ENDIF}
|
||||
{$IFDEF WEBAPACHEHTTP}
|
||||
|
||||
{$IFDEF WEBAPACHEHTTP}
|
||||
|
||||
, Web.ApacheHTTP
|
||||
{$ENDIF}
|
||||
{$IFDEF SYSTEMNETENCODING}
|
||||
|
||||
{$ENDIF}
|
||||
{$IFDEF SYSTEMNETENCODING}
|
||||
|
||||
, System.NetEncoding
|
||||
{$ELSE}
|
||||
|
||||
{$ELSE}
|
||||
|
||||
, Soap.EncdDecd
|
||||
{$ENDIF};
|
||||
|
||||
{$ENDIF};
|
||||
|
||||
{ TMVCSalutationMiddleware }
|
||||
|
||||
@ -102,6 +112,32 @@ begin
|
||||
FSetupJWTClaims := aConfigClaims;
|
||||
end;
|
||||
|
||||
procedure TMVCJwtAuthenticationMiddleware.InternalRender(
|
||||
AJSONValue: TJSONValue; AContentType, AContentEncoding: string;
|
||||
AContext: TWebContext; AInstanceOwner: Boolean);
|
||||
var
|
||||
OutEncoding: TEncoding;
|
||||
lContentType, lJString: string;
|
||||
begin
|
||||
lJString := AJSONValue.ToJSON;
|
||||
|
||||
AContext.Response.RawWebResponse.ContentType := AContentType + '; charset=' + AContentEncoding;
|
||||
lContentType := AContentType + '; charset=' + AContentEncoding;
|
||||
OutEncoding := TEncoding.GetEncoding(AContentEncoding);
|
||||
try
|
||||
AContext.Response.SetContentStream(
|
||||
TBytesStream.Create(
|
||||
TEncoding.Convert(TEncoding.Default, OutEncoding,
|
||||
TEncoding.Default.GetBytes(lJString))
|
||||
), lContentType);
|
||||
finally
|
||||
OutEncoding.Free;
|
||||
end;
|
||||
|
||||
if aInstanceOwner then
|
||||
FreeAndNil(AJSONValue)
|
||||
end;
|
||||
|
||||
procedure TMVCJwtAuthenticationMiddleware.OnAfterControllerAction
|
||||
(Context: TWebContext; const AActionName: string; const Handled: Boolean);
|
||||
begin
|
||||
|
||||
@ -188,7 +188,7 @@ uses
|
||||
Data.SqlExpr,
|
||||
DBXCommon,
|
||||
{$ENDIF}
|
||||
MVCFramework.RTTIUtils,
|
||||
MVCFramework.Rtti.Utils,
|
||||
MVCFramework.DuckTyping,
|
||||
Generics.Collections;
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -24,179 +24,155 @@
|
||||
|
||||
unit MVCFramework.View;
|
||||
|
||||
{$WARNINGS OFF}
|
||||
|
||||
{$I dmvcframework.inc}
|
||||
|
||||
interface
|
||||
|
||||
{$WARNINGS OFF}
|
||||
|
||||
uses
|
||||
MVCFramework,
|
||||
MVCFramework.Commons,
|
||||
System.SysUtils,
|
||||
System.IOUtils,
|
||||
System.Generics.Collections,
|
||||
Data.DB,
|
||||
MVCFramework.View.Cache,
|
||||
System.SysUtils,
|
||||
MVCFramework,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.TypesAliases,
|
||||
SynMustache,
|
||||
SynCommons,
|
||||
MVCFramework.Patches;
|
||||
SynCommons;
|
||||
|
||||
{$WARNINGS ON}
|
||||
|
||||
type
|
||||
|
||||
TMVCBaseView = class(TMVCBase)
|
||||
private
|
||||
FViewName: string;
|
||||
FWebContext: TWebContext;
|
||||
FViewModel: TMVCDataObjects;
|
||||
FViewModel: TMVCViewDataObject;
|
||||
FViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
FMVCEngine: TMVCEngine;
|
||||
// FViewCache : TViewCache;
|
||||
// procedure SetViewCache(const Value: TViewCache);
|
||||
|
||||
strict protected
|
||||
FCurrentContentType: string;
|
||||
FContentType: string;
|
||||
FOutput: string;
|
||||
|
||||
protected
|
||||
/// <summary>
|
||||
/// returns the real name of the file or empty string if no
|
||||
// suitable file is found
|
||||
/// </summary>
|
||||
function GetRealFileName(AViewName: String): String; virtual;
|
||||
function IsCompiledVersionUpToDate(const FileName, CompiledFileName: string)
|
||||
: Boolean; virtual; abstract;
|
||||
function GetRealFileName(const AViewName: string): string; virtual;
|
||||
function IsCompiledVersionUpToDate(const AFileName, ACompiledFileName: string): Boolean; virtual; abstract;
|
||||
public
|
||||
constructor Create(
|
||||
const AViewName: string;
|
||||
const AEngine: TMVCEngine;
|
||||
const AWebContext: TWebContext;
|
||||
const AViewModel: TMVCViewDataObject;
|
||||
const AViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
const AContentType: string); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Execute; virtual; abstract;
|
||||
|
||||
property ViewName: string read FViewName;
|
||||
property WebContext: TWebContext read FWebContext;
|
||||
|
||||
public
|
||||
constructor Create(AViewName: string; AMVCEngine: TMVCEngine;
|
||||
AWebContext: TWebContext; AViewModels: TMVCDataObjects;
|
||||
AViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
ACurrentContentType: string); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Execute; virtual; abstract;
|
||||
function GetOutput: String;
|
||||
// property ViewCache: TViewCache read FViewCache write SetViewCache;
|
||||
property ViewModel: TMVCViewDataObject read FViewModel;
|
||||
property ViewDataSets: TObjectDictionary<string, TDataSet> read FViewDataSets;
|
||||
property ContentType: string read FContentType;
|
||||
property Output: string read FOutput;
|
||||
end;
|
||||
|
||||
TMVCMustacheView = class(TMVCBaseView)
|
||||
private
|
||||
{ private declarations }
|
||||
protected
|
||||
{ protected declarations }
|
||||
public
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.IOUtils
|
||||
, System.Classes
|
||||
{$IFDEF SYSTEMJSON}
|
||||
, System.JSON
|
||||
{$ELSE}
|
||||
, Data.DBXJSON
|
||||
{$ENDIF};
|
||||
|
||||
{ TMVCBaseView }
|
||||
|
||||
constructor TMVCBaseView.Create(AViewName: string; AMVCEngine: TMVCEngine;
|
||||
AWebContext: TWebContext; AViewModels: TMVCDataObjects;
|
||||
AViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
ACurrentContentType: string);
|
||||
constructor TMVCBaseView.Create(
|
||||
const AViewName: string;
|
||||
const AEngine: TMVCEngine;
|
||||
const AWebContext: TWebContext;
|
||||
const AViewModel: TMVCViewDataObject;
|
||||
const AViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
const AContentType: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FViewName := AViewName;
|
||||
Engine := AEngine;
|
||||
FWebContext := AWebContext;
|
||||
FMVCEngine := AMVCEngine;
|
||||
FViewModel := AViewModels;
|
||||
FViewModel := AViewModel;
|
||||
FViewDataSets := AViewDataSets;
|
||||
FCurrentContentType := ACurrentContentType;
|
||||
FContentType := AContentType;
|
||||
FOutput := EmptyStr;
|
||||
end;
|
||||
|
||||
destructor TMVCBaseView.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMVCBaseView.GetOutput: String;
|
||||
begin
|
||||
Result := FOutput;
|
||||
end;
|
||||
|
||||
function TMVCBaseView.GetRealFileName(AViewName: String): String;
|
||||
function TMVCBaseView.GetRealFileName(const AViewName: string): string;
|
||||
var
|
||||
LFileName: string;
|
||||
_FFileName: string;
|
||||
LDefaultViewFileExtension: string;
|
||||
FileName: string;
|
||||
F: string;
|
||||
DefaultViewFileExtension: string;
|
||||
begin
|
||||
LDefaultViewFileExtension := GetMVCConfig
|
||||
[TMVCConfigKey.DefaultViewFileExtension];
|
||||
LFileName := StringReplace(AViewName, '/', '\', [rfReplaceAll]);
|
||||
// $0.02 of normalization
|
||||
if LFileName = '\' then
|
||||
LFileName := '\index.' + LDefaultViewFileExtension
|
||||
else
|
||||
LFileName := LFileName + '.' + LDefaultViewFileExtension;
|
||||
DefaultViewFileExtension := Config[TMVCConfigKey.DefaultViewFileExtension];
|
||||
FileName := stringReplace(AViewName, '/', '\', [rfReplaceAll]);
|
||||
|
||||
if DirectoryExists(GetMVCConfig[TMVCConfigKey.ViewPath]) then
|
||||
_FFileName := ExpandFileName
|
||||
(IncludeTrailingPathDelimiter(GetMVCConfig.Value[TMVCConfigKey.ViewPath])
|
||||
+ LFileName)
|
||||
if (FileName = '\') then
|
||||
FileName := '\index.' + DefaultViewFileExtension
|
||||
else
|
||||
_FFileName := ExpandFileName
|
||||
(IncludeTrailingPathDelimiter(GetApplicationFileNamePath +
|
||||
GetMVCConfig.Value[TMVCConfigKey.ViewPath]) + LFileName);
|
||||
FileName := FileName + '.' + DefaultViewFileExtension;
|
||||
|
||||
// if not found in the view_path folder, look in the document_root
|
||||
if not TFile.Exists(_FFileName) then
|
||||
LFileName := ExpandFileName
|
||||
(IncludeTrailingPathDelimiter(GetApplicationFileNamePath +
|
||||
GetMVCConfig.Value[TMVCConfigKey.DocumentRoot]) + LFileName)
|
||||
if DirectoryExists(Config[TMVCConfigKey.ViewPath]) then
|
||||
F := ExpandFileName(IncludeTrailingPathDelimiter(Config.Value[TMVCConfigKey.ViewPath]) + FileName)
|
||||
else
|
||||
LFileName := _FFileName;
|
||||
F := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.ViewPath]) + FileName);
|
||||
|
||||
if FileExists(LFileName) then
|
||||
begin
|
||||
Result := LFileName;
|
||||
end
|
||||
if not TFile.Exists(F) then
|
||||
FileName := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.DocumentRoot]) + FileName)
|
||||
else
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
FileName := F;
|
||||
|
||||
if FileExists(FileName) then
|
||||
Result := FileName
|
||||
else
|
||||
Result := EmptyStr;
|
||||
end;
|
||||
|
||||
// procedure TMVCBaseView.SetViewCache(const Value: TViewCache);
|
||||
// begin
|
||||
// FViewCache := Value;
|
||||
// end;
|
||||
|
||||
{ TMVCMustacheView }
|
||||
|
||||
{$WARNINGS OFF}
|
||||
|
||||
procedure TMVCMustacheView.Execute;
|
||||
var
|
||||
LFileName: String;
|
||||
LTemplate: RawUTF8;
|
||||
LMEngine: TSynMustache;
|
||||
LPair: TPair<String, TJSONValue>;
|
||||
LJContext: TJSONObject;
|
||||
ViewFileName: string;
|
||||
ViewTemplate: RawUTF8;
|
||||
ViewEngine: TSynMustache;
|
||||
DataObj: TPair<string, string>;
|
||||
Jo: TJSONObject;
|
||||
begin
|
||||
LFileName := GetRealFileName(ViewName);
|
||||
if not FileExists(LFileName) then
|
||||
raise EMVCFrameworkView.CreateFmt('View [%s] not found', [ViewName]);
|
||||
LTemplate := StringToUTF8(TFile.ReadAllText(LFileName, TEncoding.UTF8));
|
||||
LMEngine := TSynMustache.Parse(LTemplate);
|
||||
LJContext := TJSONObject.Create;
|
||||
try
|
||||
if FViewModel <> nil then
|
||||
begin
|
||||
for LPair in FViewModel do
|
||||
begin
|
||||
LJContext.AddPair(LPair.Key, LPair.Value)
|
||||
end;
|
||||
end;
|
||||
except
|
||||
LJContext.Free;
|
||||
raise;
|
||||
end;
|
||||
ViewFileName := GetRealFileName(ViewName);
|
||||
if not FileExists(ViewFileName) then
|
||||
raise EMVCFrameworkViewException.CreateFmt('View [%s] not found', [ViewName]);
|
||||
|
||||
FOutput := UTF8ToString(LMEngine.RenderJSON(LJContext.ToJSON));
|
||||
ViewTemplate := stringToUTF8(TFile.ReadAllText(ViewFileName, TEncoding.UTF8));
|
||||
ViewEngine := TSynMustache.Parse(ViewTemplate);
|
||||
|
||||
Jo := TJSONObject.Create;
|
||||
try
|
||||
if Assigned(FViewModel) then
|
||||
for DataObj in FViewModel do
|
||||
Jo.AddPair(DataObj.Key, TJSONObject.ParseJSONValue(DataObj.Value));
|
||||
|
||||
FOutput := UTF8Tostring(ViewEngine.RenderJSON(Jo.ToJSON));
|
||||
finally
|
||||
Jo.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$WARNINGS ON}
|
||||
|
||||
end.
|
||||
|
||||
@ -177,6 +177,7 @@ type
|
||||
|
||||
function ClientIp: string;
|
||||
function ClientPrefer(const AMediaType: string): Boolean;
|
||||
function ClientPreferHTML: Boolean;
|
||||
|
||||
function SegmentParam(const AParamName: string; out AValue: string): Boolean;
|
||||
function SegmentParamsCount: Integer;
|
||||
@ -375,6 +376,8 @@ type
|
||||
FContext: TWebContext;
|
||||
FContentCharset: string;
|
||||
FResponseStream: TStringBuilder;
|
||||
FViewModel: TMVCViewDataObject;
|
||||
FViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
function GetContext: TWebContext;
|
||||
function GetSession: TWebSession;
|
||||
function GetContentType: string;
|
||||
@ -393,6 +396,24 @@ type
|
||||
function GetClientId: string;
|
||||
function GetCurrentWebModule: TWebModule;
|
||||
function GetNewStompClient(const AClientId: string = ''): IStompClient;
|
||||
function GetViewModel: TMVCViewDataObject;
|
||||
function GetViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
function GetRenderedView(const AViewNames: TArray<string>): string; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Load mustache view located in TMVCConfigKey.ViewsPath
|
||||
/// returns the rendered views and generates output using
|
||||
/// models pushed using Push* methods
|
||||
/// </summary>
|
||||
function LoadView(const AViewNames: TArray<string>): string; virtual;
|
||||
|
||||
/// <summary>
|
||||
/// Load a view fragment in the output render stream. The view fragment is appended to the
|
||||
/// ResponseStream verbatim. No processing happens.
|
||||
/// Useful when used with cache.
|
||||
/// It is equivalent to <code>ResponseStream.Append(AViewFragment);</code>
|
||||
/// </summary>
|
||||
procedure LoadViewFragment(const AViewFragment: string);
|
||||
|
||||
procedure EnqueueMessageOnTopicOrQueue(
|
||||
const AMessage: TMVCStompMessage;
|
||||
@ -441,9 +462,15 @@ type
|
||||
property ContentType: string read GetContentType write SetContentType;
|
||||
property ContentCharset: string read FContentCharset write FContentCharset;
|
||||
property StatusCode: Integer read GetStatusCode write SetStatusCode;
|
||||
property ViewModel: TMVCViewDataObject read GetViewModel;
|
||||
property ViewDataSets: TObjectDictionary<string, TDataSet> read GetViewDataSets;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure PushToView(const AModelName: string; const AModel: string);
|
||||
procedure PushObjectToView(const AModelName: string; const AModel: TObject);
|
||||
procedure PushDataSetToView(const AModelName: string; const ADataSet: TDataSet);
|
||||
end;
|
||||
|
||||
TMVCControllerClazz = class of TMVCController;
|
||||
@ -635,7 +662,8 @@ implementation
|
||||
uses
|
||||
MVCFramework.Router,
|
||||
MVCFramework.SysControllers,
|
||||
MVCFramework.MessagingController;
|
||||
MVCFramework.MessagingController,
|
||||
MVCFramework.View;
|
||||
|
||||
var
|
||||
_IsShuttingDown: Int64 = 0;
|
||||
@ -872,6 +900,11 @@ begin
|
||||
Result := AnsiPos(AMediaType, LowerCase(RawWebRequest.Accept)) = 1;
|
||||
end;
|
||||
|
||||
function TMVCWebRequest.ClientPreferHTML: Boolean;
|
||||
begin
|
||||
Result := ClientPrefer(TMVCMediaType.TEXT_HTML);
|
||||
end;
|
||||
|
||||
function TMVCWebRequest.ContentParam(const AName: string): string;
|
||||
begin
|
||||
Result := FWebRequest.ContentFields.Values[AName];
|
||||
@ -2110,12 +2143,20 @@ begin
|
||||
FContext := nil;
|
||||
FContentCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET;
|
||||
FResponseStream := nil;
|
||||
FViewModel := nil;
|
||||
FViewDataSets := nil;
|
||||
end;
|
||||
|
||||
destructor TMVCController.Destroy;
|
||||
begin
|
||||
if Assigned(FResponseStream) then
|
||||
FResponseStream.Free;
|
||||
|
||||
if Assigned(FViewModel) then
|
||||
FViewModel.Free;
|
||||
|
||||
if Assigned(FViewDataSets) then
|
||||
FViewDataSets.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -2181,6 +2222,40 @@ begin
|
||||
Result := GetContext.Response.StatusCode;
|
||||
end;
|
||||
|
||||
function TMVCController.GetViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
begin
|
||||
if not Assigned(FViewDataSets) then
|
||||
FViewDataSets := TObjectDictionary<string, TDataSet>.Create;
|
||||
Result := FViewDataSets;
|
||||
end;
|
||||
|
||||
function TMVCController.GetViewModel: TMVCViewDataObject;
|
||||
begin
|
||||
if not Assigned(FViewModel) then
|
||||
FViewModel := TMVCViewDataObject.Create;
|
||||
Result := FViewModel;
|
||||
end;
|
||||
|
||||
function TMVCController.LoadView(const AViewNames: TArray<string>): string;
|
||||
begin
|
||||
try
|
||||
Result := GetRenderedView(AViewNames);
|
||||
ResponseStream.Append(Result);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
LogException(E);
|
||||
ContentType := TMVCMediaType.TEXT_PLAIN;
|
||||
Render(E);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCController.LoadViewFragment(const AViewFragment: string);
|
||||
begin
|
||||
ResponseStream.Append(AViewFragment);
|
||||
end;
|
||||
|
||||
procedure TMVCController.MVCControllerAfterCreate;
|
||||
begin
|
||||
{ Implement if need be. }
|
||||
@ -2204,6 +2279,27 @@ begin
|
||||
{ Implement if need be. }
|
||||
end;
|
||||
|
||||
procedure TMVCController.PushDataSetToView(const AModelName: string; const ADataSet: TDataSet);
|
||||
var
|
||||
LSerializer: IMVCSerializer;
|
||||
begin
|
||||
LSerializer := TMVCJSONSerializer.Create;
|
||||
PushToView(AModelName, LSerializer.SerializeDataSet(ADataSet));
|
||||
end;
|
||||
|
||||
procedure TMVCController.PushObjectToView(const AModelName: string; const AModel: TObject);
|
||||
var
|
||||
LSerializer: IMVCSerializer;
|
||||
begin
|
||||
LSerializer := TMVCJSONSerializer.Create;
|
||||
PushToView(AModelName, LSerializer.SerializeObject(AModel));
|
||||
end;
|
||||
|
||||
procedure TMVCController.PushToView(const AModelName: string; const AModel: string);
|
||||
begin
|
||||
GetViewModel.Add(AModelName, AModel);
|
||||
end;
|
||||
|
||||
procedure TMVCController.RaiseSessionExpired;
|
||||
begin
|
||||
raise EMVCSessionExpiredException.Create('Session expired.');
|
||||
@ -2393,6 +2489,44 @@ begin
|
||||
raise EMVCException.Create('Can not render an empty collection.');
|
||||
end;
|
||||
|
||||
function TMVCController.GetRenderedView(const AViewNames: TArray<string>): string;
|
||||
var
|
||||
View: TMVCMustacheView;
|
||||
ViewName: string;
|
||||
SBuilder: TStringBuilder;
|
||||
begin
|
||||
SBuilder := TStringBuilder.Create;
|
||||
try
|
||||
try
|
||||
for ViewName in AViewNames do
|
||||
begin
|
||||
View := TMVCMustacheView.Create(
|
||||
ViewName,
|
||||
Engine,
|
||||
Context,
|
||||
ViewModel,
|
||||
ViewDataSets,
|
||||
ContentType);
|
||||
try
|
||||
View.Execute;
|
||||
SBuilder.Append(View.Output);
|
||||
finally
|
||||
View.Free;
|
||||
end;
|
||||
end;
|
||||
Result := SBuilder.ToString;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
ContentType := TMVCMediaType.TEXT_PLAIN;
|
||||
Render(E);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
SBuilder.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCController.Render<T>(const ACollection: TObjectList<T>);
|
||||
begin
|
||||
Self.Render<T>(ACollection, True);
|
||||
|
||||
@ -419,7 +419,7 @@ uses
|
||||
Math,
|
||||
SqlTimSt,
|
||||
DateUtils,
|
||||
MVCFramework.RTTIUtils,
|
||||
MVCFramework.Rtti.Utils,
|
||||
Xml.adomxmldom,
|
||||
{$IFDEF SYSTEMNETENCODING}
|
||||
System.NetEncoding,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user