Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Refactoring and Removing Dependency with SystemJSON and Mapper

Browse Source
This commit is contained in:
Ezequiel Juliano Müller 2017-03-13 16:52:11 -03:00
parent d0f3961bed
commit 5f34de36b1
9 changed files with 2339 additions and 2790 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
sources/MVCFramework.Commons.pas
View File

@ -30,16 +30,19 @@ interface
uses uses
System.SysUtils, Generics.Collections, MVCFramework.TypesAliases, System.SysUtils,
System.Generics.Collections, MVCFramework.Session, LoggerPro, System.SyncObjs,
System.SyncObjs; System.Generics.Collections,
MVCFramework.TypesAliases,
MVCFramework.Session,
LoggerPro;
{$I dmvcframeworkbuildconsts.inc} {$I dmvcframeworkbuildconsts.inc}
type type
TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD,
httpOPTIONS, httpPATCH, httpTRACE); TMVCHTTPMethodType = (httpGET, httpPOST, httpPUT, httpDELETE, httpHEAD, httpOPTIONS, httpPATCH, httpTRACE);
TMVCHTTPMethods = set of TMVCHTTPMethodType; TMVCHTTPMethods = set of TMVCHTTPMethodType;
TMVCPair<TKey, TVal> = class TMVCPair<TKey, TVal> = class
@ -64,7 +67,7 @@ type
property Val3: TVal3 read FVal3; property Val3: TVal3 read FVal3;
end; end;
TMVCMimeType = class sealed TMVCMimeType = record
public const public const
APPLICATION_JSON = 'application/json'; APPLICATION_JSON = 'application/json';
TEXT_HTML = 'text/html'; TEXT_HTML = 'text/html';
@ -79,7 +82,7 @@ type
TEXT_EVENTSTREAM = 'text/event-stream'; TEXT_EVENTSTREAM = 'text/event-stream';
end deprecated 'use TMVCMediaType'; end deprecated 'use TMVCMediaType';
TMVCMediaType = class sealed TMVCMediaType = record
public const public const
APPLICATION_ATOM_XML = 'application/atom+xml'; APPLICATION_ATOM_XML = 'application/atom+xml';
APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded'; APPLICATION_FORM_URLENCODED = 'application/x-www-form-urlencoded';
@ -88,6 +91,7 @@ type
APPLICATION_SVG_XML = 'application/svg+xml'; APPLICATION_SVG_XML = 'application/svg+xml';
APPLICATION_XHTML_XML = 'application/xhtml+xml'; APPLICATION_XHTML_XML = 'application/xhtml+xml';
APPLICATION_XML = 'application/xml'; APPLICATION_XML = 'application/xml';
APPLICATION_OCTETSTREAM = 'application/octet-stream';
MEDIA_TYPE_WILDCARD = '*'; MEDIA_TYPE_WILDCARD = '*';
MULTIPART_FORM_DATA = 'multipart/form-data'; MULTIPART_FORM_DATA = 'multipart/form-data';
TEXT_HTML = 'text/html'; TEXT_HTML = 'text/html';
@ -97,13 +101,13 @@ type
TEXT_JAVASCRIPT = 'text/javascript'; TEXT_JAVASCRIPT = 'text/javascript';
TEXT_CACHEMANIFEST = 'text/cache-manifest'; TEXT_CACHEMANIFEST = 'text/cache-manifest';
TEXT_EVENTSTREAM = 'text/event-stream'; TEXT_EVENTSTREAM = 'text/event-stream';
TEXT_CSV = 'text/csv'; // https://tools.ietf.org/html/rfc7111 TEXT_CSV = 'text/csv';
IMAGE_JPEG = 'image/jpeg'; IMAGE_JPEG = 'image/jpeg';
IMAGE_PNG = 'image/x-png'; IMAGE_PNG = 'image/x-png';
WILDCARD = '*/*'; WILDCARD = '*/*';
end; end;
TMVCCharSet = class sealed TMVCCharSet = record
public const public const
US_ASCII = 'US-ASCII'; US_ASCII = 'US-ASCII';
WINDOWS_1250 = 'windows-1250'; WINDOWS_1250 = 'windows-1250';
@ -127,7 +131,7 @@ type
UTF_16LE = 'UTF-16LE'; UTF_16LE = 'UTF-16LE';
end; end;
TMVCConstants = class sealed TMVCConstants = record
public const public const
SESSION_TOKEN_NAME = 'dtsessionid'; SESSION_TOKEN_NAME = 'dtsessionid';
DEFAULT_CONTENT_CHARSET = 'UTF-8'; DEFAULT_CONTENT_CHARSET = 'UTF-8';
@ -136,6 +140,28 @@ type
LAST_AUTHORIZATION_HEADER_VALUE = '__DMVC_LAST_AUTHORIZATION_HEADER_VALUE_'; LAST_AUTHORIZATION_HEADER_VALUE = '__DMVC_LAST_AUTHORIZATION_HEADER_VALUE_';
end; end;
TMVCConfigKey = record
public const
SessionTimeout = 'sessiontimeout';
DocumentRoot = 'document_root';
ViewPath = 'view_path';
DefaultContentType = 'default_content_type';
DefaultContentCharset = 'default_content_charset';
DefaultViewFileExtension = 'default_view_file_extension';
ISAPIPath = 'isapi_path';
StompServer = 'stompserver';
StompServerPort = 'stompserverport';
StompUsername = 'stompusername';
StompPassword = 'stomppassword';
Messaging = 'messaging';
AllowUnhandledAction = 'allow_unhandled_action';
ServerName = 'server_name';
ExposeServerSignature = 'server_signature';
IndexDocument = 'index_document';
SessionType = 'session_type';
FallbackResource = 'fallback_resource';
end;
EMVCException = class(Exception) EMVCException = class(Exception)
private private
FHTTPErrorCode: UInt16; FHTTPErrorCode: UInt16;
@ -361,7 +387,7 @@ type
HTTPVersionNotSupported = 505; HTTPVersionNotSupported = 505;
end; end;
{$SCOPEDENUMS ON} {$SCOPEDENUMS ON}
type type
@ -391,9 +417,13 @@ uses
idGlobal, idGlobal,
System.StrUtils, System.StrUtils,
idCoderMIME idCoderMIME
{$IFDEF SYSTEMJSON}
, System.JSON //just to allow inline {$IFDEF SYSTEMJSON}
{$ENDIF}
, System.JSON // just to allow inline
{$ENDIF}
; ;
const const

8
sources/MVCFramework.MessagingController.pas
View File

@ -133,8 +133,8 @@ begin
raise EMVCException.Create('Invalid or empty topic'); raise EMVCException.Create('Invalid or empty topic');
if not CTX.Request.ThereIsRequestBody then if not CTX.Request.ThereIsRequestBody then
raise EMVCException.Create('Body request required'); raise EMVCException.Create('Body request required');
EnqueueMessageOnTopicOrQueue(queuetype = 'queue', '/' + queuetype + '/' + topicname, // EnqueueMessageOnTopicOrQueue(queuetype = 'queue', '/' + queuetype + '/' + topicname,
CTX.Request.BodyAsJSONObject.Clone as TJSONObject, true); // CTX.Request.BodyAsJSONObject.Clone as TJSONObject, true);
// EnqueueMessage('/queue/' + topicname, CTX.Request.BodyAsJSONObject.Clone as TJSONObject, true); // EnqueueMessage('/queue/' + topicname, CTX.Request.BodyAsJSONObject.Clone as TJSONObject, true);
Render(200, 'Message sent to topic ' + topicname); Render(200, 'Message sent to topic ' + topicname);
end; end;
@ -224,12 +224,12 @@ begin
if LTimeOut then if LTimeOut then
begin begin
res.AddPair('_timeout', TJSONTrue.Create); res.AddPair('_timeout', TJSONTrue.Create);
Render(http_status.RequestTimeout, res); //Render(http_status.RequestTimeout, res);
end end
else else
begin begin
res.AddPair('_timeout', TJSONFalse.Create); res.AddPair('_timeout', TJSONFalse.Create);
Render(http_status.OK, res); //Render(http_status.OK, res);
end; end;
finally finally

441
sources/MVCFramework.Router.pas
View File

@ -6,6 +6,8 @@
// //
// https://github.com/danieleteti/delphimvcframework // https://github.com/danieleteti/delphimvcframework
// //
// Collaborators on this file: Ezequiel Juliano Müller (ezequieljuliano@gmail.com)
//
// *************************************************************************** // ***************************************************************************
// //
// Licensed under the Apache License, Version 2.0 (the "License"); // Licensed under the Apache License, Version 2.0 (the "License");
@ -27,172 +29,192 @@ unit MVCFramework.Router;
interface interface
uses uses
Web.HTTPApp, System.Rtti,
MVCFramework.RTTIUtils, System.SysUtils,
MVCFramework.Commons, System.Generics.Collections,
System.RTTI, System.RegularExpressions,
System.AnsiStrings,
MVCFramework, MVCFramework,
System.Generics.Collections; MVCFramework.Commons,
IdURI;
type type
TMVCRouter = class TMVCRouter = class
private private
FCTX: TRttiContext; FRttiContext: TRttiContext;
FMethodToCall: TRTTIMethod; FConfig: TMVCConfig;
FMVCControllerClass: TMVCControllerClass; FMethodToCall: TRttiMethod;
FMVCControllerDelegate: TMVCControllerDelegate; FControllerClazz: TMVCControllerClazz;
FMVCConfig: TMVCConfig; FControllerCreateAction: TMVCControllerCreateAction;
function IsHTTPContentTypeCompatible(AWebRequestMethodType: TMVCHTTPMethodType; function GetAttribute<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): T;
AContentType: string; AAttributes: TArray<TCustomAttribute>): Boolean; function GetFirstMediaType(const AContentType: string): string;
function IsHTTPAcceptCompatible(AWebRequestMethodType: TMVCHTTPMethodType; AAccept: string;
AAttributes: TArray<TCustomAttribute>): Boolean;
function GetFirstMimeType(const AContentType: string): string;
protected
function IsHTTPMethodCompatible(AMethodType: TMVCHTTPMethodType;
AAttributes: TArray<TCustomAttribute>): Boolean; virtual;
function IsCompatiblePath(AMVCPath: string; APath: string; var AParams: TMVCRequestParamsTable)
: Boolean; virtual;
function GetAttribute<T: TCustomAttribute>(AAttributes: TArray<TCustomAttribute>): T;
function IsHTTPContentTypeCompatible(
const ARequestMethodType: TMVCHTTPMethodType;
var AContentType: string;
const AAttributes: TArray<TCustomAttribute>): Boolean;
function IsHTTPAcceptCompatible(
const ARequestMethodType: TMVCHTTPMethodType;
var AAccept: string;
const AAttributes: TArray<TCustomAttribute>): Boolean;
function IsHTTPMethodCompatible(
const AMethodType: TMVCHTTPMethodType;
const AAttributes: TArray<TCustomAttribute>): Boolean;
function IsCompatiblePath(
const AMVCPath: string;
const APath: string;
var AParams: TMVCRequestParamsTable): Boolean;
protected
{ protected declarations }
public public
class function StringMethodToHTTPMetod(const Value: AnsiString): TMVCHTTPMethodType; class function StringMethodToHTTPMetod(const AValue: string): TMVCHTTPMethodType; static;
constructor Create(AMVCConfig: TMVCConfig); public
function ExecuteRouting(const AWebRequestPathInfo: AnsiString; constructor Create(const AConfig: TMVCConfig);
AWebRequestMethodType: TMVCHTTPMethodType; const AWebRequestContentType: AnsiString; destructor Destroy; override;
const AWebRequestAccept: AnsiString; AMVCControllers: TObjectList<TMVCControllerRoutable>;
const ADefaultContentType: string; const ADefaultContentCharset: string; function ExecuteRouting(
var AMVCRequestParams: TMVCRequestParamsTable; out AResponseContentType: string; const ARequestPathInfo: string;
out AResponseContentEncoding: string): Boolean; overload; const ARequestMethodType: TMVCHTTPMethodType;
property MethodToCall: TRTTIMethod read FMethodToCall; const ARequestContentType: string;
property MVCControllerClass: TMVCControllerClass read FMVCControllerClass; const ARequestAccept: string;
property MVCControllerDelegate: TMVCControllerDelegate read FMVCControllerDelegate; const AControllers: TObjectList<TMVCControllerDelegate>;
const ADefaultContentType: string;
const ADefaultContentCharset: string;
var ARequestParams: TMVCRequestParamsTable;
out AResponseContentType: string;
out AResponseContentEncoding: string): Boolean;
property MethodToCall: TRttiMethod read FMethodToCall;
property ControllerClazz: TMVCControllerClazz read FControllerClazz;
property ControllerCreateAction: TMVCControllerCreateAction read FControllerCreateAction;
end; end;
implementation implementation
uses
System.AnsiStrings,
System.StrUtils,
System.RegularExpressions,
System.SysUtils,
idURI;
{ TMVCRouter } { TMVCRouter }
constructor TMVCRouter.Create(AMVCConfig: TMVCConfig); constructor TMVCRouter.Create(const AConfig: TMVCConfig);
begin begin
inherited Create; inherited Create;
FMVCConfig := AMVCConfig; FRttiContext := TRttiContext.Create;
FConfig := AConfig;
FMethodToCall := nil;
FControllerClazz := nil;
FControllerCreateAction := nil;
end; end;
function TMVCRouter.ExecuteRouting(const AWebRequestPathInfo: AnsiString; destructor TMVCRouter.Destroy;
AWebRequestMethodType: TMVCHTTPMethodType; const AWebRequestContentType: AnsiString; begin
const AWebRequestAccept: AnsiString; AMVCControllers: TObjectList<TMVCControllerRoutable>; FRttiContext.Free;
const ADefaultContentType, ADefaultContentCharset: string; inherited Destroy;
var AMVCRequestParams: TMVCRequestParamsTable; out AResponseContentType: string; end;
function TMVCRouter.ExecuteRouting(const ARequestPathInfo: string;
const ARequestMethodType: TMVCHTTPMethodType;
const ARequestContentType, ARequestAccept: string;
const AControllers: TObjectList<TMVCControllerDelegate>;
const ADefaultContentType: string;
const ADefaultContentCharset: string;
var ARequestParams: TMVCRequestParamsTable;
out AResponseContentType: string;
out AResponseContentEncoding: string): Boolean; out AResponseContentEncoding: string): Boolean;
var var
controllerRoutable: TMVCControllerRoutable; LRequestPathInfo: string;
_type: TRttiType; LRequestAccept: string;
_methods: TArray<TRTTIMethod>; LRequestContentType: string;
_method: TRTTIMethod; LControllerMappedPath: string;
_attribute: TCustomAttribute; LControllerDelegate: TMVCControllerDelegate;
_attributes: TArray<TCustomAttribute>; LAttributes: TArray<TCustomAttribute>;
i: Integer; LAtt: TCustomAttribute;
ControllerMappedPath: string; LRttiType: TRttiType;
MethodPathAttribute: string; LMethods: TArray<TRTTIMethod>;
MVCProduceAttr: MVCProducesAttribute; LMethod: TRTTIMethod;
Found: Boolean; LFound: Boolean;
LWebRequestPathInfo: string; LMethodPath: string;
LWebRequestAccept: string; LProduceAttribute: MVCProducesAttribute;
begin begin
FMethodToCall := nil; Result := False;
FMVCControllerClass := nil;
FMVCControllerDelegate := nil;
LWebRequestAccept := string(AWebRequestAccept);
LWebRequestPathInfo := string(AWebRequestPathInfo); FMethodToCall := nil;
if Trim(LWebRequestPathInfo) = EmptyStr then FControllerClazz := nil;
LWebRequestPathInfo := '/' FControllerCreateAction := nil;
LRequestAccept := ARequestAccept;
LRequestContentType := ARequestContentType;
LRequestPathInfo := ARequestPathInfo;
if (Trim(LRequestPathInfo) = EmptyStr) then
LRequestPathInfo := '/'
else else
begin begin
if LWebRequestPathInfo[1] <> '/' then if LRequestPathInfo[1] <> '/' then
LWebRequestPathInfo := '/' + LWebRequestPathInfo; LRequestPathInfo := '/' + LRequestPathInfo;
end; end;
LRequestPathInfo := TIdURI.PathEncode(LRequestPathInfo);
// FIX https://github.com/danieleteti/delphimvcframework/issues/17
LWebRequestPathInfo := TIdURI.PathEncode(LWebRequestPathInfo);
{ ISAPI CHANGE THE REQUEST PATH INFO START } { ISAPI CHANGE THE REQUEST PATH INFO START }
if IsLibrary then if IsLibrary then
begin begin
if string(LWebRequestPathInfo).StartsWith(FMVCConfig.Value[TMVCConfigKey.ISAPIPath]) then if string(LRequestPathInfo).StartsWith(FConfig.Value[TMVCConfigKey.ISAPIPath]) then
LWebRequestPathInfo := LWebRequestPathInfo.Remove(0, LRequestPathInfo := LRequestPathInfo.Remove(0, FConfig.Value[TMVCConfigKey.ISAPIPath].Length);
FMVCConfig.Value[TMVCConfigKey.ISAPIPath].Length); if Length(LRequestPathInfo) = 0 then
if Length(LWebRequestPathInfo) = 0 then LRequestPathInfo := '/';
LWebRequestPathInfo := '/';
end; end;
{ ISAPI CHANGE THE REQUEST PATH INFO END } { ISAPI CHANGE THE REQUEST PATH INFO END }
TMonitor.Enter(Lock); // start of lock TMonitor.Enter(Lock);
try try
LControllerMappedPath := EmptyStr;
Result := False; for LControllerDelegate in AControllers do
ControllerMappedPath := '';
for controllerRoutable in AMVCControllers do
begin begin
SetLength(_attributes, 0); SetLength(LAttributes, 0);
_type := FCTX.GetType(controllerRoutable.&Class.ClassInfo); LRttiType := FRttiContext.GetType(LControllerDelegate.Clazz.ClassInfo);
_attributes := _type.GetAttributes; LAttributes := LRttiType.GetAttributes;
if _attributes = nil then if (LAttributes = nil) then
Continue; Continue;
Found := False; LFound := False;
for _attribute in _attributes do for LAtt in LAttributes do
if _attribute is MVCPathAttribute then if LAtt is MVCPathAttribute then
begin begin
Found := True; LFound := True;
ControllerMappedPath := MVCPathAttribute(_attribute).Path; LControllerMappedPath := MVCPathAttribute(LAtt).Path;
Break; Break;
end; end;
if not Found then if not LFound then
raise EMVCException.Create('Controller ' + _type.Name + ' doesn''t have MVCPath attribute'); raise EMVCException.CreateFmt('Controller %s does not have MVCPath attribute', [LRttiType.Name]);
if ControllerMappedPath = '/' then // WE WANT TO AVOID '//' AS MVCPATH if (LControllerMappedPath = '/') then
ControllerMappedPath := ''; LControllerMappedPath := '';
if (not ControllerMappedPath.IsEmpty) and (Pos(ControllerMappedPath, LWebRequestPathInfo) <> 1) if (not LControllerMappedPath.IsEmpty) and (Pos(LControllerMappedPath, LRequestPathInfo) <> 1) then
then
Continue; Continue;
_methods := _type.GetMethods; LMethods := LRttiType.GetMethods;
for _method in _methods do for LMethod in LMethods do
begin begin
_attributes := _method.GetAttributes; LAttributes := LMethod.GetAttributes;
for i := 0 to Length(_attributes) - 1 do for LAtt in LAttributes do
begin if LAtt is MVCPathAttribute then
_attribute := _attributes[i]; if IsHTTPMethodCompatible(ARequestMethodType, LAttributes) and
if _attribute is MVCPathAttribute then IsHTTPContentTypeCompatible(ARequestMethodType, LRequestContentType, LAttributes) and
begin IsHTTPAcceptCompatible(ARequestMethodType, LRequestAccept, LAttributes) then
if IsHTTPMethodCompatible(AWebRequestMethodType, _attributes) and
IsHTTPContentTypeCompatible(AWebRequestMethodType, string(AWebRequestContentType),
_attributes) and IsHTTPAcceptCompatible(AWebRequestMethodType, LWebRequestAccept,
_attributes) then
begin begin
MethodPathAttribute := MVCPathAttribute(_attribute).Path; LMethodPath := MVCPathAttribute(LAtt).Path;
if IsCompatiblePath(ControllerMappedPath + MethodPathAttribute, LWebRequestPathInfo, if IsCompatiblePath(LControllerMappedPath + LMethodPath, LRequestPathInfo, ARequestParams) then
AMVCRequestParams) then
begin begin
FMethodToCall := _method; FMethodToCall := LMethod;
FMVCControllerClass := controllerRoutable.&Class; FControllerClazz := LControllerDelegate.Clazz;
FMVCControllerDelegate := controllerRoutable.Delegate; FControllerCreateAction := LControllerDelegate.CreateAction;
// getting the default contenttype using MVCProduceAttribute LProduceAttribute := GetAttribute<MVCProducesAttribute>(LAttributes);
MVCProduceAttr := GetAttribute<MVCProducesAttribute>(_attributes); if Assigned(LProduceAttribute) then
if MVCProduceAttr <> nil then
begin begin
AResponseContentType := MVCProduceAttr.Value; AResponseContentType := LProduceAttribute.Value;
AResponseContentEncoding := MVCProduceAttr.ProduceEncoding; AResponseContentEncoding := LProduceAttribute.Encoding;
end end
else else
begin begin
@ -200,194 +222,193 @@ begin
AResponseContentEncoding := ADefaultContentCharset; AResponseContentEncoding := ADefaultContentCharset;
end; end;
Exit(True); Exit(True);
end; // if is compatible path end;
end; // if is compatible method, contenttype and accept end;
end; // if attribute is mvcpath end;
end; // for each attributes on method
end; // for each methods end;
end; // for each controllers
finally finally
TMonitor.Exit(Lock); TMonitor.Exit(Lock);
end; end;
end; end;
function TMVCRouter.GetAttribute<T>(AAttributes: TArray<TCustomAttribute>): T; function TMVCRouter.GetAttribute<T>(const AAttributes: TArray<TCustomAttribute>): T;
var var
a: TCustomAttribute; Att: TCustomAttribute;
begin begin
Result := nil; Result := nil;
for a in AAttributes do for Att in AAttributes do
if a is T then if Att is T then
Exit(T(a)); Exit(T(Att));
end; end;
function TMVCRouter.GetFirstMimeType(const AContentType: string): string; function TMVCRouter.GetFirstMediaType(const AContentType: string): string;
begin begin
Result := AContentType; Result := AContentType;
while Pos(',', Result) > 0 do while Pos(',', Result) > 0 do
Result := Copy(Result, 1, Pos(',', Result) - 1); Result := Copy(Result, 1, Pos(',', Result) - 1);
while Pos(';', Result) > 0 do while Pos(';', Result) > 0 do
Result := Copy(Result, 1, Pos(';', Result) - 1); Result := Copy(Result, 1, Pos(';', Result) - 1);
// application/json;charset=UTF-8 {daniele}
end; end;
function TMVCRouter.IsCompatiblePath(AMVCPath: string; APath: string; function TMVCRouter.IsCompatiblePath(
const AMVCPath: string;
const APath: string;
var AParams: TMVCRequestParamsTable): Boolean; var AParams: TMVCRequestParamsTable): Boolean;
function ToPattern(const V: string; Names: TList<string>): string; function ToPattern(const V: string; Names: TList<string>): string;
var var
s: string; S: string;
begin begin
Result := V; Result := V;
for s in Names do for S in Names do
Result := StringReplace(Result, '($' + s + ')', '([ àèéùòì@\.\_\,%\w\d\x2D\x3A]*)', Result := StringReplace(Result, '($' + S + ')', '([ àèéùòì@\.\_\,%\w\d\x2D\x3A]*)', [rfReplaceAll]);
[rfReplaceAll]);
end; end;
function GetParametersNames(const V: string): TList<string>; function GetParametersNames(const V: string): TList<string>;
var var
s: string; S: string;
matches: TMatchCollection; Matches: TMatchCollection;
match: TMatch; M: TMatch;
i: Integer; I: Integer;
begin begin
Result := TList<string>.Create; Result := TList<string>.Create;
s := '\(\$([A-Za-z0-9\_]+)\)'; S := '\(\$([A-Za-z0-9\_]+)\)';
// dt 2/08/2016 added "_" as allowed character in the parameter name Matches := TRegEx.Matches(V, S, [roIgnoreCase, roCompiled, roSingleLine]);
matches := TRegEx.matches(V, s, [roIgnoreCase, roCompiled, roSingleLine]); for M in Matches do
for match in matches do for I := 0 to M.Groups.Count - 1 do
for i := 0 to match.Groups.Count - 1 do
begin begin
s := match.Groups[i].Value; S := M.Groups[I].Value;
if (Length(s) > 0) and (s[1] <> '(') then if (Length(S) > 0) and (S[1] <> '(') then
begin begin
Result.Add(s); Result.Add(S);
Break; Break;
end; end;
end; end;
end; end;
var var
re: TRegEx; RegEx: TRegEx;
m: TMatch; Macth: TMatch;
pattern: string; Pattern: string;
i: Integer; I: Integer;
Names: TList<string>; Names: TList<string>;
begin begin
Names := GetParametersNames(AMVCPath); Names := GetParametersNames(AMVCPath);
try try
pattern := ToPattern(AMVCPath, Names); Pattern := ToPattern(AMVCPath, Names);
if APath = AMVCPath then if (APath = AMVCPath) then
Exit(True) Exit(True)
else else
begin begin
re := TRegEx.Create('^' + pattern + '$', [roIgnoreCase, roCompiled, roSingleLine]); RegEx := TRegEx.Create('^' + Pattern + '$', [roIgnoreCase, roCompiled, roSingleLine]);
m := re.match(APath); Macth := RegEx.match(APath);
Result := m.Success; Result := Macth.Success;
if Result then if Result then
for i := 1 to pred(m.Groups.Count) do for I := 1 to pred(Macth.Groups.Count) do
AParams.Add(Names[i - 1], TIdURI.URLDecode(m.Groups[i].Value)); AParams.Add(Names[I - 1], TIdURI.URLDecode(Macth.Groups[I].Value));
end; end;
finally finally
Names.Free; Names.Free;
end; end;
end; end;
function TMVCRouter.IsHTTPAcceptCompatible(AWebRequestMethodType: TMVCHTTPMethodType; function TMVCRouter.IsHTTPAcceptCompatible(
AAccept: string; AAttributes: TArray<TCustomAttribute>): Boolean; const ARequestMethodType: TMVCHTTPMethodType;
var AAccept: string;
const AAttributes: TArray<TCustomAttribute>): Boolean;
var var
i: Integer; I: Integer;
MethodAccept: string; MethodAccept: string;
FoundOneAttribProduces: Boolean; FoundOneAttProduces: Boolean;
begin begin
Result := False; Result := False;
FoundOneAttribProduces := False;
for i := 0 to high(AAttributes) do
begin
if AAttributes[i] is MVCProducesAttribute then
begin
FoundOneAttribProduces := True;
MethodAccept := MVCProducesAttribute(AAttributes[i]).Value;
AAccept := GetFirstMimeType(AAccept);
// while Pos(',', AAccept) > 0 do
// AAccept := Copy(AAccept, 1, Pos(',', AAccept) - 1);
FoundOneAttProduces := False;
for I := 0 to High(AAttributes) do
if AAttributes[I] is MVCProducesAttribute then
begin
FoundOneAttProduces := True;
MethodAccept := MVCProducesAttribute(AAttributes[I]).Value;
AAccept := GetFirstMediaType(AAccept);
Result := SameText(AAccept, MethodAccept, loInvariantLocale); Result := SameText(AAccept, MethodAccept, loInvariantLocale);
if Result then if Result then
Break; Break;
end; end;
end;
Result := (not FoundOneAttribProduces) or (FoundOneAttribProduces and Result); Result := (not FoundOneAttProduces) or (FoundOneAttProduces and Result);
end; end;
function TMVCRouter.IsHTTPContentTypeCompatible(AWebRequestMethodType: TMVCHTTPMethodType; function TMVCRouter.IsHTTPContentTypeCompatible(
AContentType: string; AAttributes: TArray<TCustomAttribute>): Boolean; const ARequestMethodType: TMVCHTTPMethodType;
var AContentType: string;
const AAttributes: TArray<TCustomAttribute>): Boolean;
var var
i: Integer; I: Integer;
MethodContentType: string; MethodContentType: string;
FoundOneAttribConsumes: Boolean; FoundOneAttConsumes: Boolean;
begin begin
// content type is applicable only for PUT, POST and PATCH if ARequestMethodType in [httpGET, httpDELETE, httpHEAD, httpOPTIONS] then
if AWebRequestMethodType in [httpGET, httpDELETE, httpHEAD, httpOPTIONS] then
Exit(True); Exit(True);
Result := False; Result := False;
FoundOneAttribConsumes := False;
for i := 0 to high(AAttributes) do FoundOneAttConsumes := False;
begin for I := 0 to High(AAttributes) do
if AAttributes[i] is MVCConsumesAttribute then if AAttributes[I] is MVCConsumesAttribute then
begin begin
FoundOneAttribConsumes := True; FoundOneAttConsumes := True;
MethodContentType := MVCConsumesAttribute(AAttributes[i]).Value; MethodContentType := MVCConsumesAttribute(AAttributes[I]).Value;
AContentType := GetFirstMimeType(AContentType); AContentType := GetFirstMediaType(AContentType);
Result := SameText(AContentType, MethodContentType, loInvariantLocale); Result := SameText(AContentType, MethodContentType, loInvariantLocale);
if Result then if Result then
Break; Break;
end; end;
end;
Result := (not FoundOneAttribConsumes) or (FoundOneAttribConsumes and Result); Result := (not FoundOneAttConsumes) or (FoundOneAttConsumes and Result);
end; end;
function TMVCRouter.IsHTTPMethodCompatible(AMethodType: TMVCHTTPMethodType; function TMVCRouter.IsHTTPMethodCompatible(
AAttributes: TArray<TCustomAttribute>): Boolean; const AMethodType: TMVCHTTPMethodType;
const AAttributes: TArray<TCustomAttribute>): Boolean;
var var
i: Integer; I: Integer;
MustBeCompatible: Boolean; MustBeCompatible: Boolean;
CompatibleMethods: TMVCHTTPMethods; CompatibleMethods: TMVCHTTPMethods;
begin begin
Result := False; Result := False;
// if there aren't MVCHTTPMethod attributes defined, the action is compatibile with all methods
MustBeCompatible := False; MustBeCompatible := False;
for i := 0 to high(AAttributes) do for I := 0 to High(AAttributes) do
begin if AAttributes[I] is MVCHTTPMethodAttribute then
if AAttributes[i] is MVCHTTPMethodAttribute then
begin begin
MustBeCompatible := True; MustBeCompatible := True;
CompatibleMethods := MVCHTTPMethodAttribute(AAttributes[i]).MVCHTTPMethods; CompatibleMethods := MVCHTTPMethodAttribute(AAttributes[I]).MVCHTTPMethods;
Result := (AMethodType in CompatibleMethods); Result := (AMethodType in CompatibleMethods);
end; end;
end;
Result := (not MustBeCompatible) or (MustBeCompatible and Result); Result := (not MustBeCompatible) or (MustBeCompatible and Result);
end; end;
class function TMVCRouter.StringMethodToHTTPMetod(const Value: AnsiString): TMVCHTTPMethodType; class function TMVCRouter.StringMethodToHTTPMetod(const AValue: string): TMVCHTTPMethodType;
begin begin
if Value = 'GET' then if AValue = 'GET' then
Exit(httpGET); Exit(httpGET);
if Value = 'POST' then if AValue = 'POST' then
Exit(httpPOST); Exit(httpPOST);
if Value = 'DELETE' then if AValue = 'DELETE' then
Exit(httpDELETE); Exit(httpDELETE);
if Value = 'PUT' then if AValue = 'PUT' then
Exit(httpPUT); Exit(httpPUT);
if Value = 'HEAD' then if AValue = 'HEAD' then
Exit(httpHEAD); Exit(httpHEAD);
if Value = 'OPTIONS' then if AValue = 'OPTIONS' then
Exit(httpOPTIONS); Exit(httpOPTIONS);
if Value = 'PATCH' then if AValue = 'PATCH' then
Exit(httpPATCH); Exit(httpPATCH);
if Value = 'TRACE' then if AValue = 'TRACE' then
Exit(httpTRACE); Exit(httpTRACE);
raise EMVCException.CreateFmt('Unknown HTTP method [%s]', [Value]); raise EMVCException.CreateFmt('Unknown HTTP method [%s]', [AValue]);
end; end;
end. end.

2
sources/MVCFramework.Serializer.Commons.pas
View File

@ -67,7 +67,7 @@ type
destructor Destroy; override; destructor Destroy; override;
end; end;
TMVCSerializerHelpful = class sealed TMVCSerializerHelpful = record
public public
class function GetKeyName(const AField: TRttiField; const AType: TRttiType): string; overload; static; class function GetKeyName(const AField: TRttiField; const AType: TRttiType): string; overload; static;
class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static; class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static;

4
sources/MVCFramework.Serializer.Intf.pas
View File

@ -61,6 +61,9 @@ type
function SerializeDataSet(const ADataSet: TDataSet): string; overload; function SerializeDataSet(const ADataSet: TDataSet): string; overload;
function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
@ -70,6 +73,7 @@ type
procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet); procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet);
procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet);
end; end;
implementation implementation

19
sources/MVCFramework.Serializer.JSON.pas
View File

@ -93,6 +93,9 @@ type
function SerializeDataSet(const ADataSet: TDataSet): string; overload; function SerializeDataSet(const ADataSet: TDataSet): string; overload;
function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
@ -102,6 +105,7 @@ type
procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet); procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet);
procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet);
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
end; end;
@ -329,6 +333,11 @@ begin
raise EMVCSerializationException.Create('Method TMVCJSONSerializer.DeserializeDataSet not implemented.'); raise EMVCSerializationException.Create('Method TMVCJSONSerializer.DeserializeDataSet not implemented.');
end; end;
procedure TMVCJSONSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet);
begin
raise EMVCSerializationException.Create('Method TMVCJSONSerializer.DeserializeDataSetRecord not implemented.');
end;
procedure TMVCJSONSerializer.DeserializeObject( procedure TMVCJSONSerializer.DeserializeObject(
const ASerializedObject: string; const AObject: TObject; const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType); const AType: TMVCSerializationType);
@ -582,6 +591,16 @@ begin
raise EMVCSerializationException.Create('Method TMVCJSONSerializer.SerializeDataSet not implemented.'); raise EMVCSerializationException.Create('Method TMVCJSONSerializer.SerializeDataSet not implemented.');
end; end;
function TMVCJSONSerializer.SerializeDataSetRecord(const ADataSet: TDataSet): string;
begin
Result := SerializeDataSetRecord(ADataSet, []);
end;
function TMVCJSONSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: array of string): string;
begin
raise EMVCSerializationException.Create('Method TMVCJSONSerializer.SerializeDataSetRecord not implemented.');
end;
function TMVCJSONSerializer.SerializeDataSet( function TMVCJSONSerializer.SerializeDataSet(
const ADataSet: TDataSet): string; const ADataSet: TDataSet): string;
begin begin

24
sources/MVCFramework.Serializer.JsonDataObjects.pas
View File

@ -104,6 +104,9 @@ type
function SerializeDataSet(const ADataSet: TDataSet): string; overload; function SerializeDataSet(const ADataSet: TDataSet): string; overload;
function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet): string; overload;
function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: array of string): string; overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
@ -113,6 +116,7 @@ type
procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: array of string); overload;
procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet); procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet);
procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet);
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
end; end;
@ -343,12 +347,16 @@ begin
end; end;
end; end;
procedure TMVCJsonDataObjectsSerializer.DeserializeDataSet( procedure TMVCJsonDataObjectsSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet);
const ASerializedDataSet: string; const ADataSet: TDataSet);
begin begin
raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.DeserializeDataSet not implemented.'); raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.DeserializeDataSet not implemented.');
end; end;
procedure TMVCJsonDataObjectsSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet);
begin
raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.DeserializeDataSetRecord not implemented.');
end;
procedure TMVCJsonDataObjectsSerializer.DeserializeObject( procedure TMVCJsonDataObjectsSerializer.DeserializeObject(
const ASerializedObject: string; const AObject: TObject; const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType); const AType: TMVCSerializationType);
@ -599,6 +607,18 @@ begin
raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.SerializeDataSet not implemented.'); raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.SerializeDataSet not implemented.');
end; end;
function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(
const ADataSet: TDataSet): string;
begin
Result := SerializeDataSetRecord(ADataSet, []);
end;
function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(
const ADataSet: TDataSet; const AIgnoredFields: array of string): string;
begin
raise EMVCSerializationException.Create('Method TMVCJsonDataObjectsSerializer.SerializeDataSetRecord not implemented.');
end;
function TMVCJsonDataObjectsSerializer.SerializeDataSet( function TMVCJsonDataObjectsSerializer.SerializeDataSet(
const ADataSet: TDataSet): string; const ADataSet: TDataSet): string;
begin begin

31
sources/MVCFramework.SysControllers.pas
View File

@ -28,9 +28,9 @@ interface
{$I dmvcframework.inc} {$I dmvcframework.inc}
uses uses
MVCFramework, MVCFramework.Commons; MVCFramework,
MVCFramework.Commons;
type type
@ -38,14 +38,12 @@ type
[MVCDoc('Built-in DelphiMVCFramework System controller')] [MVCDoc('Built-in DelphiMVCFramework System controller')]
TMVCSystemController = class(TMVCController) TMVCSystemController = class(TMVCController)
protected protected
procedure OnBeforeAction(Context: TWebContext; const AActionNAme: string; procedure OnBeforeAction(Context: TWebContext; const AActionNAme: string; var Handled: Boolean); override;
var Handled: Boolean); override;
function GetUpTime: string; function GetUpTime: string;
public public
[MVCPath('/describeserver.info')] [MVCPath('/describeserver.info')]
[MVCHTTPMethods([httpGET, httpPOST])] [MVCHTTPMethods([httpGET, httpPOST])]
[MVCDoc('Describe controllers and actions published by the RESTful server per resources') [MVCDoc('Describe controllers and actions published by the RESTful server per resources')]
]
procedure DescribeServer(Context: TWebContext); procedure DescribeServer(Context: TWebContext);
[MVCPath('/describeplatform.info')] [MVCPath('/describeplatform.info')]
@ -65,11 +63,17 @@ uses
, System.Classes , System.Classes
, Winapi.Windows , Winapi.Windows
, System.TypInfo , System.TypInfo
{$IFDEF SYSTEMJSON} // XE6
{$IFDEF SYSTEMJSON} // XE6
, System.JSON , System.JSON
{$ELSE}
{$ELSE}
, Data.DBXJSON , Data.DBXJSON
{$ENDIF}
{$ENDIF}
; ;
function MSecToTime(mSec: Int64): string; function MSecToTime(mSec: Int64): string;
@ -121,7 +125,7 @@ end;
procedure TMVCSystemController.DescribeServer(Context: TWebContext); procedure TMVCSystemController.DescribeServer(Context: TWebContext);
var var
LJResp: TJSONObject; LJResp: TJSONObject;
LControllerRoutable: TMVCControllerRoutable; LController: TMVCControllerDelegate;
ControllerInfo: TJSONObject; ControllerInfo: TJSONObject;
LRTTIType: TRttiInstanceType; LRTTIType: TRttiInstanceType;
LCTX: TRttiContext; LCTX: TRttiContext;
@ -141,13 +145,12 @@ begin
try try
LJResp := TJSONObject.Create; LJResp := TJSONObject.Create;
try try
for LControllerRoutable in GetMVCEngine.RegisteredControllers do for LController in Engine.Controllers do
begin begin
ControllerInfo := TJSONObject.Create; ControllerInfo := TJSONObject.Create;
LJResp.AddPair(LControllerRoutable.&Class.QualifiedClassName, LJResp.AddPair(LController.Clazz.QualifiedClassName, ControllerInfo);
ControllerInfo);
LRTTIType := LCTX.GetType(LControllerRoutable.&Class) LRTTIType := LCTX.GetType(LController.Clazz)
as TRttiInstanceType; as TRttiInstanceType;
for LAttribute in LRTTIType.GetAttributes do for LAttribute in LRTTIType.GetAttributes do
begin begin

4540
sources/MVCFramework.pas
View File

File diff suppressed because it is too large Load Diff