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

2024-11-15 15:55:54 +01:00 · 2020-11-13 09:31:20 +01:00 · 2020-11-13 09:31:20 +01:00 · 6ea08357d3
commit 6ea08357d3
parent c81db8207c
3 changed files with 80 additions and 47 deletions
--- a/README.md
+++ b/README.md
@ -397,7 +397,7 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
 - Fixed! [issue388](https://github.com/danieleteti/delphimvcframework/issues/388)
 - Fixed! Has been patched a serious security bug affecting deployment configurations which uses internal WebServer to serve static files (do not affect all Apache, IIS or proxied deployments).  Thanks to **Stephan Munz** to have discovered it. *Update to dmvcframework-3.2-RC5+ is required for all such kind of deployments.*

-## 3.2.1-carbon ("repo" version currently in beta)
+## 3.2.1-carbon ("repo" version currently in RC phase)

 ### Improvements and Bug Fixes

@ -590,6 +590,8 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma

 - Fix for [issue221](https://github.com/danieleteti/delphimvcframework/issues/221)

+- Fix for [issue430](https://github.com/danieleteti/delphimvcframework/issues/430) (Thanks to [sonjli](https://github.com/sonjli) for its initial work)
+
 - Support for [Mustache](https://mustache.github.io/) partials (Thanks to [David Moorhouse](https://github.com/fastbike) and his work about [issue 221](https://github.com/danieleteti/delphimvcframework/issues/221)). Sample *\samples\serversideviews_mustache* has been updated to show how to use partials.

 - Added dynamic properties access to `TMVCActiveRecord` descendants. Indexed property `Attributes` is index using the property name and set/get a `TValue` representing the property value.
--- a/samples/activerecord_restful_crud/EntitiesProcessors.pas
+++ b/samples/activerecord_restful_crud/EntitiesProcessors.pas
@ -10,30 +10,40 @@ uses
 type
  TArticleProcessor = class(TInterfacedObject, IMVCEntityProcessor)
  public
-    procedure CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
+    procedure CreateEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string;
      var Handled: Boolean);
-    procedure GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
+    procedure GetEntities(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string;
+      var Handled: Boolean);
+    procedure GetEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+      var Handled: Boolean);
+    procedure UpdateEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+      var Handled: Boolean);
+    procedure DeleteEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
      var Handled: Boolean);
-    procedure GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
-    procedure UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
-    procedure DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
  end;

  TContactProcessor = class(TInterfacedObject, IMVCEntityProcessor)
  public
-    procedure CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
+    procedure CreateEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string;
      var Handled: Boolean);
-    procedure GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
+    procedure GetEntities(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string;
+      var Handled: Boolean);
+    procedure GetEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+      var Handled: Boolean);
+    procedure UpdateEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+      var Handled: Boolean);
+    procedure DeleteEntity(const Context: TWebContext;
+      const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
      var Handled: Boolean);
-    procedure GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
-    procedure UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
-    procedure DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-      const id: Integer; var Handled: Boolean);
  end;

 implementation
@ -47,10 +57,10 @@ uses
  JsonDataObjects,
  MVCFramework.Serializer.Commons,
  System.Generics.Collections,
-  MVCFramework.DuckTyping;
+  MVCFramework.DuckTyping, MVCFramework.Commons, System.NetEncoding;

-procedure TArticleProcessor.CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-  var Handled: Boolean);
+procedure TArticleProcessor.CreateEntity(const Context: TWebContext;
+  const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
 var
  lArticle: TArticle;
 begin
@ -64,26 +74,37 @@ begin
  Handled := True;
 end;

-procedure TArticleProcessor.DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-  const id: Integer; var Handled: Boolean);
-begin
-  Handled := False;
-end;
-
-procedure TArticleProcessor.GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
+procedure TArticleProcessor.DeleteEntity(const Context: TWebContext;
+  const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
  var Handled: Boolean);
 begin
  Handled := False;
 end;

-procedure TArticleProcessor.GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-  const id: Integer; var Handled: Boolean);
+procedure TArticleProcessor.GetEntities(const Context: TWebContext;
+  const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
+begin
+  Handled := True;
+  Renderer.Render(ObjectDict().Add('data', TMVCActiveRecord.All<TArticle>,
+    procedure(const AObject: TObject; const Links: IMVCLinks)
+    begin
+      Links.AddRefLink
+        .Add(HATEOAS.HREF, 'https://www.google.com/search?q=' + TNetEncoding.URL.EncodeQuery(TArticle(AObject).Description))
+        .Add(HATEOAS._TYPE, 'text/html')
+        .Add(HATEOAS.REL, 'googlesearch');
+    end));
+end;
+
+procedure TArticleProcessor.GetEntity(const Context: TWebContext;
+const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+var Handled: Boolean);
 begin
  Handled := False;
 end;

-procedure TArticleProcessor.UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
-  const id: Integer; var Handled: Boolean);
+procedure TArticleProcessor.UpdateEntity(const Context: TWebContext;
+const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+var Handled: Boolean);
 begin
  Handled := False;
 end;
@ -91,7 +112,7 @@ end;
 { TPeopleProcessor }

 procedure TContactProcessor.CreateEntity(const Context: TWebContext;
-  const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
+const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
 var
  lSer: TMVCJsonDataObjectsSerializer;
  lJSON: TJsonObject;
@ -111,12 +132,14 @@ begin
      lPerson := TPerson.Create;
      try
        // deserialize person
-        lSer.JsonObjectToObject(lJSON, lPerson, TMVCSerializationType.stDefault, nil);
+        lSer.JsonObjectToObject(lJSON, lPerson,
+          TMVCSerializationType.stDefault, nil);

        lPhones := TObjectList<TPhone>.Create(True);
        try
          // deserialize phones
-          lSer.JsonArrayToList(lJSON.A['phones'], WrapAsList(lPhones), TPhone, TMVCSerializationType.stDefault, nil);
+          lSer.JsonArrayToList(lJSON.A['phones'], WrapAsList(lPhones), TPhone,
+            TMVCSerializationType.stDefault, nil);

          // persist to database using transaction
          TMVCActiveRecord.CurrentConnection.StartTransaction;
@ -146,26 +169,27 @@ begin
  finally
    lSer.Free;
  end;
-  Context.Response.CustomHeaders.Values['X-REF'] := Context.Request.PathInfo + '/' + lID.ToString;
+  Context.Response.CustomHeaders.Values['X-REF'] := Context.Request.PathInfo +
+    '/' + lID.ToString;
  Renderer.Render(TMVCResponse.Create(201, 'Contact created with phones', ''));
 end;

 procedure TContactProcessor.DeleteEntity(const Context: TWebContext;
-  const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
-  var Handled: Boolean);
+const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+var Handled: Boolean);
 begin
  Handled := False; // inherit the default behaviour
 end;

 procedure TContactProcessor.GetEntities(const Context: TWebContext;
-  const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
+const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
 begin
  Handled := False; // inherit the default behaviour
 end;

 procedure TContactProcessor.GetEntity(const Context: TWebContext;
-  const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
-  var Handled: Boolean);
+const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+var Handled: Boolean);
 var
  lContact: TContact;
  lSer: TMVCJsonDataObjectsSerializer;
@ -182,8 +206,10 @@ begin
      try
        lJSON := TJsonObject.Create;
        try
-          lSer.ObjectToJsonObject(lContact, lJSON, TMVCSerializationType.stDefault, nil);
-          lSer.ListToJsonArray(WrapAsList(lPhones), lJSON.A['phones'], TMVCSerializationType.stDefault, nil);
+          lSer.ObjectToJsonObject(lContact, lJSON,
+            TMVCSerializationType.stDefault, nil);
+          lSer.ListToJsonArray(WrapAsList(lPhones), lJSON.A['phones'],
+            TMVCSerializationType.stDefault, nil);
          Renderer.Render(lJSON, False);
        finally
          lJSON.Free;
@ -201,16 +227,18 @@ begin
 end;

 procedure TContactProcessor.UpdateEntity(const Context: TWebContext;
-  const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
-  var Handled: Boolean);
+const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
+var Handled: Boolean);
 begin
  Handled := False; // inherit the default behaviour
 end;

 initialization

-ActiveRecordMappingRegistry.AddEntityProcessor('articles', TArticleProcessor.Create);
-ActiveRecordMappingRegistry.AddEntityProcessor('contacts', TContactProcessor.Create);
+ActiveRecordMappingRegistry.AddEntityProcessor('articles',
+  TArticleProcessor.Create);
+ActiveRecordMappingRegistry.AddEntityProcessor('contacts',
+  TContactProcessor.Create);

 finalization

--- a/sources/MVCFramework.Serializer.JsonDataObjects.pas
+++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas
@ -504,6 +504,7 @@ var
  lObj: TObject;
  lJSONValue: TJsonBaseObject;
  lJsonDataType: TJsonDataType;
+  lLinks: IMVCLinks;
 begin
  Result := nil;
  try
@ -569,7 +570,9 @@ begin
      begin
        Result := TJsonObject.Create;
        AJsonDataType := jdtObject;
-        ObjectToJsonObject(AObject, TJsonObject(Result), GetSerializationType(AObject, AType), AIgnoredAttributes);
+        lLinks := TMVCLinks.Create;
+        InternalObjectToJsonObject(AObject, TJsonObject(Result), GetSerializationType(AObject, AType), AIgnoredAttributes,
+          ASerializationAction, lLinks, nil);
      end;
    end;
  except