From 5ccfefc99fd9e6bee0f0c805ddbc2441ab88c22b Mon Sep 17 00:00:00 2001 From: reckface Date: Tue, 7 Apr 2015 10:43:38 +0100 Subject: [PATCH 1/4] Renamed to avoid TRestClient name collision The Delphi XE5 already contains TRestClient, so this was renamed to TJsonRestClient Additionally, TClientDataSet was added --- src/RestClient.pas | 99 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 73 insertions(+), 26 deletions(-) diff --git a/src/RestClient.pas b/src/RestClient.pas index b0fe1d5..d0f4975 100644 --- a/src/RestClient.pas +++ b/src/RestClient.pas @@ -11,7 +11,7 @@ interface {$ELSE} Contnrs, OldRttiUnMarshal, {$ENDIF} - DB, JsonListAdapter; + DB, dbclient, JsonListAdapter; const DEFAULT_COOKIE_VERSION = 1; {Cookies using the default version correspond to RFC 2109.} @@ -46,7 +46,7 @@ TJsonListAdapter = class(TInterfacedObject, IJsonListAdapter) class function NewFrom(AList: TList; AItemClass: TClass): IJsonListAdapter; end; - TRestClient = class(TComponent) + TJsonRestClient = class(TComponent) private FHttpConnection: IHttpConnection; {$IFDEF USE_GENERICS} @@ -122,7 +122,7 @@ TCookie = class TResource = class private - FRestClient: TRestClient; + FRestClient: TJsonRestClient; // due to TRestClient Name collision FURL: string; FAcceptTypes: string; FContent: TMemoryStream; @@ -130,11 +130,11 @@ TResource = class FHeaders: TStrings; FAcceptedLanguages: string; - constructor Create(RestClient: TRestClient; URL: string); + constructor Create(RestClient: TJsonRestClient; URL: string); procedure SetContent(entity: TObject); + procedure SetJsonContent(json: string); public destructor Destroy; override; - function GetAcceptTypes: string; function GetURL: string; function GetContent: TStream; @@ -184,6 +184,9 @@ TResource = class function Post(Entity: TObject): T;overload; function Put(Entity: TObject): T;overload; function Patch(Entity: TObject): T;overload; + function PostJson(data: string; table: string; titles: string): TClientDataSet;overload; + function CreateDataset(data: string; table: string = ''; titles: string = ''): TClientDataSet; + function PostJson(data: string): string; overload; {$ELSE} function Get(AListClass, AItemClass: TClass): TObject;overload; function Post(Adapter: IJsonListAdapter): TObject;overload; @@ -200,14 +203,14 @@ TResource = class implementation uses StrUtils, Math, - {$IFDEF USE_SUPER_OBJECT} + //{$IFDEF USE_SUPER_OBJECT} // Super object proved superior to the Delphi Generics SuperObject, JsonToDataSetConverter, - {$ENDIF} + //{$ENDIF} HttpConnectionFactory; { TRestClient } -constructor TRestClient.Create(Owner: TComponent); +constructor TJsonRestClient.Create(Owner: TComponent); begin inherited; {$IFDEF USE_GENERICS} @@ -223,14 +226,14 @@ constructor TRestClient.Create(Owner: TComponent); FEnabledCompression := True; end; -destructor TRestClient.Destroy; +destructor TJsonRestClient.Destroy; begin FResources.Free; FHttpConnection := nil; inherited; end; -function TRestClient.DoCustomCreateConnection: IHttpConnection; +function TJsonRestClient.DoCustomCreateConnection: IHttpConnection; begin if Assigned(FOnCustomCreateConnection) then begin @@ -247,7 +250,7 @@ function TRestClient.DoCustomCreateConnection: IHttpConnection; end; end; -function TRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandler): String; +function TJsonRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandler): String; var vResponse: TStringStream; vUrl: String; @@ -319,38 +322,38 @@ function TRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResourc end; {$IFDEF DELPHI_2009_UP} -procedure TRestClient.DoRequestFunc(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandlerFunc); +procedure TJsonRestClient.DoRequestFunc(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandlerFunc); begin FTempHandler := AHandler; DoRequest(Method, ResourceRequest, HandleAnonymousMethod); end; -procedure TRestClient.HandleAnonymousMethod(ResponseContent: TStream); +procedure TJsonRestClient.HandleAnonymousMethod(ResponseContent: TStream); begin FTempHandler(ResponseContent); FTempHandler := nil; end; {$ENDIF} -function TRestClient.GetOnConnectionLost: THTTPConnectionLostEvent; +function TJsonRestClient.GetOnConnectionLost: THTTPConnectionLostEvent; begin result := FHttpConnection.OnConnectionLost; end; -function TRestClient.GetOnError: THTTPErrorEvent; +function TJsonRestClient.GetOnError: THTTPErrorEvent; begin result := FHttpConnection.OnError; end; -function TRestClient.GetResponseCode: Integer; +function TJsonRestClient.GetResponseCode: Integer; begin CheckConnection; Result := FHttpConnection.ResponseCode; end; -procedure TRestClient.RecreateConnection; +procedure TJsonRestClient.RecreateConnection; begin if not (csDesigning in ComponentState) then begin @@ -366,7 +369,7 @@ procedure TRestClient.RecreateConnection; end; end; -procedure TRestClient.CheckConnection; +procedure TJsonRestClient.CheckConnection; begin if (FHttpConnection = nil) then begin @@ -374,19 +377,19 @@ procedure TRestClient.CheckConnection; end; end; -procedure TRestClient.Loaded; +procedure TJsonRestClient.Loaded; begin RecreateConnection; end; -function TRestClient.Resource(URL: String): TResource; +function TJsonRestClient.Resource(URL: String): TResource; begin Result := TResource.Create(Self, URL); FResources.Add(Result); end; -procedure TRestClient.SetConnectionType(const Value: THttpConnectionType); +procedure TJsonRestClient.SetConnectionType(const Value: THttpConnectionType); begin if (FConnectionType <> Value) then begin @@ -396,7 +399,7 @@ procedure TRestClient.SetConnectionType(const Value: THttpConnectionType); end; end; -procedure TRestClient.SetEnabledCompression(const Value: Boolean); +procedure TJsonRestClient.SetEnabledCompression(const Value: Boolean); begin if (FEnabledCompression <> Value) then begin @@ -409,18 +412,18 @@ procedure TRestClient.SetEnabledCompression(const Value: Boolean); end; end; -procedure TRestClient.SetOnConnectionLost( +procedure TJsonRestClient.SetOnConnectionLost( AConnectionLostEvent: THTTPConnectionLostEvent); begin FHttpConnection.OnConnectionLost := AConnectionLostEvent; end; -procedure TRestClient.SetOnError(AErrorEvent: THTTPErrorEvent); +procedure TJsonRestClient.SetOnError(AErrorEvent: THTTPErrorEvent); begin FHttpConnection.OnError := AErrorEvent; end; -function TRestClient.UnWrapConnection: IHttpConnection; +function TJsonRestClient.UnWrapConnection: IHttpConnection; begin Result := FHttpConnection; end; @@ -535,7 +538,7 @@ function TResource.ContentType(ContentType: String): TResource; Result := Self; end; -constructor TResource.Create(RestClient: TRestClient; URL: string); +constructor TResource.Create(RestClient: TJsonRestClient; URL: string); begin inherited Create; FRestClient := RestClient; @@ -636,6 +639,37 @@ function TResource.Post(Entity: TObject): T; Result := Default(T); end; +function TResource.PostJson(data: string; table: string; titles: string): TClientDataSet; +var + vResponse: string; + vJson: ISuperObject; +begin + SetJsonContent(data); + vResponse := FRestClient.DoRequest(METHOD_POST, Self); + Result := CreateDataset(vResponse, table, titles); +end; +function TResource.CreateDataset(data: string; table: string = ''; titles: string = ''): TClientDataSet; +var + vJson: ISuperObject; +begin + vJson := SuperObject.SO(data); + + Result := TJsonToDataSetConverter.CreateDataSetMetadata(vJson, table, titles); + + TJsonToDataSetConverter.ToDataSet(Result, vJson.O[table]); + +end; +function TResource.PostJson(data: string): string; +var + vResponse: string; + vJson: ISuperObject; +begin + SetJsonContent(data); + vResponse := FRestClient.DoRequest(METHOD_POST, Self); + Result := vResponse; +end; + + function TResource.Put(Entity: TObject): T; var vResponse: string; @@ -758,6 +792,19 @@ procedure TResource.SetContent(entity: TObject); end; end; +procedure TResource.SetJsonContent(json: string); +var + vStream: TStringStream; +begin + FContent.Clear; + vStream := TStringStream.Create(json); + try + vStream.Position := 0; + FContent.CopyFrom(vStream, vStream.Size); + finally + vStream.Free; + end; +end; function TResource.Put(Content: TStream): String; begin Content.Position := 0; From 4e7640a57f6deb165a0087b9ae33f1d29b6e4619 Mon Sep 17 00:00:00 2001 From: reckface Date: Tue, 7 Apr 2015 10:47:18 +0100 Subject: [PATCH 2/4] Introduced Post methods that return Datasets Expanded the functionality to support HTTP Posts that returned datasets. Also removed the directives that conditionally prevented the use of SuperObject. The Delphi generic based Json deserialization (unmarshalling) produced unpredictable results, whereas the superobject was more predictable. --- src/JsonToDataSetConverter.pas | 110 ++++++++++++++++++++++++++------- 1 file changed, 89 insertions(+), 21 deletions(-) diff --git a/src/JsonToDataSetConverter.pas b/src/JsonToDataSetConverter.pas index 305b6f7..1b19948 100644 --- a/src/JsonToDataSetConverter.pas +++ b/src/JsonToDataSetConverter.pas @@ -11,15 +11,17 @@ TJsonToDataSetConverter = class class procedure SetFieldValue(AField: TField; AValue: ISuperObject); class procedure ExtractFields(ADataSet: TDataSet; AObject: ISuperObject); + class procedure ExtractStructure(ADataSet: TDataSet; AObject: ISuperObject; tableNode, titleNode: string); class function SuperTypeToFieldType(ASuperType: TSuperType): TFieldType; class function SuperTypeToFieldSize(ASuperType: TSuperType): Integer; public - class procedure UnMarshalToDataSet(ADataSet: TDataSet; AJson: string);overload; - class procedure UnMarshalToDataSet(ADataSet: TDataSet; AObject: ISuperObject);overload; + class procedure UnMarshalToDataSet(ADataSet: TClientDataSet; AJson: string); + class procedure ToDataSet(ADataSet: TClientDataSet; AObject: ISuperObject); class function CreateDataSetMetadata(AJson: string): TClientDataSet; overload; class function CreateDataSetMetadata(AObject: ISuperObject): TClientDataSet; overload; + class function CreateDataSetMetadata(AObject: ISuperObject; table, structure: string): TClientDataSet; overload; end; implementation @@ -83,6 +85,26 @@ class function TJsonToDataSetConverter.CreateDataSetMetadata(AObject: ISuperObje Result.CreateDataSet; end; +class function TJsonToDataSetConverter.CreateDataSetMetadata(AObject: ISuperObject; table, structure: string): TClientDataSet; +var + vArray: TSuperArray; +begin + Result := TClientDataSet.Create(nil); + + if AObject.IsType(stArray) then + begin + vArray := AObject.O[table].AsArray; + + ExtractStructure(Result, AObject, table, structure); + end + else + begin + ExtractStructure(Result, AObject, table, structure); + end; + if Result.Fields.Count > 0 then + Result.CreateDataSet; +end; + class procedure TJsonToDataSetConverter.ExtractFields(ADataSet: TDataSet;AObject: ISuperObject); var vIterator: TSuperObjectIter; @@ -114,32 +136,75 @@ class procedure TJsonToDataSetConverter.ExtractFields(ADataSet: TDataSet;AObject end; end; +class procedure TJsonToDataSetConverter.ExtractStructure(ADataSet: TDataSet; AObject: ISuperObject; tableNode, titleNode: string); + +var + vIterator: TSuperObjectIter; + vNestedField: TDataSetField; + vArray: TSuperArray; + table: TSuperArray; + I: Integer; +begin + i:= 0; + table:= AObject.o[tableNode].AsArray; + if SuperObject.ObjectFindFirst(table[0], vIterator) then + begin + try + repeat + if (vIterator.val.IsType(stArray)) then + begin + vNestedField := TDataSetUtils.CreateDataSetField(ADataSet, vIterator.key); + + vArray := vIterator.val.AsArray; + if (vArray.Length > 0) then + begin + ExtractFields(vNestedField.NestedDataSet, vArray[0]); + end; + end + else + begin + TDataSetUtils.CreateField(ADataSet, SuperTypeToFieldType(vIterator.val.DataType), vIterator.key, + SuperTypeToFieldSize(vIterator.val.DataType), AObject.o[titleNode].S[vIterator.key]); + end; + until not SuperObject.ObjectFindNext(vIterator); + finally + SuperObject.ObjectFindClose(vIterator); + end; + end; + +end; + class procedure TJsonToDataSetConverter.SetFieldValue(AField: TField;AValue: ISuperObject); var vFieldName: string; - vNestedDataSet: TDataSet; + vNestedDataSet: TClientDataSet; begin - vFieldName := AField.FieldName; - case AField.DataType of - ftSmallint, ftInteger, ftWord, ftLargeint: AField.AsInteger := AValue.AsInteger; - ftFloat, ftCurrency, ftBCD, ftFMTBcd: AField.AsFloat := AValue.AsDouble; - ftBoolean: AField.AsBoolean := AValue.AsBoolean; - ftDate, ftTime, ftDateTime, ftTimeStamp: AField.AsDateTime := AValue.AsDouble; - ftDataSet: begin - vNestedDataSet := TDataSetField(AField).NestedDataSet; - - UnMarshalToDataSet(vNestedDataSet, AValue); - end; - else - AField.AsString := AValue.AsString; - end; + vFieldName := AField.FieldName; + if (AValue.IsType(stNull)) then + begin + vNestedDataSet := nil; + exit; + end; + case AField.DataType of + ftSmallint, ftInteger, ftWord, ftLargeint: AField.AsInteger := AValue.AsInteger; + ftFloat, ftCurrency, ftBCD, ftFMTBcd: AField.AsFloat := AValue.AsDouble; + ftBoolean: AField.AsBoolean := AValue.AsBoolean; + ftDate, ftTime, ftDateTime, ftTimeStamp: AField.AsDateTime := AValue.AsDouble; + ftDataSet: begin + vNestedDataSet := TClientDataSet( TDataSetField(AField).NestedDataSet); + + ToDataSet(vNestedDataSet, AValue); + end; + else + AField.AsString := AValue.AsString; + end; end; class function TJsonToDataSetConverter.SuperTypeToFieldSize(ASuperType: TSuperType): Integer; begin Result := 0; - if (ASuperType = stString) then + if (ASuperType = stNull) or (ASuperType = stString) then // Some fields return as null begin Result := 255; end; @@ -155,16 +220,19 @@ class function TJsonToDataSetConverter.SuperTypeToFieldType(ASuperType: TSuperTy stObject: Result := ftDataSet; stArray: Result := ftDataSet; stString: Result := ftString; + stNull: Result:= ftstring; // Rather than fail with an unknown type else Result := ftUnknown; end; end; -class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet;AObject: ISuperObject); +class procedure TJsonToDataSetConverter.ToDataSet(ADataSet: TClientDataSet; AObject: ISuperObject); var i: Integer; vArray: TSuperArray; begin + if (ADataSet.FieldDefs.Count = 0) then // Check for whether any data is returned + EXIT; ADataSet.DisableControls; try if AObject.IsType(stArray) then @@ -187,13 +255,13 @@ class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet;AO ADataSet.First; end; -class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet; AJson: string); +class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TClientDataSet; AJson: string); var AObject: ISuperObject; begin AObject := SuperObject.SO(AJson); - UnMarshalToDataSet(ADataSet, AObject); + ToDataSet(ADataSet, AObject); end; end. From 051b0637ef63492a5722657d6899b2df857a8221 Mon Sep 17 00:00:00 2001 From: reckface Date: Tue, 7 Apr 2015 10:54:57 +0100 Subject: [PATCH 3/4] Introduced optional DisplayName parameter The Field Definition can now have a display name instead of the json-determined fieldName --- src/DataSetUtils.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/DataSetUtils.pas b/src/DataSetUtils.pas index 8be93a0..53eb7cb 100644 --- a/src/DataSetUtils.pas +++ b/src/DataSetUtils.pas @@ -7,7 +7,7 @@ interface type TDataSetUtils = class public - class function CreateField(DataSet: TDataSet; FieldType: TFieldType; const FieldName: string = '';ASize: Integer=0): TField; + class function CreateField(DataSet: TDataSet; FieldType: TFieldType; const FieldName: string = '';ASize: Integer=0; const displayName: string=''): TField; class function CreateDataSetField(DataSet: TDataSet; const FieldName: string): TDataSetField; end; @@ -21,19 +21,21 @@ class function TDataSetUtils.CreateDataSetField(DataSet: TDataSet;const FieldNam end; class function TDataSetUtils.CreateField(DataSet: TDataSet; - FieldType: TFieldType; const FieldName: string; ASize: Integer): TField; + FieldType: TFieldType; const FieldName: string; ASize: Integer; const displayName: string): TField; begin Result:= DefaultFieldClasses[FieldType].Create(DataSet); Result.FieldName:= FieldName; if Result.FieldName = '' then Result.FieldName:= 'Field' + IntToStr(DataSet.FieldCount +1); + if(displayName <> '') then + result.DisplayLabel := displayName; Result.FieldKind := fkData; Result.DataSet:= DataSet; Result.Name:= DataSet.Name + Result.FieldName; Result.Size := ASize; if (FieldType = ftString) and (ASize <= 0) then - raise Exception.CreateFmt('Size não definido para o campo "%s".',[FieldName]); + raise Exception.CreateFmt('Size não definido para o campo "%s".',[FieldName]); end; end. From f6b2d58c9c560e16ae173c01cc4b60c5a47e996c Mon Sep 17 00:00:00 2001 From: reckface Date: Fri, 17 Apr 2015 21:20:17 +0100 Subject: [PATCH 4/4] added deprecated TRestClient --- src/RestClient.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/RestClient.pas b/src/RestClient.pas index d0f4975..0ea51ce 100644 --- a/src/RestClient.pas +++ b/src/RestClient.pas @@ -104,7 +104,10 @@ TJsonRestClient = class(TComponent) property OnCustomCreateConnection: TCustomCreateConnection read FOnCustomCreateConnection write FOnCustomCreateConnection; property TimeOut: TTimeOut read FTimeOut; end; - + + type + TRestClient = TJsonRestClient deprecated 'Use TJsonRestClient'; + TCookie = class private FName: String;