{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Simple JSON Path implementation. | } { | | } { | | } { | Copyright (C) - 2018 - Gerrit Moeller. | } { | | } { | Source code dstributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMJsonPath; interface uses //{$IFDEF JEDIAPI}JwaWinType,{$ENDIF} GMStrDef, GMCollections, GMIntf, GMCommon, GMUnionValue, GMJson; type // jpaAncestor, jpaAncestorOrSelf, jpaNamespace, TJsonPathScope = (jpsRoot, jpsChild, jpsDescendant, jpsDescendantOrSelf, jpsFollowing, jpsFollowingSibling, jpsPreceding, jpsPrecedingSibling, jpsSelf); //TXPathPredicate = (xppFirst, xppLast); TJsonPathExprStepRec = record Axis: TJsonPathScope; NodeTest: TGMString; // Predicate: TGMString; // TXPathPredicate; end; TGMJsonPathEvaluator = class; IGMJsonPathEvaluator = interface(IUnknown) ['{1A2FA727-ACCF-4E95-933F-29F96E966411}'] function Obj: TGMJsonPathEvaluator; end; TGMMatchingJSONValuesCollection = IGMGenericCollection<IGMJsonValueBase>; TGMJsonPathEvaluator = class(TGMRefCountedObj, IGMJsonPathEvaluator) protected FJsonDocument: IGMJsonValueBase; FMatchingEntries: TGMMatchingJSONValuesCollection; procedure IterateMatchingNodes(const AJsonPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TJsonPathExprStepRec); procedure EvaluateNextLocationStep(const AJsonPathExpression: TGMString; AContextNode: IUnknown); procedure EvaluateSingleExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown); public constructor Create(const ARefLifeTime: Boolean = True); overload; override; constructor Create(const AJsonRoot: IGMJsonValueBase; const AMatchingEntries: TGMMatchingJSONValuesCollection; const ARefLifeTime: Boolean = True); reintroduce; overload; function Obj: TGMJsonPathEvaluator; procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown); end; EGMJsonPathException = class(EGMException); procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AContextNode: IUnknown; const AMatchingEntries: TGMMatchingJSONValuesCollection); function GMGetJsonTerminalValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): RGMJsonValueData; function GMGetJsonTerminalValueDflt(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ADefaultValue: RGMUnionValue; const AApplyDefaultOnNullValues: Boolean = True): RGMUnionValue; function GMGetJsonArray(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): IGMJsonArray; function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJsonValueBase; overload; function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AIID: TGUID; out AIntf): Boolean; overload; function GMCreateMatchingValuesCollection: TGMMatchingJSONValuesCollection; const cJsonPathUnionSep = '|'; cJsonPathStepSep = '.'; cJsonRootSyntaxToken = '$'; // 'Ancestor','Ancestor-Or-Self', 'Namespace' cScopeLiterals: array [TJsonPathScope] of TGMString = ('Root', 'Child', 'Descendant', 'Descendant-Or-Self', 'Following', 'Following-Sibling', 'Preceding', 'Preceding-Sibling', 'Self'); implementation uses TypInfo; resourcestring srInvalidAxisNameFmt = 'Invalid JSON-Path axis name: "%s"'; srAxisNotImplemented = 'JSON-Path Axis "%s" not implemented yet'; srNoValueMatchingExprFmt = 'No JSON %s value found matching the JSON-path expression "%s"'; srTerminal = 'terminal'; srArray = 'array'; type TJsonPathAxisNameObj = class; IXPathAxisNameObj = interface(IUnknown) ['{BBB808B5-6929-449C-8D5E-5B0CC0280438}'] function Obj: TJsonPathAxisNameObj; end; TJsonPathAxisNameObj = class(TGMNameObj, IGMGetName, IXPathAxisNameObj) // TGMRefCountedObj protected FAxis: TJsonPathScope; // FName: TGMString; public constructor Create(const AAxis: TJsonPathScope; const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload; function Obj: TJsonPathAxisNameObj; // function GetName: TGMString; stdcall; end; var vJsonPathScopeLiterals: IGMIntfCollection = nil; { ------------------------- } { ---- Global Routines ---- } { ------------------------- } function JsonPathScopeLiterals: IGMIntfCollection; var a: TJsonPathScope; begin if vJsonPathScopeLiterals = nil then begin vJsonPathScopeLiterals := TGMIntfArrayCollection.Create(False, True, GMCompareByName); for a:=Low(a) to High(a) do vJsonPathScopeLiterals.Add(TJsonPathAxisNameObj.Create(a, cScopeLiterals[a])); end; Result := vJsonPathScopeLiterals; end; function ParseStepEvalData(const AEvalStepExpression: TGMString; const ADefaultAxis: TJsonPathScope; const ACaller: TObject): TJsonPathExprStepRec; const cStrRoutineName = 'ParseStepEvalData'; var pScanScope: PGMChar; axisName: TGMString; nameObj, foundEntry: IUnknown; axisEntry: IXPathAxisNameObj; // pScanPredicate len: Integer; isVerboseSyntax: Boolean; begin FillChar(Result, SizeOf(Result), 0); Result.Axis := ADefaultAxis; isVerboseSyntax := False; // // Search for axis specification in verbose syntax // pScanScope := GMStrLScan(PGMChar(AEvalStepExpression), ':', Length(AEvalStepExpression)); if pScanScope <> nil then begin Inc(pScanScope); if pScanScope^ = ':' then begin SetString(axisName, PGMChar(AEvalStepExpression), pScanScope - PGMChar(AEvalStepExpression) - 1); nameObj := TGMNameObj.Create(axisName); if not JsonPathScopeLiterals.Find(nameObj, foundEntry) then raise EGMJsonPathException.ObjError(GMFormat(srInvalidAxisNameFmt, [axisName]), ACaller, cStrRoutineName) else if GMQueryInterface(foundEntry, IXPathAxisNameObj, axisEntry) then Result.Axis := axisEntry.Obj.FAxis; Inc(pScanScope); isVerboseSyntax := True; end; end; // // check for abbreviated axis syntax if no axis has been specified in verbose syntax // if not isVerboseSyntax then begin pScanScope := PGMChar(AEvalStepExpression); // if pScanScope <> nil then case pScanScope^ of '.': begin Inc(pScanScope); if pScanScope^ = '.' then begin Result.Axis := jpsDescendant; Inc(pScanScope); end else Result.Axis := jpsChild; end; cJsonRootSyntaxToken: begin Result.Axis := jpsRoot; Inc(pScanScope); end; '@': begin Result.Axis := jpsSelf; Inc(pScanScope); end; end; end; //pScanPredicate := GMStrLScan(pScanScope, '[', PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope); //if pScanPredicate <> nil then SetString(Result.Predicate, pScanPredicate, PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanPredicate); //if pScanPredicate = nil then len := PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope else len := pScanPredicate - pScanScope; len := PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope; SetString(Result.NodeTest, pScanScope, len); end; function IsNodeMatch(const ANode: IUnknown; const AEvalData: TJsonPathExprStepRec): Boolean; begin if AEvalData.NodeTest = '*' then Result := True else Result := GMSameText(GMGetIntfName(ANode), AEvalData.NodeTest); end; function GMCreateMatchingValuesCollection: TGMMatchingJSONValuesCollection; begin Result := TGMGenericArrayCollection<IGMJsonValueBase>.Create; end; { ------------------------------ } { ---- TJsonPathAxisNameObj ---- } { ------------------------------ } constructor TJsonPathAxisNameObj.Create(const AAxis: TJsonPathScope; const AName: TGMString; const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FAxis := AAxis; FName := AName; end; function TJsonPathAxisNameObj.Obj: TJsonPathAxisNameObj; begin Result := Self; end; //function TJsonPathAxisNameObj.GetName: TGMString; //begin // Result := FName; //end; { ------------------------------ } { ---- TGMJsonPathEvaluator ---- } { ------------------------------ } constructor TGMJsonPathEvaluator.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); end; constructor TGMJsonPathEvaluator.Create(const AJsonRoot: IGMJsonValueBase; const AMatchingEntries: TGMMatchingJSONValuesCollection; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); FJsonDocument := AJsonRoot; FMatchingEntries := AMatchingEntries; end; function TGMJsonPathEvaluator.Obj: TGMJsonPathEvaluator; begin Result := Self; end; procedure TGMJsonPathEvaluator.IterateMatchingNodes(const AJsonPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TJsonPathExprStepRec); const cStrMethodName = 'IterateMatchingNodes'; var ctxNode, outerSubNode: IGMJsonValueBase; subValueIt: TGMJSONValuesIterator; // unkNode: IUnknown; procedure ProcessNode(const ANode: IGMJsonValueBase); begin if Length(AJsonPathExpression) > 0 then EvaluateNextLocationStep(AJsonPathExpression, ANode) else if FMatchingEntries <> nil then FMatchingEntries.Add(ANode); end; procedure ProcessNodeIfMatch(const ANode: IGMJsonValueBase); begin if IsNodeMatch(ANode, AStepEval) then ProcessNode(ANode); end; procedure IterateAllSubNodes(const ANode: IGMJsonValueBase); var it: TGMJSONValuesIterator; innerSubNode: IGMJsonValueBase; // unkNode: IUnknown; begin if ANode = nil then Exit; it := ANode.CreateSubValueIterator; if it <> nil then while it.NextEntry(innerSubNode) do // unkNode begin ProcessNodeIfMatch(innerSubNode); //if GMQueryInterface(unkNode, IGMJsonValueBase, innerSubNode) then IterateAllSubNodes(innerSubNode); end; end; begin if not GMQueryInterface(AContextNode, IGMJsonValueBase, ctxNode) then Exit; case AStepEval.Axis of jpsRoot: ProcessNode(FJsonDocument); jpsSelf: ProcessNode(ctxNode); jpsChild: begin subValueIt := ctxNode.CreateSubValueIterator; if subValueIt <> nil then while subValueIt.NextEntry(outerSubNode) do ProcessNodeIfMatch(outerSubNode); end; jpsDescendant, jpsDescendantOrSelf: begin if AStepEval.Axis = jpsDescendantOrSelf then ProcessNodeIfMatch(ctxNode); IterateAllSubNodes(ctxNode); end; // xpaParent: ProcessNodeIfMatch(ctxNode.Obj.Parent); // jpaAncestor, jpaAncestorOrSelf: // begin // if AStepEval.Axis = xpaAncestor then ctxNode := ctxNode.Obj.Parent; // while ctxNode <> nil do // begin // ProcessNodeIfMatch(ctxNode); // ctxNode := ctxNode.Obj.Parent; // end; // end; else raise EGMJsonPathException.ObjError(GMFormat(srAxisNotImplemented, [GetEnumName(TypeInfo(TJsonPathScope), Ord(AStepEval.Axis))]), Self, cStrMethodName); end; end; procedure TGMJsonPathEvaluator.EvaluateNextLocationStep(const AJsonPathExpression: TGMString; AContextNode: IUnknown); var locationStepExpr, remainingExpr: TGMString; pStartCh, pChScan, pChEnd: PGMChar; dfltAxis: TJsonPathScope; stepEval: TJsonPathExprStepRec; begin dfltAxis := jpsChild; pStartCh := PGMChar(AJsonPathExpression); if pStartCh^ = cJsonPathStepSep then begin Inc(pStartCh); if pStartCh^ = cJsonPathStepSep then begin dfltAxis := jpsDescendant; Inc(pStartCh); end; // pStartCh := pStartCh + 1; end; pChScan := GMStrLScan(pStartCh, cJsonPathStepSep, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pStartCh); if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AJsonPathExpression) + Length(AJsonPathExpression); SetString(locationStepExpr, pStartCh, pChEnd - pStartCh); stepEval := ParseStepEvalData(locationStepExpr, dfltAxis, Self); SetString(remainingExpr, pChEnd, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pChEnd); IterateMatchingNodes(remainingExpr, AContextNode, stepEval); end; procedure TGMJsonPathEvaluator.EvaluateSingleExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown); begin if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) then Exit; if AJsonPathExpression[1] = cJsonRootSyntaxToken then AContextNode := FJsonDocument; EvaluateNextLocationStep(AJsonPathExpression, AContextNode); end; procedure TGMJsonPathEvaluator.GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown); var chPos: PtrInt; expression: TGMString; begin if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) or (FMatchingEntries = nil) then Exit; if AContextNode = nil then AContextNode := FJsonDocument; chPos := 1; repeat expression := GMNextWord(chPos, AJsonPathExpression, cJsonPathUnionSep); if Length(expression) > 0 then EvaluateSingleExpression(expression, AContextNode); until Length(expression) <= 0; end; //procedure TGMJsonPathEvaluator.GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown); //var expression: TGMString; pStartCh, pChScan, pChEnd: PGMChar; //begin //if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) or (FMatchingEntries = nil) then Exit; // //if AContextNode = nil then AContextNode := FJsonDocument; // //pStartCh := PGMChar(AJsonPathExpression); // //repeat // pChScan := GMStrLScan(pStartCh, cJsonPathUnionSep, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pStartCh); // // if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AJsonPathExpression) + Length(AJsonPathExpression); // // SetString(expression, pStartCh, pChEnd - pStartCh); //// expression := GMStrip(expression); <- would prevent specifying spaces at the end // if Length(expression) > 0 then EvaluateSingleExpression(expression, AContextNode); // // pStartCh := pChEnd; // if pChScan <> nil then Inc(pStartCh); // pStartCh := pStartCh + 1; // //until pChScan = nil; //end; { ---------------- } { ---- Global ---- } { ---------------- } procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AContextNode: IUnknown; const AMatchingEntries: TGMMatchingJSONValuesCollection); var xpathEvaluator: IGMJsonPathEvaluator; begin xpathEvaluator := TGMJsonPathEvaluator.Create(AJsonRoot, AMatchingEntries); xpathEvaluator.Obj.GMEvaluateJsonPathExpression(AJsonPathExpression, AContextNode); end; function GMGetJsonTerminalValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject): RGMJsonValueData; const cStrRoutineName = 'GMGetJsonTerminalValue'; var matchingValues: TGMMatchingJSONValuesCollection; termVal: IGMJsonTerminalValue; it: TGMJSONValuesIterator; // unkVal: IUnknown; jsonEntry: IGMJsonValueBase; begin matchingValues := GMCreateMatchingValuesCollection; GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues); it := matchingValues.CreateIterator; if it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, IGMJsonTerminalValue, termVal) then Result := termVal.ValueData else raise EGMJsonPathException.ObjError(GMFormat(srNoValueMatchingExprFmt, [srTerminal, AJsonPathExpression]), ACaller, cStrRoutineName); end; function GMGetJsonTerminalValueDflt(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ADefaultValue: RGMUnionValue; const AApplyDefaultOnNullValues: Boolean): RGMUnionValue; var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; termVal: IGMJsonTerminalValue; it: TGMJSONValuesIterator; begin matchingValues := GMCreateMatchingValuesCollection; GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues); it := matchingValues.CreateIterator; if it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, IGMJsonTerminalValue, termVal) and not (termVal.ValueData.IsNullOrUnassigned and AApplyDefaultOnNullValues) then Result := termVal.ValueData else Result := ADefaultValue; end; function GMGetJsonArray(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): IGMJsonArray; const cStrRoutineName = 'GMGetJsonArray'; var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator; begin matchingValues := GMCreateMatchingValuesCollection; GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues); it := matchingValues.CreateIterator; if not it.NextEntry(jsonEntry) or not GMQueryInterface(jsonEntry, IGMJsonArray, Result) then raise EGMJsonPathException.ObjError(GMFormat(srNoValueMatchingExprFmt, [srArray]) +': '+ AJsonPathExpression, ACaller, cStrRoutineName); end; function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJsonValueBase; var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator; begin matchingValues := GMCreateMatchingValuesCollection; GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues); it := matchingValues.CreateIterator; if not it.NextEntry(jsonEntry) or not GMQueryInterface(jsonEntry, IGMJsonValueBase, Result) then Result := nil; end; function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AIID: TGUID; out AIntf): Boolean; var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator; begin matchingValues := GMCreateMatchingValuesCollection; GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues); it := matchingValues.CreateIterator; Result := it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, AIID, AIntf); end; initialization JsonPathScopeLiterals; // <- Create in Main Thread! end.