mirror of https://gitlab.com/basile.b/dexed.git
fix, DUB json file that included trailing commas were not loadable
This commit is contained in:
parent
c9a1878987
commit
b3d489d610
|
@ -0,0 +1,229 @@
|
||||||
|
This package implements JSON support for FPC.
|
||||||
|
|
||||||
|
You might want to have a look at the lazarus jsonviewer tool, written using
|
||||||
|
fpJSON (see lazarus/tools/jsonviewer). It visualizes the fpJSON data and
|
||||||
|
shows how to program using fpjson.
|
||||||
|
|
||||||
|
JSON support consists of 3 parts:
|
||||||
|
|
||||||
|
unit fpJSON contains the data representation. Basically, it defines a set of
|
||||||
|
classes:
|
||||||
|
|
||||||
|
TJSONData
|
||||||
|
+- TJSONNumber
|
||||||
|
+- TJSONIntegerNumber
|
||||||
|
+- TJSONFloatNumber
|
||||||
|
+- TJSONInt64Number
|
||||||
|
+- TJSONString
|
||||||
|
+- TJSONBoolean
|
||||||
|
+- TJSONNull
|
||||||
|
+- TJSONObject
|
||||||
|
+- TJSONArray
|
||||||
|
|
||||||
|
The TJSONData.JSONType property is an enumerated:
|
||||||
|
TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
|
||||||
|
|
||||||
|
Which allows to determine the type of a value.
|
||||||
|
|
||||||
|
The following methods exist:
|
||||||
|
|
||||||
|
Procedure Clear;
|
||||||
|
Clears the value. For arrays and objects, removes all elements/members
|
||||||
|
Function Clone : TJSONData;
|
||||||
|
Creates an exact replica of the valye
|
||||||
|
property Count: Integer;
|
||||||
|
For simple values this is zero, for complex values this is the number of
|
||||||
|
elements/members. Read only.
|
||||||
|
property Items[Index: Integer]: TJSONData
|
||||||
|
For simple values, reading this will result in an error. For complex
|
||||||
|
values, this gives access to the members.
|
||||||
|
property Value: variant;
|
||||||
|
The value as a variant. Only for simple values.
|
||||||
|
Property AsString : TJSONStringType:
|
||||||
|
The value as a string. Only for simple values.
|
||||||
|
Property AsFloat : TJSONFloat;
|
||||||
|
The value as a float (double). only for simple values.
|
||||||
|
Property AsInteger : Integer ;
|
||||||
|
The value as an integer. only for simple values.
|
||||||
|
Property AsInt64 : Int64;
|
||||||
|
The value as an 64-bit integer. only for simple values.
|
||||||
|
Property AsBoolean : Boolean ;
|
||||||
|
The value as a boolean.
|
||||||
|
Property IsNull : Boolean ;
|
||||||
|
Is the value Null ?
|
||||||
|
Property AsJSON : TJSONStringType
|
||||||
|
Return the value in JSON notation. For simple and complex values.
|
||||||
|
|
||||||
|
The TJSONArray type provides access to the elements in the array in the
|
||||||
|
following ways:
|
||||||
|
|
||||||
|
Property Types[Index : Integer] : TJSONType;
|
||||||
|
Indexed access to the types of the elements in the array.
|
||||||
|
Property Nulls[Index : Integer] : Boolean
|
||||||
|
Checks if the Index-the element is NULL.
|
||||||
|
Property Integers[Index : Integer] : Integer
|
||||||
|
Read/Write element values as integers.
|
||||||
|
Property Int64s[Index : Integer] : Int64
|
||||||
|
Read/Write element values as 64-bit integers.
|
||||||
|
Property Strings[Index : Integer] : TJSONStringType;
|
||||||
|
Read/Write element values as strings.
|
||||||
|
Property Floats[Index : Integer] : TJSONFloat ;
|
||||||
|
Read/Write element values as floats (doubles).
|
||||||
|
Property Booleans[Index : Integer] : Boolean;
|
||||||
|
Read/Write element values as booleans.
|
||||||
|
Property Arrays[Index : Integer] : TJSONArray;
|
||||||
|
Read/Write element values as arrays.
|
||||||
|
Property Objects[Index : Integer] : TJSONObject;
|
||||||
|
Read/Write element values a strings
|
||||||
|
|
||||||
|
Reading an element as a type which is incompatible, will result in an
|
||||||
|
exception. For instance if element 5 is an object value, then the following
|
||||||
|
will result in an exception:
|
||||||
|
i:=i+Array.Integers[5]
|
||||||
|
|
||||||
|
The TJSONObject type similarly provides access to the elements in the array
|
||||||
|
using the member names:
|
||||||
|
property Names[Index : Integer] : TJSONStringType;
|
||||||
|
Indexed access to the member names.
|
||||||
|
property Elements[AName: string] : TJSONData;
|
||||||
|
Read/Write a member as a raw TJSONData value.
|
||||||
|
Property Types[AName : String] : TJSONType Read GetTypes;
|
||||||
|
Read/Write the type of a member.
|
||||||
|
Property Nulls[AName : String] : Boolean;
|
||||||
|
Read/Write a member as a NULL value.
|
||||||
|
Property Floats[AName : String] : TJSONFloat;
|
||||||
|
Read/Write a member as a float value (double)
|
||||||
|
Property Integers[AName : String] : Integer;
|
||||||
|
Read/Write a member as an integer value
|
||||||
|
Property Int64s[AName : String] : Int64;
|
||||||
|
Read/Write a member as an 64-bit integer value
|
||||||
|
Property Strings[AName : String] : TJSONStringType;
|
||||||
|
Read/Write a member as a string value.
|
||||||
|
Property Booleans[AName : String] : Boolean;
|
||||||
|
Read/Write a member as a boolean value.
|
||||||
|
Property Arrays[AName : String] : TJSONArray;
|
||||||
|
Read/Write a member as an array value.
|
||||||
|
Property Objects[AName : String] : TJSONObject
|
||||||
|
Read/Write a member as an object value.
|
||||||
|
|
||||||
|
Members can be added with the Add() call, which exists in various overloaded
|
||||||
|
forms:
|
||||||
|
function Add(const AName: TJSONStringType; Const AValue): Integer;
|
||||||
|
Where the type of AVAlue is one of the supported types:
|
||||||
|
integer, int64, double, string, TJSONArray or TJSONObject.
|
||||||
|
|
||||||
|
The Delete() call deletes an element from an array or object. The element is
|
||||||
|
freed.
|
||||||
|
|
||||||
|
Important remark:
|
||||||
|
The array and object classes own their members: the members are destroyed as
|
||||||
|
they are deleted. For this, the Extract() call exists: it removes an
|
||||||
|
element/member from the array/object, without destroying it.
|
||||||
|
|
||||||
|
Converting from string/stream to JSONData
|
||||||
|
=========================================
|
||||||
|
|
||||||
|
The fpjson unit contains a GetJSON() function which accepts a string or a
|
||||||
|
stream as a parameter. The function will parse the JSON in the stream and
|
||||||
|
the return value is a TJSONData value corresponding to the JSON.
|
||||||
|
The function works with a callback, which is set by the JSONParser unit.
|
||||||
|
The JSONParser unit simply needs to be included in the project.
|
||||||
|
|
||||||
|
The parsing happens with default settings for the parser class.
|
||||||
|
You can override this behaviour by creating your own callback,
|
||||||
|
and creating the parser with different settings.
|
||||||
|
|
||||||
|
Enumerator support
|
||||||
|
==================
|
||||||
|
|
||||||
|
the TJSONData class offers support for an enumerator, hence the
|
||||||
|
For e in JSON do
|
||||||
|
construct can be used. The enumerator is a TJSONEnum value, which has 3
|
||||||
|
members:
|
||||||
|
Key : The key of the element
|
||||||
|
(name in TJSONObject, Index in TJSONArray, empty otherwise)
|
||||||
|
KeyNum: The index of the element.
|
||||||
|
(Index in TJSONArray/TJSONObject, 0 otherwise)
|
||||||
|
Value : The value of the element
|
||||||
|
(These are the member values for TJSONArray/TJSONObject, and is the
|
||||||
|
element itself otherwise)
|
||||||
|
|
||||||
|
While the enumerator is looping, it is not allowed to change the content of
|
||||||
|
the array or object, and the value may not be freed.
|
||||||
|
|
||||||
|
Scanner/Parser
|
||||||
|
==============
|
||||||
|
|
||||||
|
The JSONSCanner unit contains a scanner for JSON data: TJSONScanner.
|
||||||
|
Currently it does not support full unicode, only UTF-8 is supported.
|
||||||
|
|
||||||
|
The JSONParser unit contains the parser for JSON data: TJSONParser.
|
||||||
|
It uses to scanner to read the tokens. The scanner is created automatically.
|
||||||
|
|
||||||
|
|
||||||
|
The Parse method will parse the data that was passed to the parser and will
|
||||||
|
return the JSON value.
|
||||||
|
|
||||||
|
Sample use:
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : TJSONParser;
|
||||||
|
S : String;
|
||||||
|
D : TJSONObject;
|
||||||
|
|
||||||
|
begin
|
||||||
|
P:=TJSONParser.Create('{ "top": 10, "left": 20}');
|
||||||
|
try
|
||||||
|
D:=P.Parse as TJSONObject;
|
||||||
|
Writeln('Top : ',D.Integers['top']);
|
||||||
|
Writeln('Left : ',D.Integers['left']);
|
||||||
|
D.free;
|
||||||
|
Finally
|
||||||
|
P.free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Note that the member names are case sensitive.
|
||||||
|
|
||||||
|
As an alternative, a stream may be passed to the constructor of TJSONParser.
|
||||||
|
|
||||||
|
The scanner and parser support the 'Strict' property.
|
||||||
|
Strict JSON syntax requires the member names of an object to be strings:
|
||||||
|
{ "top": 10, "left": 20}
|
||||||
|
However, due to the sloppy definition of Javascript (and hence JSON),
|
||||||
|
the following type of JSON notation is frequently encountered:
|
||||||
|
{ top: 10, left: 20}
|
||||||
|
By default, this sloppy notation is accepted. Setting 'Strict' to true will
|
||||||
|
reject this.
|
||||||
|
|
||||||
|
A second effect of the Strict property is the requirement of " as a string
|
||||||
|
delimiter. A single quote is also often found in Javascript and JSON:
|
||||||
|
{ title: 'A nice title' }
|
||||||
|
By default, this is accepted. Setting 'Strict' to true will reject this.
|
||||||
|
|
||||||
|
Customizing the classes : Factory support
|
||||||
|
=========================================
|
||||||
|
|
||||||
|
The various classes created by the methods can be customized.
|
||||||
|
This can be useful to create customized descendents, for example to attach
|
||||||
|
extra data to the various values. All instances of TJSONData are created
|
||||||
|
through the CreateJSON() functions, which use a set of customizable classes
|
||||||
|
to create the JSONData structures.
|
||||||
|
|
||||||
|
All functions which somehow create a new instance (clone, add, insert, parsing)
|
||||||
|
use the CreateJSON functions.
|
||||||
|
|
||||||
|
Which classes need to be created for a specific value is enumerated in
|
||||||
|
|
||||||
|
TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberFloat,
|
||||||
|
jitString, jitBoolean, jitNull, jitArray, jitObject);
|
||||||
|
|
||||||
|
when a Int64 value must be instantiated, the class identified with
|
||||||
|
jitNumberInt64 is instantiated.
|
||||||
|
|
||||||
|
To customize the classes, the new class can be set using SetJSONInstanceType:
|
||||||
|
|
||||||
|
Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
|
||||||
|
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
|
||||||
|
|
||||||
|
The function checks whether sane classes are specified.;
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,793 @@
|
||||||
|
{
|
||||||
|
This file is part of the Free Component Library
|
||||||
|
|
||||||
|
Implementation of TJSONConfig class
|
||||||
|
Copyright (c) 2007 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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
{
|
||||||
|
TJSONConfig enables applications to use JSON files for storing their
|
||||||
|
configuration data
|
||||||
|
}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE objfpc}
|
||||||
|
{$H+}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
unit jsonConf;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, fpjson, jsonscanner, jsonparser;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
EJSONConfigError = class(Exception);
|
||||||
|
|
||||||
|
(* ********************************************************************
|
||||||
|
"APath" is the path and name of a value: A JSON configuration file
|
||||||
|
is hierachical. "/" is the path delimiter, the part after the last
|
||||||
|
"/" is the name of the value. The path components will be mapped
|
||||||
|
to nested JSON objects, with the name equal to the part. In practice
|
||||||
|
this means that "/my/path/value" will be written as:
|
||||||
|
{
|
||||||
|
"my" : {
|
||||||
|
"path" : {
|
||||||
|
"value" : Value
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
******************************************************************** *)
|
||||||
|
|
||||||
|
{ TJSONConfig }
|
||||||
|
|
||||||
|
TJSONConfig = class(TComponent)
|
||||||
|
private
|
||||||
|
FFilename: String;
|
||||||
|
FFormatIndentSize: Integer;
|
||||||
|
FFormatoptions: TFormatOptions;
|
||||||
|
FFormatted: Boolean;
|
||||||
|
FKey: TJSONObject;
|
||||||
|
procedure DoSetFilename(const AFilename: String; ForceReload: Boolean);
|
||||||
|
procedure SetFilename(const AFilename: String);
|
||||||
|
Function StripSlash(Const P : UnicodeString) : UnicodeString;
|
||||||
|
protected
|
||||||
|
FJSON: TJSONObject;
|
||||||
|
FModified: Boolean;
|
||||||
|
procedure Loaded; override;
|
||||||
|
function FindPath(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
|
||||||
|
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
|
||||||
|
function FindObject(Const APath: UnicodeString; AllowCreate : Boolean;Out ElName : UnicodeString) : TJSONObject;
|
||||||
|
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; AllowObject : Boolean = False) : TJSONData;
|
||||||
|
function FindElement(Const APath: UnicodeString; CreateParent : Boolean; out AParent : TJSONObject; Out ElName : UnicodeString; AllowObject : Boolean = False) : TJSONData;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
Procedure Reload;
|
||||||
|
procedure Clear;
|
||||||
|
procedure Flush; // Writes the JSON file
|
||||||
|
procedure OpenKey(const aPath: UnicodeString; AllowCreate : Boolean);
|
||||||
|
procedure CloseKey;
|
||||||
|
procedure ResetKey;
|
||||||
|
Procedure EnumSubKeys(Const APath : UnicodeString; List : TStrings);
|
||||||
|
Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
|
||||||
|
|
||||||
|
function GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
|
||||||
|
function GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
|
||||||
|
function GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
|
||||||
|
function GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
|
||||||
|
function GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
|
||||||
|
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
|
||||||
|
Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; AValue: Double); overload;
|
||||||
|
procedure SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False); overload;
|
||||||
|
|
||||||
|
procedure SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString); overload;
|
||||||
|
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Integer); overload;
|
||||||
|
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Int64); overload;
|
||||||
|
procedure SetDeleteValue(const APath: UnicodeString; AValue, DefValue: Boolean); overload;
|
||||||
|
|
||||||
|
procedure DeletePath(const APath: UnicodeString);
|
||||||
|
procedure DeleteValue(const APath: UnicodeString);
|
||||||
|
property Modified: Boolean read FModified;
|
||||||
|
published
|
||||||
|
Property Filename: String read FFilename write SetFilename;
|
||||||
|
Property Formatted : Boolean Read FFormatted Write FFormatted;
|
||||||
|
Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
|
||||||
|
Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// ===================================================================
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
Resourcestring
|
||||||
|
SErrInvalidJSONFile = '"%s" is not a valid JSON configuration file.';
|
||||||
|
SErrCouldNotOpenKey = 'Could not open key "%s".';
|
||||||
|
|
||||||
|
constructor TJSONConfig.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FJSON:=TJSONObject.Create;
|
||||||
|
FKey:=FJSON;
|
||||||
|
FFormatOptions:=DefaultFormat;
|
||||||
|
FFormatIndentsize:=DefaultIndentSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJSONConfig.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(FJSON) then
|
||||||
|
begin
|
||||||
|
Flush;
|
||||||
|
FreeANdNil(FJSON);
|
||||||
|
end;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.Clear;
|
||||||
|
begin
|
||||||
|
FJSON.Clear;
|
||||||
|
FKey:=FJSON;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.Flush;
|
||||||
|
|
||||||
|
Var
|
||||||
|
F : Text;
|
||||||
|
S : TJSONStringType;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Modified then
|
||||||
|
begin
|
||||||
|
AssignFile(F,FileName);
|
||||||
|
Rewrite(F);
|
||||||
|
Try
|
||||||
|
if Formatted then
|
||||||
|
S:=FJSON.FormatJSON(Formatoptions,FormatIndentSize)
|
||||||
|
else
|
||||||
|
S:=FJSON.AsJSON;
|
||||||
|
Writeln(F,S);
|
||||||
|
Finally
|
||||||
|
CloseFile(F);
|
||||||
|
end;
|
||||||
|
FModified := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean
|
||||||
|
): TJSONObject;
|
||||||
|
|
||||||
|
Var
|
||||||
|
Dummy : UnicodeString;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=FindObject(APath,AllowCreate,Dummy);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.FindObject(const APath: UnicodeString; AllowCreate: Boolean;
|
||||||
|
out ElName: UnicodeString): TJSONObject;
|
||||||
|
|
||||||
|
Var
|
||||||
|
S,El : UnicodeString;
|
||||||
|
P,I : Integer;
|
||||||
|
T : TJSonObject;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// Writeln('Looking for : ', APath);
|
||||||
|
S:=APath;
|
||||||
|
If Pos('/',S)=1 then
|
||||||
|
Result:=FJSON
|
||||||
|
else
|
||||||
|
Result:=FKey;
|
||||||
|
Repeat
|
||||||
|
P:=Pos('/',S);
|
||||||
|
If (P<>0) then
|
||||||
|
begin
|
||||||
|
// Only real paths, ignore double slash
|
||||||
|
If (P<>1) then
|
||||||
|
begin
|
||||||
|
El:=Copy(S,1,P-1);
|
||||||
|
If (Result.Count=0) then
|
||||||
|
I:=-1
|
||||||
|
else
|
||||||
|
I:=Result.IndexOfName(UTF8Encode(El));
|
||||||
|
If (I=-1) then
|
||||||
|
// No element with this name.
|
||||||
|
begin
|
||||||
|
If AllowCreate then
|
||||||
|
begin
|
||||||
|
// Create new node.
|
||||||
|
T:=Result;
|
||||||
|
Result:=TJSonObject.Create;
|
||||||
|
T.Add(UTF8Encode(El),Result);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result:=Nil
|
||||||
|
end
|
||||||
|
else
|
||||||
|
// Node found, check if it is an object
|
||||||
|
begin
|
||||||
|
if (Result.Items[i].JSONtype=jtObject) then
|
||||||
|
Result:=Result.Objects[UTF8Encode(el)]
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Writeln(el,' type wrong');
|
||||||
|
If AllowCreate then
|
||||||
|
begin
|
||||||
|
// Writeln('Creating ',el);
|
||||||
|
Result.Delete(I);
|
||||||
|
T:=Result;
|
||||||
|
Result:=TJSonObject.Create;
|
||||||
|
T.Add(UTF8Encode(El),Result);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result:=Nil
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Delete(S,1,P);
|
||||||
|
end;
|
||||||
|
Until (P=0) or (Result=Nil);
|
||||||
|
ElName:=S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.FindElement(const APath: UnicodeString; CreateParent: Boolean; AllowObject : Boolean = False): TJSONData;
|
||||||
|
|
||||||
|
Var
|
||||||
|
O : TJSONObject;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=FindElement(APath,CreateParent,O,ElName,AllowObject);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.FindElement(const APath: UnicodeString;
|
||||||
|
CreateParent: Boolean; out AParent: TJSONObject; out ElName: UnicodeString;
|
||||||
|
AllowObject : Boolean = False): TJSONData;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=Nil;
|
||||||
|
Aparent:=FindObject(APath,CreateParent,ElName);
|
||||||
|
If Assigned(Aparent) then
|
||||||
|
begin
|
||||||
|
// Writeln('Found parent, looking for element:',elName);
|
||||||
|
I:=AParent.IndexOfName(UTF8Encode(ElName));
|
||||||
|
// Writeln('Element index is',I);
|
||||||
|
If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
|
||||||
|
Result:=AParent.Items[i];
|
||||||
|
end;
|
||||||
|
// Writeln('Find ',aPath,' in "',FJSON.AsJSOn,'" : ',Elname,' : ',Result<>NIl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),False);
|
||||||
|
If Assigned(El) then
|
||||||
|
Result:=El.AsUnicodeString
|
||||||
|
else
|
||||||
|
Result:=ADefault;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),False);
|
||||||
|
If Not Assigned(el) then
|
||||||
|
Result:=ADefault
|
||||||
|
else if (el is TJSONNumber) then
|
||||||
|
Result:=El.AsInteger
|
||||||
|
else
|
||||||
|
Result:=StrToIntDef(El.AsString,ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),False);
|
||||||
|
If Not Assigned(el) then
|
||||||
|
Result:=ADefault
|
||||||
|
else if (el is TJSONNumber) then
|
||||||
|
Result:=El.AsInt64
|
||||||
|
else
|
||||||
|
Result:=StrToInt64Def(El.AsString,ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),False);
|
||||||
|
If Not Assigned(el) then
|
||||||
|
Result:=ADefault
|
||||||
|
else if (el is TJSONBoolean) then
|
||||||
|
Result:=El.AsBoolean
|
||||||
|
else
|
||||||
|
Result:=StrToBoolDef(El.AsString,ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),False);
|
||||||
|
If Not Assigned(el) then
|
||||||
|
Result:=ADefault
|
||||||
|
else if (el is TJSONNumber) then
|
||||||
|
Result:=El.AsFloat
|
||||||
|
else
|
||||||
|
Result:=StrToFloatDef(El.AsString,ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
|
||||||
|
const ADefault: String): Boolean;
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
D : TJSONEnum;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AValue.Clear;
|
||||||
|
El:=FindElement(StripSlash(APath),False,True);
|
||||||
|
Result:=Assigned(el);
|
||||||
|
If Not Result then
|
||||||
|
begin
|
||||||
|
AValue.Text:=ADefault;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Case El.JSONType of
|
||||||
|
jtArray:
|
||||||
|
For D in El do
|
||||||
|
if D.Value.JSONType in ActualValueJSONTypes then
|
||||||
|
AValue.Add(D.Value.AsString);
|
||||||
|
jtObject:
|
||||||
|
For D in El do
|
||||||
|
if D.Value.JSONType in ActualValueJSONTypes then
|
||||||
|
AValue.Add(D.Key+'='+D.Value.AsString);
|
||||||
|
else
|
||||||
|
AValue.Text:=EL.AsString
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
|
||||||
|
const ADefault: TStrings): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=GetValue(APath,AValue,'');
|
||||||
|
If Not Result then
|
||||||
|
AValue.Assign(ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; const AValue: UnicodeString);
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName);
|
||||||
|
if Assigned(El) and (El.JSONType<>jtString) then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
El:=TJSONString.Create(AValue);
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
El.AsUnicodeString:=AValue;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
|
||||||
|
begin
|
||||||
|
if AValue = DefValue then
|
||||||
|
DeleteValue(APath)
|
||||||
|
else
|
||||||
|
SetValue(APath, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Integer);
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName);
|
||||||
|
if Assigned(El) and (Not (El is TJSONIntegerNumber)) then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
If (I<>-1) then // Normally not needed...
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
El:=TJSONIntegerNumber.Create(AValue);
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
El.AsInteger:=AValue;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Int64);
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName);
|
||||||
|
if Assigned(El) and (Not (El is TJSONInt64Number)) then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
If (I<>-1) then // Normally not needed...
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
El:=TJSONInt64Number.Create(AValue);
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
El.AsInt64:=AValue;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
||||||
|
DefValue: Integer);
|
||||||
|
begin
|
||||||
|
if AValue = DefValue then
|
||||||
|
DeleteValue(APath)
|
||||||
|
else
|
||||||
|
SetValue(APath, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
||||||
|
DefValue: Int64);
|
||||||
|
begin
|
||||||
|
if AValue = DefValue then
|
||||||
|
DeleteValue(APath)
|
||||||
|
else
|
||||||
|
SetValue(APath, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Boolean);
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName);
|
||||||
|
if Assigned(El) and (el.JSONType<>jtBoolean) then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
El:=TJSONBoolean.Create(AValue);
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
El.AsBoolean:=AValue;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: Double);
|
||||||
|
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName);
|
||||||
|
if Assigned(El) and (Not (El is TJSONFloatNumber)) then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
El:=TJSONFloatNumber.Create(AValue);
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
El.AsFloat:=AValue;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetValue(const APath: UnicodeString; AValue: TStrings; AsObject : Boolean = False);
|
||||||
|
var
|
||||||
|
El : TJSONData;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
O : TJSONObject;
|
||||||
|
I : integer;
|
||||||
|
A : TJSONArray;
|
||||||
|
N,V : String;
|
||||||
|
DoDelete: Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
El:=FindElement(StripSlash(APath),True,O,ElName,True);
|
||||||
|
if Assigned(El) then
|
||||||
|
begin
|
||||||
|
if AsObject then
|
||||||
|
DoDelete:=(Not (El is TJSONObject))
|
||||||
|
else
|
||||||
|
DoDelete:=(Not (El is TJSONArray));
|
||||||
|
if DoDelete then
|
||||||
|
begin
|
||||||
|
I:=O.IndexOfName(UTF8Encode(elName));
|
||||||
|
O.Delete(i);
|
||||||
|
El:=Nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
If Not Assigned(el) then
|
||||||
|
begin
|
||||||
|
if AsObject then
|
||||||
|
El:=TJSONObject.Create
|
||||||
|
else
|
||||||
|
El:=TJSONArray.Create;
|
||||||
|
O.Add(UTF8Encode(ElName),El);
|
||||||
|
end;
|
||||||
|
if Not AsObject then
|
||||||
|
begin
|
||||||
|
A:=El as TJSONArray;
|
||||||
|
A.Clear;
|
||||||
|
For N in Avalue do
|
||||||
|
A.Add(N);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
O:=El as TJSONObject;
|
||||||
|
For I:=0 to AValue.Count-1 do
|
||||||
|
begin
|
||||||
|
AValue.GetNameValue(I,N,V);
|
||||||
|
O.Add(N,V);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FModified:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; AValue,
|
||||||
|
DefValue: Boolean);
|
||||||
|
begin
|
||||||
|
if AValue = DefValue then
|
||||||
|
DeleteValue(APath)
|
||||||
|
else
|
||||||
|
SetValue(APath,AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.DeletePath(const APath: UnicodeString);
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : UnicodeString;
|
||||||
|
L : integer;
|
||||||
|
Node : TJSONObject;
|
||||||
|
ElName : UnicodeString;
|
||||||
|
|
||||||
|
begin
|
||||||
|
P:=StripSlash(APath);
|
||||||
|
L:=Length(P);
|
||||||
|
If (L>0) then
|
||||||
|
begin
|
||||||
|
Node := FindObject(P,False,ElName);
|
||||||
|
If Assigned(Node) then
|
||||||
|
begin
|
||||||
|
L:=Node.IndexOfName(UTF8Encode(ElName));
|
||||||
|
If (L<>-1) then
|
||||||
|
Node.Delete(L);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
DeletePath(APath);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.Reload;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Length(Filename) > 0 then
|
||||||
|
DoSetFilename(Filename,True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.Loaded;
|
||||||
|
begin
|
||||||
|
inherited Loaded;
|
||||||
|
Reload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.FindPath(const APath: UnicodeString; AllowCreate: Boolean
|
||||||
|
): TJSONObject;
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : UnicodeString;
|
||||||
|
L : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
P:=APath;
|
||||||
|
L:=Length(P);
|
||||||
|
If (L=0) or (P[L]<>'/') then
|
||||||
|
P:=P+'/';
|
||||||
|
Result:=FindObject(P,AllowCreate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean);
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : TJSONParser;
|
||||||
|
J : TJSONData;
|
||||||
|
F : TFileStream;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (not ForceReload) and (FFilename = AFilename) then
|
||||||
|
exit;
|
||||||
|
FFilename := AFilename;
|
||||||
|
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
Flush;
|
||||||
|
If Not FileExists(AFileName) then
|
||||||
|
Clear
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
F:=TFileStream.Create(AFileName,fmopenRead);
|
||||||
|
try
|
||||||
|
P:=TJSONParser.Create(F,[joUTF8,joComments]);
|
||||||
|
try
|
||||||
|
J:=P.Parse;
|
||||||
|
If (J is TJSONObject) then
|
||||||
|
begin
|
||||||
|
FreeAndNil(FJSON);
|
||||||
|
FJSON:=J as TJSONObject;
|
||||||
|
FKey:=FJSON;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[AFileName]);
|
||||||
|
finally
|
||||||
|
P.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
F.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.SetFilename(const AFilename: String);
|
||||||
|
begin
|
||||||
|
DoSetFilename(AFilename, False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONConfig.StripSlash(const P: UnicodeString): UnicodeString;
|
||||||
|
|
||||||
|
Var
|
||||||
|
L : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
L:=Length(P);
|
||||||
|
If (L>0) and (P[l]='/') then
|
||||||
|
Result:=Copy(P,1,L-1)
|
||||||
|
else
|
||||||
|
Result:=P;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TJSONConfig.CloseKey;
|
||||||
|
begin
|
||||||
|
ResetKey;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : UnicodeString;
|
||||||
|
L : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
P:=APath;
|
||||||
|
L:=Length(P);
|
||||||
|
If (L=0) then
|
||||||
|
FKey:=FJSON
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (P[L]<>'/') then
|
||||||
|
P:=P+'/';
|
||||||
|
FKey:=FindObject(P,AllowCreate);
|
||||||
|
If (FKey=Nil) Then
|
||||||
|
Raise EJSONConfigError.CreateFmt(SErrCouldNotOpenKey,[APath]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.ResetKey;
|
||||||
|
begin
|
||||||
|
FKey:=FJSON;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.EnumSubKeys(const APath: UnicodeString; List: TStrings);
|
||||||
|
|
||||||
|
Var
|
||||||
|
AKey : TJSONObject;
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AKey:=FindPath(APath,False);
|
||||||
|
If Assigned(AKey) then
|
||||||
|
begin
|
||||||
|
For I:=0 to AKey.Count-1 do
|
||||||
|
If AKey.Items[i] is TJSONObject then
|
||||||
|
List.Add(AKey.Names[i]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONConfig.EnumValues(const APath: UnicodeString; List: TStrings);
|
||||||
|
|
||||||
|
Var
|
||||||
|
AKey : TJSONObject;
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AKey:=FindPath(APath,False);
|
||||||
|
If Assigned(AKey) then
|
||||||
|
begin
|
||||||
|
For I:=0 to AKey.Count-1 do
|
||||||
|
If Not (AKey.Items[i] is TJSONObject) then
|
||||||
|
List.Add(AKey.Names[i]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,382 @@
|
||||||
|
{
|
||||||
|
This file is part of the Free Component Library
|
||||||
|
|
||||||
|
JSON source parser
|
||||||
|
Copyright (c) 2007 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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
unit jsonparser;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpJSON, jsonscanner;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
{ TJSONParser }
|
||||||
|
|
||||||
|
TJSONParser = Class(TObject)
|
||||||
|
Private
|
||||||
|
FScanner : TJSONScanner;
|
||||||
|
function GetO(AIndex: TJSONOption): Boolean;
|
||||||
|
function GetOptions: TJSONOptions;
|
||||||
|
function ParseNumber: TJSONNumber;
|
||||||
|
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||||
|
procedure SetOptions(AValue: TJSONOptions);
|
||||||
|
Protected
|
||||||
|
procedure DoError(const Msg: String);
|
||||||
|
function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
|
||||||
|
function GetNextToken: TJSONToken;
|
||||||
|
function CurrentTokenString: String;
|
||||||
|
function CurrentToken: TJSONToken;
|
||||||
|
function ParseArray: TJSONArray;
|
||||||
|
function ParseObject: TJSONObject;
|
||||||
|
Property Scanner : TJSONScanner read FScanner;
|
||||||
|
Public
|
||||||
|
function Parse: TJSONData;
|
||||||
|
Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
|
||||||
|
Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
|
||||||
|
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
|
||||||
|
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
|
||||||
|
destructor Destroy();override;
|
||||||
|
// Use strict JSON: " for strings, object members are strings, not identifiers
|
||||||
|
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
|
||||||
|
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
|
||||||
|
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
|
||||||
|
// Parsing options
|
||||||
|
Property Options : TJSONOptions Read GetOptions Write SetOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EJSONParser = Class(EParserError);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
Resourcestring
|
||||||
|
SErrUnexpectedEOF = 'Unexpected EOF encountered.';
|
||||||
|
SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
|
||||||
|
SErrExpectedColon = 'Expected colon (:), got token "%s".';
|
||||||
|
SErrUnexpectedComma = 'Invalid comma encountered.';
|
||||||
|
SErrEmptyElement = 'Empty element encountered.';
|
||||||
|
SErrExpectedElementName = 'Expected element name, got token "%s"';
|
||||||
|
SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
|
||||||
|
SErrInvalidNumber = 'Number is not an integer or real number: %s';
|
||||||
|
SErrNoScanner = 'No scanner. No source specified ?';
|
||||||
|
|
||||||
|
{ TJSONParser }
|
||||||
|
|
||||||
|
procedure DefJSONParserHandler(AStream: TStream; const AUseUTF8: Boolean; out
|
||||||
|
Data: TJSONData);
|
||||||
|
|
||||||
|
Var
|
||||||
|
P : TJSONParser;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Data:=Nil;
|
||||||
|
P:=TJSONParser.Create(AStream,[joUTF8]);
|
||||||
|
try
|
||||||
|
Data:=P.Parse;
|
||||||
|
finally
|
||||||
|
P.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONParser.Parse: TJSONData;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (FScanner=Nil) then
|
||||||
|
DoError(SErrNoScanner);
|
||||||
|
Result:=DoParse(False,True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
Consume next token and convert to JSON data structure.
|
||||||
|
If AtCurrent is true, the current token is used. If false,
|
||||||
|
a token is gotten from the scanner.
|
||||||
|
If AllowEOF is false, encountering a tkEOF will result in an exception.
|
||||||
|
}
|
||||||
|
|
||||||
|
function TJSONParser.CurrentToken: TJSONToken;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=FScanner.CurToken;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONParser.CurrentTokenString: String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
|
||||||
|
Result:=FScanner.CurTokenString
|
||||||
|
else
|
||||||
|
Result:=TokenInfos[CurrentToken];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONParser.DoParse(AtCurrent, AllowEOF: Boolean): TJSONData;
|
||||||
|
|
||||||
|
var
|
||||||
|
T : TJSONToken;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
try
|
||||||
|
If not AtCurrent then
|
||||||
|
T:=GetNextToken
|
||||||
|
else
|
||||||
|
T:=FScanner.CurToken;
|
||||||
|
Case T of
|
||||||
|
tkEof : If Not AllowEof then
|
||||||
|
DoError(SErrUnexpectedEOF);
|
||||||
|
tkNull : Result:=CreateJSON;
|
||||||
|
tkTrue,
|
||||||
|
tkFalse : Result:=CreateJSON(t=tkTrue);
|
||||||
|
tkString : if joUTF8 in Options then
|
||||||
|
Result:=CreateJSON(UTF8Decode(CurrentTokenString))
|
||||||
|
else
|
||||||
|
Result:=CreateJSON(CurrentTokenString);
|
||||||
|
tkCurlyBraceOpen : Result:=ParseObject;
|
||||||
|
tkCurlyBraceClose : DoError(SErrUnexpectedToken);
|
||||||
|
tkSQuaredBraceOpen : Result:=ParseArray;
|
||||||
|
tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
|
||||||
|
tkNumber : Result:=ParseNumber;
|
||||||
|
tkComma : DoError(SErrUnexpectedToken);
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
FreeAndNil(Result);
|
||||||
|
Raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Creates the correct JSON number type, based on the current token.
|
||||||
|
function TJSONParser.ParseNumber: TJSONNumber;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : Integer;
|
||||||
|
I64 : Int64;
|
||||||
|
QW : QWord;
|
||||||
|
F : TJSONFloat;
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S:=CurrentTokenString;
|
||||||
|
I:=0;
|
||||||
|
if TryStrToQWord(S,QW) then
|
||||||
|
begin
|
||||||
|
if QW>qword(high(Int64)) then
|
||||||
|
Result:=CreateJSON(QW)
|
||||||
|
else
|
||||||
|
if QW>MaxInt then
|
||||||
|
begin
|
||||||
|
I64 := QW;
|
||||||
|
Result:=CreateJSON(I64);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I := QW;
|
||||||
|
Result:=CreateJSON(I);
|
||||||
|
end
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
If TryStrToInt64(S,I64) then
|
||||||
|
if (I64>Maxint) or (I64<-MaxInt) then
|
||||||
|
Result:=CreateJSON(I64)
|
||||||
|
Else
|
||||||
|
begin
|
||||||
|
I:=I64;
|
||||||
|
Result:=CreateJSON(I);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I:=0;
|
||||||
|
Val(S,F,I);
|
||||||
|
If (I<>0) then
|
||||||
|
DoError(SErrInvalidNumber);
|
||||||
|
Result:=CreateJSON(F);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONParser.GetO(AIndex: TJSONOption): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=AIndex in Options;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONParser.GetOptions: TJSONOptions;
|
||||||
|
begin
|
||||||
|
Result:=FScanner.Options
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||||
|
begin
|
||||||
|
if aValue then
|
||||||
|
FScanner.Options:=FScanner.Options+[AINdex]
|
||||||
|
else
|
||||||
|
FScanner.Options:=FScanner.Options-[AINdex]
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONParser.SetOptions(AValue: TJSONOptions);
|
||||||
|
begin
|
||||||
|
FScanner.Options:=AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Current token is {, on exit current token is }
|
||||||
|
function TJSONParser.ParseObject: TJSONObject;
|
||||||
|
|
||||||
|
Var
|
||||||
|
T : TJSONtoken;
|
||||||
|
E : TJSONData;
|
||||||
|
N : String;
|
||||||
|
LastComma : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
LastComma:=False;
|
||||||
|
Result:=CreateJSONObject([]);
|
||||||
|
Try
|
||||||
|
T:=GetNextToken;
|
||||||
|
While T<>tkCurlyBraceClose do
|
||||||
|
begin
|
||||||
|
If (T<>tkString) and (T<>tkIdentifier) then
|
||||||
|
DoError(SErrExpectedElementName);
|
||||||
|
N:=CurrentTokenString;
|
||||||
|
T:=GetNextToken;
|
||||||
|
If (T<>tkColon) then
|
||||||
|
DoError(SErrExpectedColon);
|
||||||
|
E:=DoParse(False,False);
|
||||||
|
Result.Add(N,E);
|
||||||
|
T:=GetNextToken;
|
||||||
|
If Not (T in [tkComma,tkCurlyBraceClose]) then
|
||||||
|
DoError(SExpectedCommaorBraceClose);
|
||||||
|
If T=tkComma then
|
||||||
|
begin
|
||||||
|
T:=GetNextToken;
|
||||||
|
LastComma:=(t=tkCurlyBraceClose);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options)) then // Test for ,} case
|
||||||
|
DoError(SErrUnExpectedToken);
|
||||||
|
Except
|
||||||
|
FreeAndNil(Result);
|
||||||
|
Raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Current token is [, on exit current token is ]
|
||||||
|
function TJSONParser.ParseArray: TJSONArray;
|
||||||
|
|
||||||
|
Var
|
||||||
|
T : TJSONtoken;
|
||||||
|
E : TJSONData;
|
||||||
|
LastComma : Boolean;
|
||||||
|
S : TJSONOPTions;
|
||||||
|
begin
|
||||||
|
Result:=CreateJSONArray([]);
|
||||||
|
LastComma:=False;
|
||||||
|
Try
|
||||||
|
Repeat
|
||||||
|
T:=GetNextToken;
|
||||||
|
If (T<>tkSquaredBraceClose) then
|
||||||
|
begin
|
||||||
|
E:=DoParse(True,False);
|
||||||
|
If (E<>Nil) then
|
||||||
|
Result.Add(E)
|
||||||
|
else if (Result.Count>0) then
|
||||||
|
DoError(SErrEmptyElement);
|
||||||
|
T:=GetNextToken;
|
||||||
|
If Not (T in [tkComma,tkSquaredBraceClose]) then
|
||||||
|
DoError(SExpectedCommaorBraceClose);
|
||||||
|
LastComma:=(t=TkComma);
|
||||||
|
end;
|
||||||
|
Until (T=tkSquaredBraceClose);
|
||||||
|
S:=Options;
|
||||||
|
If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S)) then // Test for ,] case
|
||||||
|
DoError(SErrUnExpectedToken);
|
||||||
|
Except
|
||||||
|
FreeAndNil(Result);
|
||||||
|
Raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Get next token, discarding whitespace
|
||||||
|
function TJSONParser.GetNextToken: TJSONToken;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Repeat
|
||||||
|
Result:=FScanner.FetchToken;
|
||||||
|
Until (Not (Result in [tkComment,tkWhiteSpace]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONParser.DoError(const Msg: String);
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S:=Format(Msg,[CurrentTokenString]);
|
||||||
|
S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
|
||||||
|
Raise EJSONParser.Create(S);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
|
||||||
|
begin
|
||||||
|
Inherited Create;
|
||||||
|
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
|
||||||
|
if AUseUTF8 then
|
||||||
|
Options:=Options + [joUTF8];
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
|
||||||
|
begin
|
||||||
|
Inherited Create;
|
||||||
|
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
|
||||||
|
if AUseUTF8 then
|
||||||
|
Options:=Options + [joUTF8];
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);
|
||||||
|
begin
|
||||||
|
FScanner:=TJSONScanner.Create(Source,AOptions);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONParser.Create(const Source: String; AOptions: TJSONOptions);
|
||||||
|
begin
|
||||||
|
FScanner:=TJSONScanner.Create(Source,AOptions);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJSONParser.Destroy();
|
||||||
|
begin
|
||||||
|
FreeAndNil(FScanner);
|
||||||
|
inherited Destroy();
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure InitJSONHandler;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if GetJSONParserHandler=Nil then
|
||||||
|
SetJSONParserHandler(@DefJSONParserHandler);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure DoneJSONHandler;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if GetJSONParserHandler=@DefJSONParserHandler then
|
||||||
|
SetJSONParserHandler(Nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
InitJSONHandler;
|
||||||
|
finalization
|
||||||
|
DoneJSONHandler;
|
||||||
|
end.
|
||||||
|
|
|
@ -0,0 +1,481 @@
|
||||||
|
{
|
||||||
|
This file is part of the Free Component Library
|
||||||
|
|
||||||
|
JSON source lexical scanner
|
||||||
|
Copyright (c) 2007 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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
|
||||||
|
unit jsonscanner;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses SysUtils, Classes;
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
|
||||||
|
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
|
||||||
|
SErrOpenString = 'string exceeds end of line';
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TJSONToken = (
|
||||||
|
tkEOF,
|
||||||
|
tkWhitespace,
|
||||||
|
tkString,
|
||||||
|
tkNumber,
|
||||||
|
tkTrue,
|
||||||
|
tkFalse,
|
||||||
|
tkNull,
|
||||||
|
// Simple (one-character) tokens
|
||||||
|
tkComma, // ','
|
||||||
|
tkColon, // ':'
|
||||||
|
tkCurlyBraceOpen, // '{'
|
||||||
|
tkCurlyBraceClose, // '}'
|
||||||
|
tkSquaredBraceOpen, // '['
|
||||||
|
tkSquaredBraceClose, // ']'
|
||||||
|
tkIdentifier, // Any Javascript identifier
|
||||||
|
tkComment,
|
||||||
|
tkUnknown
|
||||||
|
);
|
||||||
|
|
||||||
|
EScannerError = class(EParserError);
|
||||||
|
|
||||||
|
TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
|
||||||
|
TJSONOptions = set of TJSONOption;
|
||||||
|
|
||||||
|
Const
|
||||||
|
DefaultOptions = [joUTF8];
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
{ TJSONScanner }
|
||||||
|
|
||||||
|
TJSONScanner = class
|
||||||
|
private
|
||||||
|
FAllowComments: Boolean;
|
||||||
|
FSource : TStringList;
|
||||||
|
FCurRow: Integer;
|
||||||
|
FCurToken: TJSONToken;
|
||||||
|
FCurTokenString: string;
|
||||||
|
FCurLine: string;
|
||||||
|
TokenStr: PChar;
|
||||||
|
FOptions : TJSONOptions;
|
||||||
|
function GetCurColumn: Integer;
|
||||||
|
function GetO(AIndex: TJSONOption): Boolean;
|
||||||
|
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||||
|
protected
|
||||||
|
procedure Error(const Msg: string);overload;
|
||||||
|
procedure Error(const Msg: string; Const Args: array of Const);overload;
|
||||||
|
function DoFetchToken: TJSONToken;
|
||||||
|
public
|
||||||
|
constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
||||||
|
constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
||||||
|
constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
|
||||||
|
constructor Create(const Source: String; AOptions: TJSONOptions); overload;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function FetchToken: TJSONToken;
|
||||||
|
|
||||||
|
|
||||||
|
property CurLine: string read FCurLine;
|
||||||
|
property CurRow: Integer read FCurRow;
|
||||||
|
property CurColumn: Integer read GetCurColumn;
|
||||||
|
|
||||||
|
property CurToken: TJSONToken read FCurToken;
|
||||||
|
property CurTokenString: string read FCurTokenString;
|
||||||
|
// Use strict JSON: " for strings, object members are strings, not identifiers
|
||||||
|
Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
|
||||||
|
// if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
|
||||||
|
Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
|
||||||
|
// Parsing options
|
||||||
|
Property Options : TJSONOptions Read FOptions Write FOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
TokenInfos: array[TJSONToken] of string = (
|
||||||
|
'EOF',
|
||||||
|
'Whitespace',
|
||||||
|
'String',
|
||||||
|
'Number',
|
||||||
|
'True',
|
||||||
|
'False',
|
||||||
|
'Null',
|
||||||
|
',',
|
||||||
|
':',
|
||||||
|
'{',
|
||||||
|
'}',
|
||||||
|
'[',
|
||||||
|
']',
|
||||||
|
'identifier',
|
||||||
|
'comment',
|
||||||
|
''
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
|
||||||
|
|
||||||
|
Var
|
||||||
|
O : TJSONOptions;
|
||||||
|
|
||||||
|
begin
|
||||||
|
O:=DefaultOptions;
|
||||||
|
if AUseUTF8 then
|
||||||
|
Include(O,joUTF8)
|
||||||
|
else
|
||||||
|
Exclude(O,joUTF8);
|
||||||
|
Create(Source,O);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
|
||||||
|
Var
|
||||||
|
O : TJSONOptions;
|
||||||
|
|
||||||
|
begin
|
||||||
|
O:=DefaultOptions;
|
||||||
|
if AUseUTF8 then
|
||||||
|
Include(O,joUTF8)
|
||||||
|
else
|
||||||
|
Exclude(O,joUTF8);
|
||||||
|
Create(Source,O);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
|
||||||
|
begin
|
||||||
|
FSource:=TStringList.Create;
|
||||||
|
FSource.LoadFromStream(Source);
|
||||||
|
FOptions:=AOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
|
||||||
|
begin
|
||||||
|
FSource:=TStringList.Create;
|
||||||
|
FSource.Text:=Source;
|
||||||
|
FOptions:=AOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJSONScanner.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FSource);
|
||||||
|
Inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TJSONScanner.FetchToken: TJSONToken;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=DoFetchToken;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONScanner.Error(const Msg: string);
|
||||||
|
begin
|
||||||
|
raise EScannerError.Create(Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
|
||||||
|
begin
|
||||||
|
raise EScannerError.CreateFmt(Msg, Args);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONScanner.DoFetchToken: TJSONToken;
|
||||||
|
|
||||||
|
function FetchLine: Boolean;
|
||||||
|
begin
|
||||||
|
Result:=FCurRow<FSource.Count;
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
FCurLine:=FSource[FCurRow];
|
||||||
|
TokenStr:=PChar(FCurLine);
|
||||||
|
Inc(FCurRow);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FCurLine:='';
|
||||||
|
TokenStr:=nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
TokenStart, CurPos: PChar;
|
||||||
|
it : TJSONToken;
|
||||||
|
I : Integer;
|
||||||
|
OldLength, SectionLength, Index: Integer;
|
||||||
|
C : char;
|
||||||
|
S : String;
|
||||||
|
IsStar,EOC: Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if TokenStr = nil then
|
||||||
|
if not FetchLine then
|
||||||
|
begin
|
||||||
|
Result := tkEOF;
|
||||||
|
FCurToken := Result;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FCurTokenString := '';
|
||||||
|
|
||||||
|
case TokenStr[0] of
|
||||||
|
#0: // Empty line
|
||||||
|
begin
|
||||||
|
FetchLine;
|
||||||
|
Result := tkWhitespace;
|
||||||
|
end;
|
||||||
|
#9, ' ':
|
||||||
|
begin
|
||||||
|
Result := tkWhitespace;
|
||||||
|
repeat
|
||||||
|
Inc(TokenStr);
|
||||||
|
if TokenStr[0] = #0 then
|
||||||
|
if not FetchLine then
|
||||||
|
begin
|
||||||
|
FCurToken := Result;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
until not (TokenStr[0] in [#9, ' ']);
|
||||||
|
end;
|
||||||
|
'"','''':
|
||||||
|
begin
|
||||||
|
C:=TokenStr[0];
|
||||||
|
If (C='''') and (joStrict in Options) then
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
||||||
|
Inc(TokenStr);
|
||||||
|
TokenStart := TokenStr;
|
||||||
|
OldLength := 0;
|
||||||
|
FCurTokenString := '';
|
||||||
|
while not (TokenStr[0] in [#0,C]) do
|
||||||
|
begin
|
||||||
|
if (TokenStr[0]='\') then
|
||||||
|
begin
|
||||||
|
// Save length
|
||||||
|
SectionLength := TokenStr - TokenStart;
|
||||||
|
Inc(TokenStr);
|
||||||
|
// Read escaped token
|
||||||
|
Case TokenStr[0] of
|
||||||
|
'"' : S:='"';
|
||||||
|
'''' : S:='''';
|
||||||
|
't' : S:=#9;
|
||||||
|
'b' : S:=#8;
|
||||||
|
'n' : S:=#10;
|
||||||
|
'r' : S:=#13;
|
||||||
|
'f' : S:=#12;
|
||||||
|
'\' : S:='\';
|
||||||
|
'/' : S:='/';
|
||||||
|
'u' : begin
|
||||||
|
S:='0000';
|
||||||
|
For I:=1 to 4 do
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Case TokenStr[0] of
|
||||||
|
'0'..'9','A'..'F','a'..'f' :
|
||||||
|
S[i]:=Upcase(TokenStr[0]);
|
||||||
|
else
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// WideChar takes care of conversion...
|
||||||
|
if (joUTF8 in Options) then
|
||||||
|
S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
|
||||||
|
else
|
||||||
|
S:=WideChar(StrToInt('$'+S));
|
||||||
|
end;
|
||||||
|
#0 : Error(SErrOpenString);
|
||||||
|
else
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
||||||
|
end;
|
||||||
|
SetLength(FCurTokenString, OldLength + SectionLength+1+Length(S));
|
||||||
|
if SectionLength > 0 then
|
||||||
|
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
|
||||||
|
Move(S[1],FCurTokenString[OldLength + SectionLength+1],Length(S));
|
||||||
|
Inc(OldLength, SectionLength+Length(S));
|
||||||
|
// Next char
|
||||||
|
// Inc(TokenStr);
|
||||||
|
TokenStart := TokenStr+1;
|
||||||
|
end;
|
||||||
|
if TokenStr[0] = #0 then
|
||||||
|
Error(SErrOpenString);
|
||||||
|
Inc(TokenStr);
|
||||||
|
end;
|
||||||
|
if TokenStr[0] = #0 then
|
||||||
|
Error(SErrOpenString);
|
||||||
|
SectionLength := TokenStr - TokenStart;
|
||||||
|
SetLength(FCurTokenString, OldLength + SectionLength);
|
||||||
|
if SectionLength > 0 then
|
||||||
|
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkString;
|
||||||
|
end;
|
||||||
|
',':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkComma;
|
||||||
|
end;
|
||||||
|
'0'..'9','.','-':
|
||||||
|
begin
|
||||||
|
TokenStart := TokenStr;
|
||||||
|
while true do
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
case TokenStr[0] of
|
||||||
|
'.':
|
||||||
|
begin
|
||||||
|
if TokenStr[1] in ['0'..'9', 'e', 'E'] then
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
repeat
|
||||||
|
Inc(TokenStr);
|
||||||
|
until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
|
||||||
|
end;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
'0'..'9': ;
|
||||||
|
'e', 'E':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
if TokenStr[0] in ['-','+'] then
|
||||||
|
Inc(TokenStr);
|
||||||
|
while TokenStr[0] in ['0'..'9'] do
|
||||||
|
Inc(TokenStr);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
SectionLength := TokenStr - TokenStart;
|
||||||
|
FCurTokenString:='';
|
||||||
|
SetString(FCurTokenString, TokenStart, SectionLength);
|
||||||
|
If (FCurTokenString[1]='.') then
|
||||||
|
FCurTokenString:='0'+FCurTokenString;
|
||||||
|
Result := tkNumber;
|
||||||
|
end;
|
||||||
|
':':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkColon;
|
||||||
|
end;
|
||||||
|
'{':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkCurlyBraceOpen;
|
||||||
|
end;
|
||||||
|
'}':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkCurlyBraceClose;
|
||||||
|
end;
|
||||||
|
'[':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkSquaredBraceOpen;
|
||||||
|
end;
|
||||||
|
']':
|
||||||
|
begin
|
||||||
|
Inc(TokenStr);
|
||||||
|
Result := tkSquaredBraceClose;
|
||||||
|
end;
|
||||||
|
'/' :
|
||||||
|
begin
|
||||||
|
if Not (joComments in Options) then
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||||
|
TokenStart:=TokenStr;
|
||||||
|
Inc(TokenStr);
|
||||||
|
Case Tokenstr[0] of
|
||||||
|
'/' : begin
|
||||||
|
SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
|
||||||
|
Inc(TokenStr);
|
||||||
|
FCurTokenString:='';
|
||||||
|
SetString(FCurTokenString, TokenStr, SectionLength);
|
||||||
|
Fetchline;
|
||||||
|
end;
|
||||||
|
'*' :
|
||||||
|
begin
|
||||||
|
IsStar:=False;
|
||||||
|
Inc(TokenStr);
|
||||||
|
TokenStart:=TokenStr;
|
||||||
|
Repeat
|
||||||
|
if (TokenStr[0]=#0) then
|
||||||
|
begin
|
||||||
|
SectionLength := (TokenStr - TokenStart);
|
||||||
|
S:='';
|
||||||
|
SetString(S, TokenStart, SectionLength);
|
||||||
|
FCurtokenString:=FCurtokenString+S;
|
||||||
|
if not fetchLine then
|
||||||
|
Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||||
|
TokenStart:=TokenStr;
|
||||||
|
end;
|
||||||
|
IsStar:=TokenStr[0]='*';
|
||||||
|
Inc(TokenStr);
|
||||||
|
EOC:=(isStar and (TokenStr[0]='/'));
|
||||||
|
Until EOC;
|
||||||
|
if EOC then
|
||||||
|
begin
|
||||||
|
SectionLength := (TokenStr - TokenStart-1);
|
||||||
|
S:='';
|
||||||
|
SetString(S, TokenStart, SectionLength);
|
||||||
|
FCurtokenString:=FCurtokenString+S;
|
||||||
|
Inc(TokenStr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||||
|
end;
|
||||||
|
Result:=tkComment;
|
||||||
|
end;
|
||||||
|
'a'..'z','A'..'Z','_':
|
||||||
|
begin
|
||||||
|
TokenStart := TokenStr;
|
||||||
|
repeat
|
||||||
|
Inc(TokenStr);
|
||||||
|
until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
|
||||||
|
SectionLength := TokenStr - TokenStart;
|
||||||
|
FCurTokenString:='';
|
||||||
|
SetString(FCurTokenString, TokenStart, SectionLength);
|
||||||
|
for it := tkTrue to tkNull do
|
||||||
|
if CompareText(CurTokenString, TokenInfos[it]) = 0 then
|
||||||
|
begin
|
||||||
|
Result := it;
|
||||||
|
FCurToken := Result;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if (joStrict in Options) then
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
|
||||||
|
else
|
||||||
|
Result:=tkIdentifier;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
FCurToken := Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONScanner.GetCurColumn: Integer;
|
||||||
|
begin
|
||||||
|
Result := TokenStr - PChar(CurLine);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=AIndex in FOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJSONScanner.SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||||
|
begin
|
||||||
|
If AValue then
|
||||||
|
Include(Foptions,AIndex)
|
||||||
|
else
|
||||||
|
Exclude(Foptions,AIndex)
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
|
@ -31,7 +31,7 @@
|
||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
<OtherUnitFiles Value="..\src;..\etc"/>
|
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<Parsing>
|
<Parsing>
|
||||||
|
@ -73,7 +73,7 @@
|
||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
<OtherUnitFiles Value="..\src"/>
|
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<Parsing>
|
<Parsing>
|
||||||
|
@ -390,7 +390,7 @@
|
||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
<OtherUnitFiles Value="..\src;..\etc"/>
|
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
|
|
|
@ -209,8 +209,9 @@ begin
|
||||||
//
|
//
|
||||||
FreeAndNil(fJSON);
|
FreeAndNil(fJSON);
|
||||||
parser := TJSONParser.Create(loader, true);
|
parser := TJSONParser.Create(loader, true);
|
||||||
//TODO-cgonnawork: from FPC 3.02, uses parser.options to allow trailing comma in DUB descriptions
|
parser.Options:= parser.Options + [joIgnoreTrailingComma] - [joStrict];
|
||||||
// http://bugs.freepascal.org/view.php?id=29357
|
//TODO-cfcl-json: remove etc/fcl-json the day they'll merge and rlz the version with 'Options'
|
||||||
|
//TODO-cfcl-json: track possible changes and fixes at http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/fcl-json/
|
||||||
try
|
try
|
||||||
try
|
try
|
||||||
fJSON := parser.Parse as TJSONObject;
|
fJSON := parser.Parse as TJSONObject;
|
||||||
|
|
|
@ -300,10 +300,9 @@ To do so, the application option _Native project compiler_ must be set according
|
||||||
|
|
||||||
Since the version 2 alpha 1, Coedit also handles DUB projects.
|
Since the version 2 alpha 1, Coedit also handles DUB projects.
|
||||||
|
|
||||||
DUB project description must be in JSON format. JSON format must be strictly compliant with RFC 4627 and trailing commas will cause errors.
|
DUB project description must be in JSON format, SDL in not handled.
|
||||||
This restriction will be removed in the future (when CE will be build with FPC 3.0.2).
|
|
||||||
|
|
||||||
Dub projects are handled exactly as the native projects are. The _project_ menu proposes the same features.
|
DUB projects are handled exactly as the CE projects are. The _project_ menu proposes the same features.
|
||||||
However the configuration is done in another widget, see the [dedicated paragraph][lnk_widg_dub].
|
However the configuration is done in another widget, see the [dedicated paragraph][lnk_widg_dub].
|
||||||
|
|
||||||
# D Completion Daemon integration
|
# D Completion Daemon integration
|
||||||
|
|
Loading…
Reference in New Issue