mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
- Improved! In case of unhandled exception TMVCEngine is compliant with the default response content-type (usually it did would reply using text/plain).
- Fix! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184).
This commit is contained in:
Daniele Teti
parent
e4274d27db
commit
75e975811b
@ -76,8 +76,11 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
|
||||
- New! `TMVCActiveRecord.DeleteRQL` deletes records using an `RQL` expression as `where` clause.
|
||||
- New! Microsoft SQLServer Support in ActiveRecord and RQL (thanks to one of the biggest Delphi based company in Italy which heavily uses DMVCFramework)
|
||||
- Improved! `ActiveRecordShowCase` sample is much better now.
|
||||
- Improved! In case of unhandled exception `TMVCEngine` is compliant with the default response content-type (usually it did would reply using `text/plain`).
|
||||
- Fix! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184).
|
||||
- New Installation procedure! Just open the project group, build all and install the design-time package (which is `dmvcframeworkDT`)
|
||||
|
||||
|
||||
|Delphi Version|Project Group|
|
||||
|---|---|
|
||||
|Delphi 10.3 Rio| `packages\d103\dmvcframework_group.groupproj`|
|
||||
|
||||
@ -51,6 +51,9 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
{ TCustomAuth }
|
||||
|
||||
procedure TCustomAuth.OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{B42B1969-7408-4E0A-8624-A48DADE46556}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>CustomAuthClient.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{0293A1B2-2793-41CE-9099-8B24A46AA8CF}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>CustomAuthServer.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
|
||||
@ -57,7 +57,8 @@ uses
|
||||
// MVCFramework.Serializer.JSON,
|
||||
|
||||
{$IFDEF WEBAPACHEHTTP}
|
||||
Web.ApacheHTTP, // Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
|
||||
Web.ApacheHTTP,
|
||||
// Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
@ -340,7 +341,8 @@ type
|
||||
procedure Flush; virtual;
|
||||
procedure BindToSession(const ASessionId: string);
|
||||
function SendSessionCookie(const AContext: TWebContext): string;
|
||||
function AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer): TWebSession;
|
||||
function AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer)
|
||||
: TWebSession;
|
||||
public
|
||||
constructor Create(const ARequest: TWebRequest; const AResponse: TWebResponse; const AConfig: TMVCConfig;
|
||||
const ASerializers: TDictionary<string, IMVCSerializer>);
|
||||
@ -388,8 +390,7 @@ type
|
||||
|
||||
IMVCRenderer = interface
|
||||
['{2FF6DAC8-2F19-4C78-B9EC-A86296847D39}']
|
||||
procedure Render(const AContent: string);
|
||||
overload;
|
||||
procedure Render(const AContent: string); overload;
|
||||
procedure Render(const AObject: TObject); overload;
|
||||
procedure Render(const AObject: TObject; const AOwns: Boolean); overload;
|
||||
procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
|
||||
@ -397,15 +398,18 @@ type
|
||||
procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ATextWriter: TTextWriter; const AOwns: Boolean = True); overload;
|
||||
procedure Render(const AStream: TStream; const AOwns: Boolean = True); overload;
|
||||
procedure Render(const AErrorCode: Integer; const AErrorMessage: string; const AErrorClassName: string = ''); overload;
|
||||
procedure Render(const AException: Exception; AExceptionItems: TList<string> = nil; const AOwns: Boolean = True); overload;
|
||||
procedure Render(const AErrorCode: Integer; const AErrorMessage: string;
|
||||
const AErrorClassName: string = ''); 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;
|
||||
// SSE Support
|
||||
procedure RenderSSE(const EventID: string; const EventData: string; EventName: string = '';
|
||||
@ -424,11 +428,12 @@ type
|
||||
|
||||
IMVCAuthenticationHandler = interface
|
||||
['{19B580EA-8A47-4364-A302-EEF3C6207A9F}']
|
||||
procedure OnRequest(const AContext: TWebContext; const AControllerQualifiedClassName, AActionName: string; var AAuthenticationRequired: Boolean);
|
||||
procedure OnAuthentication(const AContext: TWebContext; const AUserName, APassword: string; AUserRoles: TList<string>; var AIsValid: Boolean;
|
||||
const ASessionData: TDictionary<string, string>);
|
||||
procedure OnAuthorization(const AContext: TWebContext; AUserRoles: TList<string>; const AControllerQualifiedClassName: string; const AActionName: string;
|
||||
var AIsAuthorized: Boolean);
|
||||
procedure OnRequest(const AContext: TWebContext; const AControllerQualifiedClassName, AActionName: string;
|
||||
var AAuthenticationRequired: Boolean);
|
||||
procedure OnAuthentication(const AContext: TWebContext; const AUserName, APassword: string;
|
||||
AUserRoles: TList<string>; var AIsValid: Boolean; const ASessionData: TDictionary<string, string>);
|
||||
procedure OnAuthorization(const AContext: TWebContext; AUserRoles: TList<string>;
|
||||
const AControllerQualifiedClassName: string; const AActionName: string; var AIsAuthorized: Boolean);
|
||||
end;
|
||||
|
||||
TMVCRenderer = class(TMVCBase)
|
||||
@ -456,21 +461,24 @@ type
|
||||
procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
|
||||
procedure Render<T: class>(const ACollection: TObjectList<T>); overload;
|
||||
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean); overload;
|
||||
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
|
||||
procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
|
||||
const AType: TMVCSerializationType); overload;
|
||||
procedure Render(const ACollection: IMVCList); overload;
|
||||
procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase;
|
||||
const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType); overload;
|
||||
procedure Render(const ATextWriter: TTextWriter; const AOwns: Boolean = True); overload;
|
||||
procedure Render(const AStream: TStream; const AOwns: Boolean = True); overload;
|
||||
procedure Render(const AErrorCode: Integer; const AErrorMessage: string; const AErrorClassName: string = '';
|
||||
const ADataObject: TObject = nil); overload;
|
||||
procedure Render(const AException: Exception; AExceptionItems: TList<string> = 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;
|
||||
// SSE Support
|
||||
procedure RenderSSE(const EventID: string; const EventData: string; EventName: string = '';
|
||||
@ -551,7 +559,8 @@ type
|
||||
protected
|
||||
{ protected declarations }
|
||||
public
|
||||
constructor Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '');
|
||||
constructor Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
|
||||
const AURLSegment: string = '');
|
||||
property Clazz: TMVCControllerClazz read FClazz;
|
||||
property CreateAction: TMVCControllerCreateAction read FCreateAction;
|
||||
property URLSegment: string read FURLSegment;
|
||||
@ -586,8 +595,8 @@ type
|
||||
/// <param name="AControllerQualifiedClassName">Qualified classname of the matching controller.</param>
|
||||
/// <param name="AActionName">Method name of the matching controller method.</param>
|
||||
/// <param name="AHandled">If set to True the Request would finished. Response must be set by the implementor. Default value is False.</param>
|
||||
procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string; const AActionName: string;
|
||||
var AHandled: Boolean);
|
||||
procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string;
|
||||
const AActionName: string; var AHandled: Boolean);
|
||||
/// <summary>
|
||||
/// Procedure is called after the specific controller method was called.
|
||||
/// It is still possible to cancel or to completly modifiy the request.
|
||||
@ -600,7 +609,8 @@ type
|
||||
|
||||
TMVCEngine = class(TComponent)
|
||||
private const
|
||||
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES = 'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime and String';
|
||||
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES =
|
||||
'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime and String';
|
||||
private
|
||||
FViewEngineClass: TMVCViewEngineClass;
|
||||
FWebModule: TWebModule;
|
||||
@ -624,14 +634,18 @@ type
|
||||
procedure LoadSystemControllers; virtual;
|
||||
procedure FixUpWebModule;
|
||||
procedure ExecuteBeforeRoutingMiddleware(const AContext: TWebContext; var AHandled: Boolean);
|
||||
procedure ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext; const AControllerQualifiedClassName: string;
|
||||
const AActionName: string; var AHandled: Boolean);
|
||||
procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string; const AHandled: Boolean);
|
||||
procedure ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext;
|
||||
const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
|
||||
procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string;
|
||||
const AHandled: Boolean);
|
||||
|
||||
procedure DefineDefaultResponseHeaders(const AContext: TWebContext);
|
||||
procedure OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse; var AHandled: Boolean); virtual;
|
||||
procedure ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest; const AResponse: TWebResponse); virtual;
|
||||
function ExecuteAction(const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse): Boolean; virtual;
|
||||
procedure OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
|
||||
var AHandled: Boolean); virtual;
|
||||
procedure ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest;
|
||||
const AResponse: TWebResponse); virtual;
|
||||
function ExecuteAction(const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse)
|
||||
: Boolean; virtual;
|
||||
public
|
||||
class function GetCurrentSession(const ASessionTimeout: Integer; const ASessionId: string;
|
||||
const ARaiseExceptionIfExpired: Boolean = True): TWebSession; static;
|
||||
@ -640,23 +654,27 @@ type
|
||||
class function SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string; overload; static;
|
||||
class procedure ClearSessionCookiesAlreadySet(const ACookies: TCookieCollection); static;
|
||||
public
|
||||
constructor Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig> = nil; const ACustomLogger: ILogWriter = nil);
|
||||
reintroduce;
|
||||
constructor Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig> = nil;
|
||||
const ACustomLogger: ILogWriter = nil); reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
function GetSessionBySessionId(const ASessionId: string): TWebSession;
|
||||
|
||||
function AddSerializer(const AContentType: string; const ASerializer: IMVCSerializer): TMVCEngine;
|
||||
function AddMiddleware(const AMiddleware: IMVCMiddleware): TMVCEngine;
|
||||
function AddController(const AControllerClazz: TMVCControllerClazz; const AURLSegment: string = ''): TMVCEngine; overload;
|
||||
function AddController(const AControllerClazz: TMVCControllerClazz; const AURLSegment: string = '')
|
||||
: TMVCEngine; overload;
|
||||
function AddController(const AControllerClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
|
||||
const AURLSegment: string = ''): TMVCEngine; overload;
|
||||
function PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string): TMVCEngine;
|
||||
function PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string)
|
||||
: TMVCEngine;
|
||||
function SetViewEngine(const AViewEngineClass: TMVCViewEngineClass): TMVCEngine;
|
||||
|
||||
function GetServerSignature(const AContext: TWebContext): string;
|
||||
procedure HTTP404(const AContext: TWebContext);
|
||||
procedure HTTP500(const AContext: TWebContext; const AReasonString: string = '');
|
||||
procedure SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
|
||||
const AReasonString: string);
|
||||
|
||||
property ViewEngineClass: TMVCViewEngineClass read GetViewEngineClass;
|
||||
property WebModule: TWebModule read FWebModule;
|
||||
@ -989,7 +1007,8 @@ begin
|
||||
Result := FWebRequest.CookieFields.Values[AName];
|
||||
end;
|
||||
|
||||
constructor TMVCWebRequest.Create(const AWebRequest: TWebRequest; const ASerializers: TDictionary<string, IMVCSerializer>);
|
||||
constructor TMVCWebRequest.Create(const AWebRequest: TWebRequest;
|
||||
const ASerializers: TDictionary<string, IMVCSerializer>);
|
||||
begin
|
||||
inherited Create;
|
||||
FBody := EmptyStr;
|
||||
@ -1313,8 +1332,8 @@ begin
|
||||
LRoles := string.Join('$$', FRoles.ToArray)
|
||||
else
|
||||
LRoles := '';
|
||||
AWebSession[TMVCConstants.CURRENT_USER_SESSION_KEY] := FUserName + '$$' + DateTimeToISOTimeStamp(FLoggedSince) + '$$' + FRealm +
|
||||
'$$' + LRoles;
|
||||
AWebSession[TMVCConstants.CURRENT_USER_SESSION_KEY] := FUserName + '$$' + DateTimeToISOTimeStamp(FLoggedSince) + '$$'
|
||||
+ FRealm + '$$' + LRoles;
|
||||
end;
|
||||
|
||||
procedure TUser.SetCustomData(const Value: TMVCCustomData);
|
||||
@ -1332,7 +1351,8 @@ end;
|
||||
|
||||
{ TWebContext }
|
||||
|
||||
function TWebContext.AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer): TWebSession;
|
||||
function TWebContext.AddSessionToTheSessionList(const ASessionType, ASessionId: string; const ASessionTimeout: Integer)
|
||||
: TWebSession;
|
||||
var
|
||||
Session: TWebSession;
|
||||
begin
|
||||
@ -1473,7 +1493,8 @@ begin
|
||||
if not Assigned(FWebSession) then
|
||||
begin
|
||||
Id := TMVCEngine.SendSessionCookie(Self);
|
||||
FWebSession := AddSessionToTheSessionList(Config[TMVCConfigKey.SessionType], Id, StrToInt64(Config[TMVCConfigKey.SessionTimeout]));
|
||||
FWebSession := AddSessionToTheSessionList(Config[TMVCConfigKey.SessionType], Id,
|
||||
StrToInt64(Config[TMVCConfigKey.SessionTimeout]));
|
||||
FIsSessionStarted := True;
|
||||
FSessionMustBeClose := False;
|
||||
end;
|
||||
@ -1532,8 +1553,8 @@ begin
|
||||
Result := AddController(AControllerClazz, nil, AURLSegment);
|
||||
end;
|
||||
|
||||
function TMVCEngine.AddController(const AControllerClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
|
||||
const AURLSegment: string): TMVCEngine;
|
||||
function TMVCEngine.AddController(const AControllerClazz: TMVCControllerClazz;
|
||||
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string): TMVCEngine;
|
||||
begin
|
||||
FControllers.Add(TMVCControllerDelegate.Create(AControllerClazz, ACreateAction, AURLSegment));
|
||||
Result := Self;
|
||||
@ -1604,7 +1625,8 @@ begin
|
||||
Log.Info('EXIT: Config default values', LOGGERPRO_TAG);
|
||||
end;
|
||||
|
||||
constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>; const ACustomLogger: ILogWriter);
|
||||
constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>;
|
||||
const ACustomLogger: ILogWriter);
|
||||
begin
|
||||
inherited Create(AWebModule);
|
||||
FWebModule := AWebModule;
|
||||
@ -1651,7 +1673,8 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMVCEngine.ExecuteAction(const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse): Boolean;
|
||||
function TMVCEngine.ExecuteAction(const ASender: TObject; const ARequest: TWebRequest;
|
||||
const AResponse: TWebResponse): Boolean;
|
||||
var
|
||||
LParamsTable: TMVCRequestParamsTable;
|
||||
LContext: TWebContext;
|
||||
@ -1667,9 +1690,10 @@ begin
|
||||
Result := False;
|
||||
|
||||
ARequest.ReadTotalContent;
|
||||
if ARequest.ContentLength > fConfigCache_MaxRequestSize then
|
||||
if ARequest.ContentLength > FConfigCache_MaxRequestSize then
|
||||
begin
|
||||
raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]', [(FConfigCache_MaxRequestSize div 1024)]);
|
||||
raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]',
|
||||
[(FConfigCache_MaxRequestSize div 1024)]);
|
||||
end;
|
||||
|
||||
LParamsTable := TMVCRequestParamsTable.Create;
|
||||
@ -1677,140 +1701,197 @@ begin
|
||||
LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);
|
||||
try
|
||||
DefineDefaultResponseHeaders(LContext);
|
||||
if IsStaticFileRequest(ARequest, LFileName) then
|
||||
Result := SendStaticFileIfPresent(LContext, LFileName)
|
||||
else
|
||||
begin
|
||||
LHandled := False;
|
||||
LRouter := TMVCRouter.Create(FConfig, _MVCGlobalActionParamsCache);
|
||||
try
|
||||
ExecuteBeforeRoutingMiddleware(LContext, LHandled);
|
||||
if not LHandled then
|
||||
begin
|
||||
if LRouter.ExecuteRouting(ARequest.PathInfo, TMVCRouter.StringMethodToHTTPMetod(ARequest.Method), ARequest.ContentType,
|
||||
ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType], FConfig[TMVCConfigKey.DefaultContentCharset],
|
||||
LParamsTable, LResponseContentMediaType, LResponseContentCharset) then
|
||||
LHandled := False;
|
||||
LRouter := TMVCRouter.Create(FConfig, _MVCGlobalActionParamsCache);
|
||||
try // finally
|
||||
LSelectedController := nil;
|
||||
try // only for lselectedcontroller
|
||||
try // global exception handler
|
||||
ExecuteBeforeRoutingMiddleware(LContext, LHandled);
|
||||
if not LHandled then
|
||||
begin
|
||||
try
|
||||
if Assigned(LRouter.ControllerCreateAction) then
|
||||
LSelectedController := LRouter.ControllerCreateAction()
|
||||
else
|
||||
LSelectedController := LRouter.ControllerClazz.Create;
|
||||
except
|
||||
on Ex: Exception do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Cannot create controller'],
|
||||
LOGGERPRO_TAG);
|
||||
HTTP500(LContext, 'Cannot create controller');
|
||||
Result := False;
|
||||
Exit;
|
||||
if LRouter.ExecuteRouting(ARequest.PathInfo, TMVCRouter.StringMethodToHTTPMetod(ARequest.Method),
|
||||
ARequest.ContentType, ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType],
|
||||
FConfig[TMVCConfigKey.DefaultContentCharset], LParamsTable, LResponseContentMediaType,
|
||||
LResponseContentCharset) then
|
||||
begin
|
||||
try
|
||||
if Assigned(LRouter.ControllerCreateAction) then
|
||||
LSelectedController := LRouter.ControllerCreateAction()
|
||||
else
|
||||
LSelectedController := LRouter.ControllerClazz.Create;
|
||||
except
|
||||
on Ex: Exception do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")',
|
||||
[Ex.Classname, Ex.Message, 'Cannot create controller'], LOGGERPRO_TAG);
|
||||
raise EMVCException.Create(HTTP_STATUS.InternalServerError, 'Cannot create controller');
|
||||
// HTTP500(LContext, 'Cannot create controller');
|
||||
// Result := False;
|
||||
// Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
try
|
||||
LSelectedController.Engine := Self;
|
||||
LSelectedController.Context := LContext;
|
||||
LSelectedController.ApplicationSession := FApplicationSession;
|
||||
LContext.ParamsTable := LParamsTable;
|
||||
ExecuteBeforeControllerActionMiddleware(LContext, LRouter.ControllerClazz.QualifiedClassName,
|
||||
LRouter.MethodToCall.Name, LHandled);
|
||||
if LHandled then
|
||||
Exit(True);
|
||||
|
||||
LSelectedController.MVCControllerAfterCreate;
|
||||
try
|
||||
ExecuteBeforeControllerActionMiddleware(LContext, LRouter.ControllerClazz.QualifiedClassName, LRouter.MethodToCall.Name,
|
||||
LHandled);
|
||||
if LHandled then
|
||||
Exit(True);
|
||||
LHandled := False;
|
||||
LSelectedController.ContentType := BuildContentType(LResponseContentMediaType,
|
||||
LResponseContentCharset);
|
||||
// LSelectedController.ContentCharset := LResponseContentCharset;
|
||||
LActionFormalParams := LRouter.MethodToCall.GetParameters;
|
||||
if (Length(LActionFormalParams) = 0) then
|
||||
SetLength(LActualParams, 0)
|
||||
else if (Length(LActionFormalParams) = 1) and
|
||||
(SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then
|
||||
begin
|
||||
SetLength(LActualParams, 1);
|
||||
LActualParams[0] := LContext;
|
||||
end
|
||||
else
|
||||
FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, LActualParams);
|
||||
|
||||
LSelectedController.MVCControllerAfterCreate;
|
||||
try
|
||||
LHandled := False;
|
||||
LSelectedController.ContentType := BuildContentType(LResponseContentMediaType, LResponseContentCharset);
|
||||
// LSelectedController.ContentCharset := LResponseContentCharset;
|
||||
LActionFormalParams := LRouter.MethodToCall.GetParameters;
|
||||
if (Length(LActionFormalParams) = 0) then
|
||||
SetLength(LActualParams, 0)
|
||||
else if (Length(LActionFormalParams) = 1) and
|
||||
(SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then
|
||||
begin
|
||||
SetLength(LActualParams, 1);
|
||||
LActualParams[0] := LContext;
|
||||
end
|
||||
else
|
||||
FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, LActualParams);
|
||||
LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled);
|
||||
|
||||
LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled);
|
||||
|
||||
if not LHandled then
|
||||
begin
|
||||
try
|
||||
LRouter.MethodToCall.Invoke(LSelectedController, LActualParams);
|
||||
finally
|
||||
LSelectedController.OnAfterAction(LContext, LRouter.MethodToCall.Name);
|
||||
end;
|
||||
if not LHandled then
|
||||
begin
|
||||
try
|
||||
LRouter.MethodToCall.Invoke(LSelectedController, LActualParams);
|
||||
finally
|
||||
LSelectedController.OnAfterAction(LContext, LRouter.MethodToCall.Name);
|
||||
end;
|
||||
|
||||
finally
|
||||
LSelectedController.MVCControllerBeforeDestroy;
|
||||
end;
|
||||
ExecuteAfterControllerActionMiddleware(LContext, LRouter.MethodToCall.Name, LHandled);
|
||||
except
|
||||
on E: EMVCSessionExpiredException do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
|
||||
LContext.SessionStop(False);
|
||||
LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
LSelectedController.Render(E);
|
||||
end;
|
||||
on E: EMVCException do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
|
||||
LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
LSelectedController.Render(E);
|
||||
end;
|
||||
on E: EInvalidOp do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
|
||||
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
LSelectedController.Render(E);
|
||||
end;
|
||||
on Ex: Exception do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Global Action Exception Handler'],
|
||||
LOGGERPRO_TAG);
|
||||
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
LSelectedController.Render(Ex);
|
||||
end;
|
||||
finally
|
||||
LSelectedController.MVCControllerBeforeDestroy;
|
||||
end;
|
||||
ExecuteAfterControllerActionMiddleware(LContext, LRouter.MethodToCall.Name, LHandled);
|
||||
// except
|
||||
// on E: EMVCSessionExpiredException do
|
||||
// begin
|
||||
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
|
||||
// LContext.SessionStop(False);
|
||||
// LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
// LSelectedController.Render(E);
|
||||
// end;
|
||||
// on E: EMVCException do
|
||||
// begin
|
||||
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage], LOGGERPRO_TAG);
|
||||
// LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
// LSelectedController.Render(E);
|
||||
// end;
|
||||
// on E: EInvalidOp do
|
||||
// begin
|
||||
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
|
||||
// LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
// LSelectedController.Render(E);
|
||||
// end;
|
||||
// on Ex: Exception do
|
||||
// begin
|
||||
// Log.ErrorFmt('[%s] %s (Custom message: "%s")', [Ex.Classname, Ex.Message, 'Global Action Exception Handler'],
|
||||
// LOGGERPRO_TAG);
|
||||
// LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
// LSelectedController.Render(Ex);
|
||||
// end;
|
||||
// end;
|
||||
|
||||
LContext.Response.ContentType := LSelectedController.ContentType;
|
||||
|
||||
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> ' + LRouter.ControllerClazz.QualifiedClassName
|
||||
+ ' - ' + IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString)
|
||||
finally
|
||||
LSelectedController.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
|
||||
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> ' +
|
||||
LRouter.ControllerClazz.QualifiedClassName + ' - ' + IntToStr(AResponse.StatusCode) + ' ' +
|
||||
AResponse.ReasonString)
|
||||
|
||||
end
|
||||
else // execute-routing
|
||||
begin
|
||||
if not Config[TMVCConfigKey.FallbackResource].IsEmpty then
|
||||
if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
|
||||
begin
|
||||
if (LContext.Request.PathInfo = '/') or (LContext.Request.PathInfo = '') then // useful for SPA
|
||||
Result := SendStaticFileIfPresent(LContext, TPath.Combine(Config[TMVCConfigKey.DocumentRoot],
|
||||
Config[TMVCConfigKey.FallbackResource]));
|
||||
end;
|
||||
if not Result then
|
||||
begin
|
||||
HTTP404(LContext);
|
||||
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> NO ACTION ' + ' - ' +
|
||||
IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString);
|
||||
end;
|
||||
if not Config[TMVCConfigKey.FallbackResource].IsEmpty then
|
||||
begin
|
||||
if (LContext.Request.PathInfo = '/') or (LContext.Request.PathInfo = '') then // useful for SPA
|
||||
Result := SendStaticFileIfPresent(LContext, TPath.Combine(Config[TMVCConfigKey.DocumentRoot],
|
||||
Config[TMVCConfigKey.FallbackResource]));
|
||||
end;
|
||||
if (not Result) and (IsStaticFileRequest(ARequest, LFileName)) then
|
||||
begin
|
||||
Result := SendStaticFileIfPresent(LContext, LFileName);
|
||||
end;
|
||||
if not Result then
|
||||
begin
|
||||
// HTTP404(LContext);
|
||||
Log(TLogLevel.levNormal, ARequest.Method + ':' + ARequest.RawPathInfo + ' -> NO ACTION ' + ' - ' +
|
||||
IntToStr(AResponse.StatusCode) + ' ' + AResponse.ReasonString);
|
||||
raise EMVCException.Create(HTTP_STATUS.NotFound, 'Not Found');
|
||||
end;
|
||||
end
|
||||
else
|
||||
LContext.Response.FlushOnDestroy := False;
|
||||
end; // end-execute-routing
|
||||
end; // if not handled by beforerouting
|
||||
except
|
||||
on E: EMVCSessionExpiredException do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage],
|
||||
LOGGERPRO_TAG);
|
||||
LContext.SessionStop(False);
|
||||
LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
LSelectedController.Render(E);
|
||||
end;
|
||||
on E: EMVCException do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, E.DetailedMessage],
|
||||
LOGGERPRO_TAG);
|
||||
if Assigned(LSelectedController) then
|
||||
begin
|
||||
LSelectedController.ResponseStatus(E.HTTPErrorCode);
|
||||
LSelectedController.Render(E);
|
||||
end
|
||||
else
|
||||
LContext.Response.FlushOnDestroy := False;
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]));
|
||||
end;
|
||||
end;
|
||||
on E: EInvalidOp do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")', [E.Classname, E.Message, 'Invalid Op'], LOGGERPRO_TAG);
|
||||
if Assigned(LSelectedController) then
|
||||
begin
|
||||
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
LSelectedController.Render(E);
|
||||
end
|
||||
else
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
|
||||
Format('[%s] %s', [E.Classname, E.Message]));
|
||||
end;
|
||||
end;
|
||||
on E: Exception do
|
||||
begin
|
||||
Log.ErrorFmt('[%s] %s (Custom message: "%s")',
|
||||
[E.Classname, E.Message, 'Global Action Exception Handler'], LOGGERPRO_TAG);
|
||||
if Assigned(LSelectedController) then
|
||||
begin
|
||||
LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
|
||||
LSelectedController.Render(E);
|
||||
end
|
||||
else
|
||||
begin
|
||||
SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError,
|
||||
Format('[%s] %s', [E.Classname, E.Message]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LRouter.Free;
|
||||
FreeAndNil(LSelectedController);
|
||||
end;
|
||||
finally
|
||||
LRouter.Free;
|
||||
end;
|
||||
finally
|
||||
LContext.Free;
|
||||
@ -1829,8 +1910,8 @@ begin
|
||||
FMiddlewares[I].OnAfterControllerAction(AContext, AActionName, AHandled);
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext; const AControllerQualifiedClassName: string;
|
||||
const AActionName: string; var AHandled: Boolean);
|
||||
procedure TMVCEngine.ExecuteBeforeControllerActionMiddleware(const AContext: TWebContext;
|
||||
const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
|
||||
var
|
||||
Middleware: IMVCMiddleware;
|
||||
begin
|
||||
@ -1863,8 +1944,8 @@ begin
|
||||
Result := TIdURI.URLDecode(Result);
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.FillActualParamsForAction(const AContext: TWebContext; const AActionFormalParams: TArray<TRttiParameter>;
|
||||
const AActionName: string; var AActualParams: TArray<TValue>);
|
||||
procedure TMVCEngine.FillActualParamsForAction(const AContext: TWebContext;
|
||||
const AActionFormalParams: TArray<TRttiParameter>; const AActionName: string; var AActualParams: TArray<TValue>);
|
||||
var
|
||||
ParamName: string;
|
||||
I: Integer;
|
||||
@ -1883,7 +1964,8 @@ begin
|
||||
ParamName := AActionFormalParams[I].Name;
|
||||
|
||||
if not AContext.Request.SegmentParam(ParamName, StrValue) then
|
||||
raise EMVCException.CreateFmt('Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
|
||||
raise EMVCException.CreateFmt
|
||||
('Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
|
||||
[ParamName, AActionName]);
|
||||
|
||||
case AActionFormalParams[I].ParamType.TypeKind of
|
||||
@ -1920,7 +2002,8 @@ begin
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]', [AActionFormalParams[I].Name, E.Message]);
|
||||
raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]',
|
||||
[AActionFormalParams[I].Name, E.Message]);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
@ -1949,16 +2032,17 @@ begin
|
||||
AActualParams[I] := False
|
||||
else
|
||||
raise EMVCException.CreateFmt
|
||||
('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".', [ParamName]);
|
||||
('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".',
|
||||
[ParamName]);
|
||||
end
|
||||
else
|
||||
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' + ALLOWED_TYPED_ACTION_PARAMETERS_TYPES,
|
||||
[ParamName]);
|
||||
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' +
|
||||
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ParamName]);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' + ALLOWED_TYPED_ACTION_PARAMETERS_TYPES,
|
||||
[ParamName]);
|
||||
raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' +
|
||||
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ParamName]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -2029,14 +2113,16 @@ end;
|
||||
function TMVCEngine.GetViewEngineClass: TMVCViewEngineClass;
|
||||
begin
|
||||
if FViewEngineClass = nil then
|
||||
raise EMVCConfigException.Create('No View Engine configured. [HINT: Use TMVCEngine.SetViewEngine() to set a valid view engine]');
|
||||
raise EMVCConfigException.Create
|
||||
('No View Engine configured. [HINT: Use TMVCEngine.SetViewEngine() to set a valid view engine]');
|
||||
Result := FViewEngineClass;
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.HTTP404(const AContext: TWebContext);
|
||||
begin
|
||||
AContext.Response.SetStatusCode(HTTP_STATUS.NotFound);
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN, AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
|
||||
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
AContext.Response.SetReasonString('Not Found');
|
||||
AContext.Response.SetContent('Not Found' + sLineBreak + GetServerSignature(AContext));
|
||||
end;
|
||||
@ -2044,9 +2130,42 @@ end;
|
||||
procedure TMVCEngine.HTTP500(const AContext: TWebContext; const AReasonString: string);
|
||||
begin
|
||||
AContext.Response.SetStatusCode(HTTP_STATUS.InternalServerError);
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN, AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
|
||||
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
AContext.Response.SetReasonString('Internal server error');
|
||||
AContext.Response.SetContent('Internal server error' + sLineBreak + GetServerSignature(AContext) + ': ' + AReasonString);
|
||||
AContext.Response.SetContent('Internal server error' + sLineBreak + GetServerSignature(AContext) + ': ' +
|
||||
AReasonString);
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.SendRawHTTPStatus(const AContext: TWebContext; const HTTPStatusCode: Integer;
|
||||
const AReasonString: string);
|
||||
var
|
||||
lSer: IMVCSerializer;
|
||||
lError: TMVCErrorResponse;
|
||||
begin
|
||||
AContext.Response.SetStatusCode(HTTPStatusCode);
|
||||
AContext.Response.SetReasonString(AReasonString);
|
||||
if Serializers.TryGetValue(AContext.Config[TMVCConfigKey.DefaultContentType], lSer) then
|
||||
begin
|
||||
lError := TMVCErrorResponse.Create;
|
||||
try
|
||||
lError.Classname := '';
|
||||
lError.StatusCode := HTTPStatusCode;
|
||||
lError.Message := AReasonString;
|
||||
AContext.Response.SetContent(lSer.SerializeObject(lError));
|
||||
finally
|
||||
lError.Free;
|
||||
end;
|
||||
AContext.Response.SetContentType(AContext.Config[TMVCConfigKey.DefaultContentType]);
|
||||
end
|
||||
else
|
||||
begin
|
||||
AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
|
||||
AContext.Config[TMVCConfigKey.DefaultContentCharset]));
|
||||
|
||||
AContext.Response.SetContent(GetServerSignature(AContext) + sLineBreak + 'HTTP ' + HTTPStatusCode.ToString + ': ' +
|
||||
AReasonString);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCEngine.IsStaticFileRequest(const ARequest: TWebRequest; out AFileName: string): Boolean;
|
||||
@ -2062,7 +2181,8 @@ begin
|
||||
Log(TLogLevel.levNormal, 'EXIT: LoadSystemControllers');
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse; var AHandled: Boolean);
|
||||
procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
|
||||
var AHandled: Boolean);
|
||||
begin
|
||||
AHandled := False;
|
||||
{ there is a bug in WebBroker Linux on 10.2.1 tokyo }
|
||||
@ -2087,9 +2207,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCEngine.PublishObject(
|
||||
const AObjectCreatorDelegate: TMVCObjectCreatorDelegate;
|
||||
const AURLSegment: string): TMVCEngine;
|
||||
function TMVCEngine.PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string)
|
||||
: TMVCEngine;
|
||||
begin
|
||||
Result := AddController(TMVCJSONRPCPublisher,
|
||||
function: TMVCController
|
||||
@ -2116,15 +2235,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest; const AResponse: TWebResponse);
|
||||
procedure TMVCEngine.ResponseErrorPage(const AException: Exception; const ARequest: TWebRequest;
|
||||
const AResponse: TWebResponse);
|
||||
begin
|
||||
AResponse.SetCustomHeader('x-mvc-error', AException.Classname + ': ' + AException.Message);
|
||||
AResponse.StatusCode := HTTP_STATUS.OK;
|
||||
begin
|
||||
AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;
|
||||
AResponse.Content := Config[TMVCConfigKey.ServerName] + ' ERROR:' + sLineBreak + 'Exception raised of class: ' + AException.Classname +
|
||||
sLineBreak + '***********************************************' + sLineBreak + AException.Message + sLineBreak +
|
||||
'***********************************************';
|
||||
AResponse.Content := Config[TMVCConfigKey.ServerName] + ' ERROR:' + sLineBreak + 'Exception raised of class: ' +
|
||||
AException.Classname + sLineBreak + '***********************************************' + sLineBreak +
|
||||
AException.Message + sLineBreak + '***********************************************';
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2132,13 +2252,15 @@ class function TMVCEngine.SendSessionCookie(const AContext: TWebContext): string
|
||||
var
|
||||
SId: string;
|
||||
begin
|
||||
SId := StringReplace(StringReplace(StringReplace(GUIDToString(TGUID.NewGuid), '}', '', []), '{', '', []), '-', '', [rfReplaceAll]);
|
||||
SId := StringReplace(StringReplace(StringReplace(GUIDToString(TGUID.NewGuid), '}', '', []), '{', '', []), '-', '',
|
||||
[rfReplaceAll]);
|
||||
Result := SendSessionCookie(AContext, SId);
|
||||
end;
|
||||
|
||||
procedure TMVCEngine.SaveCacheConfigValues;
|
||||
begin
|
||||
FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize], TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
|
||||
FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize],
|
||||
TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
|
||||
end;
|
||||
|
||||
class function TMVCEngine.SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string;
|
||||
@ -2240,8 +2362,8 @@ end;
|
||||
|
||||
{ TMVCControllerDelegate }
|
||||
|
||||
constructor TMVCControllerDelegate.Create(const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
|
||||
const AURLSegment: string = '');
|
||||
constructor TMVCControllerDelegate.Create(const AClazz: TMVCControllerClazz;
|
||||
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '');
|
||||
begin
|
||||
inherited Create;
|
||||
FClazz := AClazz;
|
||||
@ -2256,7 +2378,8 @@ begin
|
||||
Result := TPath.GetExtension(AStaticFileName).ToLower = '.' + AConfig[TMVCConfigKey.DefaultViewFileExtension].ToLower;
|
||||
end;
|
||||
|
||||
class function TMVCStaticContents.IsStaticFile(const AViewPath, AWebRequestPath: string; out ARealFileName: string): Boolean;
|
||||
class function TMVCStaticContents.IsStaticFile(const AViewPath, AWebRequestPath: string;
|
||||
out ARealFileName: string): Boolean;
|
||||
var
|
||||
FileName: string;
|
||||
begin
|
||||
@ -2332,6 +2455,11 @@ end;
|
||||
function TMVCRenderer.GetContentType: string;
|
||||
begin
|
||||
Result := GetContext.Response.ContentType;
|
||||
if Result.Trim.IsEmpty then
|
||||
begin
|
||||
GetContext.Response.ContentType := FContext.FConfig[MVCFramework.Commons.TMVCConfigKey.DefaultContentType];
|
||||
Result := GetContentType;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCRenderer.GetContext: TWebContext;
|
||||
@ -2577,7 +2705,8 @@ begin
|
||||
SendStream(AStream, AOwns);
|
||||
end;
|
||||
|
||||
procedure TMVCRenderer.Render(const AErrorCode: Integer; const AErrorMessage, AErrorClassName: string; const ADataObject: TObject);
|
||||
procedure TMVCRenderer.Render(const AErrorCode: Integer; const AErrorMessage, AErrorClassName: string;
|
||||
const ADataObject: TObject);
|
||||
var
|
||||
R: TMVCErrorResponse;
|
||||
begin
|
||||
@ -2599,7 +2728,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType);
|
||||
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType);
|
||||
begin
|
||||
if Assigned(ADataSet) then
|
||||
begin
|
||||
@ -2617,7 +2746,8 @@ begin
|
||||
raise EMVCException.Create('Can not render an empty dataset.');
|
||||
end;
|
||||
|
||||
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean; const AType: TMVCSerializationType);
|
||||
procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
|
||||
const AType: TMVCSerializationType);
|
||||
begin
|
||||
if Assigned(ACollection) then
|
||||
begin
|
||||
@ -2745,10 +2875,12 @@ begin
|
||||
begin
|
||||
SetContentType(TMVCMediaType.TEXT_HTML);
|
||||
ResponseStream.Clear;
|
||||
ResponseStream.Append('<html><head><style>pre { color: #000000; background-color: #d0d0d0; }</style></head><body>')
|
||||
.Append('<h1>' + Config[TMVCConfigKey.ServerName] + ': Error Raised</h1>').AppendFormat('<pre>HTTP Return Code: %d' + sLineBreak,
|
||||
[GetContext.Response.StatusCode]).AppendFormat('HTTP Reason Text: "%s"</pre>', [GetContext.Response.ReasonString])
|
||||
.Append('<h3><pre>').AppendFormat('Exception Class Name : %s' + sLineBreak, [AException.Classname])
|
||||
ResponseStream.Append
|
||||
('<html><head><style>pre { color: #000000; background-color: #d0d0d0; }</style></head><body>')
|
||||
.Append('<h1>' + Config[TMVCConfigKey.ServerName] + ': Error Raised</h1>')
|
||||
.AppendFormat('<pre>HTTP Return Code: %d' + sLineBreak, [GetContext.Response.StatusCode])
|
||||
.AppendFormat('HTTP Reason Text: "%s"</pre>', [GetContext.Response.ReasonString]).Append('<h3><pre>')
|
||||
.AppendFormat('Exception Class Name : %s' + sLineBreak, [AException.Classname])
|
||||
.AppendFormat('Exception Message : %s' + sLineBreak, [AException.Message]).Append('</pre></h3>');
|
||||
if Assigned(AExceptionItems) and (AExceptionItems.Count > 0) then
|
||||
begin
|
||||
@ -2758,7 +2890,7 @@ begin
|
||||
ResponseStream.Append('</pre><h2>');
|
||||
end
|
||||
else
|
||||
ResponseStream.AppendLine('<pre>No other informations available</pre>');
|
||||
ResponseStream.AppendLine('<pre>No other information available</pre>');
|
||||
ResponseStream.Append('</body></html>');
|
||||
RenderResponseStream;
|
||||
end
|
||||
@ -2822,12 +2954,13 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList;
|
||||
const ASerializationType: TMVCDatasetSerializationType);
|
||||
const ASerializationType: TMVCDatasetSerializationType);
|
||||
begin
|
||||
Render(ADataSet, AOwns, AIgnoredFields, ncLowerCase, ASerializationType);
|
||||
end;
|
||||
|
||||
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationType: TMVCDatasetSerializationType);
|
||||
procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean;
|
||||
const ASerializationType: TMVCDatasetSerializationType);
|
||||
begin
|
||||
Render(ADataSet, AOwns, [], ASerializationType);
|
||||
end;
|
||||
@ -2859,8 +2992,9 @@ end;
|
||||
|
||||
{ TMVCBaseView }
|
||||
|
||||
constructor TMVCBaseViewEngine.Create(const AEngine: TMVCEngine; const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject;
|
||||
const AViewDataSets: TObjectDictionary<string, TDataSet>; const AContentType: string);
|
||||
constructor TMVCBaseViewEngine.Create(const AEngine: TMVCEngine; const AWebContext: TWebContext;
|
||||
const AViewModel: TMVCViewDataObject; const AViewDataSets: TObjectDictionary<string, TDataSet>;
|
||||
const AContentType: string);
|
||||
begin
|
||||
inherited Create;
|
||||
Engine := AEngine;
|
||||
@ -2893,11 +3027,12 @@ begin
|
||||
if DirectoryExists(Config[TMVCConfigKey.ViewPath]) then
|
||||
F := ExpandFileName(IncludeTrailingPathDelimiter(Config.Value[TMVCConfigKey.ViewPath]) + FileName)
|
||||
else
|
||||
F := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.ViewPath]) + FileName);
|
||||
F := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.ViewPath])
|
||||
+ FileName);
|
||||
|
||||
if not TFile.Exists(F) then
|
||||
FileName := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath + Config.Value[TMVCConfigKey.DocumentRoot])
|
||||
+ FileName)
|
||||
FileName := ExpandFileName(IncludeTrailingPathDelimiter(GetApplicationFileNamePath +
|
||||
Config.Value[TMVCConfigKey.DocumentRoot]) + FileName)
|
||||
else
|
||||
FileName := F;
|
||||
|
||||
@ -2918,4 +3053,3 @@ finalization
|
||||
FreeAndNil(_MVCGlobalActionParamsCache);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,16 +1,19 @@
|
||||
program DMVCFrameworkTests;
|
||||
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
{$IFNDEF GUI_TESTRUNNER}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}{$STRONGLINKTYPES ON}
|
||||
{$ENDIF}{$ENDIF}{$STRONGLINKTYPES ON}
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
{$IFDEF TESTINSIGHT}
|
||||
TestInsight.DUnitX,
|
||||
{$ENDIF }
|
||||
{$IFDEF GUI_TESTRUNNER}
|
||||
Vcl.Forms,
|
||||
DUnitX.Loggers.GUI.Vcl,
|
||||
{$ENDIF}
|
||||
{$IFDEF CONSOLE_TESTRUNNER}
|
||||
DUnitX.Loggers.Console,
|
||||
// DUnitX.Loggers.GUIX,
|
||||
{$ENDIF}
|
||||
DUnitX.Loggers.Xml.NUnit,
|
||||
DUnitX.TestFramework,
|
||||
FrameworkTestsU in 'FrameworkTestsU.pas',
|
||||
@ -19,9 +22,10 @@ uses
|
||||
BOs in 'BOs.pas',
|
||||
TestServerControllerU in '..\TestServer\TestServerControllerU.pas',
|
||||
RESTAdapterTestsU in 'RESTAdapterTestsU.pas',
|
||||
MVCFramework.Tests.WebModule2 in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule},
|
||||
MVCFramework.Tests.WebModule2
|
||||
in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule} ,
|
||||
MVCFramework.Tests.StandaloneServer in '..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas',
|
||||
MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule},
|
||||
MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule} ,
|
||||
MVCFramework.Tests.RESTClient in '..\RESTClient\MVCFramework.Tests.RESTClient.pas',
|
||||
MVCFramework.Tests.AppController in '..\RESTClient\MVCFramework.Tests.AppController.pas',
|
||||
BusinessObjectsU in '..\..\..\samples\commons\BusinessObjectsU.pas',
|
||||
@ -34,51 +38,67 @@ uses
|
||||
MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas';
|
||||
|
||||
{$R *.RES}
|
||||
{$IFDEF CONSOLE_TESTRUNNER}
|
||||
|
||||
procedure MainConsole();
|
||||
var
|
||||
runner : ITestRunner;
|
||||
results : IRunResults;
|
||||
logger : ITestLogger;
|
||||
nunitLogger : ITestLogger;
|
||||
runner: ITestRunner;
|
||||
results: IRunResults;
|
||||
logger: ITestLogger;
|
||||
nunitLogger: ITestLogger;
|
||||
begin
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
|
||||
{$IFDEF TESTINSIGHT}
|
||||
TestInsight.DUnitX.RunRegisteredTests;
|
||||
exit;
|
||||
{$ENDIF}
|
||||
|
||||
try
|
||||
//Check command line options, will exit if invalid
|
||||
// Check command line options, will exit if invalid
|
||||
TDUnitX.CheckCommandLine;
|
||||
//Create the test runner
|
||||
// Create the test runner
|
||||
runner := TDUnitX.CreateRunner;
|
||||
//Tell the runner to use RTTI to find Fixtures
|
||||
// Tell the runner to use RTTI to find Fixtures
|
||||
runner.UseRTTI := True;
|
||||
//tell the runner how we will log things
|
||||
//Log to the console window
|
||||
logger := TDUnitXConsoleLogger.Create(true);
|
||||
// tell the runner how we will log things
|
||||
// Log to the console window
|
||||
logger := TDUnitXConsoleLogger.Create(True);
|
||||
runner.AddLogger(logger);
|
||||
//Generate an NUnit compatible XML File
|
||||
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
|
||||
runner.AddLogger(nunitLogger);
|
||||
runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests;
|
||||
// Generate an NUnit compatible XML File
|
||||
// nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
|
||||
// runner.AddLogger(nunitLogger);
|
||||
runner.FailsOnNoAsserts := False; // When true, Assertions must be made during tests;
|
||||
|
||||
//Run tests
|
||||
// Run tests
|
||||
results := runner.Execute;
|
||||
if not results.AllPassed then
|
||||
System.ExitCode := EXIT_ERRORS;
|
||||
|
||||
{$IFNDEF CI}
|
||||
//We don't want this happening when running under CI.
|
||||
{$IFNDEF CI}
|
||||
// We don't want this happening when running under CI.
|
||||
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
|
||||
begin
|
||||
System.Write('Done.. press <Enter> key to quit.');
|
||||
System.Readln;
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
except
|
||||
on E: Exception do
|
||||
System.Writeln(E.ClassName, ': ', E.Message);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$IFDEF GUI_TESTRUNNER}
|
||||
|
||||
procedure MainGUI;
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGUIVCLTestRunner, GUIVCLTestRunner);
|
||||
Application.Run;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
begin
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
{$IFDEF CONSOLE_TESTRUNNER}
|
||||
MainConsole();
|
||||
{$ENDIF}
|
||||
{$IFDEF GUI_TESTRUNNER}
|
||||
MainGUI();
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{0582DE6A-D716-46D3-8CBD-84AD73A4B536}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Config Condition="'$(Config)'==''">GUI</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||
<TargetedPlatforms>1</TargetedPlatforms>
|
||||
<AppType>Console</AppType>
|
||||
@ -34,7 +34,35 @@
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='USE_MESSAGING' or '$(Cfg_3)'!=''">
|
||||
<PropertyGroup Condition="'$(Config)'=='CONSOLE' or '$(Cfg_4)'!=''">
|
||||
<Cfg_4>true</Cfg_4>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_4)'=='true') or '$(Cfg_4_Win32)'!=''">
|
||||
<Cfg_4_Win32>true</Cfg_4_Win32>
|
||||
<CfgParent>Cfg_4</CfgParent>
|
||||
<Cfg_4>true</Cfg_4>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='CI' or '$(Cfg_5)'!=''">
|
||||
<Cfg_5>true</Cfg_5>
|
||||
<CfgParent>Cfg_4</CfgParent>
|
||||
<Cfg_4>true</Cfg_4>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_5)'=='true') or '$(Cfg_5_Win32)'!=''">
|
||||
<Cfg_5_Win32>true</Cfg_5_Win32>
|
||||
<CfgParent>Cfg_5</CfgParent>
|
||||
<Cfg_5>true</Cfg_5>
|
||||
<Cfg_4>true</Cfg_4>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='GUI' or '$(Cfg_3)'!=''">
|
||||
<Cfg_3>true</Cfg_3>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
@ -47,12 +75,6 @@
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='SERVER_ON_LINUX' or '$(Cfg_4)'!=''">
|
||||
<Cfg_4>true</Cfg_4>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||
<Cfg_2>true</Cfg_2>
|
||||
<CfgParent>Base</CfgParent>
|
||||
@ -73,7 +95,6 @@
|
||||
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
|
||||
<SanitizedProjectName>DMVCFrameworkTests</SanitizedProjectName>
|
||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||
<DCC_Define>_CONSOLE_TESTRUNNER;TESTINSIGHT;$(DCC_Define)</DCC_Define>
|
||||
<DCC_UnitSearchPath>$(BDS)\Source\DUnit\src;..\..\..\sources;..\..\..\lib\delphistompclient;..\..\..\lib\dmustache;..\..\..\lib\loggerpro;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<DCC_DcuOutput>.\$(Platform)\$(Config)\dcu</DCC_DcuOutput>
|
||||
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||
@ -106,17 +127,26 @@
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<DCC_MapFile>3</DCC_MapFile>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_3)'!=''">
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
<VerInfo_Locale>1040</VerInfo_Locale>
|
||||
<DCC_Define>USE_MESSAGING;$(DCC_Define)</DCC_Define>
|
||||
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||
<PropertyGroup Condition="'$(Cfg_4)'!=''">
|
||||
<DCC_Define>CONSOLE_TESTRUNNER;$(DCC_Define)</DCC_Define>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
|
||||
<PropertyGroup Condition="'$(Cfg_4_Win32)'!=''">
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_4)'!=''">
|
||||
<DCC_Define>LINUX_SERVER;$(DCC_Define)</DCC_Define>
|
||||
<PropertyGroup Condition="'$(Cfg_5_Win32)'!=''">
|
||||
<DCC_Define>CI;$(DCC_Define)</DCC_Define>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_3)'!=''">
|
||||
<DCC_UnitSearchPath>$(BDS)\source\DunitX;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<DCC_Define>_CONSOLE_TESTRUNNER;GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
|
||||
<DCC_Define>GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
@ -141,13 +171,11 @@
|
||||
<DCCReference Include="RESTAdapterTestsU.pas"/>
|
||||
<DCCReference Include="..\StandaloneServer\MVCFramework.Tests.WebModule2.pas">
|
||||
<Form>TestWebModule2</Form>
|
||||
<FormType>dfm</FormType>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas"/>
|
||||
<DCCReference Include="..\RESTClient\MVCFramework.Tests.WebModule1.pas">
|
||||
<Form>TestWebModule1</Form>
|
||||
<FormType>dfm</FormType>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="..\RESTClient\MVCFramework.Tests.RESTClient.pas"/>
|
||||
@ -160,10 +188,14 @@
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.JSONRPC.pas"/>
|
||||
<DCCReference Include="..\..\..\samples\commons\RandomUtilsU.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas"/>
|
||||
<BuildConfiguration Include="CI">
|
||||
<Key>Cfg_5</Key>
|
||||
<CfgParent>Cfg_4</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="SERVER_ON_LINUX">
|
||||
<BuildConfiguration Include="CONSOLE">
|
||||
<Key>Cfg_4</Key>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
</BuildConfiguration>
|
||||
@ -171,14 +203,14 @@
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="USE_MESSAGING">
|
||||
<Key>Cfg_3</Key>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Debug">
|
||||
<Key>Cfg_1</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="GUI">
|
||||
<Key>Cfg_3</Key>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
@ -239,7 +271,8 @@
|
||||
<Source Name="MainSource">DMVCFrameworkTests.dpr</Source>
|
||||
</Source>
|
||||
<Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\DataExplorerDBXPluginEnt260.bpl">DBExpress Enterprise Data Explorer Integration</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
|
||||
@ -41,10 +41,8 @@ const
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
type
|
||||
|
||||
[TestFixture]
|
||||
TBaseServerTest = class(TObject)
|
||||
protected
|
||||
RESTClient: TRESTClient;
|
||||
@ -59,11 +57,12 @@ type
|
||||
|
||||
end;
|
||||
|
||||
[TestFixture]
|
||||
TServerTest = class(TBaseServerTest)
|
||||
public
|
||||
[Test]
|
||||
[TestCase('/fault', '/fault')]
|
||||
[TestCase('/fault2', '/fault2')]
|
||||
[TestCase('request url /fault', '/fault')]
|
||||
[TestCase('request url /fault2', '/fault2')]
|
||||
procedure TestControllerWithExceptionInCreate(const URLSegment: string);
|
||||
|
||||
[Test]
|
||||
@ -73,12 +72,12 @@ type
|
||||
[Test]
|
||||
[TestCase('1', ' à,è')]
|
||||
[TestCase('2', 'é,ù,ò')]
|
||||
[TestCase('2', 'ì,@,[')]
|
||||
[TestCase('2', '],{,}')]
|
||||
[TestCase('2', '(,),\')]
|
||||
[TestCase('2', '=,;,&')]
|
||||
[TestCase('2', '#,.,_')]
|
||||
[TestCase('2', '%, , ')]
|
||||
[TestCase('3', 'ì,@,[')]
|
||||
[TestCase('4', '],{,}')]
|
||||
[TestCase('5', '(,),\')]
|
||||
[TestCase('6', '=,;,&')]
|
||||
[TestCase('7', '#,.,_')]
|
||||
[TestCase('8', '%, , ')]
|
||||
procedure TestReqWithURLMappedParams(const par1, par2, par3: string);
|
||||
[Test]
|
||||
procedure TestPOSTWithParamsAndJSONBody;
|
||||
@ -473,15 +472,16 @@ begin
|
||||
Assert.areEqual('johndoe', LRes.BodyAsString);
|
||||
end;
|
||||
|
||||
procedure TServerTest.TestControllerWithExceptionInCreate(
|
||||
const URLSegment: string);
|
||||
procedure TServerTest.TestControllerWithExceptionInCreate(const URLSegment: string);
|
||||
var
|
||||
res: IRESTResponse;
|
||||
begin
|
||||
res := RESTClient.doGET(URLSegment, []);
|
||||
Assert.areEqual(HTTP_STATUS.InternalServerError, res.ResponseCode);
|
||||
Assert.Contains(res.ContentType, 'text/plain', true, 'Is not a text/plain in case of error');
|
||||
//Assert.Contains(res.ContentType, 'text/plain', true, 'Is not a text/plain in case of error');
|
||||
Assert.Contains(res.ContentType, 'application/json', true, 'Is not a application/json in case of error');
|
||||
Assert.Contains(res.BodyAsString, 'Cannot create controller', true, 'Exception message in body is not correct');
|
||||
//Assert.Contains(res.BodyAsString, 'Cannot create controller', true, 'Exception message in body is not correct');
|
||||
end;
|
||||
|
||||
procedure TServerTest.TestCookies;
|
||||
@ -733,12 +733,10 @@ var
|
||||
lCompType: string;
|
||||
j: Integer;
|
||||
const
|
||||
CompressionTypes: array [1 .. 9] of string =
|
||||
('deflate', 'gzip', 'deflate,gzip', 'gzip,deflate',
|
||||
'gzip,invalid', 'deflate,notvalid', 'notvalid,gzip', 'invalid', '');
|
||||
CompressionTypeResult: array [1 .. 9] of string =
|
||||
('deflate', 'gzip', 'deflate', 'gzip',
|
||||
'gzip', 'deflate', 'gzip', '', '');
|
||||
CompressionTypes: array [1 .. 9] of string = ('deflate', 'gzip', 'deflate,gzip', 'gzip,deflate', 'gzip,invalid',
|
||||
'deflate,notvalid', 'notvalid,gzip', 'invalid', '');
|
||||
CompressionTypeResult: array [1 .. 9] of string = ('deflate', 'gzip', 'deflate', 'gzip', 'gzip', 'deflate',
|
||||
'gzip', '', '');
|
||||
begin
|
||||
j := 1;
|
||||
for lCompType in CompressionTypes do
|
||||
@ -1330,7 +1328,7 @@ begin
|
||||
lRPCResp := FExecutor2.ExecuteRequest(lReq);
|
||||
LRes := lRPCResp.Result.AsType<TDateTime>();
|
||||
DecodeDateTime(LRes, lYear, lMonth, lDay, lHour, lMinute, lSecond, lMillisecond);
|
||||
Assert.AreEqual(2000, lYear);
|
||||
Assert.areEqual(2000, lYear);
|
||||
end;
|
||||
|
||||
procedure TJSONRPCServerTest.TestRequestWithoutParams;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{FAC8B4A9-B614-46ED-BF18-D718EC2E7F3E}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>None</FrameworkType>
|
||||
<MainSource>TestServer.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
|
||||
@ -770,8 +770,16 @@ begin
|
||||
Dm.EntityAsIsId.AsLargeInt := 2;
|
||||
Dm.EntityAsIsName.AsString := 'Ezequiel Juliano Müller';
|
||||
Dm.EntityAsIs.Post;
|
||||
|
||||
|
||||
//serialize dataset
|
||||
S := FSerializer.SerializeDataSet(Dm.EntityAsIs);
|
||||
Assert.areEqual(JSON_LIST, S, 'json list');
|
||||
|
||||
//serialize dataset as object
|
||||
S := FSerializer.SerializeObject(Dm.EntityAsIs);
|
||||
Assert.areEqual(JSON_LIST, S, 'json list');
|
||||
|
||||
finally
|
||||
Dm.Free;
|
||||
end;
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{DE94B0A5-DA22-4941-9AE1-FB2BBDCD4F7E}</ProjectGuid>
|
||||
<ProjectVersion>18.5</ProjectVersion>
|
||||
<ProjectVersion>18.6</ProjectVersion>
|
||||
<FrameworkType>None</FrameworkType>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">CI</Config>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||
<TargetedPlatforms>1</TargetedPlatforms>
|
||||
<AppType>Console</AppType>
|
||||
@ -48,7 +48,7 @@
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<SanitizedProjectName>TestSerializerJsonDataObjects</SanitizedProjectName>
|
||||
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||
<DCC_Define>_CONSOLE_TESTRUNNER;TESTINSIGHT;$(DCC_Define)</DCC_Define>
|
||||
<DCC_Define>CONSOLE_TESTRUNNER;_TESTINSIGHT;$(DCC_Define)</DCC_Define>
|
||||
<VerInfo_Locale>1046</VerInfo_Locale>
|
||||
<DCC_DcpOutput>.\$(Platform)\$(Config)\dcp</DCC_DcpOutput>
|
||||
<DCC_UnitSearchPath>$(BDS)\Source\DUnit\src;..\..\..\sources;..\..\..\lib\loggerpro;..\..\..\lib\dmustache;..\..\..\lib\delphistompclient;..\..\..\lib\jsondataobjects\Source;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
@ -122,11 +122,11 @@
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Excluded_Packages>
|
||||
<Excluded_Packages Name="C:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl\LockBoxFMXDD250.bpl">TurboPack LockBox Delphi FMX designtime package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\DataExplorerDBXPluginEnt260.bpl">DBExpress Enterprise Data Explorer Integration</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="C:\Program Files (x86)\FastReports\LibD26\dclfrxtee26.bpl">FastReport 6.0 Tee Components</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
<Source>
|
||||
<Source Name="MainSource">TestSerializerJsonDataObjects.dpr</Source>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user