Comments (5)
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.
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.
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.
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.
Now sample "serversideviews_mustache" uses this new deserializer.
from delphimvcframework.
Related Issues (20)
- Helpers for HTMX HOT 7
- Using Spring4D Collections in ViewData HOT 18
- TMVCActiveRecordMiddleware error - Object factory for class is missing HOT 1
- SelectByNamedQuery created exception when using with Microsoft SQL Server HOT 2
- Add option to the wizard to configure mustache engine HOT 6
- TMVCActiveRecordController - refresh=true
- Packages for older versions contains bad includes section
- [HOW TO] Running on another port - via commandline switch. HOT 2
- Character % doesn't work in URL anymore HOT 6
- Request for crud sample using ADO HOT 2
- [htmx-sample] Rename all the class helper method with an "HX" suffix to avoid confusion
- Add "MVCFromContentField" attribute
- Embeded e-Mail Sending System feature request
- JSON Serializing floating point properties. HOT 8
- Nested Mustache Partials Rendering HOT 4
- Error: No mapping for the Unicode character exists in the target multi-byte code HOT 4
- The TUserPasswordChecker class does not exist HOT 1
- Error when compile to Linux HOT 5
- Model with multiple Primary Key. HOT 4
- Swagger Param Body Array HOT 6
Recommend Projects
-
React
A declarative, efficient, and flexible JavaScript library for building user interfaces.
-
Vue.js
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
-
Typescript
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
-
TensorFlow
An Open Source Machine Learning Framework for Everyone
-
Django
The Web framework for perfectionists with deadlines.
-
Laravel
A PHP framework for web artisans
-
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.
-
Visualization
Some thing interesting about visualization, use data art
-
Game
Some thing interesting about game, make everyone happy.
Recommend Org
-
Facebook
We are working to build community through open source technology. NB: members must have two-factor auth.
-
Microsoft
Open source projects and samples from Microsoft.
-
Google
Google ❤️ Open Source for everyone.
-
Alibaba
Alibaba Open Source for everyone
-
D3
Data-Driven Documents codes.
-
Tencent
China tencent open source team.
from delphimvcframework.