(*
  FpBson

  Copyright (C) 2017 Michael Fuchs, http://www.ypa-software.de

  This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free
  Software Foundation; either version 2 of the License, or (at your option) any later version with the following modification:

  As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable,
  regardless of the license terms of these independent modules,and to copy and distribute the resulting executable under terms of your choice, provided that
  you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not
  derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated
  to do so. If you do not wish to do so, delete this exception statement from your version.

  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. See the GNU Library General Public License for more details.

  You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59
  Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)

(* FpBson - Freepascal implementation of the BSON format (http://bsonspec.org/spec.html) *)
unit FpBson;
{$MODE ObjFpc}
{$H+}

interface

uses
  Classes, SysUtils, DateUtils, Fgl;

const
  BSON_TYPE_DOUBLE = $01;
  BSON_TYPE_STRING = $02;
  BSON_TYPE_DOCUMENT = $03;
  BSON_TYPE_ARRAY = $04;
  BSON_TYPE_BINARY = $05;
  BSON_TYPE_UNDEFINED = $06;
  BSON_TYPE_OBJECTID = $07;
  BSON_TYPE_BOOLEAN = $08;
  BSON_TYPE_UTC_DATETIME = $09;
  BSON_TYPE_NULL = $0A;
  BSON_TYPE_REGEX = $0B;
  BSON_TYPE_DBPOINTER = $0C;
  BSON_TYPE_JAVASCRIPT = $0D;
  BSON_TYPE_SYMBOL = $0E;
  BSON_TYPE_JAVASCRIPT_WITH_SCOPE = $0F;
  BSON_TYPE_INT32 = $10;
  BSON_TYPE_TIMESTAMP = $11;
  BSON_TYPE_INT64 = $12;
  BSON_TYPE_DECIMAL128 = $13;
  BSON_TYPE_MIN_KEY = $FF;
  BSON_TYPE_MAX_KEY = $7F;
  BSON_BINARY_SUBTYPE_GENERIC = $00;
  BSON_BINARY_SUBTYPE_FUNCTION = $01;
  BSON_BINARY_SUBTYPE_BINARY_OLD = $02;
  BSON_BINARY_SUBTYPE_UUID_OLD = $03;
  BSON_BINARY_SUBTYPE_UUID = $04;
  BSON_BINARY_SUBTYPE_MD5 = $05;
  BSON_BINARY_SUBTYPE_USER_DEFINED = $80;

type
  TBytes12 = array[0..11] of Byte;

  TBytes16 = array[0..15] of Byte;

  TBsonType = class abstract(TObject)
    private
      FName: String;
      function GetNameSize: LongInt;
    protected
      function GetContent: TBytes; virtual; abstract;
      function GetContentSize: LongInt; virtual; abstract;
      function GetTypeIdentifier: Byte; virtual; abstract;
    public
      property Content: TBytes read GetContent;
      property ContentSize: LongInt read GetContentSize;
      property Name: String read FName write FName;
      property NameSize: LongInt read GetNameSize;
      property TypeIdentifier: Byte read GetTypeIdentifier;
  end;

  TBsonTypeList = specialize TFPGObjectList<TBsonType>;

  TBsonDouble = class(TBsonType)
    private
      FValue: Double;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: Double read FValue write FValue;
  end;

  TBsonString = class(TBsonType)
    private
      FValue: String;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: String read FValue write FValue;
  end;

  TBsonDocument = class(TBsonType)
    private
      FChilds: TBsonTypeList;
      function GetFreeChilds: Boolean;
      procedure SetFreeChilds(AValue: Boolean);
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      constructor Create;
      destructor Destroy; override;
    public
      property Childs: TBsonTypeList read FChilds;
      property FreeChilds: Boolean read GetFreeChilds write SetFreeChilds;
    public
      procedure AddChild(AnObject: TBsonType);
  end;

  TBsonArray = class(TBsonType)
    private
      FChilds: TBsonTypeList;
      function GetFreeChilds: Boolean;
      procedure SetFreeChilds(AValue: Boolean);
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      constructor Create;
      destructor Destroy; override;
    public
      property Childs: TBsonTypeList read FChilds;
      property FreeChilds: Boolean read GetFreeChilds write SetFreeChilds;
     public
       procedure AddChild(AnObject: TBsonType);
  end;

  TBsonBinary = class(TBsonType)
    private
      FSubtype: Byte;
      FValue: TBytes;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
   public
      property Subtype: Byte read FSubtype write FSubtype;
      property Value: TBytes read FValue write FValue;
  end;

  TBsonUndefined = class(TBsonType)
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
  end;

  TBsonObjectId = class(TBsonType)
    private
      FValue: TBytes12;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: TBytes12 read FValue write FValue;
  end;

  TBsonBoolean = class(TBsonType)
    private
      FValue: Boolean;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: Boolean read FValue write FValue;
  end;

  TBsonDatetime = class(TBsonType)
    private
      FUnixDate: Int64;
      function GetValue: TDateTime;
      procedure SetValue(AValue: TDateTime);
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: TDateTime read GetValue write SetValue;
      property UnixDate: Int64 read FUnixDate write FUnixDate;
  end;

  TBsonNull = class(TBsonType)
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
  end;

  TBsonRegex = class(TBsonType)
    private
      FOptionsString: String;
      FPattern: String;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property OptionsString: String read FOptionsString write FOptionsString;
      property Pattern: String read FPattern write FPattern;
  end;

  TBsonDbPointer = class(TBsonType)
    private
      FNamespace: String;
      FObjectId: TBytes12;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Namespace: String read FNamespace write FNamespace;
      property ObjectId: TBytes12 read FObjectId write FObjectId;
  end;

  TBsonJavascript = class(TBsonType)
    private
      FCode: String;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Code: String read FCode write FCode;
  end;

  TBsonSymbol = class(TBsonType)
    private
      FValue: String;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: String read FValue write FValue;
  end;

  TBsonJavascriptWithScope = class(TBsonType)
    private
      FCode: String;
      FDocument: TBsonDocument;
      FOwnsDocument: Boolean;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      constructor Create;
      destructor Destroy; override;
    public
      property Code: String read FCode write FCode;
      property Document: TBsonDocument read FDocument write FDocument;
      property OwnsDocument: Boolean read FOwnsDocument write FOwnsDocument;
  end;

  TBsonInt32 = class(TBsonType)
    private
      FValue: LongInt;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: LongInt read FValue write FValue;
  end;

  TBsonTimestamp = class(TBsonType)
    private
      FValue: Int64;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: Int64 read FValue write FValue;
  end;

  TBsonInt64 = class(TBsonType)
    private
      FValue: Int64;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: Int64 read FValue write FValue;
  end;

  TBsonDecimal128 = class(TBsonType)
    private
      FValue: TBytes16;
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
    public
      property Value: TBytes16 read FValue write FValue;
  end;

  TBsonMinKey = class(TBsonType)
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
  end;

  TBsonMaxKey = class(TBsonType)
    protected
      function GetContent: TBytes; override;
      function GetContentSize: LongInt; override;
      function GetTypeIdentifier: Byte; override;
  end;

  TBsonParser = class(TObject)
    protected
      function ReadElement(const AName: String; TypeIdentifier: Byte; AStream: TStream): TBsonType;
    public
      function ReadCString(AStream: TStream): String;
      function ReadSize(AStream: TStream): LongInt;
      function ReadString(AStream: TStream): String;
    public
      function ParseDouble(AStream: TStream): TBsonDouble;
      function ParseString(AStream: TStream): TBsonString;
      function ParseDocument(AStream: TStream): TBsonDocument;
      function ParseArray(AStream: TStream): TBsonArray;
      function ParseBinary(AStream: TStream): TBsonBinary;
      function ParseUndefined(AStream: TStream): TBsonUndefined;
      function ParseObjectId(AStream: TStream): TBsonObjectId;
      function ParseBoolean(AStream: TStream): TBsonBoolean;
      function ParseDatetime(AStream: TStream): TBsonDatetime;
      function ParseNull(AStream: TStream): TBsonNull;
      function ParseRegex(AStream: TStream): TBsonRegex;
      function ParseDbPointer(AStream: TStream): TBsonDbPointer;
      function ParseJavascript(AStream: TStream): TBsonJavascript;
      function ParseSymbol(AStream: TStream): TBsonSymbol;
      function ParseJavascriptWithScope(AStream: TStream): TBsonJavascriptWithScope;
      function ParseInt32(AStream: TStream): TBsonInt32;
      function ParseTimestamp(AStream: TStream): TBsonTimestamp;
      function ParseInt64(AStream: TStream): TBsonInt64;
      function ParseDecimal128(AStream: TStream): TBsonDecimal128;
      function ParseMinKey(AStream: TStream): TBsonMinKey;
      function ParseMaxKey(AStream: TStream): TBsonMaxKey;
  end;

implementation

const
  BSON_TYPE_INDENTIFIER_SIZE = 1;
  BSON_BINARY_SUBTYPE_SIZE = 1;
  INT32_SIZE = 4;
  TERMINATOR = $00;
  TERMINATOR_SIZE = 1;

function TBsonParser.ReadSize(AStream: TStream): LongInt;
begin
  Result := 0;
  AStream.ReadBuffer(Result, 4);
end;

function TBsonParser.ParseBinary(AStream: TStream): TBsonBinary;
var
  Size: LongInt;
begin
  Result := TBsonBinary.Create;
  Size := ReadSize(AStream);
  Result.Subtype := AStream.ReadByte;
  if Size > 0 then begin
    SetLength(Result.FValue, Size);
    AStream.ReadBuffer(Result.FValue[0], Size);
  end;
end;

function TBsonParser.ParseUndefined(AStream: TStream): TBsonUndefined;
begin
  Assert(Assigned(AStream));
  Result := TBsonUndefined.Create;
end;

function TBsonParser.ParseObjectId(AStream: TStream): TBsonObjectId;
begin
  Result := TBsonObjectId.Create;
  AStream.ReadBuffer(Result.FValue[0], 12);
end;

function TBsonParser.ParseBoolean(AStream: TStream): TBsonBoolean;
begin
  Result := TBsonBoolean.Create;
  Result.Value := (AStream.ReadByte = $01);
  //TODO: raise exception if undefined value?
end;

function TBsonParser.ParseDatetime(AStream: TStream): TBsonDatetime;
var
  Buffer: Int64 = 0;
begin
  Result := TBsonDatetime.Create;
  AStream.ReadBuffer(Buffer, 8);
  Result.UnixDate := Buffer div 1000;
end;

function TBsonParser.ParseNull(AStream: TStream): TBsonNull;
begin
  Assert(Assigned(AStream));
  Result := TBsonNull.Create;
end;

function TBsonParser.ParseRegex(AStream: TStream): TBsonRegex;
begin
  Result := TBsonRegex.Create;
  Result.Pattern := ReadCString(AStream);
  Result.OptionsString := ReadCString(AStream);
end;

function TBsonParser.ParseDbPointer(AStream: TStream): TBsonDbPointer;
begin
  Result := TBsonDbPointer.Create;
  Result.FNamespace := ReadString(AStream);
  AStream.ReadBuffer(Result.FObjectId[0], 12);
end;

function TBsonParser.ParseJavascript(AStream: TStream): TBsonJavascript;
begin
  Result := TBsonJavascript.Create;
  Result.Code := ReadString(AStream);
end;

function TBsonParser.ParseSymbol(AStream: TStream): TBsonSymbol;
begin
  Result := TBsonSymbol.Create;
  Result.Value := ReadString(AStream);
end;

function TBsonParser.ParseJavascriptWithScope(AStream: TStream): TBsonJavascriptWithScope;
begin
  Result := TBsonJavascriptWithScope.Create;
  ReadSize(AStream);
  Result.Code := ReadString(AStream);
  Result.Document := ParseDocument(AStream);
end;

function TBsonParser.ParseDouble(AStream: TStream): TBsonDouble;
begin
  Result := TBsonDouble.Create;
  AStream.ReadBuffer(Result.FValue, 8);
end;

function TBsonParser.ParseInt32(AStream: TStream): TBsonInt32;
begin
  Result := TBsonInt32.Create;
  AStream.ReadBuffer(Result.FValue, 4);
end;

function TBsonParser.ParseTimestamp(AStream: TStream): TBsonTimestamp;
begin
  Result := TBsonTimestamp.Create;
  AStream.ReadBuffer(Result.FValue, 8);
end;

function TBsonParser.ParseInt64(AStream: TStream): TBsonInt64;
begin
  Result := TBsonInt64.Create;
  AStream.ReadBuffer(Result.FValue, 8);
end;

function TBsonParser.ParseDecimal128(AStream: TStream): TBsonDecimal128;
begin
  Result := TBsonDecimal128.Create;
  AStream.ReadBuffer(Result.FValue[0], 16);
end;

function TBsonParser.ParseMinKey(AStream: TStream): TBsonMinKey;
begin
  Assert(Assigned(AStream));
  Result := TBsonMinKey.Create;
end;

function TBsonParser.ParseMaxKey(AStream: TStream): TBsonMaxKey;
begin
  Assert(Assigned(AStream));
  Result := TBsonMaxKey.Create;
end;

function TBsonParser.ReadString(AStream: TStream): String;
var
  Size: LongInt;
  Buffer: TBytes;
begin
  Size := ReadSize(AStream) - 1;
  if Size > 0 then begin
    SetLength(Buffer, Size);
    AStream.ReadBuffer(Buffer[0], Size);
    Result := String(StringOf(Buffer));
  end;
  AStream.ReadByte;
end;

function TBsonParser.ReadElement(const AName: String; TypeIdentifier: Byte; AStream: TStream): TBsonType;
begin
  case TypeIdentifier of
    BSON_TYPE_DOUBLE:
      Result := ParseDouble(AStream);
    BSON_TYPE_STRING:
      Result := ParseString(AStream);
    BSON_TYPE_DOCUMENT:
      Result := ParseDocument(AStream);
    BSON_TYPE_ARRAY:
      Result := ParseArray(AStream);
    BSON_TYPE_BINARY:
      Result := ParseBinary(AStream);
    BSON_TYPE_UNDEFINED:
      Result := ParseUndefined(AStream);
    BSON_TYPE_OBJECTID:
      Result := ParseObjectId(AStream);
    BSON_TYPE_BOOLEAN:
      Result := ParseBoolean(AStream);
    BSON_TYPE_UTC_DATETIME:
      Result := ParseDatetime(AStream);
    BSON_TYPE_NULL:
      Result := ParseNull(AStream);
    BSON_TYPE_REGEX:
      Result := ParseRegex(AStream);
    BSON_TYPE_DBPOINTER:
      Result := ParseDbPointer(AStream);
    BSON_TYPE_JAVASCRIPT:
      Result := ParseJavascript(AStream);
    BSON_TYPE_SYMBOL:
      Result := ParseSymbol(AStream);
    BSON_TYPE_JAVASCRIPT_WITH_SCOPE:
      Result := ParseJavascriptWithScope(AStream);
    BSON_TYPE_INT32:
      Result := ParseInt32(AStream);
    BSON_TYPE_TIMESTAMP:
      Result := ParseTimestamp(AStream);
    BSON_TYPE_INT64:
      Result := ParseInt64(AStream);
    BSON_TYPE_DECIMAL128:
      Result := ParseDecimal128(AStream);
    BSON_TYPE_MIN_KEY:
      Result := ParseMinKey(AStream);
    BSON_TYPE_MAX_KEY:
      Result := ParseMaxKey(AStream);
  else
    Result := nil;
  end;
  if Assigned(Result) then Result.Name := AName;
end;

function TBsonParser.ReadCString(AStream: TStream): String;
const
  RESIZE_STEP = 64;
var
  i: Integer = 0;
  Buffer: TBytes;
  b: Byte;
begin
  SetLength(Buffer, RESIZE_STEP);
  repeat
    b := AStream.ReadByte;
    if b <> $00 then begin
      Buffer[i] := b;
      Inc(i);
      if i >= Length(Buffer) then SetLength(Buffer, Length(Buffer) + RESIZE_STEP);
    end;
  until b = $00;
  SetLength(Buffer, i);
  Result := String(StringOf(Buffer));
end;

function TBsonParser.ParseString(AStream: TStream): TBsonString;
begin
  Result := TBsonString.Create;
  Result.Value := ReadString(AStream);
end;

function TBsonParser.ParseDocument(AStream: TStream): TBsonDocument;
var
  LastDocumentPos: LongInt;
  TypeIdentifier: Byte;
  ElementName: String;
begin
  Result := TBsonDocument.Create;
  LastDocumentPos := AStream.Position + ReadSize(AStream) - 2;
  while AStream.Position < LastDocumentPos do begin
    TypeIdentifier := AStream.ReadByte;
    ElementName := ReadCString(AStream);
    Result.AddChild(ReadElement(ElementName, TypeIdentifier, AStream));
  end;
  AStream.ReadByte;
end;

function TBsonParser.ParseArray(AStream: TStream): TBsonArray;
var
  LastArrayPos: LongInt;
  TypeIdentifier: Byte;
  i: Integer = 0;
begin
  Result := TBsonArray.Create;
  LastArrayPos := AStream.Position + ReadSize(AStream) - 2;
  while AStream.Position < LastArrayPos do begin
    TypeIdentifier := AStream.ReadByte;
    ReadCString(AStream); //TODO: raise exception if read name does not corresponds with the counter?
    Result.AddChild(ReadElement(IntToStr(i), TypeIdentifier, AStream));
    Inc(i);
  end;
  AStream.ReadByte;
end;

function TBsonArray.GetFreeChilds: Boolean;
begin
  Result := FChilds.FreeObjects;
end;

procedure TBsonArray.SetFreeChilds(AValue: Boolean);
begin
  FChilds.FreeObjects := AValue;
end;

function TBsonArray.GetContent: TBytes;
var
  Size: LongInt;
  Position: LongInt = 4;
  i: LongInt;
  Key: String;
begin
  Size := GetContentSize;
  SetLength(Result, Size);
  Move(Size, Result[0], INT32_SIZE);
  if FChilds.Count > 0 then begin
    for i := 0 to FChilds.Count - 1 do begin
      Result[Position] := FChilds[i].TypeIdentifier;
      Inc(Position, BSON_TYPE_INDENTIFIER_SIZE );
      Key := IntToStr(i);
      Move(Key[1], Result[Position], Length(Key));
      Inc(Position, Length(Key));
      Result[Position] := TERMINATOR;
      Inc(Position, TERMINATOR_SIZE);
      Move(FChilds[i].Content[0], Result[Position], FChilds[i].ContentSize);
      Inc(Position, FChilds[i].ContentSize);
    end;
  end;
  Result[High(Result)] := TERMINATOR;
end;

function TBsonArray.GetContentSize: LongInt;
var
  i: LongInt;
begin
  Result := INT32_SIZE;
  if FChilds.Count > 0 then begin
    for i := 0 to FChilds.Count - 1 do begin
      Result := Result
              + BSON_TYPE_INDENTIFIER_SIZE
              + Length(IntToStr(i))
              + TERMINATOR_SIZE
              + FChilds[i].ContentSize;
    end;
  end;
  Inc(Result, TERMINATOR_SIZE);
end;

function TBsonArray.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_ARRAY;
end;

constructor TBsonArray.Create;
begin
  inherited Create;
  FChilds := TBsonTypeList.Create();
end;

destructor TBsonArray.Destroy;
begin
  FreeAndNil(FChilds);
  inherited Destroy;
end;

procedure TBsonArray.AddChild(AnObject: TBsonType);
begin
  FChilds.Add(AnObject);
end;

function TBsonJavascriptWithScope.GetContent: TBytes;
var
  SizeOfContent, SizeOfCode: LongInt;
  EmptyDocumentSize: LongInt = 5;
  CodeBytes: TBytes;
  i: LongInt = 0;
begin
  SizeOfContent := GetContentSize;
  SetLength(Result, SizeOfContent);
  Move(SizeOfContent, Result[i], INT32_SIZE);
  Inc(i, INT32_SIZE);

  CodeBytes := BytesOf(FCode);
  SizeOfCode := Length(CodeBytes) + TERMINATOR_SIZE;
  Move(SizeOfCode, Result[i], INT32_SIZE);
  Inc(i, INT32_SIZE);

  if SizeOfCode > 1 then begin
    Move(CodeBytes[0], Result[i], SizeOfCode - 1);
    Inc(i, SizeOfCode - 1);
  end;
  Result[i] := TERMINATOR;
  Inc(i);
 if Assigned(FDocument) then
    Move(FDocument.Content[0], Result[i], FDocument.ContentSize)
  else begin
    Move(EmptyDocumentSize, Result[i], INT32_SIZE);
    Inc(i, INT32_SIZE);
    Result[i] := TERMINATOR;
  end;
end;

function TBsonJavascriptWithScope.GetContentSize: LongInt;
begin
  Result := INT32_SIZE
          + INT32_SIZE + Length(BytesOf(FCode)) + TERMINATOR_SIZE;
  if Assigned(FDocument) then
    Result := Result + FDocument.ContentSize
  else
    Result := Result + INT32_SIZE + TERMINATOR_SIZE;
end;

function TBsonJavascriptWithScope.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_JAVASCRIPT_WITH_SCOPE;
end;

constructor TBsonJavascriptWithScope.Create;
begin
  inherited Create;
  FOwnsDocument := True;
end;

destructor TBsonJavascriptWithScope.Destroy;
begin
  if FOwnsDocument then
    FreeAndNil(FDocument);
  inherited Destroy;
end;

function TBsonDecimal128.GetContent: TBytes;
begin
  SetLength(Result, 16);
  Move(FValue[0], Result[0], 16)
end;

function TBsonDecimal128.GetContentSize: LongInt;
begin
  Result := 16;
end;

function TBsonDecimal128.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_DECIMAL128;
end;

function TBsonSymbol.GetContent: TBytes;
var
  ValueBytes: TBytes;
  ValueBytesSize: LongInt;
begin
  SetLength(Result, GetContentSize);
  ValueBytes := BytesOf(FValue);
  ValueBytesSize := Length(ValueBytes) + TERMINATOR_SIZE;
  Move(ValueBytesSize, Result[0], 4);
  if Length(ValueBytes) > 0 then
    Move(ValueBytes[0], Result[4], Length(ValueBytes));
  Result[High(Result)] := $00;
end;

function TBsonSymbol.GetContentSize: LongInt;
begin
  Result := INT32_SIZE + Length(BytesOf(FValue)) + TERMINATOR_SIZE;
end;

function TBsonSymbol.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_SYMBOL;
end;

function TBsonDbPointer.GetContent: TBytes;
var
  NamespaceBytes: TBytes;
  NamespaceBytesSize: LongInt;
begin
  SetLength(Result, GetContentSize);
  NamespaceBytes := BytesOf(FNamespace);
  NamespaceBytesSize := Length(NamespaceBytes) + TERMINATOR_SIZE;
  Move(NamespaceBytesSize, Result[0], 4);
  if Length(NamespaceBytes) > 0 then
    Move(NamespaceBytes[0], Result[4], Length(NamespaceBytes));
  Result[High(Result) - 12] := TERMINATOR;
  Move(FObjectId, Result[High(Result) - 11], 12);
end;

function TBsonDbPointer.GetContentSize: LongInt;
begin
  Result := INT32_SIZE + Length(BytesOf(FNamespace)) + TERMINATOR_SIZE
          + 12;
end;

function TBsonDbPointer.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_DBPOINTER;
end;

function TBsonMaxKey.GetContent: TBytes;
begin
  SetLength(Result, 0);
end;

function TBsonMaxKey.GetContentSize: LongInt;
begin
  Result := 0;
end;

function TBsonMaxKey.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_MAX_KEY;
end;

function TBsonMinKey.GetContent: TBytes;
begin
  SetLength(Result, 0);
end;

function TBsonMinKey.GetContentSize: LongInt;
begin
  Result := 0;
end;

function TBsonMinKey.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_MIN_KEY;
end;

function TBsonJavascript.GetContent: TBytes;
var
  ValueBytes: TBytes;
  ValueBytesSize: LongInt;
begin
  SetLength(Result, GetContentSize);
  ValueBytes := BytesOf(FCode);
  ValueBytesSize := Length(ValueBytes) + TERMINATOR_SIZE;
  Move(ValueBytesSize, Result[0], 4);
  if Length(ValueBytes) > 0 then
    Move(ValueBytes[0], Result[4], Length(ValueBytes));
  Result[High(Result)] := $00;
end;

function TBsonJavascript.GetContentSize: LongInt;
begin
  Result := INT32_SIZE + Length(BytesOf(FCode)) + TERMINATOR_SIZE;
end;

function TBsonJavascript.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_JAVASCRIPT;
end;

function TBsonRegex.GetContent: TBytes;
var
  PatternBytes, OptionsStringBytes: TBytes;
begin
  SetLength(Result, GetContentSize);
  PatternBytes := BytesOf(FPattern);
  OptionsStringBytes := BytesOf(FOptionsString);
  if Length(PatternBytes) > 0 then
    Move(PatternBytes[0], Result[0], Length(PatternBytes));
  Result[Length(PatternBytes)] := TERMINATOR;
  if Length(OptionsStringBytes) > 0 then
    Move(OptionsStringBytes[0], Result[Length(PatternBytes)+1], Length(OptionsStringBytes));
  Result[High(Result)] := TERMINATOR;
end;

function TBsonRegex.GetContentSize: LongInt;
begin
  Result := Length(BytesOf(FPattern)) + TERMINATOR_SIZE
          + Length(BytesOf(FOptionsString)) + TERMINATOR_SIZE;
end;

function TBsonRegex.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_REGEX;
end;

function TBsonObjectId.GetContent: TBytes;
begin
  SetLength(Result, 12);
  Move(FValue, Result[0], 12);
end;

function TBsonObjectId.GetContentSize: LongInt;
begin
  Result := 12;
end;

function TBsonObjectId.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_OBJECTID;
end;

function TBsonTimestamp.GetContent: TBytes;
begin
  SetLength(Result, 8);
  Move(FValue, Result[0], 8);
end;

function TBsonTimestamp.GetContentSize: LongInt;
begin
  Result := 8;
end;

function TBsonTimestamp.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_TIMESTAMP;
end;

function TBsonInt64.GetContent: TBytes;
begin
  SetLength(Result, 8);
  Move(FValue, Result[0], 8)
end;

function TBsonInt64.GetContentSize: LongInt;
begin
  Result := 8;
end;

function TBsonInt64.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_INT64;
end;

function TBsonInt32.GetContent: TBytes;
begin
  SetLength(Result, 4);
  Move(FValue, Result[0], 4);
end;

function TBsonInt32.GetContentSize: LongInt;
begin
  Result := 4;
end;

function TBsonInt32.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_INT32;
end;

function TBsonNull.GetContent: TBytes;
begin
  SetLength(Result, 0);
end;

function TBsonNull.GetContentSize: LongInt;
begin
  Result := 0;
end;

function TBsonNull.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_NULL;
end;

function TBsonDatetime.GetValue: TDateTime;
begin
  Result := UnixToDateTime(FUnixDate);
end;

procedure TBsonDatetime.SetValue(AValue: TDateTime);
begin
  FUnixDate := DateTimeToUnix(AValue);
end;

function TBsonDatetime.GetContent: TBytes;
var
  UnixdateWithMilliseconds: Int64;
begin
  UnixdateWithMilliseconds := FUnixDate * 1000;
  SetLength(Result, 8);
  Move(UnixdateWithMilliseconds, Result[0], 8);
end;

function TBsonDatetime.GetContentSize: LongInt;
begin
  Result := 8;
end;

function TBsonDatetime.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_UTC_DATETIME;
end;

function TBsonUndefined.GetContent: TBytes;
begin
  SetLength(Result, 0);
end;

function TBsonUndefined.GetContentSize: LongInt;
begin
  Result := 0;
end;

function TBsonUndefined.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_UNDEFINED;
end;

function TBsonBinary.GetContent: TBytes;
var
  ValueLength: LongInt;
begin
  SetLength(Result, GetContentSize);
  ValueLength := Length(FValue);;
  Move(ValueLength, Result[0], 4);
  Result[4] := FSubtype;
  if Length(FValue) > 0 then
    Move(FValue[0], Result[5], Length(FValue));
end;

function TBsonBinary.GetContentSize: LongInt;
begin
  Result := INT32_SIZE + BSON_BINARY_SUBTYPE_SIZE + Length(FValue);
end;

function TBsonBinary.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_BINARY;
end;

function TBsonString.GetContent: TBytes;
var
  ValueBytes: TBytes;
  ValueBytesLength: LongInt;
begin
  ValueBytes := BytesOf(FValue);
  SetLength(Result, GetContentSize);
  ValueBytesLength := Length(ValueBytes) + TERMINATOR_SIZE;
  Move(ValueBytesLength, Result[0], 4);
  if Length(ValueBytes) > 0 then
    Move(ValueBytes[0], Result[4], Length(ValueBytes));
  Result[High(Result)] := $00;
end;

function TBsonString.GetContentSize: LongInt;
begin
  Result := INT32_SIZE + Length(BytesOf(FValue)) + TERMINATOR_SIZE;
end;

function TBsonString.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_STRING;
end;

function TBsonDouble.GetContent: TBytes;
begin
  SetLength(Result, 8);
  Move(FValue, Result[0], 8);
end;

function TBsonDouble.GetContentSize: LongInt;
begin
  Result := 8;
end;

function TBsonDouble.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_DOUBLE;
end;

function TBsonBoolean.GetContent: TBytes;
begin
  SetLength(Result, 1);
  if FValue then
    Result[0] := $01
  else
    Result[0] := $00;
end;

function TBsonBoolean.GetContentSize: LongInt;
begin
  Result := 1;
end;

function TBsonBoolean.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_BOOLEAN;
end;

function TBsonType.GetNameSize: LongInt;
begin
  Result := Length(BytesOf(FName));
end;

function TBsonDocument.GetFreeChilds: Boolean;
begin
  Result := FChilds.FreeObjects;
end;

procedure TBsonDocument.SetFreeChilds(AValue: Boolean);
begin
  if FChilds.FreeObjects = AValue then Exit;
  FChilds.FreeObjects := AValue;
end;

function TBsonDocument.GetContent: TBytes;
var
  o: TBsonType;
  Size: LongInt;
  i: LongInt = 4;
begin
  Size := GetContentSize;
  SetLength(Result, Size);
  Move(Size, Result[0], INT32_SIZE);
  for o in FChilds do begin
    Result[i] := o.TypeIdentifier;
    Inc(i, BSON_TYPE_INDENTIFIER_SIZE );
    Move(BytesOf(o.Name)[0], Result[i], o.NameSize);
    Inc(i, o.NameSize);
    Result[i] := TERMINATOR;
    Inc(i, TERMINATOR_SIZE);
    Move(o.Content[0], Result[i], o.ContentSize);
    Inc(i, o.ContentSize);
  end;
  Result[High(Result)] := TERMINATOR;
end;

function TBsonDocument.GetContentSize: LongInt;
var
  o: TBsonType;
begin
  Result := INT32_SIZE;
  for o in FChilds do begin
    Result := Result
            + BSON_TYPE_INDENTIFIER_SIZE
            + o.NameSize
            + TERMINATOR_SIZE
            + o.ContentSize;
  end;
  Inc(Result, TERMINATOR_SIZE);
end;

function TBsonDocument.GetTypeIdentifier: Byte;
begin
  Result := BSON_TYPE_DOCUMENT;
end;

constructor TBsonDocument.Create;
begin
  inherited Create;
  FChilds := TBsonTypeList.Create(True);
end;

destructor TBsonDocument.Destroy;
begin
  FreeAndNil(FChilds);
  inherited Destroy;
end;

procedure TBsonDocument.AddChild(AnObject: TBsonType);
begin
  FChilds.Add(AnObject);
end;

end.