From 52e15c4eca9b351fe978839c594acfdd74a07ab9 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Mon, 24 Apr 2017 00:19:53 +0200 Subject: [PATCH] refactored some ObjectsMappers responsibilities Client part of Unit test doesn't compile --- .../articles_crud_server/BusinessObjects.pas | 10 +- samples/articles_crud_server/MainDM.dfm | 2 - samples/articles_crud_server/MainDM.pas | 2 +- samples/articles_crud_server/Services.pas | 10 +- .../articles_crud_server/articles_crud.dpr | 10 +- .../articles_crud_server/articles_crud.dproj | 577 +++++++------- .../articles_crud_vcl_client/MainFormU.dfm | 2 - .../articles_crud_vcl_client/MainFormU.pas | 8 +- .../articles_crud_vcl_client.dpr | 3 +- .../articles_crud_vcl_client.dproj | 723 +++++++++--------- sources/MVCFramework.DataSet.Utils.pas | 354 +++++++++ sources/MVCFramework.FireDAC.Utils.pas | 159 ++++ sources/MVCFramework.RESTClient.pas | 332 +++----- sources/MVCFramework.Serializer.Commons.pas | 31 + sources/MVCFramework.Serializer.Defaults.pas | 20 + sources/ObjectsMappers.pas | 268 +------ .../general/Several/DMVCFrameworkTests.dproj | 2 +- unittests/general/Several/FrameworkTestsU.pas | 374 ++++----- unittests/general/Several/LiveServerTestU.pas | 1 + unittests/general/TestServer/TestServer.dpr | 3 + unittests/general/TestServer/TestServer.dproj | 2 +- 21 files changed, 1559 insertions(+), 1334 deletions(-) create mode 100644 sources/MVCFramework.DataSet.Utils.pas create mode 100644 sources/MVCFramework.FireDAC.Utils.pas create mode 100644 sources/MVCFramework.Serializer.Defaults.pas diff --git a/samples/articles_crud_server/BusinessObjects.pas b/samples/articles_crud_server/BusinessObjects.pas index 0f400292..a4727e0a 100644 --- a/samples/articles_crud_server/BusinessObjects.pas +++ b/samples/articles_crud_server/BusinessObjects.pas @@ -3,7 +3,7 @@ unit BusinessObjects; interface uses - ObjectsMappers; + MVCFramework.Serializer.Commons; type TBaseBO = class @@ -17,7 +17,7 @@ type property ID: Integer read FID write SetID; end; - [MapperJSONNaming(JSONNameLowerCase)] + [MVCNameCase(ncLowerCase)] TArticle = class(TBaseBO) private FPrice: Currency; @@ -30,11 +30,11 @@ type procedure CheckInsert; override; procedure CheckUpdate; override; procedure CheckDelete; override; - [MapperColumn('CODICE')] + [MVCColumn('CODICE')] property Code: string read FCode write SetCode; - [MapperColumn('DESCRIZIONE')] + [MVCColumn('DESCRIZIONE')] property Description: string read FDescription write SetDescription; - [MapperColumn('PREZZO')] + [MVCColumn('PREZZO')] property Price: Currency read FPrice write SetPrice; end; diff --git a/samples/articles_crud_server/MainDM.dfm b/samples/articles_crud_server/MainDM.dfm index f9bb6031..36097c60 100644 --- a/samples/articles_crud_server/MainDM.dfm +++ b/samples/articles_crud_server/MainDM.dfm @@ -9,14 +9,12 @@ object dmMain: TdmMain 'Password=masterkey' 'DriverID=FB') ConnectedStoredUsage = [] - Connected = True LoginPrompt = False BeforeConnect = ConnectionBeforeConnect Left = 64 Top = 48 end object dsArticles: TFDQuery - Active = True Connection = Connection UpdateOptions.AssignedValues = [uvFetchGeneratorsPoint, uvGeneratorName] UpdateOptions.FetchGeneratorsPoint = gpImmediate diff --git a/samples/articles_crud_server/MainDM.pas b/samples/articles_crud_server/MainDM.pas index d5162e77..9cb9e974 100644 --- a/samples/articles_crud_server/MainDM.pas +++ b/samples/articles_crud_server/MainDM.pas @@ -7,7 +7,7 @@ uses FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.FB, Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, - FireDAC.DApt, FireDAC.Comp.DataSet; + FireDAC.DApt, FireDAC.Comp.DataSet, FireDAC.Phys.FBDef, FireDAC.VCLUI.Wait; type TdmMain = class(TDataModule) diff --git a/samples/articles_crud_server/Services.pas b/samples/articles_crud_server/Services.pas index 322bf477..3491aeff 100644 --- a/samples/articles_crud_server/Services.pas +++ b/samples/articles_crud_server/Services.pas @@ -29,7 +29,9 @@ type implementation uses - ObjectsMappers, FireDAC.Stan.Option, FireDAC.Comp.Client, FireDAC.Stan.Param; + FireDAC.Stan.Option, FireDAC.Comp.Client, FireDAC.Stan.Param, + MVCFramework.FireDAC.Utils, MVCFramework.DataSet.Utils, + MVCFramework.Serializer.Commons; { TArticoliService } @@ -39,7 +41,7 @@ var begin AArticolo.CheckInsert; Cmd := FDM.updArticles.Commands[arInsert]; - Mapper.ObjectToFDParameters(Cmd.Params, AArticolo, 'NEW_'); + TFireDACUtils.ObjectToParameters(Cmd.Params, AArticolo, 'NEW_'); Cmd.OpenOrExecute; end; @@ -49,7 +51,7 @@ var begin AArticolo.CheckDelete; Cmd := FDM.updArticles.Commands[arDelete]; - Mapper.ObjectToFDParameters(Cmd.Params, AArticolo, 'OLD_'); + TFireDACUtils.ObjectToParameters(Cmd.Params, AArticolo, 'OLD_'); Cmd.Execute; end; @@ -80,7 +82,7 @@ var begin AArticolo.CheckUpdate; Cmd := FDM.updArticles.Commands[arUpdate]; - Mapper.ObjectToFDParameters(Cmd.Params, AArticolo, 'NEW_'); + TFireDACUtils.ObjectToParameters(Cmd.Params, AArticolo, 'NEW_'); Cmd.ParamByName('OLD_ID').AsInteger := AArticolo.ID; Cmd.Execute; if Cmd.RowsAffected <> 1 then diff --git a/samples/articles_crud_server/articles_crud.dpr b/samples/articles_crud_server/articles_crud.dpr index 139b1494..5c24dea5 100644 --- a/samples/articles_crud_server/articles_crud.dpr +++ b/samples/articles_crud_server/articles_crud.dpr @@ -8,17 +8,19 @@ uses IdHTTPWebBrokerBridge, Web.WebReq, Web.WebBroker, - WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule} , + WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule}, Controllers.Base in 'Controllers.Base.pas', Controllers.Articles in 'Controllers.Articles.pas', Services in 'Services.pas', BusinessObjects in 'BusinessObjects.pas', - MainDM in 'MainDM.pas' {dmMain: TDataModule} , + MainDM in 'MainDM.pas' {dmMain: TDataModule}, Commons in 'Commons.pas', MVCFramework.Serializer.JSON in '..\..\sources\MVCFramework.Serializer.JSON.pas', - ObjectsMappers in '..\..\sources\ObjectsMappers.pas', MVCFramework.Commons in '..\..\sources\MVCFramework.Commons.pas', - MVCFramework.Serializer.Intf in '..\..\sources\MVCFramework.Serializer.Intf.pas'; + MVCFramework.Serializer.Intf in '..\..\sources\MVCFramework.Serializer.Intf.pas', + MVCFramework.FireDAC.Utils in '..\..\sources\MVCFramework.FireDAC.Utils.pas', + ObjectsMappers in '..\..\sources\ObjectsMappers.pas', + MVCFramework.DataSet.Utils in '..\..\sources\MVCFramework.DataSet.Utils.pas'; {$R *.res} diff --git a/samples/articles_crud_server/articles_crud.dproj b/samples/articles_crud_server/articles_crud.dproj index 67bddb52..832164d2 100644 --- a/samples/articles_crud_server/articles_crud.dproj +++ b/samples/articles_crud_server/articles_crud.dproj @@ -105,9 +105,11 @@ - + + + @@ -135,6 +137,7 @@ + Cfg_2 Base @@ -301,6 +304,12 @@ true + + + .\ + true + + .\ @@ -331,12 +340,14 @@ true - - + - Contents\Resources 1 + + Contents\MacOS + 0 + @@ -344,18 +355,15 @@ 1 - + - res\drawable-xxhdpi + library\lib\armeabi-v7a 1 - - - Contents\MacOS - 0 - - + + + library\lib\armeabi 1 @@ -365,49 +373,294 @@ 1 - - - 1 - - - 1 - - + + + + library\lib\armeabi-v7a 1 - - + + + res\drawable 1 - + + + + res\values + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + 1 0 + + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + 1 1 - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - 1 - .framework - @@ -417,105 +670,13 @@ 1 - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi - 1 - - - + - 0 - - + Assets 1 - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - + + Assets 1 @@ -529,158 +690,6 @@ 1 - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable-hdpi - 1 - - - - - - - Assets - 1 - - - Assets - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\values - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - res\drawable - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-ldpi - 1 - - - - - 0 - .dll;.bpl - - - 1 - .dylib - - diff --git a/samples/articles_crud_vcl_client/MainFormU.dfm b/samples/articles_crud_vcl_client/MainFormU.dfm index e07a7188..de8d5d30 100644 --- a/samples/articles_crud_vcl_client/MainFormU.dfm +++ b/samples/articles_crud_vcl_client/MainFormU.dfm @@ -22,7 +22,6 @@ object MainForm: TMainForm Height = 39 Align = alTop TabOrder = 0 - ExplicitWidth = 592 object DBNavigator1: TDBNavigator AlignWithMargins = True Left = 378 @@ -32,7 +31,6 @@ object MainForm: TMainForm DataSource = dsrcArticles Align = alRight TabOrder = 0 - ExplicitLeft = 301 end object btnOpen: TButton AlignWithMargins = True diff --git a/samples/articles_crud_vcl_client/MainFormU.pas b/samples/articles_crud_vcl_client/MainFormU.pas index 03ceb5e7..9051d069 100644 --- a/samples/articles_crud_vcl_client/MainFormU.pas +++ b/samples/articles_crud_vcl_client/MainFormU.pas @@ -47,7 +47,7 @@ var implementation uses - ObjectsMappers, System.UITypes; + System.UITypes, MVCFramework.DataSet.Utils; {$R *.dfm} @@ -76,7 +76,7 @@ begin DataSet.DisableControls; try FLoading := true; - dsArticles.AppendFromJSONArrayString(Res.BodyAsString); + dsArticles.LoadFromJSONArrayString(Res.BodyAsString); FLoading := false; dsArticles.First; finally @@ -129,9 +129,7 @@ var begin Res := Clt.doGET('/articles', [DataSet.FieldByName('id').AsString]); FLoading := true; - DataSet.Edit; DataSet.LoadFromJSONObjectString(Res.BodyAsString); - DataSet.Post; FLoading := false; end; @@ -149,7 +147,7 @@ procedure TMainForm.ShowError(const AResponse: IRESTResponse); begin MessageDlg( AResponse.ResponseCode.ToString + ': ' + AResponse.ResponseText + sLineBreak + - AResponse.BodyAsJsonObject.Get('message').JsonValue.Value, + AResponse.BodyAsString, mtError, [mbOK], 0); end; diff --git a/samples/articles_crud_vcl_client/articles_crud_vcl_client.dpr b/samples/articles_crud_vcl_client/articles_crud_vcl_client.dpr index 27512344..0e2d13e8 100644 --- a/samples/articles_crud_vcl_client/articles_crud_vcl_client.dpr +++ b/samples/articles_crud_vcl_client/articles_crud_vcl_client.dpr @@ -2,7 +2,8 @@ program articles_crud_vcl_client; uses Vcl.Forms, - MainFormU in 'MainFormU.pas' {MainForm}; + MainFormU in 'MainFormU.pas' {MainForm}, + MVCFramework.Serializer.Defaults in '..\..\sources\MVCFramework.Serializer.Defaults.pas'; {$R *.res} diff --git a/samples/articles_crud_vcl_client/articles_crud_vcl_client.dproj b/samples/articles_crud_vcl_client/articles_crud_vcl_client.dproj index 5e01bbbd..f0baeca8 100644 --- a/samples/articles_crud_vcl_client/articles_crud_vcl_client.dproj +++ b/samples/articles_crud_vcl_client/articles_crud_vcl_client.dproj @@ -100,6 +100,7 @@
MainForm
dfm + Cfg_2 Base @@ -128,19 +129,24 @@ - - + + + articles_crud_vcl_client.exe + true + + + + 1 - - 1 - - - - Contents\Resources + Contents\MacOS 1 + + Contents\MacOS + 0 + @@ -148,239 +154,372 @@ 1 - - - res\drawable-xxhdpi - 1 - - - - - Contents\MacOS - 0 - - - 1 - - - Contents\MacOS - 1 - - - - - library\lib\mips - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 0 - - - 1 - - - Contents\MacOS - 1 - - - library\lib\armeabi-v7a - 1 - - - 1 - - - - - 0 - - - Contents\MacOS - 1 - .framework - - - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - 0 - - - 1 - - - Contents\MacOS - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - library\lib\armeabi-v7a 1 + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + res\drawable-hdpi 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\ + 1 + + Contents 1 - + - ..\ + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + 1 + + 1 @@ -394,146 +533,14 @@ 1 - - - 1 - - - 1 - - - 1 - - - - - res\values - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - res\drawable - 1 - - - + - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - 0 - - - 0 - - - - - library\lib\armeabi-v7a + Assets 1 - - - - 0 - .bpl - - + + Assets 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-ldpi - 1 - - - - - 0 - .dll;.bpl - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib diff --git a/sources/MVCFramework.DataSet.Utils.pas b/sources/MVCFramework.DataSet.Utils.pas new file mode 100644 index 00000000..f4fefff5 --- /dev/null +++ b/sources/MVCFramework.DataSet.Utils.pas @@ -0,0 +1,354 @@ +unit MVCFramework.DataSet.Utils; + +interface + +uses System.SysUtils, Data.DB, System.Generics.Collections, System.JSON, + System.Rtti, JsonDataObjects; + +type + TFieldNamePolicy = (fpLowerCase, fpUpperCase, fpAsIs); + + TDataSetHelper = class helper for TDataSet + public + 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; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; + procedure LoadFromJSONArray(AJSONArray: String; + AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy. + fpLowerCase); overload; + procedure LoadFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; + procedure LoadFromJSONArrayString(AJSONArrayString: string; + AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; + procedure LoadFromJSONArray(AJSONArray: TJSONArray; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; + procedure LoadFromJSONObjectString(AJSONObjectString: string); overload; + procedure LoadFromJSONObjectString(AJSONObjectString: string; + AIgnoredFields: TArray); overload; + procedure AppendFromJSONArrayString(AJSONArrayString: string); overload; + procedure AppendFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; + function AsObjectList(CloseAfterScroll + : boolean = false): TObjectList; + function AsObject(CloseAfterScroll + : boolean = false): T; + end; + + TDataSetUtils = class sealed + private + class var CTX: TRttiContext; + public + class constructor Create; + class destructor Destroy; + class procedure DataSetToObject(ADataSet: TDataSet; AObject: TObject); + class procedure DataSetToObjectList + (ADataSet: TDataSet; AObjectList: TObjectList; + ACloseDataSetAfterScroll: boolean = True); + end; + +implementation + +uses + MVCFramework.Serializer.Commons, + MVCFramework.Serializer.JSONDataObjects, + MVCFramework.Serializer.Intf; + +{ TDataSetHelper } + +function TDataSetHelper.AsJSONArray: String; +var + lSerializer: IMVCSerializer; +begin + Result := '[]'; + if not Eof then + begin + lSerializer := TMVCJsonDataObjectsSerializer.Create; + Result := lSerializer.SerializeDataSet(Self, [], ncLowerCase); + // TDataSetUtils.DataSetToJSONArray(Self, JArr, false); + end; +end; + +function TDataSetHelper.AsJSONArrayString: string; +begin + Result := AsJSONArray; +end; + +function TDataSetHelper.AsJSONObject(AFieldNamePolicy: TFieldNamePolicy): String; +var + lSerializer: IMVCSerializer; +begin + lSerializer := TMVCJsonDataObjectsSerializer.Create; + Result := lSerializer.SerializeDataSetRecord(Self, [], ncAsIs); + // Mapper.DataSetToJSONObject(Self, JObj, false); +end; + +function TDataSetHelper.AsJSONObjectString: string; +begin + Result := AsJSONObject(fpLowerCase); +end; + +function TDataSetHelper.AsObject(CloseAfterScroll: boolean): T; +var + Obj: T; +begin + if not Self.Eof then + begin + Obj := T.Create; + try + TDataSetUtils.DataSetToObject(Self, Obj); + Result := Obj; + except + FreeAndNil(Obj); + raise; + end; + end + else + Result := nil; +end; + +function TDataSetHelper.AsObjectList(CloseAfterScroll: boolean): TObjectList; +var + Objs: TObjectList; +begin + Objs := TObjectList.Create(True); + try + TDataSetUtils.DataSetToObjectList(Self, Objs, CloseAfterScroll); + Result := Objs; + except + FreeAndNil(Objs); + raise; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: String; + AFieldNamePolicy: TFieldNamePolicy); +var + lSerializer: IMVCSerializer; +begin + Self.DisableControls; + try + lSerializer := TMVCJsonDataObjectsSerializer.Create; + lSerializer.DeserializeDataSet(AJSONArray, Self, nil, ncAsIs); + // Mapper.JSONArrayToDataSet(AJSONArray, Self, TArray.Create(), false, + // AFieldNamePolicy); + finally + Self.EnableControls; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); +begin + Self.DisableControls; + try + raise Exception.Create('Not Implemented'); + // Mapper.JSONArrayToDataSet(AJSONArray, Self, AIgnoredFields, false, AFieldNamePolicy); + finally + Self.EnableControls; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); +begin + AppendFromJSONArrayString(AJSONArrayString, AIgnoredFields, AFieldNamePolicy); +end; + +procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AFieldNamePolicy: TFieldNamePolicy); +begin + AppendFromJSONArrayString(AJSONArrayString, TArray.Create(), AFieldNamePolicy); +end; + +procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); +// var +// JV: TJSONValue; +// lJArr: TJDOJsonArray; +begin + // raise Exception.Create('Not Implemented'); + + // lJArr := TJsonBaseObject.Parse(AJSONArrayString) as TJDOJsonArray; + LoadFromJSONArray(AJSONArrayString, AFieldNamePolicy); + + // JV := TJSONObject.ParseJSONValue(AJSONArrayString); + // try + // if JV is TJSONArray then + // LoadFromJSONArray(TJSONArray(JV), AIgnoredFields, AFieldNamePolicy) + // else + // raise Exception.Create('Expected JSONArray in LoadFromJSONArrayString'); + // finally + // JV.Free; + // end; +end; + +procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string); +begin + AppendFromJSONArrayString(AJSONArrayString, TArray.Create()); +end; + +procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); +begin + raise Exception.Create('Not Implemented'); + // Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false, + // AFieldNamePolicy); +end; + +procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string; + AIgnoredFields: TArray); +var + lSerializer: IMVCSerializer; +begin + lSerializer := TMVCJsonDataObjectsSerializer.Create; + lSerializer.DeserializeDataSetRecord(AJSONObjectString, Self, nil, ncAsIs); + + // JV := TJSONObject.ParseJSONValue(AJSONObjectString); + // try + // if JV is TJSONObject then + // LoadFromJSONObject(TJSONObject(JV), AIgnoredFields) + // else + // raise EMapperException.Create + // ('Extected JSONObject in LoadFromJSONObjectString'); + // finally + // JV.Free; + // end; +end; + +procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; + AFieldNamePolicy: TFieldNamePolicy); +begin + LoadFromJSONObject(AJSONObject, TArray.Create()); +end; + +procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string); +begin + LoadFromJSONObjectString(AJSONObjectString, TArray.Create()); +end; + +{ TDataSetUtils } + +class constructor TDataSetUtils.Create; +begin + TDataSetUtils.CTX := TRttiContext.Create; +end; + +class procedure TDataSetUtils.DataSetToObject(ADataSet: TDataSet; + AObject: TObject); +var + _type: TRttiType; + _fields: TArray; + _field: TRttiProperty; + _attribute: TCustomAttribute; + _dict: TDictionary; + _keys: TDictionary; + mf: MVCColumnAttribute; + field_name: string; + Value: TValue; + FoundAttribute: boolean; + FoundTransientAttribute: boolean; +begin + _dict := TDictionary.Create(); + _keys := TDictionary.Create(); + _type := CTX.GetType(AObject.ClassInfo); + _fields := _type.GetProperties; + for _field in _fields do + begin + FoundAttribute := false; + FoundTransientAttribute := false; + for _attribute in _field.GetAttributes do + begin + if _attribute is MVCColumnAttribute then + begin + FoundAttribute := True; + mf := MVCColumnAttribute(_attribute); + _dict.Add(_field.Name, mf.FieldName); + _keys.Add(_field.Name, mf.IsPK); + end + else if _attribute is MVCDoNotSerializeAttribute then + FoundTransientAttribute := True; + end; + if ((not FoundAttribute) and (not FoundTransientAttribute)) then + begin + _dict.Add(_field.Name, _field.Name); + _keys.Add(_field.Name, false); + end; + end; + for _field in _fields do + begin + if not _dict.TryGetValue(_field.Name, field_name) then + Continue; + case _field.PropertyType.TypeKind of + tkEnumeration: // tristan + begin + if _field.PropertyType.Handle = TypeInfo(boolean) then + begin + case ADataSet.FieldByName(field_name).DataType of + ftInteger, ftSmallint, ftLargeint: + begin + Value := (ADataSet.FieldByName(field_name).AsInteger = 1); + end; + ftBoolean: + begin + Value := ADataSet.FieldByName(field_name).AsBoolean; + end; + else + Continue; + end; + end; + end; + tkInteger: + Value := ADataSet.FieldByName(field_name).AsInteger; + tkInt64: + Value := ADataSet.FieldByName(field_name).AsLargeInt; + tkFloat: + Value := ADataSet.FieldByName(field_name).AsFloat; + tkString: + Value := ADataSet.FieldByName(field_name).AsString; + tkUString, tkWChar, tkLString, tkWString: + Value := ADataSet.FieldByName(field_name).AsWideString; + else + Continue; + end; + _field.SetValue(AObject, Value); + end; + _dict.Free; + _keys.Free; +end; + +class procedure TDataSetUtils.DataSetToObjectList(ADataSet: TDataSet; + AObjectList: TObjectList; ACloseDataSetAfterScroll: boolean); +var + Obj: T; + SavedPosition: TArray; +begin + ADataSet.DisableControls; + try + SavedPosition := ADataSet.Bookmark; + while not ADataSet.Eof do + begin + Obj := T.Create; + DataSetToObject(ADataSet, Obj); + AObjectList.Add(Obj); + ADataSet.Next; + end; + if ADataSet.BookmarkValid(SavedPosition) then + ADataSet.Bookmark := SavedPosition; + finally + ADataSet.EnableControls; + end; + if ACloseDataSetAfterScroll then + ADataSet.Close; +end; + +class destructor TDataSetUtils.Destroy; +begin + CTX.Free; +end; + +end. diff --git a/sources/MVCFramework.FireDAC.Utils.pas b/sources/MVCFramework.FireDAC.Utils.pas new file mode 100644 index 00000000..c61f1010 --- /dev/null +++ b/sources/MVCFramework.FireDAC.Utils.pas @@ -0,0 +1,159 @@ +unit MVCFramework.FireDAC.Utils; + +interface + +uses + FireDAC.Comp.Client, FireDAC.Stan.Param, System.Rtti; + +type + TFireDACUtils = class sealed + private + class var CTX: TRttiContext; + class function InternalExecuteQuery(AQuery: TFDQuery; AObject: TObject; + WithResult: boolean): Int64; + public + class constructor Create; + class destructor Destroy; + class function ExecuteQueryNoResult(AQuery: TFDQuery; + AObject: TObject): Int64; + class procedure ExecuteQuery(AQuery: TFDQuery; AObject: TObject); + class procedure ObjectToParameters(AFDParams: TFDParams; AObject: TObject; AParamPrefix: string = ''); + end; + +implementation + +uses + System.Generics.Collections, + Data.DB, + System.Classes, + MVCFramework.Serializer.Commons, + System.SysUtils; + +{ TFireDACUtils } + +class constructor TFireDACUtils.Create; +begin + TFireDACUtils.CTX := TRttiContext.Create; +end; + +class destructor TFireDACUtils.Destroy; +begin + TFireDACUtils.CTX.Free; +end; + +class procedure TFireDACUtils.ExecuteQuery(AQuery: TFDQuery; AObject: TObject); +begin + InternalExecuteQuery(AQuery, AObject, True); +end; + +class function TFireDACUtils.ExecuteQueryNoResult(AQuery: TFDQuery; + AObject: TObject): Int64; +begin + Result := InternalExecuteQuery(AQuery, AObject, false); +end; + +class procedure TFireDACUtils.ObjectToParameters(AFDParams: TFDParams; + AObject: TObject; AParamPrefix: string); +var + I: Integer; + pname: string; + _rttiType: TRttiType; + obj_fields: TArray; + obj_field: TRttiProperty; + obj_field_attr: MVCColumnAttribute; + Map: TObjectDictionary; + f: TRttiProperty; + fv: TValue; + PrefixLength: Integer; + + function KindToFieldType(AKind: TTypeKind; AProp: TRttiProperty): TFieldType; + begin + case AKind of + tkInteger: + Result := ftInteger; + tkFloat: + begin // daniele teti 2014-05-23 + if AProp.PropertyType.QualifiedName = 'System.TDate' then + Result := ftDate + else if AProp.PropertyType.QualifiedName = 'System.TDateTime' then + Result := ftDateTime + else if AProp.PropertyType.QualifiedName = 'System.TTime' then + Result := ftTime + else + Result := ftFloat; + end; + tkChar, tkString: + Result := ftString; + tkWChar, tkUString, tkLString, tkWString: + Result := ftWideString; + tkVariant: + Result := ftVariant; + tkArray: + Result := ftArray; + tkInterface: + Result := ftInterface; + tkInt64: + Result := ftLongWord; + else + Result := ftUnknown; + end; + end; + +begin + PrefixLength := Length(AParamPrefix); + Map := TObjectDictionary.Create; + try + if Assigned(AObject) then + begin + _rttiType := ctx.GetType(AObject.ClassType); + obj_fields := _rttiType.GetProperties; + for obj_field in obj_fields do + begin + if TMVCSerializerHelpful.HasAttribute(obj_field, obj_field_attr) then + begin + Map.Add(MVCColumnAttribute(obj_field_attr).FieldName.ToLower, + obj_field); + end + else + begin + Map.Add(obj_field.Name.ToLower, obj_field); + end + end; + end; + for I := 0 to AFDParams.Count - 1 do + begin + pname := AFDParams[I].Name.ToLower; + if pname.StartsWith(AParamPrefix, True) then + Delete(pname, 1, PrefixLength); + if Map.TryGetValue(pname, f) then + begin + fv := f.GetValue(AObject); + AFDParams[I].DataType := KindToFieldType(fv.Kind, f); + // DmitryG - 2014-03-28 + AFDParams[I].Value := fv.AsVariant; + end + else + begin + AFDParams[I].Clear; + end; + end; + finally + Map.Free; + end +end; + +class function TFireDACUtils.InternalExecuteQuery(AQuery: TFDQuery; AObject: TObject; + WithResult: boolean): Int64; +begin + ObjectToParameters(AQuery.Params, AObject); + Result := 0; + if WithResult then + AQuery.Open + else + begin + AQuery.ExecSQL; + Result := AQuery.RowsAffected; + end; +end; + +end. diff --git a/sources/MVCFramework.RESTClient.pas b/sources/MVCFramework.RESTClient.pas index 85d843f3..9884885d 100644 --- a/sources/MVCFramework.RESTClient.pas +++ b/sources/MVCFramework.RESTClient.pas @@ -32,16 +32,9 @@ uses System.Classes, IdHTTP, IdURI, - ObjectsMappers, MVCFramework.Commons, - -{$IF CompilerVersion < 27} - Data.DBXJSON, - -{$ELSE} - System.JSON, - -{$ENDIF} + MVCFramework.Serializer.Commons, + MVCFramework.DataSet.Utils, IdMultipartFormData, System.SysUtils, Data.DB, @@ -49,7 +42,7 @@ uses IdCompressorZLib, IdSSLOpenSSL, System.Generics.Collections, - System.StrUtils, Web.HTTPApp, IdCookie; + System.StrUtils, Web.HTTPApp, IdCookie, MVCFramework.Serializer.Intf; type ERESTClientException = class(Exception); @@ -91,9 +84,9 @@ type function Body: TStream; function BodyAsString: string; - function BodyAsJSONValue: TJSONValue; - function BodyAsJSONObject: TJSONObject; - function BodyAsJSONArray: TJSONArray; + // function BodyAsJSONValue: TJSONValue; + // function BodyAsJSONObject: TJSONObject; + // function BodyAsJSONArray: TJSONArray; procedure UpdateResponseCode(const AResponseCode: Word); procedure UpdateResponseText(const AResponseText: string); @@ -120,15 +113,15 @@ type property HasError: Boolean read GetHasError write SetHasError; end; - TJSONObjectResponseHelper = class helper for TJSONObject - public - function AsObject(): T; - end; +// TJSONObjectResponseHelper = class helper for TJSONObject +// public +// function AsObject(): T; +// end; - TJSONArrayResponseHelper = class helper for TJSONArray - public - function AsObjectList(): TObjectList; - end; +// TJSONArrayResponseHelper = class helper for TJSONArray +// public +// function AsObjectList(): TObjectList; +// end; TRESTClient = class(TInterfacedObject) strict private @@ -167,6 +160,8 @@ type procedure SetSessionID(const AValue: string); procedure SetProxyServer(const AValue: string); procedure SetProxyPort(const AValue: Integer); + private + FSerializer: IMVCSerializer; strict protected procedure HandleRequestCookies(); procedure HandleCookies(aCookies: TIdCookies; @@ -229,45 +224,33 @@ type : IRESTResponse; overload; function doPOST(const ABody: string): IRESTResponse; overload; - function doPOST(ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; function doPOST(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload; function doPOST(ABody: TObjectList; const AOwnsBody: Boolean = True): IRESTResponse; overload; - function doPOST(const AResource: string; const AParams: array of string) - : IRESTResponse; overload; - function doPOST(const AResource: string; const AParams: array of string; - ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; - function doPOST(const AResource: string; const AParams: array of string; + function doPOST( + const AResource: string; + const AParams: array of string): IRESTResponse; overload; + function doPOST( + const AResource: string; + const AParams: array of string; const ABody: string): IRESTResponse; overload; function doPATCH(const ABody: string): IRESTResponse; overload; - function doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; function doPATCH(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload; function doPATCH(ABody: TObjectList; const AOwnsBody: Boolean = True): IRESTResponse; overload; - function doPATCH(const AResource: string; const AParams: array of string; - ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; function doPATCH(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; overload; function doPUT(const ABody: string): IRESTResponse; overload; - function doPUT(ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; function doPUT(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload; function doPUT(ABody: TObjectList; const AOwnsBody: Boolean = True): IRESTResponse; overload; function doPUT(const AResource: string; const AParams: array of string) : IRESTResponse; overload; - function doPUT(const AResource: string; const AParams: array of string; - ABody: TJSONValue; const AOwnsBody: Boolean = True) - : IRESTResponse; overload; function doPUT(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; overload; @@ -315,16 +298,18 @@ type implementation - -{$IFNDEF ANDROID OR IOS} -{$IF CompilerVersion > 30} - - uses - System.AnsiStrings; -{$ENDIF} -{$ENDIF} + MVCFramework.Serializer.Defaults + {$IFNDEF ANDROID OR IOS} + {$IF CompilerVersion > 30} + + , System.AnsiStrings + + {$ENDIF} + {$ENDIF} + + ; type TRESTResponse = class(TInterfacedObject, IRESTResponse) @@ -333,7 +318,7 @@ type FResponseCode: Word; FResponseText: string; FHeaders: TStringlist; - FBodyAsJSONValue: TJSONValue; +// FBodyAsJSONValue: TJSONValue; FContentType: string; FContentEncoding: string; function GetHeader(const AValue: string): string; @@ -358,9 +343,9 @@ type function Body(): TStream; function BodyAsString(): string; - function BodyAsJSONValue(): TJSONValue; - function BodyAsJSONObject(): TJSONObject; - function BodyAsJSONArray(): TJSONArray; + // function BodyAsJSONValue(): TJSONValue; + // function BodyAsJSONObject(): TJSONObject; + // function BodyAsJSONArray(): TJSONArray; procedure UpdateResponseCode(const AResponseCode: Word); procedure UpdateResponseText(const AResponseText: string); @@ -389,39 +374,6 @@ begin Result := FBody; end; -function TRESTResponse.BodyAsJSONArray: TJSONArray; -begin - Result := BodyAsJSONValue as TJSONArray; -end; - -function TRESTResponse.BodyAsJSONObject: TJSONObject; -begin - Result := BodyAsJSONValue as TJSONObject; -end; - -function TRESTResponse.BodyAsJSONValue: TJSONValue; -begin - try - if not Assigned(FBodyAsJSONValue) then - begin - if (BodyAsString = '') then - FBodyAsJSONValue := nil - else - begin - try - FBodyAsJSONValue := TJSONObject.ParseJSONValue(BodyAsString); - except - FBodyAsJSONValue := nil; - end; - end; - end; - Result := FBodyAsJSONValue; - except - on E: Exception do - raise ERESTClientException.Create(E.Message); - end; -end; - function TRESTResponse.BodyAsString: string; var ss: TStringStream; @@ -453,14 +405,14 @@ begin FHeaders := TStringlist.Create; FCookies := TIdCookies.Create(nil); FBody := TStringStream.Create('', TEncoding.UTF8); - FBodyAsJSONValue := nil; +// FBodyAsJSONValue := nil; FHasError := False; end; destructor TRESTResponse.Destroy; begin - if Assigned(FBodyAsJSONValue) then - FreeAndNil(FBodyAsJSONValue); +// if Assigned(FBodyAsJSONValue) then +// FreeAndNil(FBodyAsJSONValue); FreeAndNil(FHeaders); FreeAndNil(FBody); FreeAndNil(FCookies); @@ -469,12 +421,16 @@ begin end; function TRESTResponse.Error: TMVCExceptionObj; +var + lSerializer: IMVCSerializer; begin if not FHasError then Exit(nil); if not Assigned(FErrorObject) then begin - FErrorObject := Mapper.JSONObjectToObject(self.BodyAsJSONObject); + FErrorObject := TMVCExceptionObj.Create; + lSerializer := GetDefaultSerializer; + lSerializer.DeserializeObject(Self.BodyAsString, FErrorObject); end; Result := FErrorObject; end; @@ -613,17 +569,28 @@ end; { TJSONObjectResponseHelper } -function TJSONObjectResponseHelper.AsObject: T; -begin - Result := Mapper.JSONObjectToObject(self); -end; +//function TJSONObjectResponseHelper.AsObject: T; +//var +// lSerializer: IMVCSerializer; +//begin +// lSerializer := GetDefaultSerializer; +// Result := T.Create; +// try +// lSerializer.DeserializeObject(Self.ToJSON, Result); +// except +// FreeAndNil(Result); +// raise; +// end; +// // Result := Mapper.JSONObjectToObject(self); +//end; { TJSONArrayResponseHelper } -function TJSONArrayResponseHelper.AsObjectList: TObjectList; -begin - Result := Mapper.JSONArrayToObjectList(self, False, True); -end; +//function TJSONArrayResponseHelper.AsObjectList: TObjectList; +//begin +// raise Exception.Create('Not Implemented'); +// // Result := Mapper.JSONArrayToObjectList(self, False, True); +//end; { TRESTClient } @@ -716,10 +683,14 @@ begin begin if (FHTTP.Compressor <> nil) then begin -{$HINTS OFF} + + {$HINTS OFF} + FHTTP.Compressor.Free; FHTTP.Compressor := nil; -{$HINTS ON} + + {$HINTS ON} + end; end; Result := self; @@ -819,6 +790,8 @@ begin FHTTP.HandleRedirects := True; FHTTP.Request.CustomHeaders.FoldLines := False; FHTTP.Request.BasicAuthentication := True; + + FSerializer := GetDefaultSerializer; end; function TRESTClient.DataSetDelete(const AResource, AKeyValue: string) @@ -827,16 +800,15 @@ begin Result := doDELETE(AResource, [AKeyValue]); end; -function TRESTClient.DataSetInsert(const AResource: string; ADataSet: TDataSet) - : IRESTResponse; +function TRESTClient.DataSetInsert(const AResource: string; ADataSet: TDataSet): IRESTResponse; begin - Result := doPOST(AResource, [], ADataSet.AsJSONObjectString); + Result := doPOST(AResource, [], ADataSet.AsJSONObject); end; function TRESTClient.DataSetUpdate(const AResource: string; ADataSet: TDataSet; const AKeyValue: string): IRESTResponse; begin - Result := doPUT(AResource, [AKeyValue], ADataSet.AsJSONObjectString); + Result := doPUT(AResource, [AKeyValue], ADataSet.AsJSONObject); end; destructor TRESTClient.Destroy; @@ -935,52 +907,6 @@ begin ClearAllParams; end; -function TRESTClient.doPOST(const AResource: string; - const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if not Assigned(ABody) then - raise ERESTClientException.Create('ABody is nil JSONValue'); - - try - Result := doPOST(AResource, AParams, - -{$IF CompilerVersion >= 28} - ABody.ToJSON - -{$ELSE} - ABody.ToString - -{$ENDIF}); - finally - if AOwnsBody then - FreeAndNil(ABody); - end; -end; - -function TRESTClient.doPATCH(const AResource: string; - const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if not Assigned(ABody) then - raise ERESTClientException.Create('ABody is nil JSONValue'); - - try - Result := doPATCH(AResource, AParams, - -{$IF CompilerVersion >= 28} - ABody.ToJSON - -{$ELSE} - ABody.ToString - -{$ENDIF}); - finally - if AOwnsBody then - FreeAndNil(ABody); - end; -end; - function TRESTClient.doPATCH(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; var @@ -1013,18 +939,6 @@ begin Result := doPATCH(FResource, FParams, ABody); end; -function TRESTClient.doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if (FResource = '') then - raise ERESTClientException.Create('You must enter the Resource!'); - - if not Assigned(ABody) then - raise ERESTClientException.Create('You must enter the Body!'); - - Result := doPATCH(FResource, FParams, ABody, AOwnsBody); -end; - function TRESTClient.doPATCH(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse; begin @@ -1034,8 +948,7 @@ begin if not Assigned(ABody) then raise ERESTClientException.Create('You must enter the Body!'); - Result := doPATCH(FResource, FParams, Mapper.ObjectToJSONObject(ABody) - as TJSONValue, True); + Result := doPATCH(FResource, FParams, FSerializer.SerializeObject(ABody)); if AOwnsBody then TObject(ABody).Free; @@ -1051,9 +964,7 @@ begin raise ERESTClientException.Create('You must enter the Body!'); ABody.OwnsObjects := AOwnsBody; - - Result := doPATCH(FResource, FParams, Mapper.ObjectListToJSONArray - (ABody, AOwnsBody) as TJSONValue, True); + Result := doPATCH(FResource, FParams, FSerializer.SerializeCollection(ABody)); end; function TRESTClient.doPOST(const AResource: string; @@ -1093,18 +1004,6 @@ begin Result := doPOST(FResource, FParams, ABody); end; -function TRESTClient.doPOST(ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if (FResource = '') then - raise ERESTClientException.Create('You must enter the Resource!'); - - if not Assigned(ABody) then - raise ERESTClientException.Create('You must enter the Body!'); - - Result := doPOST(FResource, FParams, ABody, AOwnsBody); -end; - function TRESTClient.doPOST(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse; begin @@ -1114,8 +1013,7 @@ begin if not Assigned(ABody) then raise ERESTClientException.Create('You must enter the Body!'); - Result := doPOST(FResource, FParams, Mapper.ObjectToJSONObject(ABody) - as TJSONValue, True); + Result := doPOST(FResource, FParams, FSerializer.SerializeObject(ABody)); if AOwnsBody then TObject(ABody).Free; @@ -1132,8 +1030,7 @@ begin ABody.OwnsObjects := AOwnsBody; - Result := doPOST(FResource, FParams, Mapper.ObjectListToJSONArray - (ABody, AOwnsBody) as TJSONValue, True); + Result := doPOST(FResource, FParams, FSerializer.SerializeCollection(ABody)); end; function TRESTClient.doPUT(const AResource: string; @@ -1146,29 +1043,6 @@ begin ClearAllParams; end; -function TRESTClient.doPUT(const AResource: string; - const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if not Assigned(ABody) then - raise ERESTClientException.Create('ABody is nil JSONValue'); - - try - Result := doPUT(AResource, AParams, - -{$IF CompilerVersion >= 28} - ABody.ToJSON - -{$ELSE} - ABody.ToString - -{$ENDIF}); - finally - if AOwnsBody then - FreeAndNil(ABody); - end; -end; - function TRESTClient.doPUT(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; var @@ -1201,18 +1075,6 @@ begin Result := doPUT(FResource, FParams, ABody); end; -function TRESTClient.doPUT(ABody: TJSONValue; const AOwnsBody: Boolean) - : IRESTResponse; -begin - if (FResource = '') then - raise ERESTClientException.Create('You must enter the Resource!'); - - if not Assigned(ABody) then - raise ERESTClientException.Create('You must enter the Body!'); - - Result := doPUT(FResource, FParams, ABody, AOwnsBody); -end; - function TRESTClient.doPUT(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse; begin @@ -1222,8 +1084,7 @@ begin if not Assigned(ABody) then raise ERESTClientException.Create('You must enter the Body!'); - Result := doPUT(FResource, FParams, Mapper.ObjectToJSONObject(ABody) - as TJSONValue, True); + Result := doPUT(FResource, FParams, FSerializer.SerializeObject(ABody)); if AOwnsBody then TObject(ABody).Free; @@ -1240,8 +1101,7 @@ begin ABody.OwnsObjects := AOwnsBody; - Result := doPUT(FResource, FParams, Mapper.ObjectListToJSONArray - (ABody, AOwnsBody) as TJSONValue, True); + Result := doPUT(FResource, FParams, FSerializer.SerializeCollection(ABody)); end; function TRESTClient.DSDelete(const AResource, AKeyValue: string) @@ -1529,11 +1389,17 @@ begin begin Result.HasError := True; Result.Body.Write(UTF8Encode(E.ErrorMessage)[1], -{$IF CompilerVersion > 30} + + {$IF CompilerVersion > 30} + ElementToCharLen(string(UTF8Encode(E.ErrorMessage)), -{$ELSE} + + {$ELSE} + ElementToCharLen(UTF8Encode(E.ErrorMessage), -{$ENDIF} + + {$ENDIF} + Length(E.ErrorMessage) * 2)); end else @@ -1637,11 +1503,17 @@ begin begin Result.HasError := True; Result.Body.Write(UTF8Encode(E.ErrorMessage)[1], -{$IF CompilerVersion > 30} + + {$IF CompilerVersion > 30} + ElementToCharLen(string(UTF8Encode(E.ErrorMessage)), -{$ELSE} + + {$ELSE} + ElementToCharLen(UTF8Encode(E.ErrorMessage), -{$ENDIF} + + {$ENDIF} + Length(E.ErrorMessage) * 2)); end else @@ -1698,10 +1570,14 @@ begin begin if (FHTTP.IOHandler <> nil) then begin -{$HINTS OFF} + + {$HINTS OFF} + FHTTP.IOHandler.Free; FHTTP.IOHandler := nil; -{$HINTS ON} + + {$HINTS ON} + end; end; Result := self; diff --git a/sources/MVCFramework.Serializer.Commons.pas b/sources/MVCFramework.Serializer.Commons.pas index 81178994..caad7c4b 100644 --- a/sources/MVCFramework.Serializer.Commons.pas +++ b/sources/MVCFramework.Serializer.Commons.pas @@ -161,6 +161,18 @@ type property SerializationType: TMVCSerializationType read FSerializationType; end; + MVCColumnAttribute = class(TCustomAttribute) + private + FFieldName: string; + FIsPK: boolean; + procedure SetFieldName(const Value: string); + procedure SetIsPK(const Value: boolean); + public + constructor Create(AFieldName: string; AIsPK: boolean = false); + property FieldName: string read FFieldName write SetFieldName; + property IsPK: boolean read FIsPK write SetIsPK; + end; + TMVCSerializerHelpful = record private { private declarations } @@ -560,4 +572,23 @@ begin FSerializationType := ASerializationType; end; +{ MVCColumnAttribute } + +constructor MVCColumnAttribute.Create(AFieldName: string; AIsPK: boolean); +begin + inherited Create; + FFieldName := AFieldName; + FIsPK := AIsPK; +end; + +procedure MVCColumnAttribute.SetFieldName(const Value: string); +begin + FFieldName := Value; +end; + +procedure MVCColumnAttribute.SetIsPK(const Value: boolean); +begin + FIsPK := Value; +end; + end. diff --git a/sources/MVCFramework.Serializer.Defaults.pas b/sources/MVCFramework.Serializer.Defaults.pas new file mode 100644 index 00000000..2d56ceb0 --- /dev/null +++ b/sources/MVCFramework.Serializer.Defaults.pas @@ -0,0 +1,20 @@ +unit MVCFramework.Serializer.Defaults; + +interface + +uses + MVCFramework.Serializer.Intf; + +function GetDefaultSerializer: IMVCSerializer; + +implementation + +uses + MVCFramework.Serializer.JsonDataObjects; + +function GetDefaultSerializer: IMVCSerializer; +begin + Result := TMVCJsonDataObjectsSerializer.Create; +end; + +end. diff --git a/sources/ObjectsMappers.pas b/sources/ObjectsMappers.pas index de7a3966..7cd79272 100644 --- a/sources/ObjectsMappers.pas +++ b/sources/ObjectsMappers.pas @@ -272,40 +272,6 @@ type PropertyName: string): boolean; end; - TDataSetHelper = class helper for TDataSet - public - function AsJSONArray: TJSONArray; - function AsJSONArrayString: string; - function AsJSONObject(AReturnNilIfEOF: boolean = false; - AFieldNamePolicy: TFieldNamePolicy = fpLowerCase): TJSONObject; - function AsJSONObjectString(AReturnEmptyStringIfEOF - : boolean = false): string; - procedure LoadFromJSONObject(AJSONObject: TJSONObject; - AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; - procedure LoadFromJSONObject(AJSONObject: TJSONObject; - AIgnoredFields: TArray; - AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; - procedure LoadFromJSONArray(AJSONArray: TJSONArray; - AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy. - fpLowerCase); overload; - procedure LoadFromJSONArrayString(AJSONArrayString: string; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; - procedure LoadFromJSONArrayString(AJSONArrayString: string; - AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; - procedure LoadFromJSONArray(AJSONArray: TJSONArray; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; - procedure LoadFromJSONObjectString(AJSONObjectString: string); overload; - procedure LoadFromJSONObjectString(AJSONObjectString: string; - AIgnoredFields: TArray); overload; - procedure AppendFromJSONArrayString(AJSONArrayString: string); overload; - procedure AppendFromJSONArrayString(AJSONArrayString: string; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; - function AsObjectList(CloseAfterScroll - : boolean = false): TObjectList; - function AsObject(CloseAfterScroll - : boolean = false): T; - end; - MapperTransientAttribute = class(TCustomAttribute) end; @@ -382,7 +348,7 @@ type property name: string read GetName; end; - MapperColumnAttribute = class(TCustomAttribute) + MapperColumnAttribute_DEPRECATED = class(TCustomAttribute) private FFieldName: string; FIsPK: boolean; @@ -522,7 +488,7 @@ var _rttiType: TRttiType; obj_fields: TArray; obj_field: TRttiProperty; - obj_field_attr: MapperColumnAttribute; + obj_field_attr: MapperColumnAttribute_DEPRECATED; Map: TObjectDictionary; f: TRttiProperty; fv: TValue; @@ -535,9 +501,9 @@ begin obj_fields := _rttiType.GetProperties; for obj_field in obj_fields do begin - if HasAttribute(obj_field, obj_field_attr) then + if HasAttribute(obj_field, obj_field_attr) then begin - Map.Add(MapperColumnAttribute(obj_field_attr).FieldName, obj_field); + Map.Add(MapperColumnAttribute_DEPRECATED(obj_field_attr).FieldName, obj_field); end else begin @@ -660,10 +626,10 @@ var _type: TRttiType; _fields: TArray; _field: TRttiProperty; - _attribute: MapperColumnAttribute; + _attribute: MapperColumnAttribute_DEPRECATED; _dict: TDictionary; _keys: TDictionary; - mf: MapperColumnAttribute; + mf: MapperColumnAttribute_DEPRECATED; field_name: string; Value: TValue; ts: TTimeStamp; @@ -674,7 +640,7 @@ begin _type := ctx.GetType(AObject.ClassInfo); _fields := _type.GetProperties; for _field in _fields do - if HasAttribute(_field, _attribute) then + if HasAttribute(_field, _attribute) then begin mf := _attribute; _dict.Add(_field.Name, mf.FieldName); @@ -903,7 +869,7 @@ var _attribute: TCustomAttribute; _dict: TDictionary; _keys: TDictionary; - mf: MapperColumnAttribute; + mf: MapperColumnAttribute_DEPRECATED; field_name: string; Value: TValue; FoundAttribute: boolean; @@ -919,10 +885,10 @@ begin FoundTransientAttribute := false; for _attribute in _field.GetAttributes do begin - if _attribute is MapperColumnAttribute then + if _attribute is MapperColumnAttribute_DEPRECATED then begin FoundAttribute := True; - mf := MapperColumnAttribute(_attribute); + mf := MapperColumnAttribute_DEPRECATED(_attribute); _dict.Add(_field.Name, mf.FieldName); _keys.Add(_field.Name, mf.IsPK); end @@ -2835,7 +2801,7 @@ var _rttiType: TRttiType; obj_fields: TArray; obj_field: TRttiProperty; - obj_field_attr: MapperColumnAttribute; + obj_field_attr: MapperColumnAttribute_DEPRECATED; Map: TObjectDictionary; f: TRttiProperty; fv: TValue; @@ -2884,9 +2850,9 @@ begin obj_fields := _rttiType.GetProperties; for obj_field in obj_fields do begin - if HasAttribute(obj_field, obj_field_attr) then + if HasAttribute(obj_field, obj_field_attr) then begin - Map.Add(MapperColumnAttribute(obj_field_attr).FieldName.ToLower, + Map.Add(MapperColumnAttribute_DEPRECATED(obj_field_attr).FieldName.ToLower, obj_field); end else @@ -2968,19 +2934,19 @@ end; { MappedField } -constructor MapperColumnAttribute.Create(AFieldName: string; AIsPK: boolean); +constructor MapperColumnAttribute_DEPRECATED.Create(AFieldName: string; AIsPK: boolean); begin inherited Create; FFieldName := AFieldName; FIsPK := AIsPK; end; -procedure MapperColumnAttribute.SetFieldName(const Value: string); +procedure MapperColumnAttribute_DEPRECATED.SetFieldName(const Value: string); begin FFieldName := Value; end; -procedure MapperColumnAttribute.SetIsPK(const Value: boolean); +procedure MapperColumnAttribute_DEPRECATED.SetIsPK(const Value: boolean); begin FIsPK := Value; end; @@ -3038,207 +3004,7 @@ begin end; { TDataSetHelper } - -function TDataSetHelper.AsJSONArray: TJSONArray; -var - JArr: TJSONArray; -begin - - JArr := TJSONArray.Create; - try - if not Eof then - Mapper.DataSetToJSONArray(Self, JArr, false); - Result := JArr; - except - FreeAndNil(JArr); - raise; - end; -end; - -function TDataSetHelper.AsJSONArrayString: string; -var - Arr: TJSONArray; -begin - Arr := AsJSONArray; - try - { .$IFDEF TOJSON } - Result := Arr.ToJSON; - { .$ELSE } - // Result := Arr.ToString; - { .$IFEND } - finally - Arr.Free; - end; -end; - -function TDataSetHelper.AsJSONObject(AReturnNilIfEOF: boolean; - AFieldNamePolicy: TFieldNamePolicy): TJSONObject; -var - JObj: TJSONObject; -begin - JObj := TJSONObject.Create; - try - Mapper.DataSetToJSONObject(Self, JObj, false); - if AReturnNilIfEOF and (JObj.Size = 0) then - FreeAndNil(JObj); - Result := JObj; - except - FreeAndNil(JObj); - raise; - end; -end; - -function TDataSetHelper.AsJSONObjectString(AReturnEmptyStringIfEOF - : boolean): string; -var - JObj: TJSONObject; -begin - JObj := AsJSONObject(True); - if not Assigned(JObj) then - begin - if AReturnEmptyStringIfEOF then - Result := '' - else - Result := '{}'; - end - else - try - { .$IFDEF TOJSON } - Result := JObj.ToJSON; - { .$ELSE } - // Result := JObj.ToString - { .$IFEND } - finally - JObj.Free; - end; -end; - -function TDataSetHelper.AsObject(CloseAfterScroll: boolean): T; -var - Obj: T; -begin - if not Self.Eof then - begin - Obj := T.Create; - try - Mapper.DataSetToObject(Self, Obj); - Result := Obj; - except - FreeAndNil(Obj); - raise; - end; - end - else - Result := nil; -end; - -function TDataSetHelper.AsObjectList(CloseAfterScroll: boolean) - : TObjectList; -var - Objs: TObjectList; -begin - Objs := TObjectList.Create(True); - try - Mapper.DataSetToObjectList(Self, Objs, CloseAfterScroll); - Result := Objs; - except - FreeAndNil(Objs); - raise; - end; -end; - -procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; - AFieldNamePolicy: TFieldNamePolicy); -begin - Self.DisableControls; - try - Mapper.JSONArrayToDataSet(AJSONArray, Self, TArray.Create(), false, - AFieldNamePolicy); - finally - Self.EnableControls; - end; -end; - -procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); -begin - Self.DisableControls; - try - Mapper.JSONArrayToDataSet(AJSONArray, Self, AIgnoredFields, false, AFieldNamePolicy); - finally - Self.EnableControls; - end; -end; - -procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); -begin - AppendFromJSONArrayString(AJSONArrayString, AIgnoredFields, AFieldNamePolicy); -end; - -procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AFieldNamePolicy: TFieldNamePolicy); -begin - AppendFromJSONArrayString(AJSONArrayString, TArray.Create(), AFieldNamePolicy); -end; - -procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); -var - JV: TJSONValue; -begin - JV := TJSONObject.ParseJSONValue(AJSONArrayString); - try - if JV is TJSONArray then - LoadFromJSONArray(TJSONArray(JV), AIgnoredFields, AFieldNamePolicy) - else - raise EMapperException.Create - ('Expected JSONArray in LoadFromJSONArrayString'); - finally - JV.Free; - end; -end; - -procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string); -begin - AppendFromJSONArrayString(AJSONArrayString, TArray.Create()); -end; - -procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; - AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); -begin - Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false, - AFieldNamePolicy); -end; - -procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string; - AIgnoredFields: TArray); -var - JV: TJSONValue; -begin - JV := TJSONObject.ParseJSONValue(AJSONObjectString); - try - if JV is TJSONObject then - LoadFromJSONObject(TJSONObject(JV), AIgnoredFields) - else - raise EMapperException.Create - ('Extected JSONObject in LoadFromJSONObjectString'); - finally - JV.Free; - end; -end; - -procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; - AFieldNamePolicy: TFieldNamePolicy); -begin - LoadFromJSONObject(AJSONObject, TArray.Create()); -end; - -procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string); -begin - LoadFromJSONObjectString(AJSONObjectString, TArray.Create()); -end; - - { MapperSerializeAsString } +{ MapperSerializeAsString } constructor MapperSerializeAsString.Create(aEncoding: string); begin diff --git a/unittests/general/Several/DMVCFrameworkTests.dproj b/unittests/general/Several/DMVCFrameworkTests.dproj index f377319a..be132b77 100644 --- a/unittests/general/Several/DMVCFrameworkTests.dproj +++ b/unittests/general/Several/DMVCFrameworkTests.dproj @@ -4,7 +4,7 @@ 18.2 VCL True - SERVER_ON_LINUX + Debug Win32 1 Console diff --git a/unittests/general/Several/FrameworkTestsU.pas b/unittests/general/Several/FrameworkTestsU.pas index 785e1ac1..e869189a 100644 --- a/unittests/general/Several/FrameworkTestsU.pas +++ b/unittests/general/Several/FrameworkTestsU.pas @@ -53,12 +53,12 @@ type procedure TestSerializeUsingFieldsWithNotExixtentPropetyInJSONObject; procedure TestComplexObjectToJSONObjectAndBack; procedure TestComplexObjectToJSONObjectAndBackWithNilReference; - procedure TestDataSetToJSONObject; - procedure TestDataSetToJSONObjectWithNulls; - procedure TestDataSetToJSONObjectFieldPolicyLowerCase; - procedure TestDataSetToJSONObjectFieldPolicyUpperCase; - procedure TestDataSetToJSONObjectFieldPolicyAsIsCase; - procedure TestDataSetToJSONArray; +// procedure TestDataSetToJSONObject; +// procedure TestDataSetToJSONObjectWithNulls; +// procedure TestDataSetToJSONObjectFieldPolicyLowerCase; +// procedure TestDataSetToJSONObjectFieldPolicyUpperCase; +// procedure TestDataSetToJSONObjectFieldPolicyAsIsCase; +// procedure TestDataSetToJSONArray; procedure TestObjectToJSONObjectAndBackWithStringStreamUTF16; procedure TestObjectToJSONObjectAndBackWithStringStreamUTF8; procedure TestObjectToJSONObjectAndBackWithStream; @@ -379,191 +379,191 @@ begin end; end; -procedure TTestMappers.TestDataSetToJSONArray; -var - ds: TClientDataSet; - JObj: TJSONObject; - ds2: TClientDataSet; - JArr: TJSONArray; -begin - ds := TClientDataSet.Create(nil); - ds2 := TClientDataSet.Create(nil); - try - ds.LoadFromFile('..\..\fishes.xml'); - ds.First; - // JArr := TJSONArray.Create; - JArr := ds.AsJSONArray; - try - // Mapper.DataSetToJSONArray(ds, JArr, false); - ds2.LoadFromFile('..\..\fishes.xml'); - ds2.EmptyDataSet; - ds.First; - while not ds.Eof do - begin - ds2.Insert; - JObj := JArr.Get(ds.RecNo - 1) as TJSONObject; - ds2.LoadFromJSONObject(JObj); - // Mapper.JSONObjectToDataSet(JObj, ds2, false); - ds2.Post; - SameFishesDataSet(ds, ds2); - ds.Next; - end; - finally - JArr.Free; - end; - finally - ds.Free; - ds2.Free; - end; -end; +//procedure TTestMappers.TestDataSetToJSONArray; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +// ds2: TClientDataSet; +// JArr: TJSONArray; +//begin +// ds := TClientDataSet.Create(nil); +// ds2 := TClientDataSet.Create(nil); +// try +// ds.LoadFromFile('..\..\fishes.xml'); +// ds.First; +// // JArr := TJSONArray.Create; +// JArr := ds.AsJSONArray; +// try +// // Mapper.DataSetToJSONArray(ds, JArr, false); +// ds2.LoadFromFile('..\..\fishes.xml'); +// ds2.EmptyDataSet; +// ds.First; +// while not ds.Eof do +// begin +// ds2.Insert; +// JObj := JArr.Get(ds.RecNo - 1) as TJSONObject; +// ds2.LoadFromJSONObject(JObj); +// // Mapper.JSONObjectToDataSet(JObj, ds2, false); +// ds2.Post; +// SameFishesDataSet(ds, ds2); +// ds.Next; +// end; +// finally +// JArr.Free; +// end; +// finally +// ds.Free; +// ds2.Free; +// end; +//end; -procedure TTestMappers.TestDataSetToJSONObject; -var - ds: TClientDataSet; - JObj: TJSONObject; - ds2: TClientDataSet; -begin - ds := TClientDataSet.Create(nil); - ds2 := TClientDataSet.Create(nil); - try - ds.LoadFromFile('..\..\fishes.xml'); - JObj := ds.AsJSONObject; - try - ds2.LoadFromFile('..\..\fishes.xml'); - ds2.EmptyDataSet; - ds2.Insert; - ds2.LoadFromJSONObject(JObj); - ds2.Post; - SameFishesDataSet(ds, ds2); - finally - JObj.Free; - end; - finally - ds.Free; - ds2.Free; - end; -end; +//procedure TTestMappers.TestDataSetToJSONObject; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +// ds2: TClientDataSet; +//begin +// ds := TClientDataSet.Create(nil); +// ds2 := TClientDataSet.Create(nil); +// try +// ds.LoadFromFile('..\..\fishes.xml'); +// JObj := ds.AsJSONObject; +// try +// ds2.LoadFromFile('..\..\fishes.xml'); +// ds2.EmptyDataSet; +// ds2.Insert; +// ds2.LoadFromJSONObject(JObj); +// ds2.Post; +// SameFishesDataSet(ds, ds2); +// finally +// JObj.Free; +// end; +// finally +// ds.Free; +// ds2.Free; +// end; +//end; -procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyAsIsCase; -var - ds: TClientDataSet; - JObj: TJSONObject; - ds2: TClientDataSet; -begin - ds := TClientDataSet.Create(nil); - ds2 := TClientDataSet.Create(nil); - try - ds.LoadFromFile('..\..\fishes.xml'); - JObj := ds.AsJSONObject(false, fpAsIs); - try - ds2.LoadFromFile('..\..\fishes.xml'); - ds2.EmptyDataSet; - ds2.Insert; - ds2.LoadFromJSONObject(JObj, fpAsIs); - ds2.Post; - SameFishesDataSet(ds, ds2); - finally - JObj.Free; - end; - finally - ds.Free; - ds2.Free; - end; -end; +//procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyAsIsCase; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +// ds2: TClientDataSet; +//begin +// ds := TClientDataSet.Create(nil); +// ds2 := TClientDataSet.Create(nil); +// try +// ds.LoadFromFile('..\..\fishes.xml'); +// JObj := ds.AsJSONObject(false, fpAsIs); +// try +// ds2.LoadFromFile('..\..\fishes.xml'); +// ds2.EmptyDataSet; +// ds2.Insert; +// ds2.LoadFromJSONObject(JObj, fpAsIs); +// ds2.Post; +// SameFishesDataSet(ds, ds2); +// finally +// JObj.Free; +// end; +// finally +// ds.Free; +// ds2.Free; +// end; +//end; -procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyLowerCase; -var - ds: TClientDataSet; - JObj: TJSONObject; - ds2: TClientDataSet; -begin - ds := TClientDataSet.Create(nil); - ds2 := TClientDataSet.Create(nil); - try - ds.LoadFromFile('..\..\fishes.xml'); - JObj := ds.AsJSONObject(false, fpLowerCase); - try - ds2.LoadFromFile('..\..\fishes.xml'); - ds2.EmptyDataSet; - ds2.Insert; - ds2.LoadFromJSONObject(JObj, fpLowerCase); - ds2.Post; - SameFishesDataSet(ds, ds2); - finally - JObj.Free; - end; - finally - ds.Free; - ds2.Free; - end; -end; +//procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyLowerCase; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +// ds2: TClientDataSet; +//begin +// ds := TClientDataSet.Create(nil); +// ds2 := TClientDataSet.Create(nil); +// try +// ds.LoadFromFile('..\..\fishes.xml'); +// JObj := ds.AsJSONObject(false, fpLowerCase); +// try +// ds2.LoadFromFile('..\..\fishes.xml'); +// ds2.EmptyDataSet; +// ds2.Insert; +// ds2.LoadFromJSONObject(JObj, fpLowerCase); +// ds2.Post; +// SameFishesDataSet(ds, ds2); +// finally +// JObj.Free; +// end; +// finally +// ds.Free; +// ds2.Free; +// end; +//end; +// +//procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyUpperCase; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +// ds2: TClientDataSet; +//begin +// ds := TClientDataSet.Create(nil); +// ds2 := TClientDataSet.Create(nil); +// try +// ds.LoadFromFile('..\..\fishes.xml'); +// JObj := ds.AsJSONObject(false, fpUpperCase); +// try +// ds2.LoadFromFile('..\..\fishes.xml'); +// ds2.EmptyDataSet; +// ds2.Insert; +// ds2.LoadFromJSONObject(JObj, fpUpperCase); +// ds2.Post; +// SameFishesDataSet(ds, ds2); +// finally +// JObj.Free; +// end; +// finally +// ds.Free; +// ds2.Free; +// end; +//end; -procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyUpperCase; -var - ds: TClientDataSet; - JObj: TJSONObject; - ds2: TClientDataSet; -begin - ds := TClientDataSet.Create(nil); - ds2 := TClientDataSet.Create(nil); - try - ds.LoadFromFile('..\..\fishes.xml'); - JObj := ds.AsJSONObject(false, fpUpperCase); - try - ds2.LoadFromFile('..\..\fishes.xml'); - ds2.EmptyDataSet; - ds2.Insert; - ds2.LoadFromJSONObject(JObj, fpUpperCase); - ds2.Post; - SameFishesDataSet(ds, ds2); - finally - JObj.Free; - end; - finally - ds.Free; - ds2.Free; - end; -end; - -procedure TTestMappers.TestDataSetToJSONObjectWithNulls; -var - ds: TClientDataSet; - JObj: TJSONObject; -begin - ds := TClientDataSet.Create(nil); - try - ds.FieldDefs.Add('string_value', ftString, 50); - ds.FieldDefs.Add('integer_value', ftInteger); - ds.FieldDefs.Add('float_value', ftFloat); - ds.FieldDefs.Add('null_value', ftString, 50); - ds.FieldDefs.Add('boolean_value', ftBoolean); - ds.CreateDataSet; - ds.Insert; - ds.FieldByName('string_value').AsString := 'myStringValue'; - ds.FieldByName('integer_value').AsInteger := 123; - ds.FieldByName('float_value').AsFloat := 123.456; - ds.FieldByName('null_value').Clear; - ds.FieldByName('boolean_value').AsBoolean := true; - ds.Post; - JObj := ds.AsJSONObject; - try - CheckEquals('myStringValue', JObj.Values['string_value'].Value); - CheckEquals(123, JObj.Values['integer_value'].GetValue().AsInt); - CheckEquals(123.456, JObj.Values['float_value'].GetValue().AsDouble, 0.0009); - CheckTrue(JObj.Values['null_value'].GetValue().Null); - CheckEquals(true, JObj.Values['boolean_value'].GetValue().AsBoolean); - CheckTrue(JObj.ToJSON.Replace(' ', '').Contains('"null_value":null')); - ds.Insert; - ds.LoadFromJSONObject(JObj); - ds.Post; - CheckTrue(ds.FieldByName('null_value').IsNull); - finally - JObj.Free; - end; - finally - ds.Free; - end; -end; +//procedure TTestMappers.TestDataSetToJSONObjectWithNulls; +//var +// ds: TClientDataSet; +// JObj: TJSONObject; +//begin +// ds := TClientDataSet.Create(nil); +// try +// ds.FieldDefs.Add('string_value', ftString, 50); +// ds.FieldDefs.Add('integer_value', ftInteger); +// ds.FieldDefs.Add('float_value', ftFloat); +// ds.FieldDefs.Add('null_value', ftString, 50); +// ds.FieldDefs.Add('boolean_value', ftBoolean); +// ds.CreateDataSet; +// ds.Insert; +// ds.FieldByName('string_value').AsString := 'myStringValue'; +// ds.FieldByName('integer_value').AsInteger := 123; +// ds.FieldByName('float_value').AsFloat := 123.456; +// ds.FieldByName('null_value').Clear; +// ds.FieldByName('boolean_value').AsBoolean := true; +// ds.Post; +// JObj := ds.AsJSONObject; +// try +// CheckEquals('myStringValue', JObj.Values['string_value'].Value); +// CheckEquals(123, JObj.Values['integer_value'].GetValue().AsInt); +// CheckEquals(123.456, JObj.Values['float_value'].GetValue().AsDouble, 0.0009); +// CheckTrue(JObj.Values['null_value'].GetValue().Null); +// CheckEquals(true, JObj.Values['boolean_value'].GetValue().AsBoolean); +// CheckTrue(JObj.ToJSON.Replace(' ', '').Contains('"null_value":null')); +// ds.Insert; +// ds.LoadFromJSONObject(JObj); +// ds.Post; +// CheckTrue(ds.FieldByName('null_value').IsNull); +// finally +// JObj.Free; +// end; +// finally +// ds.Free; +// end; +//end; procedure TTestMappers.TestJSONArrayToObjectListNoGenerics; var diff --git a/unittests/general/Several/LiveServerTestU.pas b/unittests/general/Several/LiveServerTestU.pas index 2593cf60..ef2a36d6 100644 --- a/unittests/general/Several/LiveServerTestU.pas +++ b/unittests/general/Several/LiveServerTestU.pas @@ -212,6 +212,7 @@ begin procedure(Response: IRESTResponse) begin try + { TODO -oDaniele -cGeneral : Crea una unit con i metodi che mancano } j := Response.BodyAsJsonObject.Clone as TJSONObject; except // test should not block...never! diff --git a/unittests/general/TestServer/TestServer.dpr b/unittests/general/TestServer/TestServer.dpr index 329e55f0..ad73fb4a 100644 --- a/unittests/general/TestServer/TestServer.dpr +++ b/unittests/general/TestServer/TestServer.dpr @@ -7,6 +7,9 @@ uses System.SysUtils, IdHTTPWebBrokerBridge, Web.WebReq, + {$IFNDEF LINUX} + Winapi.Windows, + {$ENDIF} Web.WebBroker, MVCFramework.Commons, WebModuleUnit in 'WebModuleUnit.pas' {bas: TWebModule} , diff --git a/unittests/general/TestServer/TestServer.dproj b/unittests/general/TestServer/TestServer.dproj index 49dde5b0..6f37fdeb 100644 --- a/unittests/general/TestServer/TestServer.dproj +++ b/unittests/general/TestServer/TestServer.dproj @@ -6,7 +6,7 @@ TestServer.dpr True Debug - Linux64 + Win32 129 Console