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/137

Browse Source
This commit is contained in:
Daniele Teti 2018-07-16 12:34:07 +02:00
parent a4381ec719
commit c305aec5fc
14 changed files with 271 additions and 262 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
7z.exe Normal file
View File

Binary file not shown.

2
samples/outputcachewithredis/Controllers/PeopleControllerU.pas
View File

@ -103,7 +103,7 @@ begin
raise;
end;
Render<TPerson>(lPeople);
SetCache(20);
SetCache(60);
end;
procedure TPeopleController.CreateBulkData(CTX: TWebContext);

2
samples/renders/CustomTypesSerializersU.pas
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//

2
samples/renders/CustomTypesU.pas
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//

76
samples/renders/RenderSampleControllerU.pas
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
@ -39,8 +39,7 @@ type
[MVCPath('/')]
TRenderSampleController = class(TMVCController)
protected
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string;
var AHandled: Boolean); override;
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); override;
public
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/($id)')]
@ -52,6 +51,11 @@ type
[MVCProduces('application/json')]
procedure GetCustomers_AsDataSet(CTX: TWebContext);
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/metadata')]
[MVCProduces('application/json')]
procedure GetDataSetWithMetadata;
[MVCHTTPMethod([httpGET])]
[MVCPath('/multi')]
[MVCProduces('application/json')]
@ -71,7 +75,7 @@ type
[MVCPath('/lotofobjects')]
procedure GetLotOfPeople;
//this action is polymorphic
// this action is polymorphic
[MVCHTTPMethod([httpGET])]
[MVCPath('/skilledpeople')]
[MVCProduces('application/json')]
@ -91,7 +95,6 @@ type
[MVCPath('/customers.csv')]
procedure GetPeopleAsCSV;
[MVCHTTPMethod([httpGET])]
[MVCPath('/customers/unicode/($id).html')]
[MVCProduces('text/html', 'UTF-8')]
@ -157,8 +160,8 @@ begin
Render(s);
end;
procedure TRenderSampleController.OnBeforeAction(AContext: TWebContext;
const AActionName: string; var AHandled: Boolean);
procedure TRenderSampleController.OnBeforeAction(AContext: TWebContext; const AActionName: string;
var AHandled: Boolean);
begin
inherited;
@ -207,8 +210,8 @@ begin
// We need a non standard representation, let's create a specific serializer.
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.DataSetToJsonArray(lDM.qryCustomers, lJObj.A['customers'], TMVCNameCase.ncLowerCase, []);
lSer.DataSetToJsonArray(lDM.qryCountry, lJObj.A['countries'], TMVCNameCase.ncLowerCase, []);
lSer.DataSetToJsonArray(lDM.qryCustomers, lJObj.a['customers'], TMVCNameCase.ncLowerCase, []);
lSer.DataSetToJsonArray(lDM.qryCountry, lJObj.a['countries'], TMVCNameCase.ncLowerCase, []);
finally
lSer.Free;
end;
@ -241,6 +244,24 @@ begin
Render(TSysUser.Create('daniele', ['poweruser', 'role1', 'role2']), True);
end;
procedure TRenderSampleController.GetDataSetWithMetadata;
var
lDM: TMyDataModule;
lHolder: TDataSetHolder;
begin
lDM := TMyDataModule.Create(nil);
try
lDM.qryCustomers.Open;
lHolder := TDataSetHolder.Create(lDM.qryCustomers);
lHolder.Metadata.AddProperty('page', '1');
lHolder.Metadata.AddProperty('count', lDM.qryCustomers.RecordCount.ToString);
Render(lHolder);
finally
lDM.Free;
end;
end;
procedure TRenderSampleController.GetLotOfPeople;
begin
Render<TPerson>(GetPeopleList, False);
@ -248,12 +269,8 @@ end;
procedure TRenderSampleController.GetPerson_AsHTML(CTX: TWebContext);
begin
ResponseStream
.Append('<html><body><ul>')
.Append('<li>FirstName: Daniele</li>')
.Append('<li>LastName: Teti')
.AppendFormat('<li>DOB: %s</li>', [DateToISODate(EncodeDate(1975, 5, 2))])
.Append('<li>Married: yes</li>')
ResponseStream.Append('<html><body><ul>').Append('<li>FirstName: Daniele</li>').Append('<li>LastName: Teti')
.AppendFormat('<li>DOB: %s</li>', [DateToISODate(EncodeDate(1975, 5, 2))]).Append('<li>Married: yes</li>')
.Append('</ul></body></html>');
RenderResponseStream;
end;
@ -283,11 +300,8 @@ end;
procedure TRenderSampleController.GetPerson_AsText(const id: Integer);
begin
ResponseStream
.AppendLine('ID : ' + id.ToString)
.AppendLine('FirstName : Daniele')
.AppendLine('LastName : Teti')
.AppendLine('DOB : ' + DateToStr(EncodeDate(1979, 5, 2)))
ResponseStream.AppendLine('ID : ' + id.ToString).AppendLine('FirstName : Daniele')
.AppendLine('LastName : Teti').AppendLine('DOB : ' + DateToStr(EncodeDate(1979, 5, 2)))
.AppendLine('Married : yes');
RenderResponseStream;
end;
@ -339,8 +353,8 @@ begin
try
People.Metadata.StartProcessing := Now;
{$REGION 'Fake data'}
Sleep(1000); //processing...
{$REGION 'Fake data'}
Sleep(1000); // processing...
p := TPerson.Create;
p.FirstName := 'Daniele';
@ -363,8 +377,7 @@ begin
p.Married := True;
People.Items.Add(p);
{$ENDREGION}
{$ENDREGION}
People.Metadata.CustomData := Format('There are %d people in the list', [People.Items.Count]);
People.Metadata.StopProcessing := Now;
Render(People, False);
@ -380,8 +393,7 @@ var
begin
People := TObjectList<TPerson>.Create(True);
{$REGION 'Fake data'}
{$REGION 'Fake data'}
p := TPerson.Create;
p.FirstName := 'Daniele';
p.LastName := 'Teti';
@ -403,8 +415,7 @@ begin
p.Married := True;
People.Add(p);
{$ENDREGION}
{$ENDREGION}
Render<TPerson>(People);
end;
@ -413,9 +424,9 @@ var
p: TJSONObject;
begin
p := TJSONObject.Create;
p.S['FirstName'] := 'Daniele';
p.S['LastName'] := 'Teti';
p.S['DOB'] := DateToISODate(EncodeDate(1975, 5, 2));
p.s['FirstName'] := 'Daniele';
p.s['LastName'] := 'Teti';
p.s['DOB'] := DateToISODate(EncodeDate(1975, 5, 2));
p.B['Married'] := True;
Render(p);
end;
@ -430,8 +441,7 @@ procedure TRenderSampleController.GetPersonPhotoAsStream(CTX: TWebContext);
var
LPhoto: TFileStream;
begin
LPhoto := TFileStream.Create('..\..\_\customer.png',
fmOpenRead or fmShareDenyWrite);
LPhoto := TFileStream.Create('..\..\_\customer.png', fmOpenRead or fmShareDenyWrite);
ContentType := 'image/png'; // you can also use MVCProduces attribute
// LPhoto is a plain TStream descendant, so it can be rendered as usual

2
samples/renders/WebModuleU.pas
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//

5
samples/renders/renders.dpr
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
@ -41,7 +41,8 @@ uses
MyDataModuleU in 'MyDataModuleU.pas' {MyDataModule: TDataModule},
CustomTypesU in 'CustomTypesU.pas',
CustomTypesSerializersU in 'CustomTypesSerializersU.pas',
InMemoryDataU in 'InMemoryDataU.pas';
InMemoryDataU in 'InMemoryDataU.pas',
MVCFramework.DataSet.Utils in '..\..\sources\MVCFramework.DataSet.Utils.pas';
{$R *.res}

23
samples/renders/renders.dproj
View File

@ -219,6 +219,7 @@
<DCCReference Include="CustomTypesU.pas"/>
<DCCReference Include="CustomTypesSerializersU.pas"/>
<DCCReference Include="InMemoryDataU.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.DataSet.Utils.pas"/>
<None Include="ModelSupport_renders\default.txaPackage"/>
<None Include="ModelSupport_renders\default.txvpck"/>
<None Include="ModelSupport_renders\WebModuleU\default.txaPackage"/>
@ -392,6 +393,12 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\RenderSampleControllerU\default.txaPackage" Configuration="Debug" Class="ProjectFile">
<Platform Name="Linux64">
<RemoteDir>.\</RemoteDir>
@ -404,19 +411,13 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
<DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Debug" Class="ProjectFile">
<Platform Name="Linux64">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\RenderSampleControllerU\default.txaPackage" Configuration="Release" Class="ProjectFile">
<DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
@ -428,13 +429,13 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Debug" Class="ProjectFile">
<Platform Name="Linux64">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Release" Class="ProjectFile">
<DeployFile LocalName="ModelSupport_renders\RenderSampleControllerU\default.txaPackage" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>

113
sources/MVCFramework.DataSet.Utils.pas
View File

@ -28,44 +28,44 @@ unit MVCFramework.DataSet.Utils;
interface
uses System.SysUtils, Data.DB, System.Generics.Collections, System.JSON,
System.Rtti, JsonDataObjects, MVCFramework.Serializer.Commons;
uses
System.SysUtils,
Data.DB,
System.Generics.Collections,
System.JSON,
System.Rtti,
JsonDataObjects,
MVCFramework.Commons,
MVCFramework.Serializer.Commons;
type
TFieldNamePolicy = (fpLowerCase, fpUpperCase, fpAsIs);
TDataSetHelper = class helper for TDataSet
public
procedure LoadFromTValue(const Value: TValue;
const aNameCase: TMVCNameCase = TMVCNameCase.ncLowerCase);
procedure LoadFromTValue(const Value: TValue; const aNameCase: TMVCNameCase = TMVCNameCase.ncLowerCase);
function AsJSONArray: string;
function AsJSONArrayString: string; deprecated 'Use AsJSONArray';
function AsJSONObject(AFieldNamePolicy: TFieldNamePolicy = fpLowerCase): string;
function AsJSONObjectString: string; deprecated 'Use AsJSONObject';
procedure LoadFromJSONObject(AJSONObject: TJSONObject;
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
procedure LoadFromJSONObject(AJSONObject: TJSONObject;
AIgnoredFields: TArray<string>;
procedure LoadFromJSONObject(AJSONObject: TJSONObject; AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
procedure LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
procedure LoadFromJSONArray(AJSONArray: string;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.
fpLowerCase); overload;
procedure LoadFromJSONArrayString(AJSONArrayString: string;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArrayString(AJSONArrayString: string;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArray(AJSONArray: TJSONArray;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string;
AIgnoredFields: TArray<string>); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string; AIgnoredFields: TArray<string>); overload;
procedure AppendFromJSONArrayString(AJSONArrayString: string); overload;
procedure AppendFromJSONArrayString(AJSONArrayString: string;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
function AsObjectList<T: class, constructor>(CloseAfterScroll
: boolean = false): TObjectList<T>;
function AsObject<T: class, constructor>(CloseAfterScroll
: boolean = false): T;
procedure AppendFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
function AsObjectList<T: class, constructor>(CloseAfterScroll: boolean = false): TObjectList<T>;
function AsObject<T: class, constructor>(CloseAfterScroll: boolean = false): T;
end;
TDataSetUtils = class sealed
@ -75,15 +75,27 @@ type
class constructor Create;
class destructor Destroy;
class procedure DataSetToObject(ADataSet: TDataSet; AObject: TObject);
class procedure DataSetToObjectList<T: class, constructor>
(ADataSet: TDataSet; AObjectList: TObjectList<T>;
class procedure DataSetToObjectList<T: class, constructor>(ADataSet: TDataSet; AObjectList: TObjectList<T>;
ACloseDataSetAfterScroll: boolean = True);
end;
[MVCNameCase(ncLowerCase)]
TDataSetHolder = class
private
FDataSet: TDataSet;
FMetadata: TMVCStringDictionary;
public
constructor Create(ADataSet: TDataSet); virtual;
destructor Destroy; override;
property Items: TDataSet read FDataSet;
[MVCNameAs('meta')]
property Metadata: TMVCStringDictionary read FMetadata;
end;
implementation
uses
MVCFramework.Serializer.JSONDataObjects,
MVCFramework.Serializer.JsonDataObjects,
MVCFramework.Serializer.Intf;
{ TDataSetHelper }
@ -92,12 +104,12 @@ procedure TDataSetHelper.LoadFromTValue(const Value: TValue; const aNameCase: TM
var
lSer: TMVCJsonDataObjectsSerializer;
begin
if not({$IFDEF TOKYOORBETTER}Value.IsObjectInstance and {$ENDIF} (Value.AsObject is TJsonArray)) then
if not({$IFDEF TOKYOORBETTER}Value.IsObjectInstance and {$ENDIF} (Value.AsObject is TJSONArray)) then
raise Exception.Create('LoadFromTValue requires a TValue containing a TJDOJsonArray');
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.JsonArrayToDataSet(TJsonArray(Value.AsObject), Self, [], TMVCNameCase.ncLowerCase);
lSer.JsonArrayToDataSet(TJSONArray(Value.AsObject), Self, [], TMVCNameCase.ncLowerCase);
finally
lSer.Free;
end;
@ -169,8 +181,7 @@ begin
end;
end;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: string;
AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: string; AFieldNamePolicy: TFieldNamePolicy);
var
lSerializer: IMVCSerializer;
begin
@ -185,8 +196,8 @@ begin
end;
end;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
Self.DisableControls;
try
@ -196,8 +207,8 @@ begin
end;
end;
procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
AppendFromJSONArrayString(AJSONArrayString, AIgnoredFields, AFieldNamePolicy);
end;
@ -207,8 +218,8 @@ begin
AppendFromJSONArrayString(AJSONArrayString, TArray<string>.Create(), AFieldNamePolicy);
end;
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
LoadFromJSONArray(AJSONArrayString, AFieldNamePolicy);
end;
@ -218,16 +229,15 @@ begin
AppendFromJSONArrayString(AJSONArrayString, TArray<string>.Create());
end;
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject;
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
raise Exception.Create('Not Implemented');
// Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false,
// AFieldNamePolicy);
end;
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string;
AIgnoredFields: TArray<string>);
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string; AIgnoredFields: TArray<string>);
var
lSerializer: IMVCSerializer;
begin
@ -246,8 +256,7 @@ begin
// end;
end;
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject;
AFieldNamePolicy: TFieldNamePolicy);
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; AFieldNamePolicy: TFieldNamePolicy);
begin
LoadFromJSONObject(AJSONObject, TArray<string>.Create());
end;
@ -264,8 +273,7 @@ begin
TDataSetUtils.CTX := TRttiContext.Create;
end;
class procedure TDataSetUtils.DataSetToObject(ADataSet: TDataSet;
AObject: TObject);
class procedure TDataSetUtils.DataSetToObject(ADataSet: TDataSet; AObject: TObject);
var
_type: TRttiType;
_fields: TArray<TRttiProperty>;
@ -355,8 +363,8 @@ begin
_keys.Free;
end;
class procedure TDataSetUtils.DataSetToObjectList<T>(ADataSet: TDataSet;
AObjectList: TObjectList<T>; ACloseDataSetAfterScroll: boolean);
class procedure TDataSetUtils.DataSetToObjectList<T>(ADataSet: TDataSet; AObjectList: TObjectList<T>;
ACloseDataSetAfterScroll: boolean);
var
Obj: T;
SavedPosition: TArray<Byte>;
@ -385,4 +393,19 @@ begin
CTX.Free;
end;
{ TDataSetHolder }
constructor TDataSetHolder.Create(ADataSet: TDataSet);
begin
inherited Create;
FDataSet := ADataSet;
FMetadata := TMVCStringDictionary.Create;
end;
destructor TDataSetHolder.Destroy;
begin
inherited;
FMetadata.Free;
end;
end.

2
sources/MVCFramework.Middleware.JWT.pas
View File

@ -76,7 +76,7 @@ implementation
uses
System.NetEncoding,
System.DateUtils,
System.Math;
System.Math, MVCFramework.Logger;
{ TMVCJWTAuthenticationMiddleware }

53
sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
View File

@ -43,21 +43,34 @@ type
private
{ private declarations }
protected
procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
procedure Deserialize(const ASerializedObject: TObject; var AElementValue: TValue; const AAttributes: TArray<TCustomAttribute>);
procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
procedure Deserialize(const ASerializedObject: TObject; var AElementValue: TValue;
const AAttributes: TArray<TCustomAttribute>);
public
{ public declarations }
end;
TMVCStringDictionarySerializer = class(TInterfacedObject, IMVCTypeSerializer)
public
procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
const AAttributes: System.TArray<System.TCustomAttribute>);
procedure Deserialize(const ASerializedObject: TObject; var AElementValue: TValue;
const AAttributes: System.TArray<System.TCustomAttribute>);
end;
implementation
uses
MVCFramework.Serializer.JsonDataObjects;
MVCFramework.Serializer.JsonDataObjects,
Data.DB,
MVCFramework.Commons,
System.Generics.Collections,
JsonDataObjects;
{ TStreamSerializerJsonDataObject }
procedure TStreamSerializerJsonDataObject.Deserialize(
const ASerializedObject: TObject; var AElementValue: TValue;
procedure TStreamSerializerJsonDataObject.Deserialize(const ASerializedObject: TObject; var AElementValue: TValue;
const AAttributes: TArray<TCustomAttribute>);
var
JsonValue: TJsonValue;
@ -94,8 +107,7 @@ begin
end;
end;
procedure TStreamSerializerJsonDataObject.Serialize(
const AElementValue: TValue; var ASerializerObject: TObject;
procedure TStreamSerializerJsonDataObject.Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
const AAttributes: TArray<TCustomAttribute>);
var
Stream: TStream;
@ -131,4 +143,31 @@ begin
end;
end;
{ TMVCStringDictionarySerializer }
procedure TMVCStringDictionarySerializer.Deserialize(const ASerializedObject: TObject; var AElementValue: TValue;
const AAttributes: System.TArray<System.TCustomAttribute>);
begin
raise EMVCDeserializationException.Create('Not Implemented');
end;
procedure TMVCStringDictionarySerializer.Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
const AAttributes: System.TArray<System.TCustomAttribute>);
var
lStringDict: TMVCStringDictionary;
lPair: TPair<string, string>;
lJSONObject: TJsonObject;
begin
lStringDict := AElementValue.AsObject as TMVCStringDictionary;
if Assigned(lStringDict) then
begin
lJSONObject := TJsonObject.Create;
for lPair in lStringDict do
begin
lJSONObject.S[lPair.Key] := lPair.Value;
end;
ASerializerObject := lJSONObject;
end;
end;
end.

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

@ -68,119 +68,51 @@ type
// const AType: TMVCSerializationType;
// const AIgnoredAttributes: TMVCIgnoredList
// );
procedure ObjectToJsonObject(
const AObject: TObject;
const AJsonObject: TJsonObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList
);
procedure AttributeToJsonDataValue(
const AJsonObject: TJsonObject;
const AName: string;
const AValue: TValue;
const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>
);
procedure JsonObjectToObject(
const AJsonObject: TJsonObject;
const AObject: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList
);
procedure JsonDataValueToAttribute(
const AJsonObject: TJsonObject;
const AName: string;
var AValue: TValue;
const AType: TMVCSerializationType;
const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>
);
procedure JsonArrayToList(
const AJsonArray: TJsonArray;
const AList: IMVCList;
const AClazz: TClass;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList
);
procedure DataSetToJsonObject(
const ADataSet: TDataSet;
const AJsonObject: TJsonObject;
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
procedure DataSetToJsonArray(
const ADataSet: TDataSet;
const AJsonArray: TJsonArray;
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
procedure JsonObjectToDataSet(
const AJsonObject: TJsonObject;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
procedure JsonArrayToDataSet(
const AJsonArray: TJsonArray;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJsonObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
procedure AttributeToJsonDataValue(const AJsonObject: TJsonObject; const AName: string; const AValue: TValue;
const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>);
procedure JsonObjectToObject(const AJsonObject: TJsonObject; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
procedure JsonDataValueToAttribute(const AJsonObject: TJsonObject; const AName: string; var AValue: TValue;
const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>);
procedure JsonArrayToList(const AJsonArray: TJsonArray; const AList: IMVCList; const AClazz: TClass;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
procedure DataSetToJsonObject(const ADataSet: TDataSet; const AJsonObject: TJsonObject;
const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList);
procedure DataSetToJsonArray(const ADataSet: TDataSet; const AJsonArray: TJsonArray; const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList);
procedure JsonObjectToDataSet(const AJsonObject: TJsonObject; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
procedure JsonArrayToDataSet(const AJsonArray: TJsonArray; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
{ IMVCSerializer }
function SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = [];
const ASerializationAction: TMVCSerializationAction = nil
): string;
const ASerializationAction: TMVCSerializationAction = nil): string;
function SerializeCollection(
const AList: TObject;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
): string;
function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []): string;
function SerializeDataSet(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
): string;
function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs): string;
function SerializeDataSetRecord(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
): string;
function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs): string;
procedure DeserializeObject(
const ASerializedObject: string;
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
);
procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []);
procedure DeserializeCollection(
const ASerializedList: string;
const AList: TObject;
const AClazz: TClass;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
);
procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass;
const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []);
procedure DeserializeDataSet(
const ASerializedDataSet: string;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
);
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
);
procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);
public
procedure AfterConstruction; override;
end;
@ -188,7 +120,7 @@ type
implementation
uses
MVCFramework.Serializer.JsonDataObjects.CustomTypes;
MVCFramework.Serializer.JsonDataObjects.CustomTypes, MVCFramework.Commons;
{ TMVCJsonDataObjectsSerializer }
@ -198,6 +130,7 @@ begin
GetTypeSerializers.Add(System.TypeInfo(TStream), TStreamSerializerJsonDataObject.Create);
GetTypeSerializers.Add(System.TypeInfo(TStringStream), TStreamSerializerJsonDataObject.Create);
GetTypeSerializers.Add(System.TypeInfo(TMemoryStream), TStreamSerializerJsonDataObject.Create);
GetTypeSerializers.Add(System.TypeInfo(TMVCStringDictionary), TMVCStringDictionarySerializer.Create);
end;
procedure TMVCJsonDataObjectsSerializer.AttributeToJsonDataValue(
@ -305,6 +238,13 @@ begin
begin
ChildObject := AValue.AsObject;
if Assigned(ChildObject) then
begin
if ChildObject is TDataSet then
begin
ChildJsonArray := AJsonObject.A[AName];
DataSetToJsonArray(TDataSet(ChildObject), ChildJsonArray, TMVCNameCase.ncLowerCase, []);
end
else
begin
ChildList := TDuckTypedList.Wrap(ChildObject);
if Assigned(ChildList) then
@ -319,6 +259,7 @@ begin
ChildJsonObject := AJsonObject.O[AName];
ObjectToJsonObject(ChildObject, ChildJsonObject, GetSerializationType(ChildObject, AType), AIgnored);
end;
end;
end
else
begin
@ -780,7 +721,6 @@ begin
TFieldType.ftGuid:
Field.AsGuid := StringToGUID(AJsonObject.S[name]);
{$ENDIF}
TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream:
begin
SS := TStringStream.Create(AJsonObject.S[name]);
@ -844,17 +784,18 @@ begin
for Prop in ObjType.GetProperties do
begin
{$IFDEF AUTOREFCOUNT}
{$IFDEF AUTOREFCOUNT}
if TMVCSerializerHelpful.IsAPropertyToSkip(Prop.Name) then
Continue;
{$ENDIF}
if (Prop.IsWritable or Prop.GetValue(AObject).IsObject) and (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
{$ENDIF}
if (Prop.IsWritable or Prop.GetValue(AObject).IsObject) and
(not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and
(not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
begin
AttributeValue := Prop.GetValue(AObject);
JsonDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType), AttributeValue, AType, AIgnoredAttributes, Prop.GetAttributes);
JsonDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType), AttributeValue,
AType, AIgnoredAttributes, Prop.GetAttributes);
if (not AttributeValue.IsEmpty) and Prop.IsWritable then
Prop.SetValue(AObject, AttributeValue);
end;
@ -863,10 +804,12 @@ begin
stFields:
begin
for Fld in ObjType.GetFields do
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and
(not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
begin
AttributeValue := Fld.GetValue(AObject);
JsonDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), AttributeValue, AType, AIgnoredAttributes, Fld.GetAttributes);
JsonDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), AttributeValue, AType,
AIgnoredAttributes, Fld.GetAttributes);
if not AttributeValue.IsEmpty then
Fld.SetValue(AObject, AttributeValue);
end;
@ -874,11 +817,8 @@ begin
end;
end;
procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(
const AObject: TObject;
const AJsonObject: TJsonObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList);
procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJsonObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
ObjType: TRttiType;
Prop: TRttiProperty;
@ -891,28 +831,29 @@ begin
for Prop in ObjType.GetProperties do
begin
{$IFDEF AUTOREFCOUNT}
{$IFDEF AUTOREFCOUNT}
if TMVCSerializerHelpful.IsAPropertyToSkip(Prop.Name) then
Continue;
{$ENDIF}
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
AttributeToJsonDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType), Prop.GetValue(AObject), AType, AIgnoredAttributes, Prop.GetAttributes);
{$ENDIF}
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and
(not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
AttributeToJsonDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType),
Prop.GetValue(AObject), AType, AIgnoredAttributes, Prop.GetAttributes);
end;
end;
stFields:
begin
for Fld in ObjType.GetFields do
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
AttributeToJsonDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), Fld.GetValue(AObject), AType, AIgnoredAttributes, Fld.GetAttributes);
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and
(not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
AttributeToJsonDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), Fld.GetValue(AObject),
AType, AIgnoredAttributes, Fld.GetAttributes);
end;
end;
end;
function TMVCJsonDataObjectsSerializer.SerializeCollection(
const AList: TObject; const AType: TMVCSerializationType;
function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList): string;
var
JsonArray: TJsonArray;
@ -942,9 +883,7 @@ begin
end;
end;
function TMVCJsonDataObjectsSerializer.SerializeDataSet(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase): string;
var
JsonArray: TJsonArray;
@ -957,7 +896,7 @@ begin
JsonArray := TJsonArray.Create;
try
BookMark := ADataSet.Bookmark;
BookMark := ADataSet.BookMark;
ADataSet.First;
while not ADataSet.Eof do
begin
@ -973,10 +912,8 @@ begin
end;
end;
function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase): string;
function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase): string;
var
JsonObject: TJsonObject;
begin
@ -1015,12 +952,8 @@ end;
// end;
// end;
function TMVCJsonDataObjectsSerializer.SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction
): string;
function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
var
JsonObject: TJsonObject;
ChildJsonValue: TJsonBaseObject;
@ -1034,8 +967,11 @@ begin
if AObject is TJsonBaseObject then
Exit(TJsonBaseObject(AObject).ToJSON(True));
if AObject is MVCFramework.TypesAliases.TJSONValue then
Exit(MVCFramework.TypesAliases.TJSONValue(AObject).ToJSON);
if AObject is TDataSet then
Exit(self.SerializeDataSet(TDataSet(AObject)));
if AObject is MVCFramework.TypesAliases.TJsonValue then
Exit(MVCFramework.TypesAliases.TJsonValue(AObject).ToJSON);
ObjType := GetRttiContext.GetType(AObject.ClassType);
if GetTypeSerializers.ContainsKey(ObjType.Handle) then
@ -1048,7 +984,8 @@ begin
if ChildJsonValue is TJsonBaseObject then
Result := ChildJsonValue.ToJSON(True)
else
raise EMVCSerializationException.Create('Cannot serialize, the serializer does not have a valid TJsonBaseObject type.');
raise EMVCSerializationException.Create
('Cannot serialize, the serializer does not have a valid TJsonBaseObject type.');
finally
ChildJsonValue.Free;
end;
@ -1065,11 +1002,8 @@ begin
end;
end;
procedure TMVCJsonDataObjectsSerializer.DeserializeObject(
const ASerializedObject: string;
const AObject: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList);
procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
JsonObject: TJsonObject;
ObjType: TRttiType;

2
unittests/general/Several/FrameworkTestsU.pas
View File

@ -2,7 +2,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2018 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//

1
unittests/general/Several/LiveServerTestU.pas
View File

@ -1224,6 +1224,7 @@ begin
try
lReq.Method := 'mynotify';
FExecutor.ExecuteNotification(lReq);
Assert.Pass();
finally
lReq.Free;
end;