paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 08:49:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented FormatJSON

Browse Source 
git-svn-id: trunk@16146 -
This commit is contained in:
michael 2010-10-12 20:08:23 +00:00
parent 8dd254b281
commit 48e8728b89
1 changed files with 102 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
packages/fcl-json/src/fpjson.pp
View File

@ -31,9 +31,21 @@ type
TJSONStringType = AnsiString;
TJSONCharType = AnsiChar;
PJSONCharType = ^TJSONCharType;
TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line
foSingleLineObject, // Object without CR/LF : all on one line
foDoNotQuoteMembers, // Do not quote object member names.
foUseTabchar); // Use tab characters instead of spaces.
TFormatOptions = set of TFormatOption;
Const
DefaultIndentSize = 2;
DefaultFormat = [];
AsJSONFormat = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
Type
{ TJSONData }
TJSONData = class(TObject)
protected
function GetAsBoolean: Boolean; virtual; abstract;
@ -52,12 +64,14 @@ type
procedure SetValue(const AValue: variant); virtual; abstract;
function GetItem(Index : Integer): TJSONData; virtual;
procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
function GetCount: Integer; virtual;
public
Constructor Create; virtual;
Class function JSONType: TJSONType; virtual;
Procedure Clear; virtual; Abstract;
Function Clone : TJSONData; virtual; abstract;
Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType;
property Count: Integer read GetCount;
property Items[Index: Integer]: TJSONData read GetItem write SetItem;
property Value: variant read GetValue write SetValue;
@ -277,6 +291,7 @@ type
function GetCount: Integer; override;
function GetItem(Index : Integer): TJSONData; override;
procedure SetItem(Index : Integer; const AValue: TJSONData); override;
Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
public
Constructor Create; overload; reintroduce;
Constructor Create(const Elements : Array of Const); overload;
@ -357,6 +372,7 @@ type
function GetCount: Integer; override;
function GetItem(Index : Integer): TJSONData; override;
procedure SetItem(Index : Integer; const AValue: TJSONData); override;
Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
public
constructor Create; reintroduce;
Constructor Create(const Elements : Array of Const); overload;
@ -541,6 +557,18 @@ begin
// Do Nothing
end;
Function TJSONData.FormatJSON(Options : TFormatOptions = DefaultFormat; IndentSize : Integer = DefaultIndentSize) : TJSONStringType;
begin
Result:=DoFormatJSON(Options,0,IndentSize);
end;
Function TJSONData.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType;
begin
Result:=AsJSON;
end;
{ TJSONnumber }
class function TJSONnumber.JSONType: TJSONType;
@ -1256,6 +1284,42 @@ begin
end;
{$warnings off}
Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
begin
If (foUseTabChar in Options) then
Result:=StringofChar(#9,Indent)
else
Result:=StringOfChar(' ',Indent);
end;
Function TJSONArray.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType;
Var
I : Integer;
begin
Result:='[';
if not (foSingleLineArray in Options) then
Result:=Result+sLineBreak;
For I:=0 to Count-1 do
begin
if not (foSingleLineArray in Options) then
Result:=Result+IndentString(Options, CurrentIndent+Indent);
Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
If (I<Count-1) then
if (foSingleLineArray in Options) then
Result:=Result+', '
else
Result:=Result+',';
if not (foSingleLineArray in Options) then
Result:=Result+sLineBreak
end;
Result:=Result+']';
end;
function TJSONArray.GetAsString: TJSONStringType;
begin
ConvertError(True);
@ -1748,6 +1812,43 @@ begin
end;
end;
Function TJSONObject.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType;
Var
i : Integer;
S : TJSONStringType;
begin
CurrentIndent:=CurrentIndent+Indent;
For I:=0 to Count-1 do
begin
If (Result<>'') then
begin
If (foSingleLineObject in Options) then
Result:=Result+', '
else
Result:=Result+','+SLineBreak;
end;
If not (foSingleLineObject in Options) then
Result:=Result+IndentString(Options,CurrentIndent);
S:=StringToJSONString(Names[i]);
If not (foDoNotQuoteMembers in options) then
S:='"'+S+'"';
Result:=Result+S+' : '+Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
end;
If (Result<>'') then
begin
if (foSingleLineObject in Options) then
Result:='{ '+Result+' }'
else
Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
end
else
Result:='{}';
end;
procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
Var