From 6bdf5547bc6f2184b2e09fb6f8f0a0853f2651f0 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Thu, 10 Oct 2019 20:16:20 +0200 Subject: [PATCH] Added ToMVCList to wrap any object and try to use as list --- README.md | 3 +- samples/commons/BusinessObjectsU.pas | 78 ++++- samples/renders/InMemoryDataU.pas | 18 ++ samples/renders/RenderSampleControllerU.pas | 77 ++--- samples/renders/renders.dproj | 302 +++++++++++++++++- sources/MVCFramework.Console.pas | 42 ++- sources/MVCFramework.DuckTyping.pas | 11 +- ...VCFramework.Serializer.JsonDataObjects.pas | 10 +- sources/MVCFramework.pas | 6 + 9 files changed, 460 insertions(+), 87 deletions(-) diff --git a/README.md b/README.md index 4618a64b..450a28b5 100644 --- a/README.md +++ b/README.md @@ -74,8 +74,9 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma > WARNING! Considering the huge amount of features added in 3.1.1-beryllium during its RC phase, the dmvcframework-3.1.1-beryllium has been renamed to dmvcframework-3.2.0-boron -- New! Added Swagger support (thanks to [João Antônio Duarte]() and [Geoffrey Smith](https://github.com/geoffsmith82)) +- New! Added Swagger support (thanks to [João Antônio Duarte](https://github.com/joaoduarte19) and [Geoffrey Smith](https://github.com/geoffsmith82)) - New! Added SQLGenerator and RQL compiler for PostgreSQL, SQLite and MSSQLServer (in addition to MySQL, MariaDB, Firebird and Interbase) +- New! Added support for interfaces serialization - now it is possible to serialize Spring4D collections (thanks to [João Antônio Duarte](https://github.com/joaoduarte19)) - Improved! Greatly improved support for [HATEOAS](https://en.wikipedia.org/wiki/HATEOAS) in renders. Check `TRenderSampleController.GetPeople_AsObjectList_HATEOS` and all the others actions end with `HATEOS` in `renders.dproj` sample) ```delphi diff --git a/samples/commons/BusinessObjectsU.pas b/samples/commons/BusinessObjectsU.pas index a517d244..b62507c2 100644 --- a/samples/commons/BusinessObjectsU.pas +++ b/samples/commons/BusinessObjectsU.pas @@ -59,6 +59,39 @@ type class function GetList(const aCount: Integer = 3): TObjectList; end; + IPerson = interface + ['{1D00C67A-A6D9-4B31-8291-705B339CDE9B}'] + function GetName: String; + procedure SetName(const Value: String); + function GetAge: Integer; + procedure SetAge(const Value: Integer); + function GetDOB: TDate; + procedure SetDOB(const Value: TDate); + property Name: String read GetName write SetName; + property Age: Integer read GetAge write SetAge; + property DOB: TDate read GetDOB write SetDOB; + end; + + [MVCNameCase(ncCamelCase)] + TInterfacedPerson = class(TInterfacedObject, IPerson) + private + fName: string; + FDOB: TDate; + fAge: Integer; + protected + function GetName: String; + procedure SetName(const Value: String); + function GetAge: Integer; + procedure SetAge(const Value: Integer); + function GetDOB: TDate; + procedure SetDOB(const Value: TDate); + public + property Name: String read GetName write SetName; + property Age: Integer read GetAge write SetAge; + property DOB: TDate read GetDOB write SetDOB; + end; + + TPeople = class(TObjectList); [MVCNameCase(ncLowerCase)] @@ -91,7 +124,7 @@ type [MVCNameCase(ncLowerCase)] TCustomer = class private - FName: string; + fName: string; FAddressLine2: string; FAddressLine1: string; FContactFirst: string; @@ -108,7 +141,7 @@ type public constructor Create; destructor Destroy; override; - property Name: string read FName write SetName; + property Name: string read fName write SetName; [MVCDoNotSerialize] property ContactFirst: string read FContactFirst write SetContactFirst; [MVCDoNotSerialize] @@ -185,14 +218,13 @@ begin Result := TObjectList.Create(true); for I := 1 to aCount do begin - Result.Add(TPerson.GetNew(GetRndFirstName, GetRndLastName, EncodeDate(1900 + Random(100), - Random(12) + 1, Random(27) + 1), true)); + Result.Add(TPerson.GetNew(GetRndFirstName, GetRndLastName, EncodeDate(1900 + Random(100), Random(12) + 1, + Random(27) + 1), true)); end; end; end; -class function TPerson.GetNew(AFirstName, ALastName: string; ADOB: TDate; - AMarried: boolean): TPerson; +class function TPerson.GetNew(AFirstName, ALastName: string; ADOB: TDate; AMarried: boolean): TPerson; begin Result := TPerson.Create; Result.FLastName := ALastName; @@ -302,7 +334,7 @@ end; procedure TCustomer.SetName(const Value: string); begin - FName := Value; + fName := Value; end; { TProgrammer } @@ -352,6 +384,38 @@ begin inherited; end; +{ TInterfacedPerson } + +function TInterfacedPerson.GetAge: Integer; +begin + Result := fAge; +end; + +function TInterfacedPerson.GetDOB: TDate; +begin + Result := FDOB; +end; + +function TInterfacedPerson.GetName: String; +begin + Result := fName; +end; + +procedure TInterfacedPerson.SetAge(const Value: Integer); +begin + fAge := Value; +end; + +procedure TInterfacedPerson.SetDOB(const Value: TDate); +begin + FDOB := Value; +end; + +procedure TInterfacedPerson.SetName(const Value: String); +begin + fName := Value; +end; + initialization Randomize; diff --git a/samples/renders/InMemoryDataU.pas b/samples/renders/InMemoryDataU.pas index d9435cf1..6ddc42aa 100644 --- a/samples/renders/InMemoryDataU.pas +++ b/samples/renders/InMemoryDataU.pas @@ -8,6 +8,7 @@ uses function GetPeopleList: TObjectList; function GetPeopleSmallList: TObjectList; +function GetInterfacedPeopleList: TList; implementation @@ -17,6 +18,23 @@ uses var GPeople, GPeopleSmall: TObjectList; +function GetInterfacedPeopleList: TList; +var + lPerson: IPerson; +begin + Result := TList.Create; + lPerson := TInterfacedPerson.Create; + lPerson.Name := 'Daniele Teti'; + lPerson.Age := 40; + lPerson.DOB := EncodeDate(1979, 11, 4); + Result.Add(lPerson); + lPerson := TInterfacedPerson.Create; + lPerson.Name := 'Peter Parker'; + lPerson.Age := 35; + lPerson.DOB := EncodeDate(1984, 11, 4); + Result.Add(lPerson); +end; + procedure PopulateList; var p: TPerson; diff --git a/samples/renders/RenderSampleControllerU.pas b/samples/renders/RenderSampleControllerU.pas index ddca1759..4c783a50 100644 --- a/samples/renders/RenderSampleControllerU.pas +++ b/samples/renders/RenderSampleControllerU.pas @@ -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)')] @@ -79,6 +78,11 @@ type [MVCProduces('application/json')] procedure GetPeople_AsObjectList; + [MVCHTTPMethod([httpGET])] + [MVCPath('/interfacedpeople')] + [MVCProduces('application/json')] + procedure GetInterfacedPeople; + [MVCHTTPMethod([httpGET])] [MVCPath('/people/hateoas')] [MVCProduces('application/json')] @@ -289,8 +293,7 @@ begin end; Context.Response.ContentType := TMVCMediaType.APPLICATION_OCTET_STREAM; Context.Response.StatusCode := HTTP_STATUS.OK; - Context.Response.CustomHeaders.Values['Content-Disposition'] := 'attachment; filename=' + - filename + ';'; + Context.Response.CustomHeaders.Values['Content-Disposition'] := 'attachment; filename=' + filename + ';'; Render(TFileStream.Create(lFullFilePath, fmOpenRead or fmShareDenyNone)); end; @@ -330,8 +333,7 @@ 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.qryCustomers, lJObj.a['customers'], TMVCNameCase.ncLowerCase, []); lSer.DataSetToJsonArray(lDM.qryCountry, lJObj.a['countries'], TMVCNameCase.ncLowerCase, []); finally lSer.Free; @@ -369,22 +371,17 @@ begin Render(lDM.qryCustomers, False, procedure(const DS: TDataset; const Links: IMVCLinks) begin - Links.AddRefLink - .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) - .Add(HATEOAS.REL, 'self') - .Add(HATEOAS._TYPE, 'application/json'); - Links.AddRefLink - .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders') - .Add(HATEOAS.REL, 'orders') + Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString).Add(HATEOAS.REL, 'self') .Add(HATEOAS._TYPE, 'application/json'); + Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders') + .Add(HATEOAS.REL, 'orders').Add(HATEOAS._TYPE, 'application/json'); end); finally lDM.Free; end; end; -procedure TRenderSampleController.GetCustomer_AsDataSetRecord( - const ID: Integer); +procedure TRenderSampleController.GetCustomer_AsDataSetRecord(const ID: Integer); var lDM: TMyDataModule; begin @@ -394,13 +391,9 @@ begin Render(lDM.qryCustomers, False, [], dstSingleRecord, procedure(const DS: TDataset; const Links: IMVCLinks) begin - Links.AddRefLink - .Add(HATEOAS.HREF, '/customers') - .Add(HATEOAS.REL, 'customers') - .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); - Links.AddRefLink - .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString) - .Add(HATEOAS.REL, 'self') + Links.AddRefLink.Add(HATEOAS.HREF, '/customers').Add(HATEOAS.REL, 'customers').Add(HATEOAS._TYPE, + TMVCMediaType.APPLICATION_JSON); + Links.AddRefLink.Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString).Add(HATEOAS.REL, 'self') .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); end); finally @@ -432,6 +425,11 @@ begin end; +procedure TRenderSampleController.GetInterfacedPeople; +begin + Render(ToMVCList(GetInterfacedPeopleList, True)); +end; + procedure TRenderSampleController.GetLotOfPeople; begin Render(GetPeopleList, False); @@ -439,10 +437,8 @@ end; procedure TRenderSampleController.GetPerson_AsHTML; begin - ResponseStream.Append('
    ').Append('
  • FirstName: Daniele
    • ') - .Append('
  • LastName: Teti') - .AppendFormat('
  • DOB: %s
    • ', [DateToISODate(EncodeDate(1975, 5, 2))]) - .Append('
  • Married: yes
    • ') + ResponseStream.Append('
      ').Append('
    • FirstName: Daniele
      • ').Append('
    • LastName: Teti') + .AppendFormat('
    • DOB: %s
      • ', [DateToISODate(EncodeDate(1975, 5, 2))]).Append('
    • Married: yes
      • ') .Append('
    '); RenderResponseStream; end; @@ -472,11 +468,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; @@ -627,15 +620,9 @@ begin Render(People, True, procedure(const APerson: TPerson; const Links: IMVCLinks) begin - Links.AddRefLink - .Add(HATEOAS.HREF, '/people/' + APerson.ID.ToString) - .Add(HATEOAS.REL, 'self') - .Add(HATEOAS._TYPE, 'application/json') - .Add('title', 'Details for ' + APerson.FullName); - Links.AddRefLink - .Add(HATEOAS.HREF, '/people') - .Add(HATEOAS.REL, 'people') - .Add(HATEOAS._TYPE, 'application/json'); + Links.AddRefLink.Add(HATEOAS.HREF, '/people/' + APerson.ID.ToString).Add(HATEOAS.REL, 'self').Add(HATEOAS._TYPE, + 'application/json').Add('title', 'Details for ' + APerson.FullName); + Links.AddRefLink.Add(HATEOAS.HREF, '/people').Add(HATEOAS.REL, 'people').Add(HATEOAS._TYPE, 'application/json'); end); end; @@ -653,14 +640,10 @@ begin Render(lPerson, False, procedure(const AObject: TObject; const Links: IMVCLinks) begin - Links.AddRefLink - .Add(HATEOAS.HREF, '/people/' + TPerson(AObject).ID.ToString) - .Add(HATEOAS.REL, 'self') - .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); - Links.AddRefLink - .Add(HATEOAS.HREF, '/people') - .Add(HATEOAS.REL, 'people') + Links.AddRefLink.Add(HATEOAS.HREF, '/people/' + TPerson(AObject).ID.ToString).Add(HATEOAS.REL, 'self') .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); + Links.AddRefLink.Add(HATEOAS.HREF, '/people').Add(HATEOAS.REL, 'people').Add(HATEOAS._TYPE, + TMVCMediaType.APPLICATION_JSON); end); finally lPerson.Free; diff --git a/samples/renders/renders.dproj b/samples/renders/renders.dproj index f52e6628..3c025f66 100644 --- a/samples/renders/renders.dproj +++ b/samples/renders/renders.dproj @@ -1,7 +1,7 @@  {8CCDACDA-3FA5-486E-AD8E-63E4113177EE} - 18.6 + 18.7 None renders.dpr True @@ -89,6 +89,11 @@ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png true $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png None @@ -317,6 +322,12 @@ true + + + .\ + true + + true @@ -328,19 +339,13 @@ true - + .\ true - - - .\ - true - - - + .\ true @@ -352,13 +357,13 @@ true - - + + .\ true - + .\ true @@ -560,6 +565,12 @@ 1 + + + res\values + 1 + + res\drawable @@ -596,6 +607,36 @@ 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + res\drawable-small @@ -620,6 +661,12 @@ 1 + + + res\values + 1 + + 1 @@ -718,6 +765,17 @@ 1 + + + 1 + + + 1 + + + 1 + + 1 @@ -729,6 +787,39 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -740,6 +831,61 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -751,6 +897,116 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 @@ -784,6 +1040,28 @@ 1 + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + 1 diff --git a/sources/MVCFramework.Console.pas b/sources/MVCFramework.Console.pas index 36e30151..9bcd19d6 100644 --- a/sources/MVCFramework.Console.pas +++ b/sources/MVCFramework.Console.pas @@ -1,18 +1,34 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + unit MVCFramework.Console; interface type TConsoleMode = (Normal, Bright); - TConsoleColor = ( - Black = 30, - Red = 31, - Green = 32, - Yellow = 33, - Blue = 34, - Magenta = 35, - Cyan = 36, - White = 37); + TConsoleColor = (Black = 30, Red = 31, Green = 32, Yellow = 33, Blue = 34, Magenta = 35, Cyan = 36, White = 37); procedure ResetConsole; procedure TextColor(const Color: TConsoleColor); @@ -23,12 +39,10 @@ implementation uses - {$IFDEF MSWINDOWS} - +{$IFDEF MSWINDOWS} WinApi.Windows, - {$ENDIF} - +{$ENDIF} System.SysUtils; const @@ -37,7 +51,7 @@ const var GForeGround: TConsoleColor; GBackGround: TConsoleColor; - GMode: TConsoleMode = TConsolemode.Normal; + GMode: TConsoleMode = TConsoleMode.Normal; function ToBackGround(const ForeGround: Byte): Byte; begin diff --git a/sources/MVCFramework.DuckTyping.pas b/sources/MVCFramework.DuckTyping.pas index aa62ba8f..d0c745ee 100644 --- a/sources/MVCFramework.DuckTyping.pas +++ b/sources/MVCFramework.DuckTyping.pas @@ -292,11 +292,16 @@ begin raise EMVCDuckTypingException.Create ('Cannot find method Indexed property "Items" or method "GetItem" or method "GetElement" in the Duck Object.'); lValue := FGetItemMethod.Invoke(FObjectAsDuck, [AIndex]); - if not lValue.IsObject then + + if lValue.Kind = tkInterface then begin - raise EMVCDuckTypingException.Create('Items in list can be only objects'); + Exit(TObject(lValue.AsInterface)); end; - Result := lValue.AsObject; + if lValue.Kind = tkClass then + begin + Exit(lValue.AsObject); + end; + raise EMVCDuckTypingException.Create('Items in list can be only objects or interfaces'); end; function TDuckTypedList.GetOwnsObjects: Boolean; diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.pas b/sources/MVCFramework.Serializer.JsonDataObjects.pas index a7caca85..4e10d9fd 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas @@ -221,6 +221,11 @@ var LEnumPrefix: string; LEnumName: string; begin + if SameText(AName, 'RefCount') then + begin + Exit; + end; + if AValue.IsEmpty then begin AJsonObject[AName] := Null; @@ -1369,9 +1374,8 @@ begin LIgnoredAttrs := TList.Create; try LIgnoredAttrs.AddRange(AIgnoredAttributes); - if Assigned(GetRttiContext.GetType(TObject(AObject).ClassType).GetProperty('RefCount')) then - LIgnoredAttrs.Add('RefCount'); - +// if Assigned(GetRttiContext.GetType(TObject(AObject).ClassType).GetProperty('RefCount')) then +// LIgnoredAttrs.Add('RefCount'); Result := SerializeObject(TObject(AObject), AType, TMVCIgnoredList(LIgnoredAttrs.ToArray), ASerializationAction); finally LIgnoredAttrs.Free; diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index b63cd456..cd6c7fad 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -601,6 +601,7 @@ type FContext: TWebContext; FContentCharset: string; FResponseStream: TStringBuilder; + function ToMVCList(const AObject: TObject; AOwnsObject: Boolean = False): IMVCList; public function GetContentType: string; function GetStatusCode: Integer; @@ -3060,6 +3061,11 @@ begin GetContext.Response.StatusCode := AValue; end; +function TMVCRenderer.ToMVCList(const AObject: TObject; AOwnsObject: Boolean): IMVCList; +begin + Result := MVCFramework.DuckTyping.WrapAsList(AObject,AOwnsObject); +end; + procedure TMVCController.SetViewData(const aModelName: string; const Value: TObject); begin GetViewModel.Add(aModelName, Value);