Code Monkey home page Code Monkey logo

Comments (5)

fastbike avatar fastbike commented on May 30, 2024

My first cut, which can handle text, numbers and booleans. Good enough to get me going. I have not written any unit tests yet.

unit MVCFramework.Serializer.URLEncoded;

// serialiser for URL encoded data

{$I dmvcframework.inc}

interface

uses System.Classes, System.Rtti,
  System.TypInfo,
  Data.DB,
  MVCFramework.Commons,
  MVCFramework.Serializer.Intf,
  MVCFramework.Serializer.Abstract,
  MVCFramework.DuckTyping,
  MVCFramework.Serializer.Commons,
  System.SysUtils;

type

  TMVCURLEncodedDataSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
  private
    procedure DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const RawData: string;
      const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
      const ACustomAttributes: TArray<TCustomAttribute>);

  protected
    procedure RaiseNotImplemented;
  protected
    { IMVCSerializer }
    procedure RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);

    function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ASerializationAction: TMVCSerializationAction = nil): string; overload;

    function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;

    function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;

    procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ARootNode: String = ''); overload;

    procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;

    procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ARootNode: String = ''); overload;

    procedure DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;

    procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);

    procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);
  public
    procedure URLEncodedStringToObject(const Data: TStringList; const AObject: TObject; const AType: TMVCSerializationType;
      const AIgnoredAttributes: TMVCIgnoredList);

  end;

implementation

uses
  System.NetEncoding;

{ TMVCURLEncodedDataSerializer }

procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: IInterface;
  const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: TObject;
  const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
  // ??
end;

procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
var
  SL: TStringList;
begin
  if (ASerializedObject = EmptyStr) then
    raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body');

  if not Assigned(AObject) then
    Exit;

  SL := TStringList.Create;
  try
    try
      SL.Delimiter := '&';
      SL.DelimitedText := ASerializedObject;
      if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then
      begin
        // todo: do we handle custom type serialisers
        // GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject),
        // AObject, [])
      end
      else
      begin
        URLEncodedStringToObject(SL, AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
      end;
    except
      on E: Exception do
        raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message);
    end;
  finally
    SL.Free;
  end;
end;

procedure TMVCURLEncodedDataSerializer.RaiseNotImplemented;
begin
  raise EMVCException.Create('Not Implemented');
end;

procedure TMVCURLEncodedDataSerializer.RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
  const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
  const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
  const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.URLEncodedStringToObject(const Data: TStringList; const AObject: TObject;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
  lObjType: TRttiType;
  lProp: TRttiProperty;
  lFld: TRttiField;
  lAttributeValue: TValue;
  lKeyName: string;
  lErrMsg: string;
begin
  if AObject = nil then
  begin
    Exit;
  end;

  lProp := nil;
  lFld := nil;

  lObjType := GetRttiContext.GetType(AObject.ClassType);
  case AType of
    stDefault, stProperties:
      begin
        try
          for lProp in lObjType.GetProperties do
          begin
{$IFDEF AUTOREFCOUNT}
            if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then
              continue;
{$ENDIF}
            if ((not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lProp)) and
              (not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and (lProp.IsWritable or lProp.GetValue(AObject).IsObject))
            then
            begin
              lAttributeValue := lProp.GetValue(AObject);
              lKeyName := TMVCSerializerHelper.GetKeyName(lProp, lObjType);

              if Data.IndexOfName(lKeyName) > -1 then
              begin
                DataValueToAttribute(AObject, lProp, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
                  lProp.GetAttributes);
                if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then
                begin
                  lProp.SetValue(AObject, lAttributeValue);
                end;
              end;
            end;
          end;
        except
          on E: EInvalidCast do
          begin
            if lProp <> nil then
            begin
              lErrMsg := Format('Invalid class typecast for property "%s" [Expected: %s, Data: %s]',
                [lKeyName, lProp.PropertyType.ToString(), Data.Values[lKeyName]]);
            end
            else
            begin
              lErrMsg := Format('Invalid class typecast for property "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
            end;
            raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
          end;
        end;
      end;
    stFields:
      begin
        try
          for lFld in lObjType.GetFields do
            if (not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lFld)) and
              (not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then
            begin
              lAttributeValue := lFld.GetValue(AObject);
              lKeyName := TMVCSerializerHelper.GetKeyName(lFld, lObjType);
              if Data.IndexOfName(lKeyName) > -1 then
              begin
                DataValueToAttribute(AObject, lFld, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
                  lFld.GetAttributes);
                if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) then
                  lFld.SetValue(AObject, lAttributeValue);
              end;
            end;
        except
          on E: EInvalidCast do
          begin
            if lFld <> nil then
            begin
              lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Data: %s]',
                [lKeyName, lFld.FieldType.ToString(), Data.Values[lKeyName]]);
            end
            else
            begin
              lErrMsg := Format('Invalid class typecast for field "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
            end;
            raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
          end;
        end;
      end;
  end;
end;

procedure TMVCURLEncodedDataSerializer.DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember;
  const RawData: string; const AName: string; var AValue: TValue; const AType: TMVCSerializationType;
  const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray<TCustomAttribute>);
var
  RttiType: TRttiType;
begin
  AValue.Empty;
  case AType of
    stUnknown, stDefault, stProperties:
      RttiType := TRttiProperty(ARttiMember).PropertyType;
    stFields:
      RttiType := TRttiField(ARttiMember).FieldType;
  end;

  case RttiType.TypeKind of
    tkString, tkWideString, tkAnsiString, tkUString:
      AValue := TNetEncoding.URL.Decode(RawData);
    tkInteger:
      AValue := RawData.ToInteger;
    tkInt64:
      AValue := RawData.ToInt64;
    tkFloat:
      AValue := RawData.ToDouble;
    tkEnumeration:
      begin
        if SameText(RttiType.ToString, 'boolean') then
          AValue := RawData.ToBoolean;
      end;
    // any others ?
  end;
end;

end.

from delphimvcframework.

danieleteti avatar danieleteti commented on May 30, 2024

from Facebook discussion (just to trace it)
I don't know htmx but normally I quite disagree to modify the API so deeply to just cope with client side "features".
Why just don't use htmx extension to use JSON in body request?
https://htmx.org/extensions/json-enc/

from delphimvcframework.

fastbike avatar fastbike commented on May 30, 2024

I was not aware of those extensions, so I'll take a look.
Regarding the need to change the API, HTMX works by dynamically changing the DOM, so a data submission will typically result in a lump of HTML being returned.
E.g. A typical work flow for data in a grid/table, is to have the following endpoints:

  • one endpoint to return the grid layout
  • another (triggered by some editing UI interaction such as a button, double click etc) that returns the selected table row with editable controls with the current values of the data, and this replaces the tr element
  • a final one that accepts the edits and returns a read only tr that replaces the editable row. All driven via templating.

I've found it relatively quick to get a basic PoC page up, until I used a form element elsewhere in the page and hit the blocker of the request body containing URL encoded data. Hence my code above.

from delphimvcframework.

fastbike avatar fastbike commented on May 30, 2024

I've had a quick look. My class is declared with no hints for the name casing of the properties.

  TFacility = class
  private
    FHPIFac: string;
    FRegionID: Integer;
    FSendFlag: Boolean;
    FFacilityName: string;
    FLocationID: Integer;
  public
    property HPIFac: string read FHPIFac write FHPIFac;
    property FacilityName: string read FFacilityName write FFacilityName;
    property LocationID: Integer read FLocationID write FLocationID;
    property RegionID: Integer read FRegionID write FRegionID;
    property SendFlag: Boolean read FSendFlag write FSendFlag;

This means the deserialiser uses the ncAsIs option, so the json property names have to exactly match the casing in the Pascal code. So this html works OK
<td><input type="text" name="FacilityName" value="{{FacilityName}}"></td>
but this one does not
<td><input type="text" name="facilityName" value="{{FacilityName}}"></td>

Given the case insensitive nature of Pascal, and the case sensitive nature of json, , this looks likely to cause bugs further down the line. Bugs that will be easy to introduce (front end html templates being done by an external party, DMVC application in house) and hard to find.

The alternative is to register a custom type serializer for each business object class ?
Which I can imagine would be subject to error and is additional code that needs to be written, tested and maintained.

from delphimvcframework.

danieleteti avatar danieleteti commented on May 30, 2024

Now sample "serversideviews_mustache" uses this new deserializer.

https://github.com/danieleteti/delphimvcframework/blob/master/samples/serversideviews_mustache/WebSiteControllerU.pas#L37

https://github.com/danieleteti/delphimvcframework/blob/master/samples/serversideviews_mustache/WebSiteControllerU.pas#L228

from delphimvcframework.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.