/// MongoDB document-oriented database direct access classes

// - this unit is a part of the freeware Synopse framework,

// licensed under a MPL/GPL/LGPL tri-license; version 1.18

unit SynMongoDB;

{

This file is part of Synopse framework.

Synopse framework. Copyright (c) Arnaud Bouchez

Synopse Informatique - https://synopse.info

*** BEGIN LICENSE BLOCK *****

Version: MPL 1.1/GPL 2.0/LGPL 2.1

The contents of this file are subject to the Mozilla Public License Version

1.1 (the "License"); you may not use this file except in compliance with

the License. You may obtain a copy of the License at

http://www.mozilla.org/MPL

Software distributed under the License is distributed on an "AS IS" basis,

WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License

for the specific language governing rights and limitations under the License.

The Original Code is Synopse mORMot framework.

The Initial Developer of the Original Code is Arnaud Bouchez.

Portions created by the Initial Developer are Copyright (c)

the Initial Developer. All Rights Reserved.

Contributor(s):

- BBackSoon

- Sabbiolina

- Zed

Alternatively, the contents of this file may be used under the terms of

either the GNU General Public License Version 2 or later (the "GPL"), or

the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),

in which case the provisions of the GPL or the LGPL are applicable instead

of those above. If you wish to allow use of your version of this file only

under the terms of either the GPL or the LGPL, and not to allow others to

use your version of this file under the terms of the MPL, indicate your

decision by deleting the provisions above and replace them with the notice

and other provisions required by the GPL or the LGPL. If you do not delete

the provisions above, a recipient may use your version of this file under

the terms of any one of the MPL, the GPL or the LGPL.

***** END LICENSE BLOCK *****

TODO:

- handle BULK commands support for MongoDB >=2.6 for faster writes

see http://blog.mongodb.org/post/84922794768

- GridFS support ?

}

interface

{$I Synopse.inc} // define HASINLINE CPU32 CPU64

uses

{$ifdef MSWINDOWS}

Windows,

{$else}

{$ifdef KYLIX3}

SynKylix,

LibC,

{$else}

SynFPCLinux,

{$endif}

{$endif}

Classes,

Variants, // this unit expects Variants to be available for storage

SysUtils,

SynCrtSock,

SynCrypto, // MD5 and SHA1 needed for OpenAuth()

SynCommons,

SynTable, // for TSynTableStatement

SynLog;

{ ************ BSON (Binary JSON) process }

type

/// binary representation of a 128-bit decimal, stored as 16 bytes

// - i.e. IEEE 754-2008 128-bit decimal floating point as used in the

// BSON Decimal128 format, and processed by the TDecimal128 object

TDecimal128Bits = record

case integer of

0: (lo, hi: QWord);

1: (l, h: Int64);

2: (b: array[0..15] of byte);

3: (c: array[0..3] of cardinal);

end;

/// points to a 128-bit decimal binary

PDecimal128Bits = ^TDecimal128Bits;

/// enough characters to contain any TDecimal128 text representation

TDecimal128Str = array[0..42] of AnsiChar;

/// some special 128-bit decimal values

// - see TDecimal128.SetSpecial to set the corresponding value

// - dsvError is returned by TDecimal128.FromText() on parsing error

// - dsvValue indicates that this is not a known "special" value, but some

// valid decimal number

TDecimal128SpecialValue = (

dsvError, dsvValue, dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax);

/// handles a 128-bit decimal value

// - i.e. IEEE 754-2008 128-bit decimal floating point as used in the

// BSON Decimal128 format, i.e. betDecimal128 TBSONElementType

// - the betFloat BSON format stores a 64-bit floating point value, which

// doesn't have exact decimals, so may suffer from rounding or approximation

// - for instance, if you work with Delphi currency values, you may store

// betDecimal128 values in MongoDB - the easiest way is to include it as a

// TBSONVariant instance, via the NumberDecimal() function

// - there is no mathematical operator/methods for Decimal128 Value Objects,

// as required by MongoDB specifications: any computation must be done

// explicitly on native language value representation (e.g. currency, TBCD or

// any BigNumber library) - use ToCurr/FromCurr or ToText/FromText to make

// the appropriate safe conversions

{$ifdef USERECORDWITHMETHODS}TDecimal128 = record

{$else}TDecimal128 = object{$endif}

public

/// the raw binary storage

Bits: TDecimal128Bits;

/// fills with the Zero value

// - note: under IEEE 754, Zero can have sign and exponents, so is not Hi=Lo=0

// - is the same as Fill(dsvZero)

procedure SetZero;

/// fills with a special value

// - dsvError or dsvValue will set dsvNan binary content

procedure SetSpecial(special: TDecimal128SpecialValue);

/// checks if the value matches one of the known special values

// - will search for dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax

function IsSpecial: TDecimal128SpecialValue;

/// fills with a 32-bit signed value

procedure FromInt32(value: integer);

/// fills with a 32-bit unsigned value

procedure FromUInt32(value: cardinal);

{$ifdef HASINLINE}inline;{$endif}

/// fills with a 64-bit signed value

procedure FromInt64(value: Int64);

/// fills with a 64-bit unsigned value

procedure FromQWord(value: QWord);

{$ifdef HASINLINE}inline;{$endif}

/// fills with a fixed decimal value, as stored in currency

// - will store the content with explictly four decimals, as in currency

// - by design, this method is very fast and accurate

procedure FromCurr(const value: Currency);

/// fills from the text representation of a decimal value

// - returns dsvValue or one of the dsvNan, dsvZero, dsvPosInf, dsvNegInf

// special value indicator otherwise on succes

// - returns dsvError on parsing failure

function FromText(text: PUTF8Char; textlen: integer): TDecimal128SpecialValue; overload;

/// fills from the text representation of a decimal value

// - returns dsvValue or one of the dsvNan, dsvZero, dsvPosInf, dsvNegInf

// special value indicator otherwise on succes

// - returns dsvError on parsing failure

function FromText(const text: RawUTF8): TDecimal128SpecialValue; overload;

/// convert a variant into one Decimal128 value

// - will first check for a TBSONVariant containing a betDecimal128 (e.g.

// as retrieved via the ToVariant method)

// - will recognize currency and VariantToInt64() stored values

// - then will try to convert the variant from its string value, expecting

// a floating-point text content

// - returns TRUE if conversion was made, FALSE on any error

function FromVariant(const value: variant): boolean;

/// fills with a native floating-point value

// - note that it doesn't make much sense to use this method: you should

// rather use the native betFloat BSON format, with native double precision

// - this method is just a wrapper around ExtendedToShort and ToText,

// so you should provide the expected precision, from the actual storage

// variable (you may specify e.g. SINGLE_PRECISION or EXTENDED_PRECISION if

// you don't use a double kind of value)

function FromFloat(const value: TSynExtended; precision: integer=0): boolean;

/// fast bit-per-bit value comparison

function Equals(const other: TDecimal128): boolean;

{$ifdef HASINLINE}inline;{$endif}

/// converts the value to its string representation

// - returns the number of AnsiChar written to Buffer

function ToText(out Buffer: TDecimal128Str): integer; overload;

/// converts this Decimal128 value to its string representation

function ToText: RawUTF8; overload;

/// converts this Decimal128 value to its string representation

procedure ToText(var result: RawUTF8); overload;

/// convert this Decimal128 value to its TBSONVariant custom variant value

function ToVariant: variant; overload;

/// convert this Decimal128 value to its TBSONVariant custom variant value

procedure ToVariant(out result: variant); overload;

/// converts this Decimal128 value to a floating-point value

// - by design, some information may be lost during conversion

// - note that it doesn't make much sense to use this method: you should

// rather use the native betFloat BSON format, with native double precision

function ToFloat: TSynExtended;

/// converts this Decimal128 value to a fixed decimal value

// - by design, some information may be lost during conversion, unless the

// value has been stored previously via the FromCurr() method - in this

// case, conversion is immediate and accurate

function ToCurr: currency; overload;

{$ifdef HASINLINE}inline;{$endif}

/// converts this Decimal128 value to a fixed decimal value

// - by design, some information may be lost during conversion, unless the

// value has been stored previously via the FromCurr() method - in this

// case, conversion is immediate and accurate

procedure ToCurr(out result: currency); overload;

/// converts this Decimal128 value to its string representation

procedure AddText(W: TTextWriter);

end;

/// points to a 128-bit decimal value

PDecimal128 = ^TDecimal128;

const

/// the textual representation of the TDecimal128 special values

DECIMAL128_SPECIAL_TEXT: array[TDecimal128SpecialValue] of RawUTF8 = (

// dsvError, dsvValue, dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax

'', '', 'NaN', '0', 'Infinity', '-Infinity',

'-9.999999999999999999999999999999999E+6144',

'9.999999999999999999999999999999999E+6144');

BSON_DECIMAL128_HI_NAN = $7c00000000000000;

BSON_DECIMAL128_HI_INT64POS = $3040000000000000; // 0 fixed decimals

BSON_DECIMAL128_HI_INT64NEG = $b040000000000000;

BSON_DECIMAL128_HI_CURRPOS = $3038000000000000; // 4 fixed decimals

BSON_DECIMAL128_HI_CURRNEG = $b038000000000000;

BSON_DECIMAL128_EXPONENT_MAX = 6111;

BSON_DECIMAL128_EXPONENT_MIN = -6176;

BSON_DECIMAL128_EXPONENT_BIAS = 6176;

BSON_DECIMAL128_MAX_DIGITS = 34;

/// ready-to-be displayed text of a TDecimal128SpecialValue

function ToText(spec: TDecimal128SpecialValue): PShortString; overload;

type

/// exception type used for BSON process

EBSONException = class(ESynException);

/// storage of a BSON binary document

// - a specific type is defined for consistency with this unit classes

// - binary content should follow the "int32 e_list #0" standard layout

TBSONDocument = RawByteString;

/// dynamic array of BSON binary document storage

TBSONDocumentDynArray = array of TBSONDocument;

/// element types for BSON internal representation

TBSONElementType = (

betEOF, betFloat, betString, betDoc, betArray, betBinary,

betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,

betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,

betJSScope, betInt32, betTimestamp, betInt64, betDecimal128);

/// points to an element type for BSON internal representation

PBSONElementType = ^TBSONElementType;

/// sub-types for betBinary element BSON internal representation

TBSONElementBinaryType = (

bbtGeneric, bbtFunction, bbtOldBinary, bbtOldUUID, bbtUUID, bbtMD5,

bbtUser = $80);

/// 24-bit storage, mapped as a 3 bytes buffer

// - as used fo TBSONObjectID.MachineID and TBSONObjectID.Counter

TBSON24 = record

b1,b2,b3: byte;

end;

/// points to 24-bit storage, mapped as a 3 bytes buffer

PBSON24 = ^TBSON24;

/// BSON ObjectID 12-byte internal binary representation

// - in MongoDB, documents stored in a collection require a unique _id field

// that acts as a primary key: by default, it uses such a 12-byte ObjectID

// - by design, sorting by _id: ObjectID is roughly equivalent to sorting by

// creation time, so ease sharding and BTREE storage

// - in our ODM, we rather use 64-bit genuine integer identifiers (TID),

// as computed by an internal sequence or TSynUniqueIdentifierGenerator

// - match betObjectID TBSONElementType

{$A-}

{$ifdef USERECORDWITHMETHODS}TBSONObjectID = record

{$else}TBSONObjectID = object{$endif}

/// big-endian 4-byte value representing the seconds since the Unix epoch

// - time is expressed in Coordinated Universal Time (UTC), not local time

UnixCreateTime: cardinal;

/// 3-byte machine identifier

// - ComputeNew will use a hash of ExeVersion.Host and ExeVersion.User

MachineID: TBSON24;

/// 2-byte process id

// - ComputeNew will derivate it from MainThreadID

ProcessID: word;

/// 3-byte counter, starting with a random value

// - used to avoid collision

Counter: TBSON24;

/// set all internal fields to zero

procedure Init; {$ifdef HASINLINE} inline; {$endif}

/// ObjectID content be filled with some unique values

// - this implementation is thread-safe

procedure ComputeNew;

/// convert an hexadecimal string value into one ObjectID

// - returns TRUE if conversion was made, FALSE on any error

function FromText(const Text: RawUTF8): boolean; overload;

/// convert an hexadecimal string value into one ObjectID

// - returns TRUE if conversion was made, FALSE on any error

function FromText(Text: PUTF8Char): boolean; overload;

/// convert a variant into one ObjectID

// - will first check for a TBSONVariant containing a betObjectID

// - then will try to convert the variant from its string value, expecting

// an hexadecimal text content

// - returns TRUE if conversion was made, FALSE on any error

function FromVariant(const value: variant): boolean;

/// convert this ObjectID to its hexadecimal string value

function ToText: RawUTF8; overload;

/// convert this ObjectID to its hexadecimal string value

procedure ToText(var result: RawUTF8); overload;

/// convert this ObjectID to its TBSONVariant custom variant value

function ToVariant: variant; overload;

/// convert this ObjectID to its TBSONVariant custom variant value

procedure ToVariant(var result: variant); overload;

/// returns the timestamp portion of the ObjectId() object as a Delphi date

// - time is expressed in Coordinated Universal Time (UTC), not local time

// so you can compare it to NowUTC returned time

function CreateDateTime: TDateTime;

/// compare two Object IDs

function Equal(const Another: TBSONObjectID): boolean; overload;

{$ifdef HASINLINE}inline;{$endif}

/// compare two Object IDs, the second being stored in a TBSONVariant

function Equal(const Another: variant): boolean; overload;

{$ifdef HASINLINE}inline;{$endif}

end;

/// points to a BSON ObjectID internal binary representation

PBSONObjectID = ^TBSONObjectID;

/// memory structure used for some special BSON storage as variant

// - betObjectID kind will store a TBSONObjectID

// - betBinary kind will store a BLOB content as RawByteString

// - betDoc and betArray kind will store a BSON document, in its original

// binary format as RawByteString (TBSONDocument)

// - betDeprecatedDbptr, betJSScope, betTimestamp and betRegEx will store the

// raw original BSON content as RawByteString

// - betJS and betDeprecatedSymbol will store the UTF-8 encoded string

// as a RawUTF8

// - betDeprecatedUndefined or betMinKey/betMaxKey do not contain any data

// - betDecimal128 will store the TDecimal128 16 bytes binary buffer

// - warning: VBlob/VText use should match BSON_ELEMENTVARIANTMANAGED constant

TBSONVariantData = packed record

/// the variant type

VType: TVarType;

/// the kind of element stored

case VKind: TBSONElementType of

betObjectID: (

{$IFDEF FPC} {$PUSH} {$ENDIF} {$HINTS OFF}

// does not complain if Filler is declared but never used

VFiller: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TBSONElementType)

-SizeOf(TBSONObjectID)] of byte;

{$IFDEF FPC} {$POP} {$ELSE} {$HINTS ON} {$ENDIF}

VObjectID: TBSONObjectID

);

betBinary, betDoc, betArray, betRegEx, betDeprecatedDbptr, betTimestamp,

betJSScope, betDecimal128: (

/// store the raw binary content as a RawByteString (or TBSONDocument for

// betDoc/betArray, i.e. the "int32 e_list #0" standard layout)

// - you have to use RawByteString(VBlob) when accessing this field

// - e.g. for betRegEx, it will contain raw [cstring cstring] content

VBlob: pointer;

);

betJS, betDeprecatedSymbol: (

/// store here a RawUTF8 with the associated text

// - you have to use RawUF8(VText) when accessing this field

VText: pointer;

);

end;

{$A+}

/// points to memory structure used for some special BSON storage as variant

PBSONVariantData = ^TBSONVariantData;

/// custom variant type used to store some special BSON elements

// - internal layout will follow TBSONVariantData

// - handled kind of item are complex BSON types, like betObjectID, betBinary

// or betDoc/betArray

// - it will allow conversion to/from string (and to date for ObjectID)

TBSONVariant = class(TSynInvokeableVariantType)

protected

function GetNewDoc(const BSONDoc: TBSONDocument): variant;

public

/// customization of JSON conversion into TBSONVariant kind of variants

function TryJSONToVariant(var JSON: PUTF8Char; var Value: variant;

EndOfObject: PUTF8Char): boolean; override;

/// variant serialization will use modMongoStrict JSON-compatible mode

procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;

/// handle type conversion

// - only types processed by now are string/OleStr/UnicodeString/date

procedure Cast(var Dest: TVarData; const Source: TVarData); override;

/// handle type conversion

// - only types processed by now are string/OleStr/UnicodeString/date

procedure CastTo(var Dest: TVarData; const Source: TVarData;

const AVarType: TVarType); override;

/// clear the instance

procedure Clear(var V: TVarData); override;

/// copy one instance

procedure Copy(var Dest: TVarData; const Source: TVarData;

const Indirect: Boolean); override;

/// compare two variant values

// - handle comparison of any variant, including TBSONVariant, via a

// temporary JSON conversion, and case-sensitive comparison

// - it uses case-sensitive text (hexadecimal) comparison for betObjectID

procedure Compare(const Left, Right: TVarData;

var Relationship: TVarCompareResult); override;

/// convert a TBSONDocument binary content into a TBSONVariant of kind

// betDoc or betArray

// - see also all BSONVariant() overloaded functions, which also create

// a TBSONVariant betDoc instance

procedure FromBSONDocument(const BSONDoc: TBSONDocument; var result: variant;

Kind: TBSONElementType=betDoc);

/// convert a BLOB binary content into a TBSONVariant of kind betBinary

// - if Bin is '', will store a NULL variant

procedure FromBinary(const Bin: RawByteString; BinType: TBSONElementBinaryType;

var result: variant);

/// convert a JSON content into a TBSONVariant of kind betDoc or betArray

// - warning: the supplied JSON buffer will be modified in-place

// - will create a plain variant value if the JSON doesn't start with [ or {

procedure FromJSON(json: PUTF8Char; var result: variant);

/// returns TRUE if the supplied variant stores the supplied BSON kind of value

function IsOfKind(const V: variant; Kind: TBSONElementType): boolean;

/// retrieve a betBinary content stored in a TBSONVariant instance

// - returns TRUE if the supplied variant is a betBinary, and set the

// binary value into the supplied Blob variable

// - returns FALSE otherwise

function ToBlob(const V: Variant; var Blob: RawByteString): boolean;

/// convert a TBSONDocument binary content into a TBSONVariant of kind betDoc

// - is the default property, so that you can write:

// ! BSONVariantType[BSON(['BSON',_Arr(['awesome',5.05, 1986])])]

// - see also all BSONVariant() overloaded functions, which also create

// a TBSONVariant betDoc instance

property NewDoc[const BSONDoc: TBSONDocument]: variant read GetNewDoc; default;

end;

/// define how betDoc/betArray BSON elements will be converted as variants

// - by default a TBSONVariant custom type will be returned, containing the

// raw BSON binary content of the embedded document or array

// - asDocVariantPerValue or asDocVariantPerReference could be used to

// create a tree of TDocVariant custom kind of variant, able to access

// to its nested properties via late-binding (asDocVariantPerReference being

// also much faster in some cases - but less safe - than asDocVariantPerValue)

// - asDocVariantPerValue will set JSON_OPTIONS[false] settings:

// ! [dvoReturnNullForUnknownProperty]

// - asDocVariantPerReference will set JSON_OPTIONS[true]/JSON_OPTIONS_FAST

// settings:

// ! [dvoValueCopiedByReference,dvoReturnNullForUnknownProperty]

// - asDocVariantInternNamesPerValue and asDocVariantInternNamesPerReference

// will include dvoInternalNames to the TDocVariant.Options

TBSONDocArrayConversion = (

asBSONVariant, asDocVariantPerValue, asDocVariantPerReference,

asDocVariantInternNamesPerValue, asDocVariantInternNamesPerReference);

/// how TBSONElement.AddMongoJSON() method and AddMongoJSON() and

// VariantSaveMongoJSON() functions will render their JSON content

// - modMongoStrict and modNoMongo will follow the JSON RFC specifications

// - modMongoShell will use a syntax incompatible with JSON RFC, but more

// common to MongoDB daily use - as 'ObjectId()' or '{ field: /acme.*corp/i }'

// - modMongoStrict will use the MongoDB Extended JSON syntax

// - modNoMongo will serialize dates as ISO-8601 strings, ObjectID as hexadecimal

// string and other MongoDB special objects in WrBase64() format

// - see http://docs.mongodb.org/manual/reference/mongodb-extended-json

TMongoJSONMode = (modNoMongo, modMongoStrict, modMongoShell);

/// data structure used during BSON binary decoding of one BSON element

// - will be retrieved by FromVariant() or FromNext()

// - see http://bsonspec.org/#/specification

// - this structure has been optimized to map the BSON binary content,

// without any temporary memory allocation (the SAX way)

{$ifdef USERECORDWITHMETHODS}TBSONElement = record

{$else}TBSONElement = object {$endif}

private

/// used internally to set the TBSONElement content, once Kind has been set

procedure FromBSON(bson: PByte);

public

/// index of this element in the original sequence list

// - is correct only when the element has been reset before the parsing

// loop, e.g.:

// ! item.Index := -1; // so item.Index will count starting at 0

// ! while item.FromNext(elem.Document) do

// ! writeln(item.Index,' ',Item.Name,' ',Item.ValueBytes);

Index: integer;

/// the UTF-8 encoded name of this element

Name: PUTF8Char;

/// the name length (in chars) of this element

NameLen: integer;

/// the element type

Kind: TBSONElementType;

/// number of bytes in the BSON element

// - will include the trailing #0 for string element

ElementBytes: integer;

/// pointer to the BSON element value

// - is the raw value, without any parsing, e.g. points to a double value or

// a document: "int32 e_list #0" standard layout (same as TBSONDocument)

// - you may cast it for simple types:

// ! PDouble(Element)^ PBoolean(Element)^ PInteger(Element)^

// ! PInt64(Element)^ PBSONObjectID(Element)^ PDecimal128(Element)^

// - or use the nested Data variant record to access more complex content

// - warning: equals nil for betString/betJS after FromVariant()

Element: pointer;

/// depending on the Kind, will point to parsed complex sub-data

// - since variable records can't have properties, we nest this information

// within this main Data variable record

// - not all Kind are handled here, only any complex data

Data: record

case TBSONElementType of

betFloat, betBoolean, betInt32, betDateTime, betInt64: (

/// this variable is not to be used directly, but for some internal

// temporary storage, e.g. with FromVariant()

// - use P*(Element)^ typecast instead

InternalStorage: Int64;

);

betString, betJS: (

/// points to the #0 ending string

Text: PUTF8Char;

/// number of bytes in Text (excluding trailing #0)

TextLen: integer;

);

betDoc, betArray: (

/// points to a "e_list #0" standard layout

DocList: PByte;

);

betBinary: (

/// points to the binary content

Blob: pointer;

/// number of bytes in Blob

BlobLen: integer;

/// corresponding sub-type of this Blob

BlobSubType: TBSONElementBinaryType;

);

betRegEx: (

RegEx: PUTF8Char;

RegExLen: integer;

RegExOptions: PUTF8Char;

RegExOptionsLen: integer;

);

betJSScope: (

JavaScript: PUTF8Char;

JavaScriptLen: integer;

ScopeDocument: PByte;

);

betTimestamp: (

{ map InternalStorage: Int64 }

time_t: cardinal;

ordinal: cardinal;

);

end;

/// fill a BSON Element structure from a variant content and associated name

// - perform the reverse conversion as made with ToVariant()

// - since the result won't store any data but points to the original binary

// content, the supplied Name/Value instances should remain available as long as

// you will access to the result content

// - aName here is just for conveniency, and could be left void

// - supplied aTemp variable will be used for temporary storage, private to

// this initialized TBSONElement

procedure FromVariant(const aName: RawUTF8; const aValue: Variant;

var aTemp: RawByteString);

/// fill a BSON Element structure from a BSON document

// - will check the document length then set Kind := betDoc and Data.DocList

// - will return TRUE if the supplied doc has a valid length, FALSE otherwise

// - you can later on use DocItemToVariant, DocItemToRawUTF8 or

// DocItemToInteger methods

// - the supplied "doc" variable should remain available until you are done

// with this TBSONElement wrapper

function FromDocument(const doc: TBSONDocument): boolean;

/// fill a BSON Element structure from a BSON encoded binary buffer list

// - parse the next BSON element: BSON parameter should point to the

// "e_list" of the "int32 e_list #0" BSON document

// - will decode the supplied binary buffer into the BSON element structure,

// then it will let BSON point to the next element, and return TRUE

// - returns FALSE when you reached betEOF, so that you can use it in a loop,

// and retrieve all the content as consecutive events, without any memory

// allocation (the SAX way):

// ! var bson: PByte;

// ! item: TBSONElement;

// ! ...

// ! BSONParseLength(bson);

// ! while item.FromNext(bson) do

// ! writeln(item.Name);

// - will raise an EBSONException if BSON content is not correct

// - as an alternative, consider using TBSONIterator, which wrap both a

// PByte and a TBSONElement into one convenient item

function FromNext(var BSON: PByte): boolean;

/// search for a given name in a BSON encoded binary buffer list

// - BSON parameter should point to the first "e_list" item of the

// "int32 e_list #0" BSON document

// - returns false if the item was not found (with case-insensitive search)

// - otherwise returns TRUE and the matching element content has been

// decoded within this TBSONElement structure

function FromSearch(BSON: PByte; const aName: RawUTF8): boolean;

/// convert a BSON element, as retrieved by TBSONElement.FromNext(),

// into a variant

// - it will return either standard variant values, or TBSONVariant custom type

// for most complex kind of elements (see TBSONVariantData type definition)

// - note that betString types will be stored as RawUTF8 varString

// - by default, it will return TBSONVariant custom variants for documents or

// arrays - but if storeDocArrayAsDocVariant is set, it will return a

// TDocVariant custom kind of variant, able to access to its nested

// properties via late-binding

function ToVariant(DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): variant; overload;

/// convert a BSON element, as retrieved by TBSONElement.FromNext(),

// into a variant

// - same as the other ToVariant() overloaded function, but avoiding a copy

// of the resulting variant

procedure ToVariant(var result: variant;

DocArrayConversion: TBSONDocArrayConversion=asBSONVariant); overload;

/// convert a BSON element into an UTF-8 string

// - any complex types (e.g. nested documents) will be converted via a

// variant

function ToRawUTF8: RawUTF8;

/// convert a BSON element into an integer value

// - will work only for betBoolean/betInt32/betInt64 types

// - any other kind of values will return the supplied default value

function ToInteger(const default: Int64=0): Int64;

/// search a variant property value within the BSON element as document

// - returns true if aName has been found as property in the BSON element,

// and fills aValue with the corresponding value

// - returns false if aName was not found, or if Kind is not betDoc or betArray

function DocItemToVariant(const aName: RawUTF8; var aValue: variant;

DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;

/// search an UTF-8 property value within the BSON element as document

// - returns the value if aName has been found as property in the BSON element

// - returns '' if aName was not found, or if Kind is not betDoc or betArray

function DocItemToRawUTF8(const aName: RawUTF8): RawUTF8;

/// search an integer property value within the BSON element as document

// - returns the value if aName has been found as property in the BSON element

// - returns default if aName was not found, or if Kind is not betDoc or betArray

function DocItemToInteger(const aName: RawUTF8; const default: Int64=0): Int64;

/// convert a BSON element, as retrieved by TBSONElement.FromNext(), into

// its JSON representation

// - this method will use by default the MongoDB Extended JSON syntax for

// specific MongoDB objects but you may use modMongoShell if needed

// - will raise an EBSONException if element is not correct

procedure AddMongoJSON(W: TTextWriter; Mode: TMongoJSONMode=modMongoStrict); overload;

end;

PBSONElement = ^TBSONElement;

/// data structure used for iterating over a BSON binary buffer

// - is just a wrapper around a PByte value, to be used with a TBSONDocument

{$ifdef USERECORDWITHMETHODS}TBSONIterator = record

{$else}TBSONIterator = object {$endif}

private

fBson: PByte;

public

/// map the current item, after the Next method did return TRUE

// - map the global document, after Init() but before the first Next call

Item: TBSONElement;

/// initialize the iteration on the supplied BSON document

// - will check the document length and returns TRUE if it is correct

// - only accepted kind are betDoc and betArray (but not used later)

// - you can then use the Next method to iterate over the Item elements

// - after this call, the Item property map to the global BSON document

// (note that after any call to the Next method, Item will map the current

// iterated value, and not the global BSON document any more)

function Init(const doc: TBSONDocument; kind: TBSONElementType=betArray): boolean;

/// will iterate on the BSON document

// - returns TRUE if the item has been retrieved into the Item property

// - returns FALSE if we reached the end of the supplied BSON buffer

function Next: boolean;

{$ifdef HASINLINE}inline;{$endif}

end;

/// used to write the BSON context

TBSONWriter = class(TFileBufferWriter)

{ note: inlining methods generates 70% SLOWER code due to inefficient compiler :( }

protected

fDocumentCount: integer;

fDocument: array of record

Offset: cardinal;

Length: cardinal;

end;

fDocumentStack: integer;

fDocumentStackOffset: TCardinalDynArray;

fDocumentArray: integer;

procedure WriteCollectionName(Flags: integer; const CollectionName: RawUTF8);

public

/// rewind the Stream to the position when Create() was called

// - this will also reset the internal document offset table

procedure CancelAll; override;

/// write a boolean value

procedure BSONWrite(const name: RawUTF8; const value: boolean); overload;

/// write a floating point value

procedure BSONWrite(const name: RawUTF8; const value: Double); overload;

/// write a 32 bit integer value

procedure BSONWrite(const name: RawUTF8; const value: integer); overload;

/// write a 64 bit integer value

procedure BSONWrite(const name: RawUTF8; const value: Int64); overload;

/// write a string (UTF-8) value

procedure BSONWrite(const name: RawUTF8; const value: RawUTF8; isJavaScript: boolean=false); overload;

/// write a string (UTF-8) value from a memory buffer

procedure BSONWrite(const name: RawUTF8; value: PUTF8Char); overload;

/// write a string (UTF-8) value from a memory buffer

procedure BSONWriteString(const name: RawUTF8; value: PUTF8Char; valueLen: integer);

/// write a binary (BLOB) value

procedure BSONWrite(const name: RawUTF8; Data: pointer; DataLen: integer); overload;

/// write an ObjectID value

procedure BSONWrite(const name: RawUTF8; const value: TBSONObjectID); overload;

/// write a RegEx value

procedure BSONWriteRegEx(const name: RawUTF8; const RegEx,Options: RawByteString);

/// write a data/time value

procedure BSONWriteDateTime(const name: RawUTF8; const value: TDateTime);

/// write an element with no value

// - elemType can be either betNull, betMinKey or betMaxKey

procedure BSONWrite(const name: RawUTF8; elemtype: TBSONElementType); overload;

/// write an element with no value

procedure BSONWrite(const name: RawUTF8; const elem: TBSONElement); overload;

/// write a BSONVariant instance value

procedure BSONWrite(const name: RawUTF8; const bson: TBSONVariantData); overload;

/// write a DocVariant instance value

procedure BSONWrite(const name: RawUTF8; const doc: TDocVariantData); overload;

/// write a TDecimal128 value

procedure BSONWrite(const name: RawUTF8; const value: TDecimal128); overload;

/// write a variant value

// - handle simple types (numbers, strings...) and custom types (TDocVariant

// and TBSONVariant, trying a translation to JSON for other custom types)

procedure BSONWriteVariant(const name: RawUTF8; const value: variant); overload;

/// write an open array (const Args: array of const) argument

// - handle simple types (numbers, strings...) and custom types (TDocVariant)

procedure BSONWrite(const name: RawUTF8; const value: TVarRec); overload;

/// write a value from the supplied JSON content

// - is able to handle any kind of values, including nested documents or

// BSON extended syntax (if DoNotTryExtendedMongoSyntax=false)

// - this method is used recursively by BSONWriteDocFromJSON(), and should

// not be called directly

// - will return JSON=nil in case of unexpected error in the supplied JSON

procedure BSONWriteFromJSON(const name: RawUTF8; var JSON: PUTF8Char;

EndOfObject: PUTF8Char; DoNotTryExtendedMongoSyntax: boolean=false);

/// recursive writing of a BSON document or value from a TDocVariant

// object or array, used e.g. by BSON(const doc: TDocVariantData) function

// - caller should execute BSONAdjustDocumentsSize() on the resulting buffer

// - this method will call BSONDocumentBegin/BSONDocumentEnd internally

// - will raise an EBSONException if doc is not a valid TDocVariant or null

// or if the resulting binary content is bigger than BSON_MAXDOCUMENTSIZE

procedure BSONWriteDoc(const doc: TDocVariantData);

/// write an object specified as name/value pairs as a BSON document

// - data must be supplied two by two, as Name,Value pairs, e.g.

// ! aBSONWriter.BSONWriteObject(['name','John','year',1972]);

// - this method wil be faster than using a BSONWriteDoc(_ObjFast(...))

procedure BSONWriteObject(const NameValuePairs: array of const);

/// write a projection specified as fieldname:1 pairs as a BSON document

procedure BSONWriteProjection(const FieldNamesCSV: RawUTF8);

/// write an object as query parameter

// - will handle all SQL operators, including IN (), IS NULL or LIKE

// - see @http://docs.mongodb.org/manual/reference/operator/query

// - inverted should be TRUE e.g. for a NOT ... expression

// - returns TRUE on success, FALSE if the operator is not implemented yet

function BSONWriteQueryOperator(name: RawUTF8; inverted: boolean;

operator: TSynTableStatementOperator; const Value: variant): boolean;

/// write one array item, i.e. the ASCII index name as text

// - only one level of array should be used per TBSONWriter class

procedure BSONWriteArray(const kind: TBSONElementType); overload;

/// write an array specified as a list of items as a BSON document

// - data must be supplied as a list of values e.g.

// ! aBSONWriter.BSONWriteArray(['John',1972]);

// - this method wil be faster than using a BSONWriteDoc(_ArrFast(...))

procedure BSONWriteArray(const Items: array of const); overload;

/// write an array of integers as a BSON Document

procedure BSONWriteArrayOfInteger(const Integers: array of integer);

/// write an array of integers as a BSON Document

procedure BSONWriteArrayOfInt64(const Integers: array of Int64);

/// write some BSON document from a supplied (extended) JSON array or object

// - warning: the incoming JSON buffer will be modified in-place: so you

// should make a private copy before running this method (see e.g. TSynTempBuffer)

// - will handle only '{ ... }', '[ ... ]' or 'null' input, with the standard

// strict JSON format, or BSON-like extensions, e.g. unquoted field names:

// $ {id:10,doc:{name:"John",birthyear:1972}}

// - if DoNotTryExtendedMongoSyntax is default FALSE, then the MongoDB Shell

// syntax will also be recognized to create BSON custom types, like

// $ new Date() ObjectId() MinKey MaxKey /<jRegex>/<jOptions>

// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json

// $ {id:new ObjectId(),doc:{name:"John",date:ISODate()}}

// $ {name:"John",field:/acme.*corp/i}

// - if DoNotTryExtendedMongoSyntax is TRUE, process may be slightly faster

// - will create the BSON binary without any temporary TDocVariant storage

function BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;

out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean=false): PUTF8Char;

/// to be called before a BSON document will be written

// - each BSONDocumentBegin should be followed by its nested BSONDocumentEnd

procedure BSONDocumentBegin; overload;

/// to be called before a BSON document will be written

// - each BSONDocumentBegin should be followed by its nested BSONDocumentEnd

// - you could create a new BSON object by specifying a name and its

// type, i.e. either betDoc or betArray

procedure BSONDocumentBegin(const name: RawUTF8; kind: TBSONElementType=betDoc); overload;

/// to be called before a BSON document will be written in an array

// - only one level of array should be used per TBSONWriter class

procedure BSONDocumentBeginInArray(const name: RawUTF8; kind: TBSONElementType=betDoc);

/// to be called when a BSON document has been written

// - it will store the current stream position into an internal array,

// which will be written when you call AdjustDocumentsSize()

// - you can optional specify how many nested documents should be closed,

// and/or if it should not write an ending betEof item

procedure BSONDocumentEnd(CloseNumber: integer=1; WriteEndingZero: boolean=true);

/// after all content has been written, call this method on the resulting

// memory buffer to store all document size as expected by the standard

procedure BSONAdjustDocumentsSize(BSON: PByteArray); virtual;

/// flush the content and return the whole binary encoded stream

// - call BSONAdjustDocumentsSize() to adjust all internal document sizes

// - expect the TBSONWriter instance to have been created as such:

// ! TBSONWriter.Create(TRawByteStringStream);

procedure ToBSONDocument(var result: TBSONDocument); virtual;

/// flush the content and return the whole document as a TBSONVariant

// - call ToBSONDocument() to adjust all internal document sizes

// - expect the TBSONWriter instance to have been created as such:

// ! TBSONWriter.Create(TRawByteStringStream);

procedure ToBSONVariant(var result: variant; Kind: TBSONElementType=betDoc);

end;

const

/// fake BSON element type which compares lower than all other possible values

// - element type sounds to be stored as shortint, so here $ff=-1<0=betEOF

// - defined as an integer to circumvent a compilation issue with FPC trunk

betMinKey = $ff;

/// fake BSON element type which compares higher than all other possible values

// - element type sounds to be stored as shortint, so here betInt64=$12<$7f

// - defined as an integer to circumvent a compilation issue with FPC trunk

betMaxKey = $7f;

/// kind of elements which will store a RawByteString/RawUTF8 content

// within its TBSONVariant kind

// - i.e. TBSONVariantData.VBlob/VText field is to be managed

BSON_ELEMENTVARIANTMANAGED =

[betBinary, betDoc, betArray, betRegEx, betDeprecatedDbptr, betTimestamp,

betJSScope, betJS, betDeprecatedSymbol, betDecimal128];

/// by definition, maximum MongoDB document size is 16 MB

BSON_MAXDOCUMENTSIZE = 16*1024*1024;

/// special JSON string content which will be used to store a betDeprecatedUndefined item

// - *[false] is for strict JSON, *[true] for MongoDB Extended JSON

BSON_JSON_UNDEFINED: array[boolean] of string[23] =

('{"$undefined":true}','undefined');

/// special JSON string content which will be used to store a betMinKey item

// - *[false] is for strict JSON, *[true] for MongoDB Extended JSON

BSON_JSON_MINKEY: array[boolean] of string[15] = ('{"$minKey":1}','MinKey');

/// special JSON string content which will be used to store a betMaxKey item

// - *[false] is for strict JSON, *[true] for MongoDB Extended JSON

BSON_JSON_MAXKEY: array[boolean] of string[15] = ('{"$maxKey":1}','MaxKey');

/// special JSON patterns which will be used to format a betObjectID item

// - *[false,*] is to be written before the hexadecimal ID, *[true,*] after

BSON_JSON_OBJECTID: array[boolean,TMongoJSONMode] of string[15] = (

('"','{"$oid":"','ObjectId("'),('"','"}','")'));

/// special JSON patterns which will be used to format a betBinary item

// - *[false,*] is for strict JSON, *[true,*] for MongoDB Extended JSON

BSON_JSON_BINARY: array[boolean,boolean] of string[15] = (

('{"$binary":"','","$type":"'),('BinData(',',"'));

/// special JSON string content which will be used to store a betDeprecatedDbptr

// - *[false,*] is for strict JSON, *[true,*] for MongoDB Extended JSON

// - (not used by now for this deprecated content)

BSON_JSON_DBREF: array[boolean,0..2] of string[15] = (

('{"$ref":"','","$id":"','"}'),('DBRef("','","','")'));

/// special JSON string content which will be used to store a betRegEx

BSON_JSON_REGEX: array[0..2] of string[15] =

('{"$regex":"','","$options":"','"}');

/// special JSON patterns which will be used to format a betDateTime item

// - *[*,false] is to be written before the date value, *[*,true] after

BSON_JSON_DATE: array[TMongoJSONMode,boolean] of string[15] = (

('"','"'),('{"$date":"','"}'),('ISODate("','")'));

/// special JSON patterns which will be used to format a betDecimal128 item

// - *[false,*] is to be written before the decimal value, *[true,*] after

BSON_JSON_DECIMAL: array[boolean,TMongoJSONMode] of string[23] = (

('"','{"$numberDecimal":"','NumberDecimal("'),('"','"}','")'));

var

/// global TCustomVariantType used to register BSON variant types

// - if you use this unit, both TDocVariant and TBSONVariant custom types

// will be registered, since they are needed for any MongoDB / BSON process

BSONVariantType: TBSONVariant;

/// ready-to-be displayed text of a TBSONElementType value

function ToText(kind: TBSONElementType): PShortString; overload;

/// create a TBSONVariant custom variant type containing a BSON Object ID

// - will be filled with some unique values, ready to create a new document key

// - will store a BSON element of betObjectID kind

function ObjectID: variant; overload;

/// create a TBSONVariant Object ID custom variant type from a supplied text

// - will raise an EBSONException if the supplied text is not valid hexadecimal

// - will set a BSON element of betObjectID kind

function ObjectID(const Hexa: RawUTF8): variant; overload;

/// convert a TBSONVariant Object ID custom variant into a TBSONObjectID

// - raise an exception if the supplied variant is not a TBSONVariant Object ID

function BSONObjectID(const aObjectID: variant): TBSONObjectID;

/// create a TBSONVariant JavaScript custom variant type from a supplied code

// - will set a BSON element of betJS kind

function JavaScript(const JS: RawUTF8): variant; overload;

/// create a TBSONVariant JavaScript and associated scope custom variant type

// from a supplied code and document

// - will set a BSON element of betJSScope kind

function JavaScript(const JS: RawUTF8; const Scope: TBSONDocument): variant; overload;

/// create a TBSONVariant Decimal128 from some text corresponding to

// a floating-point number

// - will store internally a TDecimal128 storage

function NumberDecimal(const Value: RawUTF8): variant; overload;

/// create a TBSONVariant Decimal128 from a currency fixed decimal

// - will store internally a TDecimal128 storage, with explictly 4 decimals

// - if you want to store some floating-point value, use plain BSON double format

function NumberDecimal(const Value: currency): variant; overload;

/// store some object content into BSON encoded binary

// - object will be initialized with data supplied two by two, as Name,Value

// pairs, e.g.:

// ! aBson := BSON(['name','John','year',1972]);

// - you can define nested arrays or objects as TDocVariant, e.g:

// ! aBSON := BSON(['bsonDat',_Arr(['awesome',5.05, 1986])]);

// - or you can specify nested arrays or objects with '['..']' or '{'..'}':

// ! aBSON := BSON(['BSON','[','awesome',5.05,1986,']'])

// ! u := BSONToJSON(BSON(['doc','{','name','John','year',1982,'}','id',123]));

// ! assert(u='{"doc":{"name":"John","year":1982},"id":123}');

// ! u := BSONToJSON(BSON(['doc','{','name','John','abc','[','a','b','c',']','}','id',123]));

// ! assert(u='{"doc":{"name":"John","abc":["a","b","c"]},"id":123}');

// - will create the BSON binary without any temporary TDocVariant storage

function BSON(const NameValuePairs: array of const): TBSONDocument; overload;

/// create a fields selector BSON document from a field names list

// - can be used via a TBSONVariant instance for the projection parameter of

// a TMongoRequestQuery, e.g.:

// ! BSONToJSON(BSONFieldSelector(['a','b','c']))='{"a":1,"b":1,"c":1}'

function BSONFieldSelector(const FieldNames: array of RawUTF8): TBSONDocument; overload;

/// create a fields selector BSON document from a CSV field names list

// - can be used via a TBSONVariant instance for the projection parameter of

// a TMongoRequestQuery, e.g.:

// ! BSONToJSON(BSONFieldSelector('a,b,c'))='{"a":1,"b":1,"c":1}'

function BSONFieldSelector(const FieldNamesCSV: RawUTF8): TBSONDocument; overload;

/// store some object content, supplied as (extended) JSON, into BSON encoded binary

// - in addition to the JSON RFC specification strict mode, this method will

// handle some BSON-like extensions, e.g. unquoted field names:

// ! BSON('{id:10,doc:{name:"John",birthyear:1972}}');

// - MongoDB Shell syntax will also be recognized to create TBSONVariant, like

// ! new Date() ObjectId() MinKey MaxKey /<jRegex>/<jOptions>

// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json

// ! BSON('{id:new ObjectId(),doc:{name:"John",date:ISODate()}}');

// ! BSON('{name:"John",field:/acme.*corp/i}');

// - will create the BSON binary without any temporary TDocVariant storage, by

// calling JSONBufferToBSONDocument() on a temporary copy of the supplied JSON

function BSON(const JSON: RawUTF8; kind: PBSONElementType=nil): TBSONDocument; overload;

{$ifndef ISDELPHI20092010}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// store some object content, supplied as (extended) JSON and parameters,

// into BSON encoded binary

// - in addition to the JSON RFC specification strict mode, this method will

// handle some BSON-like extensions, e.g. unquoted field names

// - MongoDB Shell syntax will also be recognized to create TBSONVariant, like

// ! new Date() ObjectId() MinKey MaxKey /<jRegex>/<jOptions>

// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json

// - typical use could be:

// ! BSON('{%:{$in:[?,?]}}',['type'],['food','snack']);

// ! BSON('{type:{$in:?}}',[],[_Arr(['food','snack'])]);

// ! BSON('{%:[?,?,?]}',['BSON'],['awesome',5.05,1986])

// ! BSON('{%:?}',['BSON'],[_Arr(['awesome',5.05,1986])])

// ! BSON('{name:?,field:/%/i}',['acme.*corp'],['John']);

// ! BSON('{id:new ObjectId(),doc:{name:?,date:ISODate(?)}}',[],['John',NowUTC]);

// - will create the BSON binary without any temporary TDocVariant storage,

// by calling JSONBufferToBSONDocument() on the generated JSON content

// - since all content will be transformed into JSON internally, use this

// method only if the supplied parameters are simple types, and identified

// explicitely via BSON-like extensions: any complex value (e.g. a TDateTime

// or a BSONVariant binary) won't be handled as expected - use the overloaded

// BSON() with explicit BSONVariant() name/value pairs instead

function BSON(const Format: RawUTF8; const Args,Params: array of const;

kind: PBSONElementType=nil): TBSONDocument; overload;

/// store some TDocVariant custom variant content into BSON encoded binary

// - will write either a BSON object or array, depending of the internal

// layout of this TDocVariantData instance (i.e. Kind property value)

// - if supplied variant is not a TDocVariant, raise an EBSONException

function BSON(const doc: TDocVariantData): TBSONDocument; overload;

/// store an array of integer into BSON encoded binary

// - object will be initialized with data supplied e.g. as a TIntegerDynArray

function BSONFromIntegers(const Integers: array of integer): TBSONDocument;

/// store an array of 64 bit integer into BSON encoded binary

// - object will be initialized with data supplied e.g. as a TIntegerDynArray

function BSONFromInt64s(const Integers: array of Int64): TBSONDocument;

/// store some object content, supplied as (extended) JSON into BSON binary

// - warning: the supplied JSON buffer will be modified in-place, if necessary:

// so you should create a temporary copy before calling this function, or call

// BSON(const JSON: RawUTF8) function instead

// - in addition to the JSON RFC specification strict mode, this method will

// handle some BSON-like extensions, e.g. unquoted field names

// - if DoNotTryExtendedMongoSyntax is FALSE, then MongoDB Shell syntax will

// also be recognized to create BSON custom values, like

// ! new Date() ObjectId() MinKey MaxKey /<jRegex>/<jOptions>

// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json