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

https://github.com/danieleteti/delphimvcframework/issues/684

Browse Source
This commit is contained in:
Daniele Teti 2023-10-06 12:30:40 +02:00
parent 0c322d6eee
commit 7baf93d73d
23 changed files with 551 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/d100/dmvcframeworkRT.dpk
View File

@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d100/dmvcframeworkRT.dproj
View File

@ -184,6 +184,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

3
packages/d101/dmvcframeworkRT.dpk
View File

@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d101/dmvcframeworkRT.dproj
View File

@ -184,6 +184,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

3
packages/d102/dmvcframeworkRT.dpk
View File

@ -112,7 +112,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d102/dmvcframeworkRT.dproj
View File

@ -194,6 +194,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

11
packages/d103/dmvcframeworkRT.dpk
View File

@ -45,10 +45,10 @@ requires
contains
Web.HTTPDImpl,
Web.ApacheConst,
Web.ApacheHTTP,
Web.Win.IsapiHTTP,
Web.HTTPDMethods,
Web.ApacheConst in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheConst.pas',
Web.ApacheHTTP in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.ApacheHTTP.pas',
Web.Win.IsapiHTTP in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.Win.IsapiHTTP.pas',
Web.HTTPDMethods in 'c:\program files (x86)\embarcadero\studio\20.0\source\Internet\Web.HTTPDMethods.pas',
MVCFramework in '..\..\sources\MVCFramework.pas',
MVCFramework.AsyncTask in '..\..\sources\MVCFramework.AsyncTask.pas',
MVCFramework.Middleware.Swagger in '..\..\sources\MVCFramework.Middleware.Swagger.pas',
@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d103/dmvcframeworkRT.dproj
View File

@ -211,6 +211,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

3
packages/d104/dmvcframeworkRT.dpk
View File

@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d104/dmvcframeworkRT.dproj
View File

@ -198,6 +198,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

3
packages/d110/dmvcframeworkRT.dpk
View File

@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d110/dmvcframeworkRT.dproj
View File

@ -195,6 +195,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

3
packages/d113/dmvcframeworkRT.dpk
View File

@ -113,7 +113,8 @@ contains
MVCFramework.Utils in '..\..\sources\MVCFramework.Utils.pas',
JsonDataObjects in '..\..\sources\JsonDataObjects.pas',
MVCFramework.DotEnv.Parser in '..\..\sources\MVCFramework.DotEnv.Parser.pas',
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas';
MVCFramework.DotEnv in '..\..\sources\MVCFramework.DotEnv.pas',
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
end.

1
packages/d113/dmvcframeworkRT.dproj
View File

@ -196,6 +196,7 @@
<DCCReference Include="..\..\sources\JsonDataObjects.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.Parser.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DotEnv.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

30
samples/serversideviews_mustache/DAL.pas
View File

@ -16,20 +16,20 @@ type
FFirstName: string;
FLastName: string;
FAge: Integer;
FItems: string;
FDevices: TArray<string>;
FGUID: string;
procedure SetFirstName(const Value: string);
procedure SetLastName(const Value: string);
procedure SetAge(const Value: Integer);
procedure SetGUID(const Value: string);
procedure SetItems(const Value: string);
procedure SetDevices(const Value: TArray<string>);
public
[MVCNameAs('first_name')]
property FirstName: string read FFirstName write SetFirstName;
[MVCNameAs('last_name')]
property LastName: string read FLastName write SetLastName;
property Age: Integer read FAge write SetAge;
property Items: string read FItems write SetItems;
property Devices: TArray<string> read FDevices write SetDevices;
property GUID: string read FGUID write SetGUID;
end;
@ -69,7 +69,7 @@ type
Items: TArray<string>);
procedure DeleteByGUID(GUID: string);
function GetPersonByGUID(GUID: string): TPerson;
function GetDevicesList: TDeviceList;
function GetDevicesList: TArray<String>;
end;
TPeopleDAL = class(TInterfacedObject, IPeopleDAL)
@ -81,7 +81,7 @@ type
Items: TArray<string>);
procedure DeleteByGUID(GUID: string);
function GetPersonByGUID(GUID: string): TPerson;
function GetDevicesList: TDeviceList;
function GetDevicesList: TArray<String>;
end;
TServicesFactory = class sealed
@ -117,7 +117,7 @@ begin
lPerson.FirstName := FirstName;
lPerson.LastName := LastName;
lPerson.Age := Age;
lPerson.Items := string.Join(',', Items);
lPerson.Devices := Items;
lPerson.GUID := TGuid.NewGuid.ToString.Replace('{', '').Replace('}', '')
.Replace('-', '');
TFile.WriteAllText(DATAFILE, GetDefaultSerializer.SerializeCollection
@ -162,13 +162,9 @@ begin
end;
end;
function TPeopleDAL.GetDevicesList: TDeviceList;
function TPeopleDAL.GetDevicesList: TArray<String>;
begin
Result := TDeviceList.Create(true);
Result.Add(TDevice.Create('smartphone', false));
Result.Add(TDevice.Create('dumbphone', false));
Result.Add(TDevice.Create('laptop', false));
Result.Add(TDevice.Create('desktop', false));
Result := ['smartphone', 'dumbphone', 'laptop', 'desktop'];
end;
function TPeopleDAL.GetPeople: TPeople;
@ -217,6 +213,11 @@ begin
FAge := Value;
end;
procedure TPerson.SetDevices(const Value: TArray<string>);
begin
FDevices := Value;
end;
procedure TPerson.SetFirstName(const Value: string);
begin
FFirstName := Value;
@ -227,11 +228,6 @@ begin
FGUID := Value;
end;
procedure TPerson.SetItems(const Value: string);
begin
FItems := Value;
end;
procedure TPerson.SetLastName(const Value: string);
begin
FLastName := Value;

13
samples/serversideviews_mustache/ServerSideViewsMustache.dpr
View File

@ -12,13 +12,16 @@ uses
Winapi.Windows,
{$ENDIF }
IdHTTPWebBrokerBridge,
MVCFramework.View.Renderers.Mustache,
Web.WebReq,
Web.WebBroker,
WebModuleU in 'WebModuleU.pas' {WebModule1: TWebModule},
WebSiteControllerU in 'WebSiteControllerU.pas',
DAL in 'DAL.pas',
MyDataModuleU in '..\renders\MyDataModuleU.pas' {MyDataModule: TDataModule},
CustomMustacheHelpersU in 'CustomMustacheHelpersU.pas';
CustomMustacheHelpersU in 'CustomMustacheHelpersU.pas',
SynMustache,
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
{$R *.res}
@ -50,6 +53,14 @@ begin
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
// these helpers will be available to the mustache views as if they were the standard ones
TMVCMustacheHelpers.OnLoadCustomHelpers := procedure(var MustacheHelpers: TSynMustacheHelpers)
begin
TSynMustache.HelperAdd(MustacheHelpers, 'MyHelper1', TMyMustacheHelpers.MyHelper1);
TSynMustache.HelperAdd(MustacheHelpers, 'MyHelper2', TMyMustacheHelpers.MyHelper2);
end;
RunServer(8080);
except
on E: Exception do

1
samples/serversideviews_mustache/ServerSideViewsMustache.dproj
View File

@ -97,6 +97,7 @@
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="CustomMustacheHelpersU.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.Serializer.URLEncoded.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

13
samples/serversideviews_mustache/WebModuleU.pas
View File

@ -25,7 +25,8 @@ uses
WebSiteControllerU,
System.IOUtils,
MVCFramework.Commons,
MVCFramework.Middleware.StaticFiles, SynMustache, CustomMustacheHelpersU;
MVCFramework.Middleware.StaticFiles, SynMustache, CustomMustacheHelpersU,
MVCFramework.Serializer.URLEncoded;
{ %CLASSGROUP 'Vcl.Controls.TControl' }
@ -56,14 +57,8 @@ begin
Config[TMVCConfigKey.ViewCache] := 'false';
end)
.AddController(TWebSiteController)
.SetViewEngine(TMVCMustacheViewEngine);
// these helpers will be available to the mustache views as if they were the standard ones
TMVCMustacheHelpers.OnLoadCustomHelpers := procedure(var MustacheHelpers: TSynMustacheHelpers)
begin
TSynMustache.HelperAdd(MustacheHelpers, 'MyHelper1', TMyMustacheHelpers.MyHelper1);
TSynMustache.HelperAdd(MustacheHelpers, 'MyHelper2', TMyMustacheHelpers.MyHelper2);
end
.SetViewEngine(TMVCMustacheViewEngine)
.AddSerializer(TMVCMediaType.APPLICATION_FORM_URLENCODED, TMVCURLEncodedDataSerializer.Create);
end;
procedure TWebModule1.WebModuleDestroy(Sender: TObject);

72
samples/serversideviews_mustache/WebSiteControllerU.pas
View File

@ -3,7 +3,8 @@ unit WebSiteControllerU;
interface
uses
MVCFramework, System.Diagnostics, System.JSON, MVCFramework.Commons;
MVCFramework, System.Diagnostics, JsonDataObjects, MVCFramework.Commons, DAL,
System.Generics.Collections;
type
@ -33,7 +34,7 @@ type
[MVCPath('/people')]
[MVCHTTPMethods([httpPOST])]
[MVCConsumes(TMVCMediaType.APPLICATION_FORM_URLENCODED)]
procedure SavePerson;
procedure SavePerson(const [MVCFromBody] Person: TPerson);
[MVCPath('/deleteperson')]
[MVCHTTPMethods([httpPOST])]
@ -43,12 +44,12 @@ type
[MVCPath('/new')]
[MVCHTTPMethods([httpGET])]
[MVCProduces(TMVCMediaType.TEXT_HTML)]
procedure NewPerson;
function NewPerson: String;
[MVCPath('/edit/($guid)')]
[MVCHTTPMethods([httpGET])]
[MVCProduces(TMVCMediaType.TEXT_HTML)]
procedure EditPerson(guid: string);
function EditPerson(guid: string): String;
[MVCPath('/')]
[MVCHTTPMethods([httpGET])]
@ -65,7 +66,7 @@ implementation
{ TWebSiteController }
uses DAL, System.SysUtils, Web.HTTPApp;
uses System.SysUtils, Web.HTTPApp;
procedure TWebSiteController.DeletePerson;
var
@ -78,28 +79,33 @@ begin
Redirect('/people');
end;
procedure TWebSiteController.EditPerson(guid: string);
function TWebSiteController.EditPerson(guid: string): String;
var
LDAL: IPeopleDAL;
lPerson: TPerson;
lDevices: TDeviceList;
lItem: TDevice;
lDevices: TArray<String>;
lJDevices: TJSONArray;
lItem: string;
lIdx: Integer;
lJObj: TJsonObject;
begin
LDAL := TServicesFactory.GetPeopleDAL;
lPerson := LDAL.GetPersonByGUID(guid);
try
lDevices := LDAL.GetDevicesList;
ViewData['person'] := lPerson;
lJObj := TJsonObject.Create;
try
ViewData['person'] := lPerson;
lJDevices := lJObj.A['devices'];
for lItem in lDevices do
begin
lItem.Selected := lPerson.Items.Contains(lItem.DeviceName);
var lJItm := lJDevices.AddObject;
lJItm.S['name'] := lItem;
lJItm.B['selected'] := TArray.BinarySearch<String>(lDevices, lItem, lIdx);
end;
ViewData['deviceslist'] := lDevices;
LoadView(['header', 'editperson', 'footer']);
RenderResponseStream;
Result := GetRenderedView(['header', 'editperson', 'footer'], lJObj);
finally
lDevices.Free;
lJObj.Free;
end;
finally
lPerson.Free;
@ -169,23 +175,28 @@ begin
finally
lPeople.Free;
end;
// ViewData['myobj'] := TPerson.Create;
// TPerson(ViewData['myobj']).FirstName := 'Daniele <br> Teti';
end;
procedure TWebSiteController.NewPerson;
function TWebSiteController.NewPerson: String;
var
LDAL: IPeopleDAL;
lDevices: TDeviceList;
lDevices: TArray<String>;
lJObj: TJsonObject;
begin
LDAL := TServicesFactory.GetPeopleDAL;
lDevices := LDAL.GetDevicesList;
lJObj := TJsonObject.Create;
try
ViewData['deviceslist'] := lDevices;
LoadView(['header', 'editperson', 'footer']);
RenderResponseStream;
var lJDevices := lJObj.A['devices'];
for var lItem in lDevices do
begin
var lJItm := lJDevices.AddObject;
lJItm.S['name'] := lItem;
lJItm.B['selected'] := False;
end;
Result := GetRenderedView(['header', 'editperson', 'footer'], lJObj);
finally
lDevices.Free;
lJObj.Free;
end;
end;
@ -214,20 +225,11 @@ begin
end;
procedure TWebSiteController.SavePerson;
procedure TWebSiteController.SavePerson(const [MVCFromBody] Person: TPerson);
var
LFirstName: string;
LLastName: string;
LAge: string;
LPeopleDAL: IPeopleDAL;
lDevices: TArray<string>;
begin
LFirstName := Context.Request.Params['first_name'].Trim;
LLastName := Context.Request.Params['last_name'].Trim;
LAge := Context.Request.Params['age'];
lDevices := Context.Request.ParamsMulti['items'];
if LFirstName.IsEmpty or LLastName.IsEmpty or LAge.IsEmpty then
if Person.FirstName.IsEmpty or Person.LastName.IsEmpty or (Person.Age <= 0) then
begin
{ TODO -oDaniele -cGeneral : Show how to properly render an exception }
raise EMVCException.Create('Invalid data',
@ -235,8 +237,8 @@ begin
end;
LPeopleDAL := TServicesFactory.GetPeopleDAL;
LPeopleDAL.AddPerson(LFirstName, LLastName, LAge.ToInteger(), lDevices);
LPeopleDAL.AddPerson(Person.FirstName, Person.LastName,
Person.Age, Person.Devices);
Redirect('/people');
end;

2
samples/serversideviews_mustache/bin/people.data
View File

@ -1 +1 @@
[{"first_name":"Bruce","last_name":"Banner","age":56,"items":"smartphone,dumbphone","guid":"2290EE213DFB4855894A3FC91FE52C17"},{"first_name":"Sue","last_name":"Storm","age":32,"items":"desktop","guid":"09162F3E925B4C529282F47DFDB5EF0F"},{"first_name":"Reed","last_name":"Richards","age":45,"items":"laptop,smartphone","guid":"298CE047B4C24D67B29710BF4ABE290C"},{"first_name":"Scott","last_name":"Summers","age":54,"items":"desktop","guid":"3DACB879E83749EDA68389EBA2286A13"},{"first_name":"Daniele","last_name":"Teti","age":40,"items":"","guid":"722E3103AB6141E3B04445593F5AD274"},{"first_name":"Daniele","last_name":"Teti","age":40,"items":"","guid":"FB8F41793F724E08A546BB02BA5676E9"}]
[{"first_name":"Daniele","last_name":"Teti","age":43,"devices":[],"guid":"49E8419B66C744529D63DB292389D541"},{"first_name":"Peter","last_name":"Parker","age":23,"devices":[],"guid":"C5489969A04D4AE4B00D4FC50C8ADB5C"},{"first_name":"Bruce","last_name":"Banner","age":50,"devices":[],"guid":"B41D180F30584558B4F4A1AAF849FFA3"},{"first_name":"Sue","last_name":"Storm","age":33,"devices":[],"guid":"3F058118B8C6470D9684E127BC30A84A"},{"first_name":"Scott","last_name":"Summer","age":35,"devices":[],"guid":"3518D8C6F60E42D19C5A7250ADEADC33"},{"first_name":"Reed","last_name":"Richards","age":45,"devices":["smartphone","desktop"],"guid":"09C85C9DEB714476AADB9EB0AD689536"}]

10
samples/serversideviews_mustache/bin/templates/editperson.mustache
View File

@ -51,12 +51,12 @@
<div class="row">
<div class="form-group">
<label for="items" class="col-sm-2 control-label">Devices</label>
<label for="devices" class="col-sm-2 control-label">Devices</label>
<div class="col-sm-4">
<select name="items" multiple class="form-control">
{{#deviceslist}}
<option value="{{devicename}}" {{#selected}}selected{{/selected}}>{{devicename}}</option>
{{/deviceslist}}
<select name="devices" multiple class="form-control">
{{#devices}}
<option value="{{name}}" {{#selected}}selected{{/selected}}>{{name}}</option>
{{/devices}}
</select>
<span style="font-size: 80%">(Ctrl+Click to select multiple devices)</span>
</div>

449
sources/MVCFramework.Serializer.URLEncoded.pas Normal file
View File

@ -0,0 +1,449 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// Collaborators on this file: David Moorhouse (info@moorhouse.net.nz)
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MVCFramework.Serializer.URLEncoded;
{$I dmvcframework.inc}
interface
uses
System.Classes, System.Rtti,
System.TypInfo, Data.DB,
MVCFramework.Commons,
MVCFramework.Serializer.Intf,
MVCFramework.Serializer.Abstract,
MVCFramework.DuckTyping,
MVCFramework.Serializer.Commons,
System.SysUtils;
type
TMVCURLEncodedDataSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
private
procedure DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const RawData: string;
const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>); overload;
procedure DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember;
const RawDataArray: TArray<string>; const AName: string; var AValue: TValue; const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray<TCustomAttribute>); overload;
protected
procedure RaiseNotImplemented;
protected
{ IMVCSerializer }
procedure RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);
function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
: string; overload;
function SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
: string; overload;
function SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
const ASerializationAction: TMVCSerializationAction = nil): string; overload;
function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
: string; overload;
function SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
: string; overload;
function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;
function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
const ARootNode: String = ''); overload;
procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;
procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
const ARootNode: String = ''); overload;
procedure DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;
procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);
procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);
function SerializeArrayOfRecord(
var ATValueContainingAnArray: TValue;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = nil;
const ASerializationAction: TMVCSerializationAction = nil
): string; overload;
public
procedure URLEncodedStringToObject(
const Data: TStringList; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
end;
implementation
uses
System.NetEncoding, System.Math;
{ TMVCURLEncodedDataSerializer }
procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: IInterface;
const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
RaiseNotImplemented;
end;
procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: TObject;
const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
begin
RaiseNotImplemented;
end;
procedure TMVCURLEncodedDataSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
RaiseNotImplemented;
end;
procedure TMVCURLEncodedDataSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
RaiseNotImplemented;
end;
procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
// ??
end;
procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
var
SL: TStringList;
begin
if (ASerializedObject = EmptyStr) then
raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body');
if not Assigned(AObject) then
Exit;
SL := TStringList.Create;
try
try
SL.Delimiter := '&';
SL.DelimitedText := ASerializedObject;
if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then
begin
RaiseNotImplemented;
// todo: do we handle custom type serialisers
// GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject),
// AObject, [])
end
else
begin
URLEncodedStringToObject(SL, AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
end;
except
on E: Exception do
raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message);
end;
finally
SL.Free;
end;
end;
procedure TMVCURLEncodedDataSerializer.RaiseNotImplemented;
begin
raise EMVCException.Create('Not Implemented');
end;
procedure TMVCURLEncodedDataSerializer.RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeArrayOfRecord(
var ATValueContainingAnArray: TValue; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
function TMVCURLEncodedDataSerializer.SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction): string;
begin
RaiseNotImplemented;
end;
procedure TMVCURLEncodedDataSerializer.URLEncodedStringToObject(
const Data: TStringList; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
lObjType: TRttiType;
lProp: TRttiProperty;
lFld: TRttiField;
lAttributeValue: TValue;
lKeyName: string;
lErrMsg: string;
I: Integer;
lArrValues: TArray<String>;
lCurrIdx: Integer;
const
INITIAL_ARRAY_SIZE = 5;
begin
if AObject = nil then
begin
Exit;
end;
lProp := nil;
lFld := nil;
lObjType := GetRttiContext.GetType(AObject.ClassType);
case AType of
stDefault, stProperties:
begin
try
for lProp in lObjType.GetProperties do
begin
{$IFDEF AUTOREFCOUNT}
if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then
continue;
{$ENDIF}
if ((not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lProp)) and
(not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and (lProp.IsWritable or lProp.GetValue(AObject).IsObject))
then
begin
lAttributeValue := lProp.GetValue(AObject);
lKeyName := TMVCSerializerHelper.GetKeyName(lProp, lObjType);
if not lAttributeValue.IsArray then
begin
if Data.IndexOfName(lKeyName) > -1 then
begin
DataValueToAttribute(AObject, lProp, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
lProp.GetAttributes);
if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then
begin
lProp.SetValue(AObject, lAttributeValue);
end;
end;
end
else
begin
// there are multiple parameters with the same name
if Data.IndexOfName(lKeyName) > -1 then
begin
SetLength(lArrValues, INITIAL_ARRAY_SIZE);
lCurrIdx := -1;
for I := 0 to Data.Count - 1 do
begin
if Data.Names[i] = lKeyName then
begin
Inc(lCurrIdx);
if (lCurrIdx >= INITIAL_ARRAY_SIZE) and (lCurrIdx >= Length(lArrValues)) then {does short-circuit make it faster?}
begin
SetLength(lArrValues, Trunc(lCurrIdx * 2));
end;
lArrValues[lCurrIdx] := Data.ValueFromIndex[i];
end;
end;
SetLength(lArrValues, lCurrIdx + 1); //trim
DataValueToAttribute(AObject, lProp, lArrValues, lKeyName,
lAttributeValue, AType, AIgnoredAttributes, lProp.GetAttributes);
if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then
begin
lProp.SetValue(AObject, lAttributeValue);
end;
end;
end;
end;
end;
except
on E: EInvalidCast do
begin
if lProp <> nil then
begin
lErrMsg := Format('Invalid class typecast for property "%s" [Expected: %s, Data: %s]',
[lKeyName, lProp.PropertyType.ToString(), Data.Values[lKeyName]]);
end
else
begin
lErrMsg := Format('Invalid class typecast for property "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
end;
raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
end;
end;
end;
stFields:
begin
try
for lFld in lObjType.GetFields do
if (not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lFld)) and
(not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then
begin
lAttributeValue := lFld.GetValue(AObject);
lKeyName := TMVCSerializerHelper.GetKeyName(lFld, lObjType);
if Data.IndexOfName(lKeyName) > -1 then
begin
DataValueToAttribute(AObject, lFld, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
lFld.GetAttributes);
if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) then
lFld.SetValue(AObject, lAttributeValue);
end;
end;
except
on E: EInvalidCast do
begin
if lFld <> nil then
begin
lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Data: %s]',
[lKeyName, lFld.FieldType.ToString(), Data.Values[lKeyName]]);
end
else
begin
lErrMsg := Format('Invalid class typecast for field "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
end;
raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
end;
end;
end;
end;
end;
procedure TMVCURLEncodedDataSerializer.DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember;
const RawData: string; const AName: string; var AValue: TValue; const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray<TCustomAttribute>);
var
RttiType: TRttiType;
begin
RttiType := nil;
AValue.Empty;
case AType of
stUnknown, stDefault, stProperties:
RttiType := TRttiProperty(ARttiMember).PropertyType;
stFields:
RttiType := TRttiField(ARttiMember).FieldType;
end;
case RttiType.TypeKind of
tkString, tkWideString, tkAnsiString, tkUString:
AValue := TNetEncoding.URL.Decode(RawData);
tkInteger:
AValue := RawData.ToInteger;
tkInt64:
AValue := RawData.ToInt64;
tkFloat:
AValue := RawData.ToDouble;
tkEnumeration:
begin
if SameText(RttiType.ToString, 'boolean') then
AValue := RawData.ToBoolean;
end;
// any others ?
end;
end;
procedure TMVCURLEncodedDataSerializer.DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember;
const RawDataArray: TArray<string>; const AName: string; var AValue: TValue; const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray<TCustomAttribute>);
var
RttiType: TRttiType;
//RttiArray: TRttiDynamicArrayType;
begin
RttiType := nil;
AValue.Empty;
case AType of
stUnknown, stDefault, stProperties:
RttiType := TRttiProperty(ARttiMember).PropertyType;
stFields:
RttiType := TRttiField(ARttiMember).FieldType;
end;
if RttiType.TypeKind <> tkDynArray then
begin
raise EMVCDeserializationException.Create('Expected DynArray in deserialization for ' + AName);
end;
//RttiArray := TRttiDynamicArrayType(RttiType);
AValue := TValue.From(RawDataArray)
end;
end.

9
sources/MVCFramework.pas
View File

@ -804,7 +804,7 @@ type
/// returns the rendered views and generates output using
/// models pushed using Push* methods
/// </summary>
function LoadView(const AViewNames: TArray<string>): string; virtual;
function LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string; virtual;
/// <summary>
/// Load a view fragment in the output render stream. The view fragment is appended to the
@ -3723,8 +3723,7 @@ begin
Result := Context.Request.GetHeader('If-Match');
end;
function TMVCController.GetRenderedView(const AViewNames: TArray<string>;
const JSONModel: TJSONObject): string;
function TMVCController.GetRenderedView(const AViewNames: TArray<string>; const JSONModel: TJSONObject): string;
var
lView: TMVCBaseViewEngine; lViewName: string; lStrStream: TStringStream;
begin
@ -3810,10 +3809,10 @@ begin
Result := FViewModel;
end;
function TMVCController.LoadView(const AViewNames: TArray<string>): string;
function TMVCController.LoadView(const AViewNames: TArray<string>; const JSONModel: TJSONObject = nil): string;
begin
try
Result := GetRenderedView(AViewNames);
Result := GetRenderedView(AViewNames, JSONModel);
ResponseStream.Append(Result);
except
on E: Exception do