From d56ddc28e8e79dd655f6459ee538b2474f5e496d Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 24 Jun 2021 12:37:47 +0000 Subject: [PATCH] * Apply one JSON to another JSON object git-svn-id: trunk@49557 - --- .gitattributes | 3 + packages/fcl-json/examples/jsonmerge.lpi | 65 ++++++ packages/fcl-json/examples/jsonmerge.pp | 117 ++++++++++ packages/fcl-json/fpmake.pp | 11 +- packages/fcl-json/src/fpjsonapply.pp | 273 +++++++++++++++++++++++ 5 files changed, 467 insertions(+), 2 deletions(-) create mode 100644 packages/fcl-json/examples/jsonmerge.lpi create mode 100644 packages/fcl-json/examples/jsonmerge.pp create mode 100644 packages/fcl-json/src/fpjsonapply.pp diff --git a/.gitattributes b/.gitattributes index d1c7aebb7f..9df09bf8af 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3810,6 +3810,8 @@ packages/fcl-json/examples/demoformat.pp svneol=native#text/plain packages/fcl-json/examples/demortti.pp svneol=native#text/plain packages/fcl-json/examples/ini2json.pp svneol=native#text/plain packages/fcl-json/examples/j2y.pp svneol=native#text/plain +packages/fcl-json/examples/jsonmerge.lpi svneol=native#text/plain +packages/fcl-json/examples/jsonmerge.pp svneol=native#text/plain packages/fcl-json/examples/parsedemo.lpi svneol=native#text/plain packages/fcl-json/examples/parsedemo.pp svneol=native#text/plain packages/fcl-json/examples/simpledemo.lpi svneol=native#text/plain @@ -3818,6 +3820,7 @@ packages/fcl-json/fpmake.pp svneol=native#text/plain packages/fcl-json/src/README.txt svneol=native#text/plain packages/fcl-json/src/fcl-json.inc svneol=native#text/plain packages/fcl-json/src/fpjson.pp svneol=native#text/plain +packages/fcl-json/src/fpjsonapply.pp svneol=native#text/plain packages/fcl-json/src/fpjsonrtti.pp svneol=native#text/plain packages/fcl-json/src/fpjsontopas.pp svneol=native#text/plain packages/fcl-json/src/json2yaml.pp svneol=native#text/plain diff --git a/packages/fcl-json/examples/jsonmerge.lpi b/packages/fcl-json/examples/jsonmerge.lpi new file mode 100644 index 0000000000..f7a1e6ea56 --- /dev/null +++ b/packages/fcl-json/examples/jsonmerge.lpi @@ -0,0 +1,65 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="jsonmerge.pp"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="../src/fpjsonapply.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="jsonmerge"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <UseHeaptrc Value="True"/> + </Debugging> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-json/examples/jsonmerge.pp b/packages/fcl-json/examples/jsonmerge.pp new file mode 100644 index 0000000000..2cf59d93c8 --- /dev/null +++ b/packages/fcl-json/examples/jsonmerge.pp @@ -0,0 +1,117 @@ +{ + This file is part of the Free Component Library + + Merge 2 JSON files. + Copyright (c) 2021 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +program jsonmerge; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, CustApp, fpJSON, jsonparser, fpjsonapply; + +type + + { TJSONMergeApplication } + + TJSONMergeApplication = class(TCustomApplication) + private + function ParseOptions: string; + protected + FApplier : TJSONApplier; + procedure DoRun; override; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure Usage(const aErrorMsg: String); virtual; + end; + +{ TJSONMergeApplication } + +Function TJSONMergeApplication.ParseOptions : string; + +begin + Result:=''; + FApplier.SourceFileName:=GetOptionValue('s','source'); + FApplier.ApplyFileName:=GetOptionValue('a','apply'); + FApplier.DestFileName:=GetOptionValue('d','destination'); + FApplier.CaseInsensitive:=HasOption('i','ignorecase'); + FApplier.RemoveNonExisting:=HasOption('r','remove'); + FApplier.Formatted:=HasOption('f','format'); + FApplier.SourcePath:=GetOptionValue('p','path'); + FApplier.ApplyPath:=GetOptionValue('y','apply-path'); + if (FApplier.SourceFileName='') then + Result:='Missing source filename' + else if (FApplier.ApplyFileName='') then + Result:='Missing apply filename'; + if (Result='') and (FApplier.DestFileName='') then + FApplier.DestFileName:=FApplier.SourceFileName; +end; + +procedure TJSONMergeApplication.DoRun; +var + ErrorMsg: String; +begin + Terminate; + ErrorMsg:=CheckOptions('hs:a:d:irfp:y:', ['help','source:','apply:','destination:','ignorecase','remove','format','path:','apply-path:']); + if (ErrorMsg='') and not HasOption('h','help') then + ErrorMsg:=ParseOptions; + if (ErrorMsg<>'') or HasOption('h','help') then + begin + Usage(ErrorMsg); + Exit; + end; + FApplier.Execute; +end; + +constructor TJSONMergeApplication.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + StopOnException:=True; + FApplier:=TJSONApplier.Create(Self); +end; + +destructor TJSONMergeApplication.Destroy; +begin + FreeAndNil(FApplier); + inherited Destroy; +end; + +procedure TJSONMergeApplication.Usage(const aErrorMsg: String); +begin + if (aErrorMsg<>'') then + Writeln(aErrorMsg); + writeln('Usage: ', ExeName, ' -h'); + writeln('where'); + writeln('-a --apply=FILE File with JSON to apply to input.'); + writeln('-d --destination=FILE File to write resulting JSON to (defaults to input)'); + writeln('-f --format Format destination JSON.'); + writeln('-h --help This help message.'); + writeln('-i --ignorecase Ignore case when looking for element names.'); + writeln('-p --path=PATH Start applying at element at PATH in source.'); + writeln('-r --remove Remove elements in source not existing in apply file.'); + writeln('-s --source=FILE File with JSON input.'); + writeln('-y --apply-path=PATH Start applying at element at PATH in apply.'); + ExitCode:=Ord(aErrorMsg<>''); +end; + +var + Application: TJSONMergeApplication; + +begin + Application:=TJSONMergeApplication.Create(nil); + Application.Title:='JSON merge tool'; + Application.Run; + Application.Free; +end. + diff --git a/packages/fcl-json/fpmake.pp b/packages/fcl-json/fpmake.pp index d0d684ca24..ca8ed8844b 100644 --- a/packages/fcl-json/fpmake.pp +++ b/packages/fcl-json/fpmake.pp @@ -83,12 +83,19 @@ begin begin AddUnit('fpjson'); AddUnit('jsonparser'); - end; + end; T:=P.Targets.AddUnit('json2yaml.pp'); with T.Dependencies do begin AddUnit('fpjson'); - end; + end; + T:=P.Targets.AddUnit('fpjsonapply.pp'); + with T.Dependencies do + begin + AddUnit('fpjson'); + end; + T.ResourceStrings:=true; + P.ExamplePath.Add('examples'); T:=P.Targets.AddExampleProgram('confdemo.pp'); diff --git a/packages/fcl-json/src/fpjsonapply.pp b/packages/fcl-json/src/fpjsonapply.pp new file mode 100644 index 0000000000..3f94ad6ea7 --- /dev/null +++ b/packages/fcl-json/src/fpjsonapply.pp @@ -0,0 +1,273 @@ +{ + This file is part of the Free Component Library + + Apply elements from one JSON object to another. + Copyright (c) 2021 by Michael Van Canneyt michael@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit fpjsonapply; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpJSON; + +Type + TOwnsJSON = (ojSource,ojApply); + TOwnsJSONs = set of TOwnsJSON; + + { TJSONApplier } + + TJSONApplier = class(TComponent) + private + FApplyFileName: String; + FApplyJSON: TJSONObject; + FApplyPath: String; + FCaseInsensitive: Boolean; + FCloneSource: boolean; + FDestFileName: String; + FDestJSON: TJSONObject; + FForceCorrectType: Boolean; + FFormatted: Boolean; + FOwnsJSON: TOwnsJSONs; + FRemoveNonExisting: Boolean; + FSourceFileName: String; + FSourceJSON: TJSONObject; + FSourcePath: String; + procedure MaybeLoadApply; + procedure MaybeLoadSource; + procedure SetApplyJSON(AValue: TJSONObject); + procedure SetSourceJSON(AValue: TJSONObject); + Protected + procedure Apply(aSrc, aApply: TJSONObject); virtual; + procedure SaveDestJSON(aFileName : string); + procedure SaveDestJSON(aStream : TStream); + Public + destructor destroy; override; + // apply ApplyJSON to SourceJSON, set result in DestJSON + Procedure Execute; virtual; + // Source JSON. If not set, load from SourceFileName + Property SourceJSON : TJSONObject Read FSourceJSON Write SetSourceJSON; + // JSON to apply. If not set, load from ApplyFileName + Property ApplyJSON : TJSONObject Read FApplyJSON Write SetApplyJSON; + // Destination JSON. Can be equal to SourceJSON if CloneSource is not True. + Property DestJSON : TJSONObject Read FDestJSON; + // Are SourceJSON, ApplyJSON owned by the component ? Are set when loading from file. + Property OwnsJSON : TOwnsJSONs Read FOwnsJSON Write FOwnsJSON; + Published + // File to load SourceJSON from if it is not set. + Property SourceFileName : String Read FSourceFileName Write FSourceFileName; + // JSON path in source JSON where to start merging. Must exist and be an object! + Property SourcePath : String Read FSourcePath Write FSourcePath; + // File to load ApplyJSON from if it is not set. + Property ApplyFileName : String Read FApplyFileName Write FApplyFileName; + // JSON path in apply JSON where to start merging. Must exist and be an object! + Property ApplyPath : String Read FApplyPath Write FApplyPath; + // file to write DestJSON to after merging. Can be empty + Property DestFileName : String Read FDestFileName Write FDestFileName; + // Make a clone copy of SourceJSON before applying ApplyJSON ? + Property CloneSource : boolean Read FCloneSource Write FCloneSource; + // Search names case insensitively ? + Property CaseInsensitive : Boolean Read FCaseInsensitive Write FCaseInsensitive; + // If the type of an entry is different in Source and Apply, overwrite the entry with the value in Apply + Property ForceCorrectType : Boolean Read FForceCorrectType Write FForceCorrectType; + // After adding new entries from Apply, remove entries in Source that are not in apply. + property RemoveNonExisting : Boolean Read FRemoveNonExisting Write FRemoveNonExisting; + // Write formatted output in Destfilename (or not) + Property Formatted : Boolean Read FFormatted Write FFormatted; + end; + + + +implementation + +Resourcestring + SErrSourceEmpty = 'Cannot apply to empty source object'; + SErrApplyEmpty = 'Cannot apply empty object'; + SErrSourceIsNotObject = 'JSON source file does not contain a JSON object'; + SErrApplyIsNotObject = 'JSON apply file does not contain a JSON object'; + SErrPathNotFound = 'Path "%s" in %s JSON not found'; + +{ TJSONApplier } + +procedure TJSONApplier.SetApplyJSON(AValue: TJSONObject); +begin + if FApplyJSON=AValue then Exit; + if ojApply in FOwnsJSON then + FreeAndNil(FApplyJSON); + FApplyJSON:=AValue; +end; + +procedure TJSONApplier.SetSourceJSON(AValue: TJSONObject); +begin + if FSourceJSON=AValue then Exit; + if ojSource in FOwnsJSON then + FreeAndNil(FSourceJSON); + FSourceJSON:=AValue; +end; + +procedure TJSONApplier.MaybeLoadSource; + +Var + D : TJSONData; + F : TFileStream; + +begin + If (FSourceJSON=Nil) and (SourceFileName<>'') then + begin + F:=TFileStream.Create(SourceFileName, fmOpenRead or fmShareDenyWrite); + try + D:=GetJSON(F); + if D.JSONType<>jtObject then + begin + D.Free; + Raise EJSON.Create(SErrSourceIsNotObject) + end; + finally + F.Free; + end; + SourceJSON:=D as TJSONObject; + Include(FOwnsJSON,ojSource); + end; +end; + +procedure TJSONApplier.MaybeLoadApply; + +Var + D : TJSONData; + F : TFileStream; + +begin + If (ApplyFileName<>'') then + begin + F:=TFileStream.Create(ApplyFileName, fmOpenRead or fmShareDenyWrite); + try + D:=GetJSON(F); + if D.JSONType<>jtObject then + begin + D.Free; + Raise EJSON.Create(SErrApplyIsNotObject) + end; + finally + F.Free; + end; + ApplyJSON:=D as TJSONObject; + Include(FOwnsJSON,ojApply); + end; +end; + +procedure TJSONApplier.Apply(aSrc, aApply : TJSONObject); + +Var + aEnum : TJSONEnum; + aIdx : Integer; + +begin + for aEnum in aApply do + begin + aIdx:=aSrc.IndexOfName(aEnum.Key,CaseInsensitive); + if (aIdx<>-1) and FForceCorrectType and (aSrc.Items[aIdx].JSONType<>aEnum.Value.JSONType) then + begin + aSrc.Delete(aIdx); + aIdx:=-1; + end; + if aIdx=-1 then + aSrc.Add(aEnum.Key,aEnum.Value.Clone) + else + if (aSrc.Items[aIdx].JSONType=jtObject) and (aEnum.Value.JSONType=jtObject) then + Apply(aSrc.Items[aIdx] as TJSONObject,aEnum.Value as TJSONObject); + end; + if RemoveNonExisting then + begin + for aIdx:=aSrc.Count-1 downto 0 do + if aApply.IndexOfName(aSrc.Names[aIdx],CaseInsensitive)=-1 then + aSrc.Delete(aIdx); + end; +end; + +procedure TJSONApplier.SaveDestJSON(aFileName: string); + +Var + F : TFileStream; + +begin + F:=TFileStream.Create(aFileName,fmCreate); + try + SaveDestJSON(F); + finally + F.Free; + end; +end; + +procedure TJSONApplier.SaveDestJSON(aStream: TStream); + +Var + S : TJSONStringType; + +begin + if Formatted then + S:=DestJSON.FormatJSON() + else + S:=DestJSON.AsJSON; + aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType)); +end; + +destructor TJSONApplier.destroy; +begin + if FDestJSON<>FSourceJSON then + FreeAndNil(FDestJSON); + // Will free if needed + SourceJSON:=Nil; + ApplyJSON:=Nil; + Inherited; +end; + + +procedure TJSONApplier.Execute; + + Function FindStart(aJSON : TJSONObject; aPath,aDesc : String) : TJSONObject; + + Var + D : TJSONData; + + begin + Result:=aJSON; + if aPath='' then + exit; + D:=Result.FindPath(aPath); + if Assigned(D) then + Writeln('Have : ',D.ClassName) + else + Writeln('No D'); + if (D=Nil) or Not (D is TJSONObject) then + Raise EJSON.CreateFmt(SErrPathNotFound,[aPath,aDesc]); + Result:=D as TJSONObject; + end; + +begin + MaybeLoadSource; + MaybeLoadApply; + if (SourceJSON=Nil) then + Raise EJSON.Create(SErrSourceEmpty); + if (ApplyJSON=Nil) then + Raise EJSON.Create(SErrApplyEmpty); + if CloneSource then + FDestJSON:=SourceJSON.Clone as TJSONObject + else + FDestJSON:=SourceJSON; + Apply(FindStart(FDestJSON,SourcePath,'Source'),FindStart(ApplyJSON,ApplyPath,'Apply')); + if (DestFileName<>'') then + SaveDestJSON(DestFileName); +end; + +end. +