json.pas

delphi2009 json 单元,了解delphi2009 json 的实现过程

  end;
  Result := pb.FSize;
  pb.Free;
end;

procedure TJsonObject.Free;
begin
  Release;
end;

constructor TJsonObject.Create(const s: string);
begin
  Create(json_type_string);
  o.c_string := strdup(PChar(s));
end;

function TJsonObject.Clone: TJsonObject;
var
  ite: TJsonObjectIter;
  arr: TJsonArray;
  i:   integer;
begin
  if not JsonIsValid(Self) then
    Result := nil
  else
    case FJsonType of
      json_type_boolean: Result := TJsonObject.Create(o.c_boolean);
      json_type_double: Result  := TJsonObject.Create(o.c_double);
      json_type_int: Result     := TJsonObject.Create(o.c_int);
      json_type_string: Result  := TJsonObject.Create(o.c_string);
      json_type_object:
      begin
        Result := TJsonObject.Create(json_type_object);
        if JsonFindFirst(self, ite) then
          with Result.AsObject do
            repeat
              Put(ite.key, ite.val.Clone);
            until not JsonFindNext(ite);
        JsonFindClose(ite);
      end;
      json_type_array:
      begin
        Result := TJsonObject.Create(json_type_array);
        arr    := AsArray;
        with Result.AsArray do
          for i := 0 to arr.Length - 1 do
            Add(arr.Get(i).Clone);
      end;
      else
        Result := nil;
    end;
end;

function TJsonObject.GetJsonType: TJsonType;
begin
  if JsonIsValid(Self) then
    Result := FJsonType
  else
    Result := json_type_null;
end;

function TJsonObject.SaveTo(const FileName: string; format: boolean): integer;
var
  stream: TFileStream;
begin
  stream := TFileStream.Create(FileName, fmCreate);
  try
    Result := SaveTo(stream, format);
  finally
    stream.Free;
  end;
end;

function TJsonObject.Validate(const rules, defs: string;
  callback: TJsonOnValidateError = nil; Sender: Pointer = nil): boolean;
var
  r, d: TJsonObject;
begin
  r      := TJsonObject.Parse(PChar(rules));
  d      := TJsonObject.Parse(PChar(defs));
  Result := Validate(r, d, callback, Sender);
  r.Release;
  d.Release;
end;

function TJsonObject.Validate(rules, defs: TJsonObject;
  callback: TJsonOnValidateError = nil; Sender: Pointer = nil): boolean;
type
  TDataType = (dtUnknown, dtStr, dtInt, dtFloat, dtNumber, dtText, dtBool,
    dtMap, dtSeq, dtScalar, dtAny);
var
  datatypes: TJsonAvlTree;
  names:     TJsonAvlTree;

  function FindInheritedProperty(const prop: PChar; p: TJsonTableString): TJsonObject;
  var
    o: TJsonObject;
    e: TJsonAvlEntry;
  begin
    o := p.Get(prop);
    if o <> nil then
      Result := o
    else
    begin
      o := p.Get('inherit');
      if o.IsType(json_type_string) then
      begin
        e := names.Search(o.o.c_string);
        if (e <> nil) then
          Result := FindInheritedProperty(prop, TJsonTableString(e.Obj))
        else
          Result := nil;
      end else
        Result := nil;
    end;
  end;

  function GetDataType(o: TJsonTableString): TDataType;
  var
    e: TJsonAvlEntry;
  begin
    e := datatypes.Search(FindInheritedProperty('type', o).AsString);
    if e <> nil then
      Result := TDataType(PtrInt(e.Obj))
    else
      Result := dtUnknown;
  end;

  procedure GetNames(o: TJsonTableString);
  var
    obj: TJsonObject;
    f:   TJsonObjectIter;
  begin
    obj := o.Get('name');
    if obj.IsType(json_type_string) then
      names.Insert(TJsonAvlEntry.Create(obj.o.c_string, o));

    case GetDataType(o) of
      dtMap:
      begin
        obj := o.Get('mapping');
        if obj.IsType(json_type_object) then
        begin
          if JsonFindFirst(obj, f) then
            repeat
              if f.val.IsType(json_type_object) then
                GetNames(f.val.o.c_object);
            until not JsonFindNext(f);
          JsonFindClose(f);
        end;
      end;
      dtSeq:
      begin
        obj := o.Get('sequence');
        if obj.IsType(json_type_object) then
          GetNames(obj.o.c_object);
      end;
    end;
  end;

  function FindInheritedField(const prop: PChar; p: TJsonTableString): TJsonObject;
  var
    o: TJsonObject;
    e: TJsonAvlEntry;
  begin
    o := p.Get('mapping');
    if o.IsType(json_type_object) then
    begin
      o := o.o.c_object.Get(prop);
      if o <> nil then
      begin
        Result := o;
        Exit;
      end;
    end;

    o := p.Get('inherit');
    if o.IsType(json_type_string) then
    begin
      e := names.Search(o.o.c_string);
      if (e <> nil) then
        Result := FindInheritedField(prop, TJsonTableString(e.Obj))
      else
        Result := nil;
    end else
      Result := nil;
  end;

  function InheritedFieldExist(const obj: TJsonObject; p: TJsonTableString;
  const Name: string = ''): boolean;
  var
    o: TJsonObject;
    e: TJsonAvlEntry;
    i: TJsonAvlIterator;
  begin
    Result := True;
    o      := p.Get('mapping');
    if o.IsType(json_type_object) then
    begin
      i := TJsonAvlIterator.Create(o.o.c_object);
      try
        i.First;
        e := i.GetIter;
        while e <> nil do
        begin
          if obj.o.c_object.Search(e.Name) = nil then
          begin
            Result := False;
            if assigned(callback) then
              callback(Sender, veFieldNotFound, Name + '.' + e.Name);
          end;
          i.Next;
          e := i.GetIter;
        end;

      finally
        i.Free;
      end;
    end;

    o := p.Get('inherit');
    if o.IsType(json_type_string) then
    begin
      e := names.Search(o.o.c_string);
      if (e <> nil) then
        Result := InheritedFieldExist(obj, TJsonTableString(e.Obj), Name) and Result;
    end;
  end;

  function getInheritedBool(f: PChar; p: TJsonTableString;
    default: boolean = False): boolean;
  var
    o: TJsonObject;
  begin
    o := FindInheritedProperty(f, p);
    case o.JsonType of
      json_type_boolean: Result := o.o.c_boolean;
      json_type_null: Result    := Default;
      else
        Result := default;
        if assigned(callback) then
          callback(Sender, veRuleMalformated, f + '');
    end;
  end;

  procedure GetInheritedFieldList(list: TJsonAvlTree; p: TJsonTableString);
  var
    o: TJsonObject;
    e: TJsonAvlEntry;
    i: TJsonAvlIterator;
  begin
    Result := True;
    o      := p.Get('mapping');
    if o.IsType(json_type_object) then
    begin
      i := TJsonAvlIterator.Create(o.o.c_object);
      try
        i.First;
        e := i.GetIter;
        while e <> nil do
        begin
          if list.Search(e.Name) = nil then
            list.Insert(TJsonAvlEntry.Create(e.Name, e.Obj));
          i.Next;
          e := i.GetIter;
        end;

      finally
        i.Free;
      end;
    end;

    o := p.Get('inherit');
    if o.IsType(json_type_string) then
    begin
      e := names.Search(o.o.c_string);
      if (e <> nil) then
        GetInheritedFieldList(list, TJsonTableString(e.Obj));
    end;
  end;

  function CheckEnum(o: TJsonObject; p: TJsonTableString; Name: string = ''): boolean;
  var
    enum: TJsonObject;
    i:    integer;
  begin
    Result := False;
    enum   := FindInheritedProperty('enum', p);
    case enum.JsonType of
      json_type_array:
        for i := 0 to enum.o.c_array.Length - 1 do
          if StrComp(o.AsString, enum.o.c_array[i].AsString) = 0 then
          begin
            Result := True;
            exit;
          end;
      json_type_null: Result := True;
      else
        Result := False;
        if assigned(callback) then
          callback(Sender, veRuleMalformated, '');
        Exit;
    end;

    if (not Result) and assigned(callback) then
      callback(Sender, veValueNotInEnum, Name);
  end;

  function CheckLength(len: integer; p: TJsonTableString;
  const objpath: string): boolean;
  var
    length, o: TJsonObject;
  begin
    Result := True;
    length := FindInheritedProperty('length', p);
    case length.JsonType of
      json_type_object:
      begin
        o := length.o.c_object.Get('min');
        if (o <> nil) and (o.AsInteger > len) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidLength, objpath);
        end;
        o := length.o.c_object.Get('max');
        if (o <> nil) and (o.AsInteger < len) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidLength, objpath);
        end;
        o := length.o.c_object.Get('minex');
        if (o <> nil) and (o.AsInteger >= len) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidLength, objpath);
        end;
        o := length.o.c_object.Get('maxex');
        if (o <> nil) and (o.AsInteger <= len) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidLength, objpath);
        end;
      end;
      json_type_null: ;
      else
        Result := False;
        if assigned(callback) then
          callback(Sender, veRuleMalformated, '');
    end;
  end;

  function CheckRange(obj: TJsonObject; p: TJsonTableString;
  const objpath: string): boolean;
  var
    length, o: TJsonObject;
  begin
    Result := True;
    length := FindInheritedProperty('range', p);
    case length.JsonType of
      json_type_object:
      begin
        o := length.o.c_object.Get('min');
        if (o <> nil) and (o.Compare(obj) = cpGreat) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidRange, objpath);
        end;
        o := length.o.c_object.Get('max');
        if (o <> nil) and (o.Compare(obj) = cpLess) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidRange, objpath);
        end;
        o := length.o.c_object.Get('minex');
        if (o <> nil) and (o.Compare(obj) in [cpGreat, cpEqu]) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidRange, objpath);
        end;
        o := length.o.c_object.Get('maxex');
        if (o <> nil) and (o.Compare(obj) in [cpLess, cpEqu]) then
        begin
          Result := False;
          if assigned(callback) then
            callback(Sender, veInvalidRange, objpath);
        end;
      end;
      json_type_null: ;
      else
        Result := False;
        if assigned(callback) then
          callback(Sender, veRuleMalformated, '');
    end;
  end;


  function process(o: TJsonObject; p: TJsonTableString; objpath: string = ''): boolean;
  var
    ite: TJsonAvlIterator;
    ent: TJsonAvlEntry;
    p2, o2, sequence: TJsonObject;
    s:   PChar;
    i:   integer;
    uniquelist, fieldlist: TJsonAvlTree;
  begin
    Result := True;
    if (o = nil) then
    begin
      if getInheritedBool('required', p) then
      begin
        if assigned(callback) then
          callback(Sender, veFieldIsRequired, objpath);
        Result := False;
      end;
    end else
      case GetDataType(p) of
        dtStr:
          case o.JsonType of
            json_type_string:
            begin
              Result := Result and CheckLength(strlen(o.o.c_string), p, objpath);
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtBool:
          case o.JsonType of
            json_type_boolean:
            begin
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtInt:
          case o.JsonType of
            json_type_int:
            begin
              Result := Result and CheckRange(o, p, objpath);
            end;
            else
              if assigned(callback) then
                callback(Sender, veInvalidDataType, objpath);
              Result := False;
          end;
        dtFloat:
          case o.JsonType of
            json_type_double: