diff --git a/samples/commons/BusinessObjectsU.pas b/samples/commons/BusinessObjectsU.pas index b685ca90..e888372e 100644 --- a/samples/commons/BusinessObjectsU.pas +++ b/samples/commons/BusinessObjectsU.pas @@ -104,7 +104,7 @@ type procedure SetContactLast(const Value: string); procedure SetName(const Value: string); public - property name: string read FName write SetName; + property Name: string read FName write SetName; [MVCDoNotSerialize] property ContactFirst: string read FContactFirst write SetContactFirst; [MVCDoNotSerialize] diff --git a/samples/renders/RenderSampleControllerU.pas b/samples/renders/RenderSampleControllerU.pas index 26e147bd..039e3d77 100644 --- a/samples/renders/RenderSampleControllerU.pas +++ b/samples/renders/RenderSampleControllerU.pas @@ -48,14 +48,16 @@ type procedure GetPerson_AsText(const ID: Integer); [MVCHTTPMethod([httpGET])] - [MVCPath('/customers/hateoas')] - [MVCProduces('application/json')] - procedure GetCustomers_AsDataSet_HATEOAS; + [MVCPath('/customers/simple')] + procedure GetCustomers_AsDataSet; [MVCHTTPMethod([httpGET])] [MVCPath('/customers')] - [MVCProduces('application/json')] - procedure GetCustomers_AsDataSet; + procedure GetCustomersAsDataSetWithRefLinks; + + [MVCHTTPMethod([httpGET])] + [MVCPath('/customers/($ID)')] + procedure GetCustomer_AsDataSetRecord(const ID: Integer); [MVCHTTPMethod([httpGET])] [MVCPath('/customers/metadata')] @@ -253,7 +255,7 @@ begin on disk and how to retrieve it. } Context.Response.ContentType := TMVCMediaType.APPLICATION_JSON; Context.Response.StatusCode := HTTP_STATUS.OK; - Render(Dict(['filename', 'ref'], [lOutputFileName, '/files/' + lOutputFileName])); + Render(StrDict(['filename', 'ref'], [lOutputFileName, '/files/' + lOutputFileName])); end; procedure TRenderSampleController.GetBinaryData(const filename: string); @@ -338,7 +340,7 @@ begin end; end; -procedure TRenderSampleController.GetCustomers_AsDataSet_HATEOAS; +procedure TRenderSampleController.GetCustomersAsDataSetWithRefLinks; var lDM: TMyDataModule; begin @@ -346,11 +348,42 @@ begin try lDM.qryCustomers.Open; Render(lDM.qryCustomers, False, - procedure(const DS: TDataset; const Links: TMVCStringDictionary) + procedure(const DS: TDataset; const Links: IMVCLinks) begin - Links[HATEOAS.HREF] := '/customers/' + DS.FieldByName('cust_no').AsString; - Links[HATEOAS.REL] := 'self'; - Links[HATEOAS._TYPE] := 'application/json'; + 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); +var + lDM: TMyDataModule; +begin + lDM := TMyDataModule.Create(nil); + try + lDM.qryCustomers.Open('SELECT * FROM CUSTOMER WHERE CUST_NO = ?', [ID]); + 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') + .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON); end); finally lDM.Free; @@ -574,12 +607,13 @@ begin {$ENDREGION} Render(People, True, - procedure(const APerson: TPerson; const Dict: TMVCStringDictionary) + procedure(const APerson: TPerson; const Links: IMVCLinks) begin - Dict[HATEOAS.HREF] := '/people/' + APerson.ID.ToString; - Dict[HATEOAS.REL] := 'self'; - Dict[HATEOAS._TYPE] := 'application/json'; - Dict['title'] := 'Details for ' + APerson.FullName; + Links.AddRefLink + .Add(HATEOAS.HREF, '/people/' + APerson.ID.ToString) + .Add(HATEOAS.REL, 'self') + .Add(HATEOAS._TYPE, 'application/json') + .Add('title', 'Details for ' + APerson.FullName); end); end; @@ -595,11 +629,16 @@ begin lPerson.DOB := EncodeDate(1979, 11, 4); lPerson.Married := True; Render(lPerson, False, - procedure(const AObject: TObject; const Links: TMVCStringDictionary) + procedure(const AObject: TObject; const Links: IMVCLinks) begin - Links[HATEOAS.HREF] := '/people/' + TPerson(AObject).ID.ToString; - Links[HATEOAS.REL] := 'self'; - Links[HATEOAS._TYPE] := TMVCMediaType.APPLICATION_JSON; + 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/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas index adb854ec..31f31557 100644 --- a/sources/MVCFramework.ActiveRecord.pas +++ b/sources/MVCFramework.ActiveRecord.pas @@ -195,7 +195,7 @@ type /// /// Called before execute sql /// - procedure OnBeforeExecuteSQL(var SQL:String); virtual; + procedure OnBeforeExecuteSQL(var SQL: String); virtual; /// /// Called after insert or update the object to the database @@ -248,8 +248,10 @@ type class function All: TObjectList; overload; class function All(const aClass: TMVCActiveRecordClass): TObjectList; overload; class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload; - function Count: int64; overload; + function Count(const RQL: String = ''): int64; overload; + class function Count(const RQL: String = ''): int64; overload; class function Count: int64; overload; + class function Count(const aClass: TMVCActiveRecordClass; const RQL: String = ''): int64; overload; class function Count(const aClass: TMVCActiveRecordClass): int64; overload; class function SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet; class function CurrentConnection: TFDConnection; @@ -284,7 +286,9 @@ type IMVCActiveRecordConnections = interface ['{7B87473C-1784-489F-A838-925E7DDD0DE2}'] procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); + procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); procedure RemoveConnection(const aName: string); + procedure RemoveDefaultConnection; procedure SetCurrent(const aName: string); function GetCurrent: TFDConnection; function GetCurrentBackend: string; @@ -308,7 +312,9 @@ type constructor Create; virtual; destructor Destroy; override; procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false); + procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); procedure RemoveConnection(const aName: string); + procedure RemoveDefaultConnection; procedure SetCurrent(const aName: string); function GetCurrent: TFDConnection; function GetByName(const aName: string): TFDConnection; @@ -481,6 +487,12 @@ begin end; end; +procedure TMVCConnectionsRepository.AddDefaultConnection( + const aConnection: TFDConnection; const aOwns: Boolean); +begin + AddConnection('default', aConnection, aOwns); +end; + constructor TMVCConnectionsRepository.Create; begin inherited; @@ -570,6 +582,11 @@ begin end; end; +procedure TMVCConnectionsRepository.RemoveDefaultConnection; +begin + RemoveConnection('default'); +end; + procedure TMVCConnectionsRepository.SetCurrent(const aName: string); var lName: string; @@ -638,7 +655,7 @@ var lPar: TFDParam; lPair: TPair; lValue: TValue; - lSQL : String; + lSQL: String; begin lQry := TFDQuery.Create(nil); try @@ -725,7 +742,7 @@ var begin lQry := TFDQuery.Create(nil); try - lQry.FetchOptions.Unidirectional := False; //True; + lQry.FetchOptions.Unidirectional := false; // True; if Connection = nil then begin lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent; @@ -959,26 +976,43 @@ begin raise EMVCActiveRecord.CreateFmt('Action not allowed on "%s"', [ClassName]); end; -class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass): int64; +class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass; const RQL: String): int64; var lAR: TMVCActiveRecord; begin lAR := aClass.Create; try - Result := lAR.Count; + Result := lAR.Count(RQL); finally lAR.Free; end; end; -function TMVCActiveRecord.Count: int64; +class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass): int64; begin - Result := GetScalar(Self.SQLGenerator.CreateSelectCount(fTableName), []); + Result := TMVCActiveRecord.Count(aClass, ''); +end; + +function TMVCActiveRecord.Count(const RQL: String = ''): int64; +var + lSQL: string; +begin + lSQL := Self.SQLGenerator.CreateSelectCount(fTableName); + if not RQL.IsEmpty then + begin + lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false); + end; + Result := GetScalar(lSQL, []); +end; + +class function TMVCActiveRecord.Count(const RQL: String = ''): int64; +begin + Result := TMVCActiveRecord.Count(TMVCActiveRecordClass(T), RQL); end; class function TMVCActiveRecord.Count: int64; begin - Result := Count(TMVCActiveRecordClass(T)); + Result := Count(''); end; class function TMVCActiveRecord.CurrentConnection: TFDConnection; @@ -1141,11 +1175,11 @@ var lStream: TStream; lName: String; begin - {$IFDEF NEXTGEN} - lName := aValue.TypeInfo.NameFld.ToString; - {$ELSE} - lName := String(aValue.TypeInfo.Name); - {$ENDIF} +{$IFDEF NEXTGEN} + lName := aValue.TypeInfo.NameFld.ToString; +{$ELSE} + lName := String(aValue.TypeInfo.Name); +{$ENDIF} case aValue.TypeInfo.Kind of // tkUnknown: // begin @@ -1200,22 +1234,24 @@ begin end; tkFloat: begin - if lName = 'TDate' then + if lName = 'TDate' then begin aParam.AsDate := Trunc(aValue.AsExtended); end - else if lName = 'TDateTime' then - begin - aParam.AsDateTime := aValue.AsExtended; - end - else if lName = 'Currency' then - begin - aParam.AsCurrency := aValue.AsCurrency; - end else - begin - aParam.AsFloat := aValue.AsExtended; - end; + if lName = 'TDateTime' then + begin + aParam.AsDateTime := aValue.AsExtended; + end + else + if lName = 'Currency' then + begin + aParam.AsCurrency := aValue.AsCurrency; + end + else + begin + aParam.AsFloat := aValue.AsExtended; + end; end; tkClass: begin @@ -1449,7 +1485,7 @@ begin // do nothing end; -procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL:String); +procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL: String); begin // do nothing end; @@ -1859,7 +1895,7 @@ function TMVCSQLGenerator.GetRQLParser: TRQL2SQL; begin if fRQL2SQL = nil then begin - fRQL2SQL := TRQL2SQL.Create;//(20); + fRQL2SQL := TRQL2SQL.Create; // (20); end; Result := fRQL2SQL; end; @@ -1886,8 +1922,8 @@ destructor TMVCConnectionsRepository.TConnHolder.Destroy; begin if OwnsConnection then Begin - if Connection.connected then - Connection.connected := False; + if Connection.Connected then + Connection.Connected := false; FreeAndNil(Connection); End; inherited; diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index f8a07f05..75dd91f8 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -387,6 +387,43 @@ type property Items[const Key: string]: string read GetItems write SetItems; default; end; + TMVCStringDictionaryList = class(TObjectList) + public + constructor Create; + end; + + IMVCLinkItem = interface + ['{8BC70061-0DD0-4D0A-B135-F83A5C86629B}'] + function Add(const PropName: String; const PropValue: String): IMVCLinkItem; + end; + + IMVCLinks = interface + ['{8A116BED-9A10-4885-AD4B-DF38A7F0D7DF}'] + function AddRefLink: IMVCLinkItem; + function Clear: IMVCLinks; + function LinksData: TMVCStringDictionaryList; + end; + + TMVCLinks = class(TInterfacedObject, IMVCLinks) + private + fData: TMVCStringDictionaryList; + protected + function AddRefLink: IMVCLinkItem; + function Clear: IMVCLinks; + public + constructor Create; virtual; + destructor Destroy; override; + function LinksData: TMVCStringDictionaryList; + end; + + TMVCDecoratorObject = class(TInterfacedObject, IMVCLinkItem) + private + fData: TMVCStringDictionary; + public + constructor Create(const aData: TMVCStringDictionary); + function Add(const PropName: String; const PropValue: String): IMVCLinkItem; + end; + { This type is thread safe } TMVCStringObjectDictionary = class private @@ -486,8 +523,8 @@ procedure SplitContentMediaTypeAndCharset(const aContentType: string; var aConte var aContentCharSet: string); function BuildContentType(const aContentMediaType: string; const aContentCharSet: string): string; -function Dict: TMVCStringDictionary; overload; -function Dict(const aKeys: array of string; const aValues: array of string) +function StrDict: TMVCStringDictionary; overload; +function StrDict(const aKeys: array of string; const aValues: array of string) : TMVCStringDictionary; overload; const @@ -1027,12 +1064,12 @@ begin Self.WriteBuffer(UFTStr[Low(UFTStr)], Length(UFTStr)); end; -function Dict: TMVCStringDictionary; overload; +function StrDict: TMVCStringDictionary; overload; begin Result := TMVCStringDictionary.Create; end; -function Dict(const aKeys: array of string; const aValues: array of string) +function StrDict(const aKeys: array of string; const aValues: array of string) : TMVCStringDictionary; overload; var I: Integer; @@ -1042,13 +1079,73 @@ begin raise EMVCException.CreateFmt('Dict error. Got %d keys but %d values', [Length(aKeys), Length(aValues)]); end; - Result := Dict(); + Result := StrDict(); for I := Low(aKeys) to High(aKeys) do begin Result.Add(aKeys[I], aValues[I]); end; end; +{ TMVCDecorator } + +function TMVCLinks.AddRefLink: IMVCLinkItem; +begin + if not Assigned(fData) then + begin + fData := TMVCStringDictionaryList.Create; + end; + + Result := TMVCDecoratorObject.Create(fData[fData.Add(TMVCStringDictionary.Create)]); +end; + +function TMVCLinks.Clear: IMVCLinks; +begin + if Assigned(fData) then + begin + fData.Clear; + end; + Result := Self; +end; + +constructor TMVCLinks.Create; +begin + inherited Create; + fData := nil; +end; + +function TMVCLinks.LinksData: TMVCStringDictionaryList; +begin + Result := fData; +end; + +destructor TMVCLinks.Destroy; +begin + FreeAndNil(fData); + inherited; +end; + +{ TMVCDecoratorObject } + +function TMVCDecoratorObject.Add(const PropName, + PropValue: String): IMVCLinkItem; +begin + fData.Items[PropName] := PropValue; + Result := Self; +end; + +constructor TMVCDecoratorObject.Create(const aData: TMVCStringDictionary); +begin + inherited Create; + fData := aData; +end; + +{ TMVCNamedPairList } + +constructor TMVCStringDictionaryList.Create; +begin + inherited Create(True); +end; + initialization gLock := TObject.Create; diff --git a/sources/MVCFramework.RQL.Parser.pas b/sources/MVCFramework.RQL.Parser.pas index 60f89f88..9a8170a9 100644 --- a/sources/MVCFramework.RQL.Parser.pas +++ b/sources/MVCFramework.RQL.Parser.pas @@ -77,7 +77,7 @@ type TRQLToken = (tkEq, tkLt, tkLe, tkGt, tkGe, tkNe, tkAnd, tkOr, tkSort, tkLimit, { RQL } tkAmpersand, tkEOF, tkOpenPar, tkClosedPar, tkOpenBracket, tkCloseBracket, tkComma, tkSemicolon, tkPlus, tkMinus, tkDblQuote, tkQuote, tkSpace, tkContains, tkIn, tkUnknown); - + TRQLCustom = class; TRQLAbstractSyntaxTree = class(TObjectList) @@ -199,10 +199,10 @@ type constructor Create(const MaxRecordCount: Integer = -1); destructor Destroy; override; procedure Execute( - const RQL: string; - out SQL: string; - const RQLCompiler: TRQLCompiler; - const UseLimit: Boolean = true); + const RQL: string; + out SQL: string; + const RQLCompiler: TRQLCompiler; + const UseLimit: Boolean = true); end; TRQLCompilerRegistry = class sealed @@ -272,7 +272,7 @@ procedure TRQL2SQL.EatWhiteSpaces; var lToken: TRQLToken; begin - while True do + while true do begin SaveCurPos; lToken := GetToken; @@ -330,7 +330,7 @@ begin fAST.Insert(0, TRQLWhere.Create); if GetToken = tkSemicolon then begin - ParseSortLimit(True); + ParseSortLimit(true); end; end else @@ -500,7 +500,8 @@ begin fCurrToken := tkLimit; Exit(fCurrToken); end; - if (lChar = 'c') and (C(1) = 'o') and (C(2) = 'n') and (C(3) = 't') and (C(4) = 'a') and (C(5) = 'i') and (C(6) = 'n') and (C(7) = 's') then + if (lChar = 'c') and (C(1) = 'o') and (C(2) = 'n') and (C(3) = 't') and (C(4) = 'a') and (C(5) = 'i') and + (C(6) = 'n') and (C(7) = 's') then begin Skip(8); fCurrToken := tkContains; @@ -559,23 +560,24 @@ begin Error('Expected string value'); if not MatchSymbol('"') then Error('Unclosed string'); - lValueIsString := True; - end - else if (aToken = tkIn) and (lToken = tkOpenBracket) then - begin - if not MatchFieldArrayValue(lFieldValue) then - Error('Expected array value'); - if not MatchSymbol(']') then - Error('Unclosed bracket'); - lValueIsString := False; + lValueIsString := true; end else - begin - BackToLastPos; - if not MatchFieldNumericValue(lFieldValue) then - Error('Expected numeric value'); - lValueIsString := False; - end; + if (aToken = tkIn) and (lToken = tkOpenBracket) then + begin + if not MatchFieldArrayValue(lFieldValue) then + Error('Expected array value'); + if not MatchSymbol(']') then + Error('Unclosed bracket'); + lValueIsString := False; + end + else + begin + BackToLastPos; + if not MatchFieldNumericValue(lFieldValue) then + Error('Expected numeric value'); + lValueIsString := False; + end; EatWhiteSpaces; if GetToken <> tkClosedPar then Error('Expected ")"'); @@ -593,7 +595,7 @@ var begin EatWhiteSpaces; SaveCurPos; - Result := True; + Result := true; lTk := GetToken; case lTk of tkEq, tkLt, tkLe, tkGt, tkGe, tkNe, tkContains, tkIn: @@ -642,7 +644,7 @@ begin lRQLLimit := TRQLLimit.Create; fAST.Add(lRQLLimit); lRQLLimit.Token := tkLimit; - lRQLLimit.Start := StrToInt64(lStart); //XE7 compat + lRQLLimit.Start := StrToInt64(lStart); // XE7 compat if fMaxRecordCount > -1 then begin lRQLLimit.Count := Min(StrToInt64(lCount), fMaxRecordCount); @@ -651,7 +653,7 @@ begin begin lRQLLimit.Count := StrToInt64(lCount); end; - Result := True; + Result := true; end; procedure TRQL2SQL.ParseLogicOperator(const aToken: TRQLToken; @@ -669,7 +671,7 @@ begin EatWhiteSpaces; lLogicOp := TRQLLogicOperator.Create(aToken); aAST.Add(lLogicOp); - while True do + while true do begin EatWhiteSpaces; lToken := GetToken; @@ -702,7 +704,7 @@ var lFieldName: string; lSort: TRQLSort; begin - Result := True; + Result := true; SaveCurPos; if GetToken <> tkSort then begin @@ -716,7 +718,7 @@ begin fAST.Add(lSort); lSort.Token := tkSort; - while True do + while true do begin EatWhiteSpaces; lToken := GetToken; @@ -768,8 +770,8 @@ function TRQL2SQL.MatchFieldArrayValue(out lFieldValue: string): Boolean; var lChar: Char; begin - Result := True; - while True do + Result := true; + while true do begin lChar := C(0); // escape chars @@ -807,12 +809,12 @@ function TRQL2SQL.MatchFieldName(out lFieldName: string): Boolean; var lChar: Char; begin - Result := True; + Result := true; lChar := C(0); if IsLetter(lChar) then begin lFieldName := lChar; - while True do + while true do begin Skip(1); lChar := C(0); @@ -832,11 +834,11 @@ function TRQL2SQL.MatchFieldNumericValue(out lFieldValue: string): Boolean; var lChar: Char; begin - Result := True; + Result := true; lFieldValue := ''; lChar := C(0); - if CharInSet(lChar, ['+','-']) then + if CharInSet(lChar, ['+', '-']) then begin lFieldValue := lChar; Skip(1); @@ -846,7 +848,7 @@ begin if IsDigit(lChar) then begin lFieldValue := lFieldValue + lChar; - while True do + while true do begin Skip(1); lChar := C(0); @@ -866,8 +868,8 @@ function TRQL2SQL.MatchFieldStringValue(out lFieldValue: string): Boolean; var lChar: Char; begin - Result := True; - while True do + Result := true; + while true do begin lChar := C(0); // escape chars @@ -921,7 +923,7 @@ constructor TRQLLogicOperator.Create(const Token: TRQLToken); begin inherited Create; Self.Token := Token; - fRQLFilter := TObjectList.Create(True); + fRQLFilter := TObjectList.Create(true); end; destructor TRQLLogicOperator.Destroy; @@ -1045,14 +1047,15 @@ begin if lField.InstanceFieldName = lRQLProperty then Exit(lField.DatabaseFieldName); end; - raise ERQLException.CreateFmt('Property %s does not exist or is transient and cannot be used in RQL', [RQLPropertyName]); + raise ERQLException.CreateFmt('Property %s does not exist or is transient and cannot be used in RQL', + [RQLPropertyName]); end; { TRQLAbstractSyntaxTree } constructor TRQLAbstractSyntaxTree.Create; begin - inherited Create(True); + inherited Create(true); end; function TRQLAbstractSyntaxTree.TreeContainsToken( @@ -1064,7 +1067,7 @@ begin for lItem in Self do begin if lItem.Token = aToken then - Exit(True); + Exit(true); end; end; diff --git a/sources/MVCFramework.Serializer.Commons.pas b/sources/MVCFramework.Serializer.Commons.pas index 77a0cab4..e897975a 100644 --- a/sources/MVCFramework.Serializer.Commons.pas +++ b/sources/MVCFramework.Serializer.Commons.pas @@ -59,9 +59,9 @@ type TMVCIgnoredList = array of string; - TMVCSerializationAction = reference to procedure(const AObject: T; const ADictionary: TMVCStringDictionary); - TMVCSerializationAction = reference to procedure(const AObject: TObject; const ADictionary: TMVCStringDictionary); - TMVCDatasetSerializationAction = reference to procedure(const ADataSet: TDataset; const ADictionary: TMVCStringDictionary); + TMVCSerializationAction = reference to procedure(const AObject: T; const Links: IMVCLinks); + TMVCSerializationAction = reference to procedure(const AObject: TObject; const Links: IMVCLinks); + TMVCDatasetSerializationAction = reference to procedure(const ADataSet: TDataset; const Links: IMVCLinks); EMVCSerializationException = class(EMVCException) end; diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas index 3ceddd88..a1c6cb71 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas @@ -210,7 +210,6 @@ procedure TMVCStringDictionarySerializer.SerializeAttribute(const AElementValue: const ASerializerObject: TObject; const AAttributes: TArray); var lStringDict: TMVCStringDictionary; -// lPair: TPair; lOutObject: TJsonObject; lJsonDict: TJsonObject; begin diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.pas b/sources/MVCFramework.Serializer.JsonDataObjects.pas index 6091db7a..409b1556 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas @@ -66,9 +66,10 @@ type public procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); - procedure InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; - const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; - const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary; + procedure InternalObjectToJsonObject(const AObject: TObject; + const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; + const AIgnoredAttributes: TMVCIgnoredList; + const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); procedure ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; @@ -154,7 +155,13 @@ uses MVCFramework.Logger, System.SysUtils; -{ TMVCJsonDataObjectsSerializer } +type + TJDOLinks = class(TMVCLinks) + public + procedure FillJSONArray(const AJsonArray: TJsonArray); + end; + + { TMVCJsonDataObjectsSerializer } procedure TMVCJsonDataObjectsSerializer.AfterConstruction; var @@ -215,22 +222,24 @@ begin else AJsonObject.S[AName] := DateToISODate(AValue.AsExtended); end - else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then - begin - if (AValue.AsExtended = 0) then - AJsonObject[AName] := Null - else - AJsonObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsExtended); - end - else if (AValue.TypeInfo = System.TypeInfo(TTime)) then - begin - if (AValue.AsExtended = 0) then - AJsonObject[AName] := Null - else - AJsonObject.S[AName] := TimeToISOTime(AValue.AsExtended); - end else - AJsonObject.F[AName] := AValue.AsExtended; + if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then + begin + if (AValue.AsExtended = 0) then + AJsonObject[AName] := Null + else + AJsonObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsExtended); + end + else + if (AValue.TypeInfo = System.TypeInfo(TTime)) then + begin + if (AValue.AsExtended = 0) then + AJsonObject[AName] := Null + else + AJsonObject.S[AName] := TimeToISOTime(AValue.AsExtended); + end + else + AJsonObject.F[AName] := AValue.AsExtended; end; tkVariant: @@ -298,31 +307,32 @@ begin begin AJsonObject.F[AName] := TimeStampToMsecs(AValue.AsType); end - else if (AValue.TypeInfo = System.TypeInfo(TValue)) then - begin - if TMVCSerializerHelper.AttributeExists(ACustomAttributes, - ValueTypeAtt) then + else + if (AValue.TypeInfo = System.TypeInfo(TValue)) then begin - CastValue := AValue.AsType; - if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then - AttributeToJsonDataValue(AJsonObject, AName, CastedValue, stDefault, [], []) + if TMVCSerializerHelper.AttributeExists(ACustomAttributes, + ValueTypeAtt) then + begin + CastValue := AValue.AsType; + if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then + AttributeToJsonDataValue(AJsonObject, AName, CastedValue, stDefault, [], []) + else + raise EMVCSerializationException.CreateFmt + ('Cannot serialize %s of TypeKind tkRecord (TValue with MVCValueAsTypeAttribute).', + [AName]); + end else - raise EMVCSerializationException.CreateFmt - ('Cannot serialize %s of TypeKind tkRecord (TValue with MVCValueAsTypeAttribute).', - [AName]); + begin + ChildValue := AValue.AsType; + ChildJsonObject := AJsonObject.O[AName]; + ChildJsonObject.S['type'] := TMVCSerializerHelper.GetTypeKindAsString + (ChildValue.TypeInfo.Kind); + AttributeToJsonDataValue(ChildJsonObject, 'value', ChildValue, stDefault, [], []); + end; end else - begin - ChildValue := AValue.AsType; - ChildJsonObject := AJsonObject.O[AName]; - ChildJsonObject.S['type'] := TMVCSerializerHelper.GetTypeKindAsString - (ChildValue.TypeInfo.Kind); - AttributeToJsonDataValue(ChildJsonObject, 'value', ChildValue, stDefault, [], []); - end; - end - else - raise EMVCSerializationException.CreateFmt - ('Cannot serialize %s of TypeKind tkRecord.', [AName]); + raise EMVCSerializationException.CreateFmt + ('Cannot serialize %s of TypeKind tkRecord.', [AName]); end; tkSet: @@ -633,18 +643,21 @@ begin if (AValue.TypeInfo = System.TypeInfo(TDate)) then AValue := TValue.From(ISODateToDate(AJsonObject[AName].Value)) - else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then - AValue := TValue.From(ISOTimeStampToDateTime(AJsonObject[AName].Value)) - - else if (AValue.TypeInfo = System.TypeInfo(TTime)) then - AValue := TValue.From(ISOTimeToTime(AJsonObject[AName].Value)) - - else if (AValue.Kind = tkEnumeration) then - TValue.Make(GetEnumValue(AValue.TypeInfo, AJsonObject[AName].Value), - AValue.TypeInfo, AValue) - else - AValue := TValue.From(AJsonObject[AName].Value); + if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then + AValue := TValue.From(ISOTimeStampToDateTime(AJsonObject[AName].Value)) + + else + if (AValue.TypeInfo = System.TypeInfo(TTime)) then + AValue := TValue.From(ISOTimeToTime(AJsonObject[AName].Value)) + + else + if (AValue.Kind = tkEnumeration) then + TValue.Make(GetEnumValue(AValue.TypeInfo, AJsonObject[AName].Value), + AValue.TypeInfo, AValue) + + else + AValue := TValue.From(AJsonObject[AName].Value); end; jdtInt: @@ -901,23 +914,19 @@ procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const ASerializationAction: TMVCSerializationAction); var I: Integer; - lDict: TMVCStringDictionary; + lDict: IMVCLinks; lSer: IMVCTypeSerializer; begin if not Assigned(AList) then raise EMVCSerializationException.Create('List not assigned'); if Assigned(ASerializationAction) then begin - lDict := TMVCStringDictionary.Create; - try - for I := 0 to Pred(AList.Count) do - begin - lDict.Clear; - InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, - ASerializationAction, lDict, lSer); - end; - finally - lDict.Free; + lDict := TJDOLinks.Create; + for I := 0 to Pred(AList.Count) do + begin + lDict.Clear; + InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, + ASerializationAction, lDict, lSer); end; end else @@ -940,7 +949,8 @@ end; procedure TMVCJsonDataObjectsSerializer.InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; - const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary; + const ASerializationAction: TMVCSerializationAction; + const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; @@ -979,8 +989,8 @@ begin if Assigned(ASerializationAction) then begin - ASerializationAction(AObject, Dict); - Serializer.SerializeAttribute(Dict, TMVCConstants.HATEOAS_PROP_NAME, AJsonObject, []); + ASerializationAction(AObject, Links); + TJDOLinks(Links).FillJSONArray(AJsonObject.A[TMVCConstants.HATEOAS_PROP_NAME]); end; end; @@ -1009,7 +1019,7 @@ var JsonArray: TJDOJsonArray; ObjList: IMVCList; Obj: TObject; - lLinks: TMVCStringDictionary; + lLinks: IMVCLinks; lSer: IMVCTypeSerializer; begin Result := EmptyStr; @@ -1033,16 +1043,13 @@ begin ('Cannot serialize _links without TMVCStringDictionary custom serializer'); end; - lLinks := TMVCStringDictionary.Create; - try - for Obj in ObjList do - begin - InternalObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), - AIgnoredAttributes, - ASerializationAction, lLinks, lSer); - end; - finally - lLinks.Free; + lLinks := TJDOLinks.Create; + for Obj in ObjList do + begin + lLinks.Clear; + InternalObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), + AIgnoredAttributes, + ASerializationAction, lLinks, lSer); end; end else @@ -1069,7 +1076,7 @@ var JsonArray: TJDOJsonArray; BookMark: TBookmark; lNameCase: TMVCNameCase; - lLinks: TMVCStringDictionary; + lLinks: IMVCLinks; LJObj: TJsonObject; lDataSetFields: TMVCDataSetFields; begin @@ -1081,45 +1088,36 @@ begin lLinks := nil; if Assigned(ASerializationAction) then begin - lLinks := TMVCStringDictionary.Create; + lLinks := TJDOLinks.Create; end; + lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); try - - lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); + JsonArray := TJDOJsonArray.Create; try - JsonArray := TJDOJsonArray.Create; - try - BookMark := ADataSet.BookMark; - lNameCase := GetNameCase(ADataSet, ANameCase); - ADataSet.First; - while not ADataSet.Eof do + BookMark := ADataSet.BookMark; + lNameCase := GetNameCase(ADataSet, ANameCase); + ADataSet.First; + while not ADataSet.Eof do + begin + LJObj := JsonArray.AddObject; + DataSetToJsonObject(ADataSet, LJObj, lNameCase, AIgnoredFields, lDataSetFields); + if Assigned(ASerializationAction) then begin - LJObj := JsonArray.AddObject; - DataSetToJsonObject(ADataSet, LJObj, lNameCase, AIgnoredFields, lDataSetFields); - if Assigned(ASerializationAction) then - begin - lLinks.Clear; - ASerializationAction(ADataSet, lLinks); - TMVCStringDictionarySerializer(fStringDictionarySerializer) - .Serialize(lLinks, LJObj.O['_links']); - end; - ADataSet.Next; + lLinks.Clear; + ASerializationAction(ADataSet, lLinks); + TJDOLinks(lLinks).FillJSONArray(LJObj.A[TMVCConstants.HATEOAS_PROP_NAME]); end; - Result := JsonArray.ToJSON(True); - finally - JsonArray.Free; - if ADataSet.BookmarkValid(BookMark) then - ADataSet.GotoBookmark(BookMark); - ADataSet.FreeBookmark(BookMark); + ADataSet.Next; end; + Result := JsonArray.ToJSON(True); finally - lDataSetFields.Free; + JsonArray.Free; + if ADataSet.BookmarkValid(BookMark) then + ADataSet.GotoBookmark(BookMark); + ADataSet.FreeBookmark(BookMark); end; finally - if Assigned(ASerializationAction) then - begin - lLinks.Free; - end; + lDataSetFields.Free; end; end; @@ -1130,6 +1128,7 @@ function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const ADataSet: TD var JsonObject: TJDOJsonObject; lDataSetFields: TMVCDataSetFields; + lLinks: IMVCLinks; begin Result := EmptyStr; if (not Assigned(ADataSet)) or (ADataSet.IsEmpty) then @@ -1140,6 +1139,12 @@ begin try DataSetToJsonObject(ADataSet, JsonObject, GetNameCase(ADataSet, ANameCase), AIgnoredFields, lDataSetFields); + lLinks := TJDOLinks.Create; + if Assigned(ASerializationAction) then + begin + ASerializationAction(ADataSet, lLinks); + TJDOLinks(lLinks).FillJSONArray(JsonObject.A[TMVCConstants.HATEOAS_PROP_NAME]); + end; Result := JsonObject.ToJSON(True); finally JsonObject.Free; @@ -1154,9 +1159,9 @@ function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var - JsonObject: TJDOJsonObject; - ObjType: TRttiType; - lDict: TMVCStringDictionary; + LJObj: TJDOJsonObject; + lObjType: TRttiType; + lDict: IMVCLinks; begin Result := EmptyStr; @@ -1172,41 +1177,37 @@ begin if AObject is System.JSON.TJsonValue then Exit(System.JSON.TJsonValue(AObject).ToJSON); - ObjType := GetRttiContext.GetType(AObject.ClassType); + lObjType := GetRttiContext.GetType(AObject.ClassType); - if GetTypeSerializers.ContainsKey(ObjType.Handle) then + if GetTypeSerializers.ContainsKey(lObjType.Handle) then begin - GetTypeSerializers.Items[ObjType.Handle].SerializeRoot(AObject, TObject(JsonObject), []); + GetTypeSerializers.Items[lObjType.Handle].SerializeRoot(AObject, TObject(LJObj), []); try - Result := JsonObject.ToJSON(True); + Result := LJObj.ToJSON(True); finally - JsonObject.Free; + LJObj.Free; end; Exit; end; - JsonObject := TJDOJsonObject.Create; + LJObj := TJDOJsonObject.Create; try if Assigned(ASerializationAction) then begin - lDict := TMVCStringDictionary.Create; - try - InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), - AIgnoredAttributes, - ASerializationAction, lDict, fStringDictionarySerializer); - finally - lDict.Free; - end; + lDict := TJDOLinks.Create; + InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), + AIgnoredAttributes, + ASerializationAction, lDict, fStringDictionarySerializer); end else begin - InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), + InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), AIgnoredAttributes, nil, nil, nil); end; - Result := JsonObject.ToJSON(True); + Result := LJObj.ToJSON(True); finally - JsonObject.Free; + LJObj.Free; end; end; @@ -1384,49 +1385,52 @@ begin JSON.O[KeyName] := TJDOJsonObject.Create; JSON.O[KeyName].Assign(TJDOJsonObject(Value.AsObject)); end - else if (lValueAsObj is TJDOJsonArray) or (lValueAsObj is TJsonArray) -{$IFDEF RIOORBETTER} or - { this is for a bug in delphi103rio } - (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjsonarray') or - { this is for a bug in delphi103rio } - (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonarray') -{$ENDIF} - then - begin - JSON.A[KeyName] := TJDOJsonArray.Create; - JSON.A[KeyName].Assign(TJDOJsonArray(Value.AsObject)); - end - else if lValueAsObj is TDataSet then - begin - lSer := TMVCJsonDataObjectsSerializer.Create; - try - JSON.A[KeyName] := TJDOJsonArray.Create; - lSer.DataSetToJsonArray(TDataSet(lValueAsObj), JSON.A[KeyName], - TMVCNameCase.ncLowerCase, []); - finally - lSer.Free; - end; - end - else if TDuckTypedList.CanBeWrappedAsList(lValueAsObj, lMVCList) then - begin - lSer := TMVCJsonDataObjectsSerializer.Create; - try - JSON.A[KeyName] := TJDOJsonArray.Create; - lSer.ListToJsonArray(lMVCList, JSON.A[KeyName], TMVCSerializationType.stDefault, nil); - finally - lSer.Free; - end; - end else - begin - lSer := TMVCJsonDataObjectsSerializer.Create; - try - JSON.O[KeyName] := lSer.SerializeObjectToJSON(lValueAsObj, - TMVCSerializationType.stProperties, [], nil); - finally - lSer.Free; - end; - end; + if (lValueAsObj is TJDOJsonArray) or (lValueAsObj is TJsonArray) +{$IFDEF RIOORBETTER} or + { this is for a bug in delphi103rio } + (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjsonarray') or + { this is for a bug in delphi103rio } + (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonarray') +{$ENDIF} + then + begin + JSON.A[KeyName] := TJDOJsonArray.Create; + JSON.A[KeyName].Assign(TJDOJsonArray(Value.AsObject)); + end + else + if lValueAsObj is TDataSet then + begin + lSer := TMVCJsonDataObjectsSerializer.Create; + try + JSON.A[KeyName] := TJDOJsonArray.Create; + lSer.DataSetToJsonArray(TDataSet(lValueAsObj), JSON.A[KeyName], + TMVCNameCase.ncLowerCase, []); + finally + lSer.Free; + end; + end + else + if TDuckTypedList.CanBeWrappedAsList(lValueAsObj, lMVCList) then + begin + lSer := TMVCJsonDataObjectsSerializer.Create; + try + JSON.A[KeyName] := TJDOJsonArray.Create; + lSer.ListToJsonArray(lMVCList, JSON.A[KeyName], TMVCSerializationType.stDefault, nil); + finally + lSer.Free; + end; + end + else + begin + lSer := TMVCJsonDataObjectsSerializer.Create; + try + JSON.O[KeyName] := lSer.SerializeObjectToJSON(lValueAsObj, + TMVCSerializationType.stProperties, [], nil); + finally + lSer.Free; + end; + end; end; else raise EMVCException.Create('Invalid type'); @@ -1463,4 +1467,24 @@ begin end; end; +procedure MVCStringDictionaryListToJSONArray(const aStringDictionaryList: TMVCStringDictionaryList; + const AJsonArray: TJsonArray); +var + lStringDictionary: TMVCStringDictionary; +begin + if aStringDictionaryList = nil then + Exit; + for lStringDictionary in aStringDictionaryList do + begin + TMVCStringDictionarySerializer.Serialize(lStringDictionary, AJsonArray.AddObject); + end; +end; + +{ TJDOLinks } + +procedure TJDOLinks.FillJSONArray(const AJsonArray: TJsonArray); +begin + MVCStringDictionaryListToJSONArray(LinksData, AJsonArray); +end; + end. diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 85aa1fb3..aa45eea9 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -64,7 +64,7 @@ uses // Delphi XE4 (all update) and XE5 (with no update) don't contains this unit. Look for the bug in QC // https://quality.embarcadero.com/browse/RSP-17216 -{$IFNDEF MOBILE} //file upload is not supported on mobile +{$IFNDEF MOBILE} // file upload is not supported on mobile Web.ReqMulti, {$ENDIF} Web.HTTPApp, @@ -76,7 +76,8 @@ uses LoggerPro, IdGlobal, IdGlobalProtocols, - IdURI, MVCFramework.Commons; + IdURI, + MVCFramework.Commons; type @@ -161,7 +162,6 @@ type end; - TMVCWebRequest = class private FWebRequest: TWebRequest; @@ -439,7 +439,8 @@ type procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); // Serializer access function Serializer: IMVCSerializer; overload; - function Serializer(const AContentType: string; const ARaiseExcpIfNotExists: Boolean = True): IMVCSerializer; overload; + function Serializer(const AContentType: string; const ARaiseExcpIfNotExists: Boolean = True) + : IMVCSerializer; overload; end; IMVCAuthenticationHandler = interface @@ -466,17 +467,20 @@ type procedure Redirect(const AUrl: string); virtual; procedure ResponseStatus(const AStatusCode: Integer; const AReasonString: string = ''); virtual; function Serializer: IMVCSerializer; overload; - function Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean = True): IMVCSerializer; overload; + function Serializer(const AContentType: string; const ARaiseExceptionIfNotExists: Boolean = True) + : IMVCSerializer; overload; procedure SendStream(const AStream: TStream; const AOwns: Boolean = True; const ARewind: Boolean = False); virtual; procedure SendFile(const AFileName: string); virtual; procedure RenderResponseStream; virtual; function ResponseStream: TStringBuilder; procedure Render(const AContent: string); overload; - //PODO renders + // PODO renders procedure Render(const AObject: TObject; const ASerializationAction: TMVCSerializationAction = nil); overload; - procedure Render(const AObject: TObject; const AOwns: Boolean; const ASerializationAction: TMVCSerializationAction = nil); overload; - procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction = nil); overload; - //PODOs Collection render + procedure Render(const AObject: TObject; const AOwns: Boolean; + const ASerializationAction: TMVCSerializationAction = nil); overload; + procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType; + const ASerializationAction: TMVCSerializationAction = nil); overload; + // PODOs Collection render procedure Render(const ACollection: TObjectList; const ASerializationAction: TMVCSerializationAction = nil); overload; procedure Render(const ACollection: TObjectList; const AOwns: Boolean; @@ -492,7 +496,7 @@ type procedure Render(const AException: Exception; AExceptionItems: TList = nil; const AOwns: Boolean = True); overload; procedure Render(const AResponse: TMVCResponse; const AOwns: Boolean = True); overload; - //Dataset support + // Dataset support procedure Render( const ADataSet: TDataSet; const ASerializationAction: TMVCDatasetSerializationAction = nil @@ -646,7 +650,8 @@ type procedure OnAfterControllerAction(AContext: TWebContext; const AActionName: string; const AHandled: Boolean); end; - TMVCExceptionHandlerProc = reference to procedure(E: Exception; SelectedController: TMVCController; WebContext: TWebContext; var ExceptionHandled: Boolean); + TMVCExceptionHandlerProc = reference to procedure(E: Exception; SelectedController: TMVCController; + WebContext: TWebContext; var ExceptionHandled: Boolean); TMVCEngine = class(TComponent) private const @@ -671,7 +676,8 @@ type procedure RegisterDefaultsSerializers; function GetViewEngineClass: TMVCViewEngineClass; protected - function CustomExceptionHandling(const Ex: Exception; const ASelectedController: TMVCController; const AContext: TWebContext): Boolean; + function CustomExceptionHandling(const Ex: Exception; const ASelectedController: TMVCController; + const AContext: TWebContext): Boolean; procedure ConfigDefaultValues; virtual; procedure SaveCacheConfigValues; procedure LoadSystemControllers; virtual; @@ -798,13 +804,15 @@ type function IsShuttingDown: Boolean; procedure EnterInShutdownState; +function CreateResponse(const StatusCode: UInt16; const ReasonString: String; const Message: String = ''): TMVCResponse; implementation uses MVCFramework.Router, MVCFramework.SysControllers, - MVCFramework.Serializer.JsonDataObjects, MVCFramework.JSONRPC; + MVCFramework.Serializer.JsonDataObjects, + MVCFramework.JSONRPC; var _IsShuttingDown: Int64 = 0; @@ -820,6 +828,11 @@ begin TInterlocked.Add(_IsShuttingDown, 1); end; +function CreateResponse(const StatusCode: UInt16; const ReasonString: String; const Message: String = ''): TMVCResponse; +begin + Result := TMVCResponse.Create(StatusCode, ReasonString, Message); +end; + { MVCHTTPMethodsAttribute } constructor MVCHTTPMethodsAttribute.Create(const AMVCHTTPMethods: TMVCHTTPMethods); @@ -968,7 +981,16 @@ begin if FSerializers.TryGetValue(ContentMediaType, lSerializer) then lSerializer.DeserializeObject(Body, AObject) else - raise EMVCException.CreateFmt('Body ContentType "%s" not supported', [ContentType]); + begin + if ContentType.Trim.IsEmpty then + begin + raise EMVCException.Create('Request ContentType header is empty, cannot deserialize body'); + end + else + begin + raise EMVCException.CreateFmt('Body ContentType "%s" not supported', [ContentType]); + end; + end; end; procedure TMVCWebRequest.BodyForListOf(const AObjectList: TObjectList); @@ -1443,12 +1465,13 @@ begin FRequest := TMVCApacheWebRequest.Create(ARequest, ASerializers) {$IFNDEF LINUX} - else if ARequest is TISAPIRequest then - FRequest := TMVCISAPIWebRequest.Create(ARequest, ASerializers) + else + if ARequest is TISAPIRequest then + FRequest := TMVCISAPIWebRequest.Create(ARequest, ASerializers) {$ENDIF} - else - raise EMVCException.Create('Unknown request type ' + ARequest.Classname); + else + raise EMVCException.Create('Unknown request type ' + ARequest.Classname); {$ELSE} FRequest := TMVCISAPIWebRequest.Create(ARequest, ASerializers) @@ -1755,14 +1778,13 @@ begin {$IFDEF BERLINORBETTER} ARequest.ReadTotalContent; - //Double check for malicious content-length header + // Double check for malicious content-length header if ARequest.ContentLength > FConfigCache_MaxRequestSize then begin raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB] (2)', [(FConfigCache_MaxRequestSize div 1024)]); end; {$ENDIF} - LParamsTable := TMVCRequestParamsTable.Create; try LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers); @@ -1777,7 +1799,8 @@ begin ExecuteBeforeRoutingMiddleware(LContext, LHandled); if not LHandled then begin - if LRouter.ExecuteRouting(ARequest.PathInfo, TMVCRouter.StringMethodToHTTPMetod(ARequest.Method), + {TODO -oDanieleT -cGeneral : Allow for HTTP method override} + if LRouter.ExecuteRouting(ARequest.PathInfo, LContext.Request.HTTPMethod, ARequest.ContentType, ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType], FConfig[TMVCConfigKey.DefaultContentCharset], LParamsTable, LResponseContentMediaType, LResponseContentCharset) then @@ -1816,14 +1839,16 @@ begin LActionFormalParams := LRouter.MethodToCall.GetParameters; if (Length(LActionFormalParams) = 0) then SetLength(LActualParams, 0) - else if (Length(LActionFormalParams) = 1) and - (SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then - begin - SetLength(LActualParams, 1); - LActualParams[0] := LContext; - end else - FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, LActualParams); + if (Length(LActionFormalParams) = 1) and + (SameText(LActionFormalParams[0].ParamType.QualifiedName, 'MVCFramework.TWebContext')) then + begin + SetLength(LActualParams, 1); + LActualParams[0] := LContext; + end + else + FillActualParamsForAction(LContext, LActionFormalParams, LRouter.MethodToCall.Name, + LActualParams); LSelectedController.OnBeforeAction(LContext, LRouter.MethodToCall.Name, LHandled); @@ -1896,7 +1921,8 @@ begin end else begin - SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]), E.ClassName); + SendRawHTTPStatus(LContext, E.HTTPErrorCode, Format('[%s] %s', [E.Classname, E.Message]), + E.Classname); end; end; end; @@ -1904,7 +1930,8 @@ begin begin if not CustomExceptionHandling(EIO, LSelectedController, LContext) then begin - Log.ErrorFmt('[%s] %s (Custom message: "%s")', [EIO.Classname, EIO.Message, 'Invalid Op'], LOGGERPRO_TAG); + Log.ErrorFmt('[%s] %s (Custom message: "%s")', [EIO.Classname, EIO.Message, 'Invalid Op'], + LOGGERPRO_TAG); if Assigned(LSelectedController) then begin LSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError); @@ -1931,7 +1958,7 @@ begin else begin SendRawHTTPStatus(LContext, HTTP_STATUS.InternalServerError, - Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname); + Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname); end; end; end; @@ -2043,28 +2070,30 @@ begin raise EMVCException.CreateFmt('Invalid TDate value for param [%s]', [AActionFormalParams[I].Name]); end; end - else if lQualifiedName = 'System.TDateTime' then - begin - try - WasDateTime := True; - AActualParams[I] := ISOTimeStampToDateTime(StrValue); - except - on E: Exception do - begin - raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]', - [AActionFormalParams[I].Name, E.Message]); + else + if lQualifiedName = 'System.TDateTime' then + begin + try + WasDateTime := True; + AActualParams[I] := ISOTimeStampToDateTime(StrValue); + except + on E: Exception do + begin + raise EMVCException.CreateFmt('Invalid TDateTime value for param [%s][%s]', + [AActionFormalParams[I].Name, E.Message]); + end; + end; + end + else + if lQualifiedName = 'System.TTime' then + begin + try + WasDateTime := True; + AActualParams[I] := ISOTimeToTime(StrValue); + except + raise EMVCException.CreateFmt('Invalid TTime value for param [%s]', [AActionFormalParams[I].Name]); + end; end; - end; - end - else if lQualifiedName = 'System.TTime' then - begin - try - WasDateTime := True; - AActualParams[I] := ISOTimeToTime(StrValue); - except - raise EMVCException.CreateFmt('Invalid TTime value for param [%s]', [AActionFormalParams[I].Name]); - end; - end; if not WasDateTime then begin FormatSettings.DecimalSeparator := '.'; @@ -2077,12 +2106,13 @@ begin begin if SameText(StrValue, 'true') or SameText(StrValue, '1') then AActualParams[I] := True - else if SameText(StrValue, 'false') or SameText(StrValue, '0') then - AActualParams[I] := False else - raise EMVCException.CreateFmt - ('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".', - [ParamName]); + if SameText(StrValue, 'false') or SameText(StrValue, '0') then + AActualParams[I] := False + else + raise EMVCException.CreateFmt + ('Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".', + [ParamName]); end else raise EMVCException.CreateFmt('Invalid type for parameter %s. Allowed types are ' + @@ -2628,7 +2658,8 @@ begin GetContext.Response.RawWebResponse.SendRedirect(AUrl); end; -procedure TMVCRenderer.Render(const AObject: TObject; const AOwns: Boolean; const ASerializationAction: TMVCSerializationAction = nil); +procedure TMVCRenderer.Render(const AObject: TObject; const AOwns: Boolean; +const ASerializationAction: TMVCSerializationAction = nil); begin Render(AObject, AOwns, stDefault, ASerializationAction); end; @@ -2766,7 +2797,8 @@ begin GetViewDataSets.Add(aDataSetName, Value); end; -procedure TMVCRenderer.Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction = nil); +procedure TMVCRenderer.Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType; +const ASerializationAction: TMVCSerializationAction = nil); begin try Render(Serializer(GetContentType).SerializeObject(AObject, AType, [], ASerializationAction)); @@ -2804,15 +2836,34 @@ begin end; procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const AIgnoredFields: TMVCIgnoredList; -const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType; const ASerializationAction: TMVCDatasetSerializationAction); +const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType; +const ASerializationAction: TMVCDatasetSerializationAction); begin if Assigned(ADataSet) then begin try - if ASerializationType = dstSingleRecord then - Render(Serializer(GetContentType).SerializeDataSetRecord(ADataSet, AIgnoredFields, ANameCase, ASerializationAction)) + case ASerializationType of + dstSingleRecord: + begin + Render(Serializer(GetContentType).SerializeDataSetRecord(ADataSet, AIgnoredFields, ANameCase, + ASerializationAction)) + + end; + dstAllRecords: + begin + Render(Serializer(GetContentType).SerializeDataSet(ADataSet, AIgnoredFields, ANameCase, + ASerializationAction)) + end else - Render(Serializer(GetContentType).SerializeDataSet(ADataSet, AIgnoredFields, ANameCase, ASerializationAction)) + begin + raise EMVCSerializationException.Create('Invalid dataset serialization type'); + end; + end; + // if ASerializationType = dstSingleRecord then + // Render(Serializer(GetContentType).SerializeDataSetRecord(ADataSet, AIgnoredFields, ANameCase, + // ASerializationAction)) + // else + // Render(Serializer(GetContentType).SerializeDataSet(ADataSet, AIgnoredFields, ANameCase, ASerializationAction)) finally if AOwns then ADataSet.Free; @@ -2832,7 +2883,7 @@ begin try if Assigned(ASerializationAction) then begin - lSerializationAction := procedure(const AObject: TObject; const Dict: TMVCStringDictionary) + lSerializationAction := procedure(const AObject: TObject; const Dict: IMVCLinks) begin ASerializationAction(T(AObject), Dict); end; @@ -3037,7 +3088,8 @@ begin Render(ADataSet, True, ASerializationAction); end; -procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; const ASerializationAction: TMVCDatasetSerializationAction); +procedure TMVCRenderer.Render(const ADataSet: TDataSet; const AOwns: Boolean; +const ASerializationAction: TMVCDatasetSerializationAction); begin Render(ADataSet, AOwns, dstAllRecords, ASerializationAction); end; @@ -3049,19 +3101,19 @@ end; procedure TMVCRenderer.Render( const ADataSet: TDataSet; - const AOwns: Boolean; - const AIgnoredFields: TMVCIgnoredList; - const ASerializationType: TMVCDatasetSerializationType; - const ASerializationAction: TMVCDatasetSerializationAction); +const AOwns: Boolean; +const AIgnoredFields: TMVCIgnoredList; +const ASerializationType: TMVCDatasetSerializationType; +const ASerializationAction: TMVCDatasetSerializationAction); begin Render(ADataSet, AOwns, AIgnoredFields, ncLowerCase, ASerializationType, ASerializationAction); end; procedure TMVCRenderer.Render( const ADataSet: TDataSet; - const AOwns: Boolean; - const ASerializationType: TMVCDatasetSerializationType; - const ASerializationAction: TMVCDatasetSerializationAction); +const AOwns: Boolean; +const ASerializationType: TMVCDatasetSerializationType; +const ASerializationAction: TMVCDatasetSerializationAction); begin Render(ADataSet, AOwns, [], ASerializationType, ASerializationAction); end; diff --git a/sources/dmvcframeworkbuildconsts.inc b/sources/dmvcframeworkbuildconsts.inc index 8c31640b..62f7541a 100644 --- a/sources/dmvcframeworkbuildconsts.inc +++ b/sources/dmvcframeworkbuildconsts.inc @@ -1,2 +1,2 @@ const - DMVCFRAMEWORK_VERSION = '3.1.1 (beryllium) RC4'; \ No newline at end of file + DMVCFRAMEWORK_VERSION = '3.1.1 (beryllium) RC5'; \ No newline at end of file diff --git a/unittests/general/Several/LiveServerTestU.pas b/unittests/general/Several/LiveServerTestU.pas index 4f781f62..c4612ac1 100644 --- a/unittests/general/Several/LiveServerTestU.pas +++ b/unittests/general/Several/LiveServerTestU.pas @@ -29,7 +29,8 @@ interface uses DUnitX.TestFramework, MVCFramework.RESTClient, - MVCFramework.JSONRPC.Client, System.DateUtils; + MVCFramework.JSONRPC.Client, + System.DateUtils; const @@ -41,6 +42,7 @@ const {$ENDIF} + type TBaseServerTest = class(TObject) @@ -698,9 +700,9 @@ begin try for I := 0 to lJArr.Count - 1 do begin - Assert.isFalse(lJArr[I].O[TMVCConstants.HATEOS_PROP_NAME].IsNull, '_links doesn''t exists'); - Assert.isFalse(lJArr[I].O[TMVCConstants.HATEOS_PROP_NAME]['x-ref-lastname'].IsNull, '_links.x-ref-lastname doesn''t exists'); - Assert.isFalse(lJArr[I].O[TMVCConstants.HATEOS_PROP_NAME]['x-ref-firstname'].IsNull, '_links.x-ref-firstname doesn''t exists'); + Assert.isTrue(lJArr[I].A[TMVCConstants.HATEOAS_PROP_NAME].Count = 2, '_links doesn''t exists'); + Assert.areEqual(lJArr[I].A[TMVCConstants.HATEOAS_PROP_NAME].O[0].s[HATEOAS.REL], 'test0'); + Assert.areEqual(lJArr[I].A[TMVCConstants.HATEOAS_PROP_NAME].O[1].s[HATEOAS.REL], 'test1'); end; finally lJArr.Free; diff --git a/unittests/general/TestServer/TestServerControllerU.pas b/unittests/general/TestServer/TestServerControllerU.pas index f0d040ef..df98f7e6 100644 --- a/unittests/general/TestServer/TestServerControllerU.pas +++ b/unittests/general/TestServer/TestServerControllerU.pas @@ -441,10 +441,16 @@ end; procedure TTestServerController.TestGetPersonsHateos; begin Render(TPerson.GetList, True, - procedure(const Person: TPerson; const Links: TMVCStringDictionary) + procedure(const Person: TPerson; const Links: IMVCLinks) begin - Links['x-ref-firstname'] := '/api/people/' + Person.FirstName; - Links['x-ref-lastname'] := '/api/people/' + Person.LastName; + Links.AddRefLink + .Add(HATEOAS.HREF, '/api/people/' + Person.ID.ToString) + .Add(HATEOAS.REL, 'test0') + .Add(HATEOAS._TYPE, 'application/json'); + Links.AddRefLink + .Add(HATEOAS.HREF, '/api/test/' + Person.ID.ToString) + .Add(HATEOAS.REL, 'test1') + .Add(HATEOAS._TYPE, 'application/json') end); end;