/mORMot

Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
Raw Blame History
6990 lines (6487 sloc) 277 KB
/// 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) 2018 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) 2018
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 *****
Version 1.18
- first public release, corresponding to mORMot Framework 1.18
and feature request [0fee1d995c]
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 USETYPEINFO 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: (b: array[0..15] of byte);
2: (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
{$ifndef UNICODE}
TDecimal128 = object
{$else}
TDecimal128 = record
{$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 ExtendedToString 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 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
// - match betObjectID TBSONElementType
{$A-}
{$ifndef UNICODE}
TBSONObjectID = object
{$else}
TBSONObjectID = record
{$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;
/// 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;
/// 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;
{$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: (
{$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;
{$HINTS ON}
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+}
/// 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)
{$ifndef UNICODE}
TBSONElement = object
protected
{$else}
TBSONElement = record
private
{$endif}
/// 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
{$ifndef UNICODE}
TBSONIterator = object
protected
{$else}
TBSONIterator = record
private
{$endif}
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
betMinKey = TBSONElementType($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
betMaxKey = TBSONElementType($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;
{$ifdef HASINLINE}inline;{$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
// ! 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
// - will return the kind of BSON document created, i.e. either betDoc or betArray
function JSONBufferToBSONDocument(JSON: PUTF8Char; var doc: TBSONDocument;
DoNotTryExtendedMongoSyntax: boolean=false): TBSONElementType;
/// store one JSON array into an array of BSON binary
// - since BSON documents are limited to 16 MB by design, this function
// will allow to process huge data content, as soon as it is provided as array
// - 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
// be recognized to create BSON custom values - but it will be slightly slower
function JSONBufferToBSONArray(JSON: PUTF8Char; out docs: TBSONDocumentDynArray;
DoNotTryExtendedMongoSyntax: boolean=false): boolean;
/// store some object content into a TBSONVariant betDoc type instance
// - object will be initialized with data supplied two by two, as Name,Value
// pairs, as expected by the corresponding overloaded BSON() function
function BSONVariant(const NameValuePairs: array of const): variant; overload;
/// create a fields selector BSON document from a field names list
// - can be used for the projection parameter of a TMongoRequestQuery, e.g.:
// ! VariantToJSON(BSONVariantFieldSelector(['a','b','c']))='{"a":1,"b":1,"c":1}'
function BSONVariantFieldSelector(const FieldNames: array of RawUTF8): variant; overload;
/// create a fields selector BSON document from a CSV field names list
// - can be used for the projection parameter of a TMongoRequestQuery, e.g.:
// ! VariantToJSON(BSONVariantFieldSelector('a,b,c'))='{"a":1,"b":1,"c":1}'
function BSONVariantFieldSelector(const FieldNamesCSV: RawUTF8): variant; overload;
{$ifdef HASINLINE}inline;{$endif}
/// store some object content, supplied as (extended) JSON, into a TBSONVariant
// betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
function BSONVariant(const JSON: RawUTF8): variant; overload;
{$ifdef HASINLINE}inline;{$endif}
/// store some object content, supplied as (extended) JSON, into a TBSONVariant
// betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
// - warning: this overloaded method will mofify the supplied JSON buffer
// in-place: you can use the overloaded BSONVariant(const JSON: RawUTF8) function
// instead if you do not want to modify the input buffer content
procedure BSONVariant(JSON: PUTF8Char; var result: variant); overload;
/// store some object content, supplied as (extended) JSON and parameters,
// into a TBSONVariant betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
function BSONVariant(const Format: RawUTF8; const Args,Params: array of const): variant; overload;
/// convert a TDocVariant variant into a TBSONVariant betDoc type instance
function BSONVariant(doc: TDocVariantData): variant; overload;
{$ifdef HASINLINE}inline;{$endif}
/// store an array of integer into a TBSONVariant betArray type instance
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONVariantFromIntegers(const Integers: array of integer): variant;
/// store an array of 64 bit integer into a TBSONVariant betArray type instance
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONVariantFromInt64s(const Integers: array of Int64): variant;
/// parse the header of a BSON encoded binary buffer, and return its length
// - BSON should point to a "int32 e_list #0" BSON document (like TBSONDocument)
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value, and raise an
// EBSONException if this comparison fails
// - as an alternative, consider using TBSONIterator, which wrap both a PByte
// and a TBSONElement into one convenient item
function BSONParseLength(var BSON: PByte; ExpectedBSONLen: integer=0): integer;
/// parse the next element in supplied BSON encoded binary buffer list
// - BSON should point to the "e_list" of the "int32 e_list #0" BSON document
// - will decode the supplied binary buffer as a variant, 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:
// ! var bson: PByte;
// ! name: RaWUTF8;
// ! value: variant;
// ! ...
// ! BSONParseLength(bson);
// ! while BSONParseNextElement(bson,name,value) do
// ! writeln(name,':',value);
// - 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
// - if you want to parse a BSON list as fast as possible, you should better use
// TBSONElement.FromNext() which avoid any memory allocation (the SAX way) - in
// fact, this function is just a wrapper around TBSONElement.FromNext + ToVariant
// - as an alternative, consider using TBSONIterator, which wrap both a PByte
// and a TBSONElement into one convenient item
function BSONParseNextElement(var BSON: PByte; var name: RawUTF8; var element: variant;
DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;
/// search for a property by number in a a supplied BSON encoded binary buffer
// - BSON should point to a "int32 e_list #0" BSON document (like TBSONDocument)
// - returns FALSE if the list has too few elements (starting at index 0)
// - otherwise, returns TRUE then let item point to the corresponding element
function BSONPerIndexElement(BSON: PByte; index: integer; var item: TBSONElement): boolean;
/// convert a BSON document into a TDocVariant variant instance
// - BSON should point to a "int32 e_list #0" BSON document
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value
// - by definition, asBSONVariant is not allowed as Option value
procedure BSONToDoc(BSON: PByte; var Result: Variant; ExpectedBSONLen: integer=0;
Option: TBSONDocArrayConversion=asDocVariantPerReference);
/// convert a TBSONDocument into a TDocVariant variant instance
// - BSON should be valid BSON document (length will be checked against expected
// "int32 e_list #0" binary layout)
// - by definition, asBSONVariant is not allowed as Option value
function BSONDocumentToDoc(const BSON: TBSONDocument;
Option: TBSONDocArrayConversion=asDocVariantPerReference): variant;
{$ifdef HASINLINE}inline;{$endif}
/// convert a BSON document into its JSON representation
// - BSON should point to a "int32 e_list #0" BSON document
// - Kind should be either betDoc or betArray
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
function BSONToJSON(BSON: PByte; Kind: TBSONElementType;
ExpectedBSONLen: integer=0; Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
/// convert a TBSONDocument into its JSON representation
// - BSON should be valid BSON document (length will be checked against expected
// "int32 e_list #0" binary layout)
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
function BSONDocumentToJSON(const BSON: TBSONDocument;
Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// convert a BSON list of elements into its JSON representation
// - BSON should point to the "e_list" of the "int32 e_list #0" BSON document,
// i.e. the item data as expected by TBSONElement.FromNext()
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
procedure BSONListToJSON(BSONList: PByte; Kind: TBSONElementType; W: TTextWriter;
Mode: TMongoJSONMode=modMongoStrict);
/// convert any kind of BSON/JSON element, encoded as variant, into JSON
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
procedure AddMongoJSON(const Value: variant; W: TTextWriter;
Mode: TMongoJSONMode=modMongoStrict); overload;
/// convert any kind of BSON/JSON element, encoded as variant, into JSON
// - in addition to default modMongoStrict as rendered by VariantSaveJSON(),
// this function can render the supplied variant with the Mongo Shell syntax
// or even raw JSON content
function VariantSaveMongoJSON(const Value: variant; Mode: TMongoJSONMode): RawUTF8;
{ ************ MongoDB Client }
const
/// MongoDB server default IP port
MONGODB_DEFAULTPORT = 27017;
type
/// exception type used for MongoDB process
EMongoException = class(ESynException);
/// the available MongoDB driver Request Opcodes
// - opReply: database reply to a client request - ResponseTo shall be set
// - opMsg: generic msg command followed by a string (deprecated)
// - opUpdate: update document
// - opInsert: insert new document
// - opQuery: query a collection
// - opGetMore: get more data from a previous query
// - opDelete: delete documents
// - opKillCursors: notify database client is done with a cursor
TMongoOperation = (
opReply, opMsg, opUpdate, opInsert, opQuery, opGetMore, opDelete, opKillCursors);
/// define how an opUpdate operation will behave
// - if mufUpsert is set, the database will insert the supplied object into
// the collection if no matching document is found
// - if mufMultiUpdate is set, the database will update all matching objects
// in the collection; otherwise (by default) only updates first matching doc
TMongoUpdateFlag =
(mufUpsert, mufMultiUpdate);
/// define how a TMongoRequestUpdate message will behave
TMongoUpdateFlags = set of TMongoUpdateFlag;
/// define how an opInsert operation will behave
// - if mifContinueOnError is set, the database will not stop processing a
// bulk insert if one fails (e.g. due to duplicate IDs); this makes bulk
// insert behave similarly to a series of single inserts, except lastError
// will be set if any insert fails, not just the last one - if multiple
// errors occur, only the most recent will be reported by getLastError
TMongoInsertFlag =
(mifContinueOnError);
/// define how a TMongoRequestInsert message will behave
TMongoInsertFlags = set of TMongoInsertFlag;
/// define how an opDelete operation will behave
// - if mdfSingleRemove is set, the database will remove only the first
// matching document in the collection. Otherwise (by default) all matching
// documents will be removed
TMongoDeleteFlag =
(mdfSingleRemove);
/// define how a TMongoRequestDelete message will behave
TMongoDeleteFlags = set of TMongoDeleteFlag;
/// define how an opQuery operation will behave
// - if mqfTailableCursor is set, cursor is not closed when the last data
// is retrieved
// - if mqfSlaveOk is set, it will allow query of replica slave; normally
// this returns an error except for namespace "local"
// - mqfOplogReplay is internal replication use only - driver should not set
// - if mqfNoCursorTimeout is set, the server normally does not times out
// idle cursors after an inactivity period (10 minutes) to prevent
// excess memory use
// - if mqfAwaitData is to use with TailableCursor. If we are at the end
// of the data, block for a while rather than returning no data. After a
// timeout period, we do return as normal
// - if mqfExhaust is set, stream the data down full blast in multiple "more"
// packages, on the assumption that the client will fully read all data queried
// - if mqfPartial is set, it will get partial results from a mongos if
// some shards are down (instead of throwing an error)
TMongoQueryFlag =
(mqfTailableCursor=1, mqfSlaveOk, mqfOplogReplay, mqfNoCursorTimeout,
mqfAwaitData, mqfExhaust, mqfPartial);
/// define how a TMongoRequestQuery message will behave
TMongoQueryFlags = set of TMongoQueryFlag;
/// abstract class used to create MongoDB Wire Protocol client messages
// - see http://docs.mongodb.org/meta-driver/latest/legacy/mongodb-wire-protocol
// - this class is not tight to the connection class itself (which is one
// known limitation of TMongoWire for instance)
TMongoRequest = class(TBSONWriter)
protected
fRequestID: integer;
fResponseTo: integer;
fRequestOpCode: TMongoOperation;
fDatabaseName,
fCollectionName,
fFullCollectionName: RawUTF8;
fBSONDocument: TBSONDocument;
public
/// write a standard Message Header for MongoDB client
// - opCode is the type of the message
// - requestID is a client or database-generated identifier that uniquely
// identifies this message: in case of opQuery or opGetMore messages, it will
// be sent in the responseTo field from the database
// - responseTo is the requestID taken from previous opQuery or opGetMore
constructor Create(const FullCollectionName: RawUTF8;
opCode: TMongoOperation; requestID, responseTo: Integer); reintroduce;
/// append a query parameter as a BSON document
// - param can be a TDocVariant, e.g. created with:
// ! _JsonFast('{name:"John",age:{$gt:21}}');
// ! _JsonFastFmt('{name:?,age:{$gt:?}}',[],['John',21]);
// ! _JsonFastFmt('{name:?,field:/%/i}',['acme.*corp'],['John']);
// - param can be a TBSONVariant containing a TBSONDocument raw binary block
// created e.g. from:
// ! BSONVariant(['BSON',_Arr(['awesome',5.05, 1986])])
// ! BSONVariantType[BSON(['BSON',_Arr(['awesome',5.05, 1986])])]
// - if param is null, it will append a void document
// - if param is a string, it will be converted as expected by most
// database commands, e.g.
// ! TMongoRequestQuery.Create('admin.$cmd','buildinfo',[],1)
// will query { buildinfo: 1 } to the admin.$cmd collection, i.e.
// $ admin.$cmd.findOne( { buildinfo: 1 } )
procedure BSONWriteParam(const paramDoc: variant);
/// flush the content and return the whole binary encoded stream
// - expect the TBSONWriter instance to have been created with reintroduced
// Create() specific constructors inheriting from this TMongoRequest class
// - this overridden version will adjust the size in the message header
procedure ToBSONDocument(var result: TBSONDocument); override;
/// write the main parameters of the request as JSON
procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); overload; virtual;
/// write the main parameters of the request as JSON
function ToJSON(Mode: TMongoJSONMode): RawUTF8; overload;
/// identify the message, after call to any reintroduced Create() constructor
property MongoRequestID: integer read fRequestID;
/// the associated full collection name, e.g. 'db.test'
property FullCollectionName: RawUTF8 read fFullCollectionName;
/// the associated full collection name, e.g. 'db'
property DatabaseName: RawUTF8 read fDatabaseName;
/// the associated full collection name, e.g. 'test'
property CollectionName: RawUTF8 read fCollectionName;
/// the message operation code
// - should be either opUpdate, opInsert, opQuery, opGetMore, opDelete
// or opKillCursors, depending on the TMongoRequest* class instantiated
property MongoRequestOpCode: TMongoOperation read fRequestOpCode;
end;
/// a MongoDB client abstract ancestor which is able to create a BULK
// command message for MongoDB >= 2.6 instead of older dedicated Wire messages
TMongoRequestWritable = class(TMongoRequest)
protected
public
end;
/// a MongoDB client message to update a document in a collection
TMongoRequestUpdate = class(TMongoRequestWritable)
protected
fSelector, fUpdate: TVarData;
public
/// initialize a MongoDB client message to update a document in a collection
// - FullCollectionName is e.g. 'dbname.collectionname'
// - how the update will be processed can be customized via Flags
// - Selector is the BSON document query to select the document, supplied as
// TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or as
// TBSONVariant - i.e. created via BSONVariant() - or null if all documents
// are to be updated
// - Update is the BSON document specification of the update to perform,
// supplied as TDocVariant or TBSONVariant
// - there is no response to an opUpdate message
constructor Create(const FullCollectionName: RawUTF8;
const Selector, Update: variant; Flags: TMongoUpdateFlags=[]); reintroduce;
/// write the main parameters of the request as JSON
procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
end;
/// a MongoDB client message to insert one or more documents in a collection
TMongoRequestInsert = class(TMongoRequestWritable)
public
/// initialize a MongoDB client message to insert one or more documents in
// a collection, supplied as variants
// - FullCollectionName is e.g. 'dbname.collectionname'
// - Documents is an array of TDocVariant or TBSONVariant - i.e. created via
// _JsonFast() _JsonFastFmt() or BSONVariant()
// - there is no response to an opInsert message
constructor Create(const FullCollectionName: RawUTF8;
const Documents: array of variant; Flags: TMongoInsertFlags=[]); reintroduce; overload;
/// initialize a MongoDB client message to insert one or more documents in
// a collection, supplied as raw BSON binary
// - FullCollectionName is e.g. 'dbname.collectionname'
// - Documents is the low-level concatenation of BSON documents, created
// e.g. with a TBSONWriter stream
// - there is no response to an opInsert message
constructor Create(const FullCollectionName: RawUTF8;
const Documents: TBSONDocument; Flags: TMongoInsertFlags=[]); reintroduce; overload;
/// initialize a MongoDB client message to insert one or more documents in
// a collection, supplied as JSON objects
// - FullCollectionName is e.g. 'dbname.collectionname'
// - JSONDocuments is an array of JSON objects
// - there is no response to an opInsert message
constructor Create(const FullCollectionName: RawUTF8;
const JSONDocuments: array of PUTF8Char; Flags: TMongoInsertFlags=[]); reintroduce; overload;
end;
/// a MongoDB client message to delete one or more documents in a collection
TMongoRequestDelete = class(TMongoRequestWritable)
protected
fQuery: TVarData;
public
/// initialize a MongoDB client message to delete one or more documents in
// a collection
// - FullCollectionName is e.g. 'dbname.collectionname'
// - Selector is the BSON document query to select the document, supplied as
// TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or as
// TBSONVariant - i.e. created via BSONVariant() - or null if all documents
// are to be deleted
// - warning: CreateDelete('db.coll',null) can be expensive so you should
// better drop the whole collection
// - there is no response to an opDelete message
constructor Create(const FullCollectionName: RawUTF8;
const Selector: variant; Flags: TMongoDeleteFlags=[]); reintroduce;
/// write the main parameters of the request as JSON
procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
end;
/// a MongoDB client message to query one or more documents in a collection
TMongoRequestQuery = class(TMongoRequest)
protected
fNumberToReturn,fNumberToSkip: integer;
fQuery, fReturnFieldsSelector: TVarData;
public
/// initialize a MongoDB client message to query one or more documents in
// a collection from a specified Cursor identifier
// - FullCollectionName is e.g. 'dbname.collectionname'
// - Query is the BSON document query to select the document, supplied as
// TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or null
// if all documents are to be retrieved - for instance:
// ! _JsonFast('{name:"John",age:{$gt:21}}');
// ! _JsonFastFmt('{name:?,age:{$gt:?}}',[],['John',21]);
// ! _JsonFastFmt('{name:?,field:/%/i}',['acme.*corp'],['John']);
// - if Query is a string, it will be converted as expected by most
// database commands, e.g.
// $ TMongoRequestQuery.Create('admin.$cmd','buildinfo',[],1)
// will query { buildinfo: 1 } to the admin.$cmd collection, i.e.
// $ admin.$cmd.findOne( { buildinfo: 1 } )
// - Query can also be a TBSONVariant, e.g. created with:
// ! BSONVariant('{name:?,age:{$gt:?}}',[],['John',21])
// - ReturnFieldsSelector is an optional selector (set to null if not
// applicable) as a BSON document that limits the fields in the returned
// documents, supplied as TDocVariant or TBSONVariant - e.g. created via:
// ! BSONVariantFieldSelector('a,b,c');
// ! BSONVariantFieldSelector(['a','b','c']);
// ! BSONVariant('{a:1,b:1,c:1}');
// ! _JsonFast('{a:1,b:1,c:1}');
// - if ReturnFieldsSelector is a string, it will be converted into
// $ { ReturnFieldsSelector: 1 }
constructor Create(const FullCollectionName: RawUTF8;
const Query, ReturnFieldsSelector: variant; NumberToReturn: integer;
NumberToSkip: Integer=0; Flags: TMongoQueryFlags=[]); reintroduce;
/// write the main parameters of the request as JSON
procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
/// retrieve the NumberToReturn parameter as set to the constructor
property NumberToReturn: integer read fNumberToReturn;
/// retrieve the NumberToSkip parameter as set to the constructor
property NumberToSkip: integer read fNumberToSkip;
end;
/// a MongoDB client message to continue the query of one or more documents
// in a collection, after a TMongoRequestQuery message
TMongoRequestGetMore = class(TMongoRequest)
public
/// initialize a MongoDB client message to continue the query of one or more
// documents in a collection, after a opQuery / TMongoRequestQuery message
// - FullCollectionName is e.g. 'dbname.collectionname'
// - you can specify the number of documents to return (e.g. from previous
// opQuery response)
// - CursorID should have been retrieved within an opReply message from the
// database
constructor Create(const FullCollectionName: RawUTF8;
NumberToReturn: integer; CursorID: Int64); reintroduce;
end;
/// a MongoDB client message to close one or more active cursors
TMongoRequestKillCursor = class(TMongoRequest)
protected
fCursors: TInt64DynArray;
public
/// initialize a MongoDB client message to close one or more active cursors
// in the database
// - it is mandatory to ensure that database resources are reclaimed by
// the client at the end of the query
// - if a cursor is read until exhausted (read until opQuery or opGetMore
// returns zero for the CursorId), there is no need to kill the cursor
// - there is no response to an opKillCursor message
constructor Create(const FullCollectionName: RawUTF8;
const CursorIDs: array of Int64); reintroduce;
/// write the main parameters of the request as JSON
procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
end;
/// used to store the binary raw data a database response to a
// TMongoRequestQuery / TMongoRequestGetMore client message
TMongoReply = RawByteString;
/// define an opReply message execution content
// - mrfCursorNotFound will be set when getMore is called but the cursor id
// is not valid at the server; returned with zero results
// - mrfQueryFailure is set when the query failed - results consist of one
// document containing an "$err" field describing the failure
// - mrfShardConfigStale should not be used by client, just by Mongos
// - mrfAwaitCapable is set when the server supports the AwaitData Query
// option (always set since Mongod version 1.6)
TMongoReplyCursorFlag = (
mrfCursorNotFound, mrfQueryFailure, mrfShardConfigStale,
mrfAwaitCapable);
/// define a TMongoReplyCursor message execution content
TMongoReplyCursorFlags = set of TMongoReplyCursorFlag;
/// internal low-level binary structure mapping the TMongoReply header
// - used e.g. by TMongoReplyCursor and TMongoConnection.GetReply()
TMongoReplyHeader = packed record
/// total message length, including the header
MessageLength: integer;
/// identifier of this message
RequestID: integer;
/// retrieve the RequestID from the original request
ResponseTo: integer;
/// low-level code of the message
OpCode: integer;
/// response flags
ResponseFlags: integer;
/// cursor identifier if the client may need to perform further opGetMore
CursorID: Int64;
/// where in the cursor this reply is starting
StartingFrom: integer;
/// number of documents in the reply
NumberReturned: integer;
end;
/// points to an low-level binary structure mapping the TMongoReply header
// - so that you can write e.g.
// ! PMongoReplyHeader(aMongoReply)^.RequestID
PMongoReplyHeader = ^TMongoReplyHeader;
/// map a MongoDB server reply message as sent by the database
// - in response to TMongoRequestQuery / TMongoRequestGetMore messages
// - you can use the record's methods to retrieve information about a given
// response, and navigate within all nested documents
// - several TMongoReplyCursor instances may map the same TMongoReply content
// - you can safely copy one TMongoReplyCursor instance to another
{$ifndef UNICODE}
TMongoReplyCursor = object
protected
{$else}
TMongoReplyCursor = record
private
{$endif}
fReply: TMongoReply;
fRequestID: integer;
fResponseTo: integer;
fResponseFlags: TMongoReplyCursorFlags;
fCursorID: Int64;
fStartingFrom: integer;
fNumberReturned: integer;
fDocuments: TPointerDynArray;
fCurrentPosition: integer;
fFirstDocument,
fCurrentDocument: PAnsiChar;
fLatestDocIndex: integer;
fLatestDocValue: variant;
procedure ComputeDocumentsList;
function GetOneDocument(index: integer): variant;
public
/// initialize the cursor with a supplied binary reply from the server
// - will raise an EMongoException if the content is not valid
// - will populate all record fields with the supplied data
procedure Init(const ReplyMessage: TMongoReply);
/// retrieve the next document in the list, as a TDocVariant instance
// - return TRUE if the supplied document has been retrieved
// - return FALSE if there is no more document to get - you can use the
// Rewind method to restart from the first document
// - could be used e.g. as:
// ! var Reply: TMongoReply;
// ! doc: variant;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! while Reply.Next(doc) do
// ! writeln('Name: ',doc.Name,' FirstName: ',doc.FirstName);
function Next(out doc: variant; option: TBSONDocArrayConversion=asDocVariantPerReference): boolean; overload;
/// retrieve the next document in the list, as BSON content
// - return TRUE if the supplied document has been retrieved - then doc
// points to a "int32 e_list #0" BSON document
// - return FALSE if there is no more document to get - you can use the
// Rewind method to restart from the first document
// - this method is almost immediate, since the BSON raw binary is returned
// directly without any conversion
// - could be used e.g. as:
// ! var Reply: TMongoReply;
// ! doc: PByte;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! while Reply.Next(doc) do
// ! writeln(BSONToJSON(doc,0,modMongoShell)); // fast display
function Next(out doc: PByte): boolean; overload;
/// retrieve the next document in the list, as a BSON binary document
// - return TRUE if the supplied document has been retrieved - then doc
// points to a "int32 e_list #0" BSON document
// - return FALSE if there is no more document to get - you can use the
// Rewind method to restart from the first document
// - this method is slightly slower than the one returning a PByte, since
// it will allocate a memory buffer to store the TBSONDocument binary
// - could be used e.g. as:
// ! var Reply: TMongoReply;
// ! doc: TBSONDocument;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! while Reply.Next(doc) do
// ! writeln(BSONToJSON(doc,0,modMongoShell)); // fast display
function Next(out BSON: TBSONDocument): boolean; overload;
/// retrieve the next document in the list, as JSON content
// - return TRUE if the supplied document has been retrieved
// - return FALSE if there is no more document to get - you can use the
// Rewind method to restart from the first document
// - could be used e.g. as:
// ! var Reply: TMongoReply;
// ! json: RawUTF8;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! while Reply.Next(json,modMongoShell) do
// ! writeln(json); // fast display
function Next(out JSON: RawUTF8; Mode: TMongoJSONMode=modMongoStrict): boolean; overload;
/// let Next() overloaded methods point to the first document of this message
procedure Rewind;
/// retrieve a given document as a TDocVariant instance
// - this method won't use any cache (like Document[..] property), since
// it should be used with a local variant on stack as cache:
// ! var Reply: TMongoReply;
// ! doc: variant;
// ! i: integer;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! for i := 0 to Reply.DocumentCount-1 do begin
// ! GmrfQueryFailureetDocument(i,doc);
// ! writeln('Name: ',doc.Name,' FirstName: ',doc.FirstName);
// ! end;
procedure GetDocument(index: integer; var result: variant);
/// return all documents content as a JSON array, or one JSON object
// if there is only one document in this reply
// - this method is very optimized and will convert the BSON binary content
// directly into JSON
procedure FetchAllToJSON(W: TTextWriter; Mode: TMongoJSONMode=modMongoStrict;
WithHeader: boolean=false; MaxSize: Cardinal=0);
/// return all documents content as a JSON array, or one JSON object
// if there is only one document in this reply
// - this method is very optimized and will convert the BSON binary content
// directly into JSON
function ToJSON(Mode: TMongoJSONMode=modMongoStrict; WithHeader: boolean=false;
MaxSize: Cardinal=0): RawUTF8;
/// append all documents content to a dynamic array of TDocVariant
// - return the new size of the Dest[] array
function AppendAllToDocVariantDynArray(var Dest: TVariantDynArray): integer;
/// append all documents content to a TDocVariant array instance
// - if the supplied instance if not already a TDocVariant of kind dvArray,
// a new void instance will be created
// - return the new size of the Dest array
function AppendAllToDocVariant(var Dest: TDocVariantData): integer;
/// append all documents content to a BSON binary stream
// - Dest.Tag will be used to count the current item number in the resulting
// BSON array
procedure AppendAllToBSON(Dest: TBSONWriter);
/// retrieve the context execution of this message
property ResponseFlags: TMongoReplyCursorFlags read fResponseFlags;
/// identifier of this message
property RequestID: integer read fRequestID;
/// retrieve the RequestID from the original request
property ResponseTo: integer read fResponseTo;
/// access to the low-level binary reply message
property Reply: TMongoReply read fReply;
/// cursor identifier if the client may need to perform further
// TMongoRequestGetMore messages
// - in the event that the result set of the query fits into one OP_REPLY
// message, CursorID will be 0
property CursorID: Int64 read fCursorID;
/// where in the cursor this reply is starting
property StartingFrom: integer read fStartingFrom;
/// number of documents in the reply
property DocumentCount: Integer read fNumberReturned;
/// points to the first document binary
// - i.e. just after the Reply header
property FirstDocument: PAnsiChar read fFirstDocument;
/// direct access to the low-level BSON binary content of each document
property DocumentBSON: TPointerDynArray read fDocuments;
/// retrieve a given document as a TDocVariant instance
// - could be used e.g. as:
// ! var Reply: TMongoReply;
// ! i: integer;
// ! ...
// ! Reply.Init(ResponseMessage);
// ! for i := 0 to Reply.DocumentCount-1 do
// ! writeln('Name: ',Reply.Document[i].Name,' FirstName: ',Reply.Document[i].FirstName);
// - note that there is an internal cache for the latest retrieved document
// by this property, so that you can call Reply.Document[i] several times
// without any noticeable speed penalty
property Document[index: integer]: variant read GetOneDocument;
/// the current position of the Next() call, starting at 0
property Position: integer read fCurrentPosition;
end;
/// event callback signature for iterative process of TMongoConnection
TOnMongoConnectionReply = procedure(Request: TMongoRequest;
const Reply: TMongoReplyCursor; var Opaque) of object;
{$M+}
TMongoClient = class;
TMongoDatabase = class;
TMongoCollection = class;
/// one TCP/IP connection to a MongoDB server
// - all access will be protected by a mutex (critical section): it is thread
// safe but you may use one TMongoClient per thread or a connection pool, for
// better performance
TMongoConnection = class
protected
fLock: TRTLCriticalSection;
fLocked: cardinal;
fClient: TMongoClient;
fSocket: TCrtSocket;
fServerAddress: RawUTF8;
fServerPort: integer;
procedure Lock;
procedure UnLock;
function Send(Request: TMongoRequest): boolean;
function GetOpened: boolean;
function GetLocked: boolean;
// will call TMongoReplyCursor.FetchAllToJSON(TTextWriter(Opaque))
procedure ReplyJSONStrict(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
procedure ReplyJSONExtended(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
procedure ReplyJSONNoMongo(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
// will call TMongoReplyCursor.AppendAllToDocVariantDynArray(TVariantDynArray(Opaque))
procedure ReplyDocVariant(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
// will call TMongoReplyCursor.AppendAllToBSON(TBSONWrite(Opaque))
procedure ReplyBSON(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
public
/// initialize the connection to the corresponding MongoDB server
// - the server address is either a host name, or an IP address
// - if no server address is specified, will try to connect to localhost
// - this won't create the connection, until Open method is executed
constructor Create(const aClient: TMongoClient; const aServerAddress: RawByteString;
aServerPort: integer=MONGODB_DEFAULTPORT); reintroduce;
/// release the connection, including the socket
destructor Destroy; override;
/// connect to the MongoDB server
// - will raise an EMongoException on error
procedure Open;
/// disconnect from MongoDB server
// - will raise an EMongoException on error
procedure Close;
/// low-level method to send a request to the server
// - if Request is not either TMongoRequestQuery or TMongoRequestGetMore,
// will raise an EMongoException
// - then will return the reply message as sent back by the database,
// ready to be accessed using a TMongoReplyCursor wrapper
procedure GetReply(Request: TMongoRequest; out result: TMongoReply);
/// low-level method to send a request to the server, and return a cursor
// - if Request is not either TMongoRequestQuery or TMongoRequestGetMore,
// will raise an EMongoException
// - then will parse and return a cursor to the reply message as sent back
// by the database, with logging if necessary
// - raise an EMongoException if mrfQueryFailure flag is set in the reply
procedure GetCursor(Request: TMongoRequest; var Result: TMongoReplyCursor);
/// low-level method to send a query to the server, calling a callback event
// on each reply
// - is used by GetDocumentsAndFree, GetBSONAndFree and GetJSONAndFree
// methods to receive the whole document (you should better call those)
// - the supplied Query instance will be released when not needed any more
procedure GetRepliesAndFree(Query: TMongoRequestQuery;
OnEachReply: TOnMongoConnectionReply; var Opaque);
/// send a query to the server, returning a TDocVariant instance containing
// all the incoming data
// - will send the Request message, and any needed TMongoRequestGetMore
// messages to retrieve all the data from the server
// - the supplied Query instance will be released when not needed any more
// - if Query.NumberToReturn<>1, it will return either null or a dvArray
// kind of TDocVariant containing all returned items
// - if Query.NumberToReturn=1, then it will return either null or a
// single TDocVariant instance
function GetDocumentsAndFree(Query: TMongoRequestQuery): variant; overload;
/// send a query to the server, returning a TDocVariant instance containing
// all the incoming data
// - will send the Request message, and any needed TMongoRequestGetMore
// messages to retrieve all the data from the server
// - the supplied Query instance will be released when not needed any more
// - if Query.NumberToReturn<>1, it will return either null or a dvArray
// kind of TDocVariant containing all returned items
// - if Query.NumberToReturn=1, then it will return either null or a
// single TDocVariant instance
procedure GetDocumentsAndFree(Query: TMongoRequestQuery; var result: variant); overload;
/// send a query to the server, returning a dynamic array of TDocVariant
// instance containing all the incoming data
// - will send the Request message, and any needed TMongoRequestGetMore
// messages to retrieve all the data from the server
// - the supplied Query instance will be released when not needed any more
procedure GetDocumentsAndFree(Query: TMongoRequestQuery; var result: TVariantDynArray); overload;
/// send a query to the server, returning a TBSONDocument instance containing
// all the incoming data, as raw binary BSON document containing an array
// of the returned items
// - will send the Request message, and any needed TMongoRequestGetMore
// messages to retrieve all the data from the server
// - the supplied Query instance will be released when not needed any more
function GetBSONAndFree(Query: TMongoRequestQuery): TBSONDocument;
/// send a query to the server, returning all the incoming data as JSON
// - will send the Request message, and any needed TMongoRequestGetMore
// messages to retrieve all the data from the server
// - this method is very optimized and will convert the BSON binary content
// directly into JSON, in either modMongoStrict or modMongoShell layout
// (modNoMongo will do the same as modMongoStrict)
// - if Query.NumberToReturn<>1, it will return either 'null' or a '[..]'
// JSON array with all the incoming documents retrieved from the server
// - if Query.NumberToReturn=1, it will return either 'null' or a single
// '{...}' JSON object
// - the supplied Query instance will be released when not needed any more
function GetJSONAndFree(Query: TMongoRequestQuery; Mode: TMongoJSONMode): RawUTF8;
/// send a message to the MongoDB server
// - will apply Client.WriteConcern policy, and run an EMongoException
// in case of any error
// - the supplied Request instance will be released when not needed any more
// - by default, it will follow Client.WriteConcern pattern - but you can
// set NoAcknowledge = TRUE to avoid calling the getLastError command
// - will return the getLastError reply (if retrieved from server)
function SendAndFree(Request: TMongoRequest; NoAcknowledge: boolean=false): variant;
/// run a database command, supplied as a TDocVariant, TBSONVariant or a
// string, and return the a TDocVariant instance
// - see http://docs.mongodb.org/manual/reference/command for a list
// of all available commands
// - for instance:
// ! RunCommand('test',_ObjFast(['dbStats',1,'scale',1024],stats);
// ! RunCommand('test',BSONVariant(['dbStats',1,'scale',1024],stats);
// ! RunCommand('admin','buildinfo',fServerBuildInfo);
// - the message will be returned by the server as a single TDocVariant
// instance (since the associated TMongoRequestQuery.NumberToSkip=1)
// - in case of any error, the error message is returned as text
// - in case of success, this method will return ''
function RunCommand(const aDatabaseName: RawUTF8;
const command: variant; var returnedValue: variant): RawUTF8; overload;
/// run a database command, supplied as a TDocVariant, TBSONVariant or a
// string, and return the raw BSON document array of received items
// - this overloaded method can be used on huge content to avoid the slower
// conversion to an array of TDocVariant instances
// - in case of success, this method will return TRUE, or FALSE on error
function RunCommand(const aDatabaseName: RawUTF8;
const command: variant; var returnedValue: TBSONDocument): boolean; overload;
/// return TRUE if the Open method has successfully been called
property Opened: boolean read GetOpened;
/// access to the corresponding MongoDB server
property Client: TMongoClient read fClient;
/// direct access to the low-level TCP/IP communication socket
property Socket: TCrtSocket read fSocket;
/// is TRUE when the connection is busy
property Locked: boolean read GetLocked;
published
/// read-only access to the supplied server address
// - the server address is either a host name, or an IP address
property ServerAddress: RawUTF8 read fServerAddress;
/// read-only access to the supplied server port
// - the server Port is MONGODB_DEFAULTPORT (27017) by default
property ServerPort: integer read fServerPort;
end;
/// array of TCP connection to a MongoDB Replica Set
// - first item [0] is the Primary member
// - other items [1..] are the Secondary members
TMongoConnectionDynArray = array of TMongoConnection;
/// define Read Preference Modes to a MongoDB replica set
// - Important: All read preference modes except rpPrimary may return stale
// data because secondaries replicate operations from the primary with some
// delay - ensure that your application can tolerate stale data if you choose
// to use a non-primary mode
// - rpPrimary: Default mode - all operations read from the current replica
// set primary
// - rpPrimaryPreferred: in most situations, operations read from the primary
// but if it is unavailable, operations read from secondary members.
// - rpPsecondary: all operations read from the secondary members
// of the replica set
// - rpPsecondaryPreferred: in most situations, operations read from
// secondary members but if no secondary members are available, operations
// read from the primary
TMongoClientReplicaSetReadPreference = (
rpPrimary, rpPrimaryPreferred, rpSecondary, rpSecondaryPreferred);
/// define Write Concern property of a MongoDB connection
// - Write concern describes the guarantee that MongoDB provides when
// reporting on the success of a write operation. The strength of the write
// concerns determine the level of guarantee. When inserts, updates and
// deletes have a weak write concern, write operations return quickly. In
// some failure cases, write operations issued with weak write concerns may
// not persist. With stronger write concerns, clients wait after sending a
// write operation for MongoDB to confirm the write operations. MongoDB
// provides different levels of write concern to better address the specific
// needs of applications. Clients may adjust write concern to ensure that
// the most important operations persist successfully to an entire
// MongoDB deployment. For other less critical operations, clients can
// adjust the write concern to ensure faster performance rather than
// ensure persistence to the entire deployment.
// - wcAcknowledged is the default safe mode: the mongod confirms the
// receipt of the write operation. Acknowledged write concern allows clients
// to catch network, duplicate key, and other errors.
// - with wcJournaled, the mongod acknowledges the write operation only
// after committing the data to the journal. This write concern ensures that
// MongoDB can recover the data following a shutdown or power interruption.
// - wcReplicaAcknowledged will guarantee that the write operation propagates
// to at least one member of a replica set
// - with wcUnacknowledged, MongoDB does not acknowledge the receipt of
// write operation. Unacknowledged is similar to errors ignored; however,
// drivers attempt to receive and handle network errors when possible. The
// driver's ability to detect network errors depends on the system's
// networking configuration.
// - with wcErrorsIgnored, MongoDB does not acknowledge write operations.
// With this level of write concern, the client cannot detect failed write
// operations. These errors include connection errors and mongod exceptions
// such as duplicate key exceptions for unique indexes. Although the errors
// ignored write concern provides fast performance, this performance gain
// comes at the cost of significant risks for data persistence and durability.
// WARNING: Do not use wcErrorsIgnored write concern in normal operation.
TMongoClientWriteConcern = (
wcAcknowledged, wcJournaled, wcReplicaAcknowledged,
wcUnacknowledged, wcErrorsIgnored);
/// remote access to a MongoDB server
// - a single server can have several active connections, if some secondary
// hosts were defined
TMongoClient = class
protected
fConnectionString: RawUTF8;
fDatabases: TRawUTF8ListHashed;
fConnections: TMongoConnectionDynArray;
fReadPreference: TMongoClientReplicaSetReadPreference;
fWriteConcern: TMongoClientWriteConcern;
fConnectionTimeOut: Cardinal;
fConnectionTLS: boolean;
fGracefulReconnect: record
Enabled, ForcedDBCR: boolean;
User, Database: RawUTF8;
EncryptedDigest: RawByteString;
end;
fLog: TSynLog;
fLogRequestEvent: TSynLogInfo;
fLogReplyEvent: TSynLogInfo;
fLogReplyEventMaxSize: cardinal;
fServerBuildInfo: variant;
fServerBuildInfoNumber: cardinal;
fLatestReadConnectionIndex: integer;
procedure AfterOpen; virtual;
function GetOneReadConnection: TMongoConnection;
function GetBytesReceived: Int64;
function GetBytesSent: Int64;
function GetBytesTransmitted: Int64;
procedure Auth(const DatabaseName,UserName,Digest: RawUTF8; ForceMongoDBCR: boolean);
function ReOpen: boolean;
public
/// prepare a connection to a MongoDB server or Replica Set
// - this constructor won't create the connection until the Open method
// is called
// - you can specify multiple hosts, as CSV values, if necessary
// - depending on the platform, you may request for a TLS secured connection
constructor Create(const Host: RawUTF8; Port: Integer=MONGODB_DEFAULTPORT;
aTLS: boolean=false; const SecondaryHostCSV: RawUTF8=''; const SecondaryPortCSV: RawUTF8=''); overload;
/// connect to a database on a remote MongoDB primary server
// - this method won't use authentication, and will return the corresponding
// MongoDB database instance
// - this method is an alias to the Database[] property
function Open(const DatabaseName: RawUTF8): TMongoDatabase;
/// secure connection to a database on a remote MongoDB server
// - this method will use authentication and will return the corresponding
// MongoDB database instance, with a dedicated secured connection
// - will use MONGODB-CR for MongoDB engines up to 2.6 (or if ForceMongoDBCR
// is TRUE), and SCRAM-SHA-1 since MongoDB 3.x
// - see http://docs.mongodb.org/manual/administration/security-access-control
function OpenAuth(const DatabaseName,UserName,PassWord: RawUTF8;
ForceMongoDBCR: boolean=false): TMongoDatabase;
/// close the connection and release all associated TMongoDatabase,
// TMongoCollection and TMongoConnection instances
destructor Destroy; override;
/// define an optional logging instance to be used
// - you can also specify the event types to be used for requests or
// replay: by default, a verbose log with sllSQL and sllDB will be set
// - e.g. mORMotMongoDB.pas will call Client.SetLog(SQLite3Log) for you
procedure SetLog(LogClass: TSynLogClass;
RequestEvent: TSynLogInfo=sllSQL; ReplyEvent: TSynLogInfo=sllDB;
ReplyEventMaxSize: cardinal=1024);
/// retrieve extended server version and build information, as text
// - will create a string from ServerBuildInfo object, e.g. as
// $ 'MongoDB 3.2.0 mozjs mmapv1,wiredTiger'
function ServerBuildInfoText: RawUTF8;
/// retrieve the server version and build information
// - return the content as a TDocVariant document, e.g.
// ! ServerBuildInfo.version = '2.4.9'
// ! ServerBuildInfo.versionArray = [2,4,9,0]
// - this property is cached, so request is sent only once
// - you may rather use ServerBuildInfoNumber to check for available
// features at runtime, for easy comparison of the server version
property ServerBuildInfo: variant read fServerBuildInfo;
/// access to a given MongoDB database
// - try to open it via a non-authenticated connection it if not already:
// will raise an exception on error, or will return an instance
// - will return an existing instance if has already been opened
property Database[const DatabaseName: RawUTF8]: TMongoDatabase read Open; default;
/// low-level access to the TCP/IP connections of this MongoDB replica set
// - first item [0] is the Primary member
// - other items [1..] are the Secondary members
property Connections: TMongoConnectionDynArray read fConnections;
/// define the logging instance to be used for LogRequestEvent/LogReplyEvent
// - you may also call the SetLog() method to set all options at once
property Log: TSynLog read fLog write fLog;
published
/// the connection definition used to connect to this MongoDB server
property ConnectionString: RawUTF8 read fConnectionString;
/// retrieve the server version and build information
// - return the content as a TDocVariant document, e.g.
// ! 2040900 for MongoDB 2.4.9, or 2060000 for MongoDB 2.6, or
// ! 3000300 for MongoDB 3.0.3
// - this property is cached, so can be used to check for available
// features at runtime, without any performance penalty
property ServerBuildInfoNumber: cardinal read fServerBuildInfoNumber;
/// define Read Preference mode to a MongoDB replica set
// - see http://docs.mongodb.org/manual/core/read-preference
// - default is rpPrimary, i.e. reading from the main primary instance
// - Important: All read preference modes except rpPrimary may return stale
// data because secondaries replicate operations from the primary with some
// delay - ensure that your application can tolerate stale data if you choose
// to use a non-primary mode
property ReadPreference: TMongoClientReplicaSetReadPreference
read fReadPreference write fReadPreference;
/// define Write Concern mode to a MongoDB replica set
// - see http://docs.mongodb.org/manual/core/write-concern
// - default is wcAcknowledged, i.e. to acknowledge all write operations
property WriteConcern: TMongoClientWriteConcern
read fWriteConcern write fWriteConcern;
/// the connection time out, in milli seconds
// - default value is 30000, i.e. 30 seconds
property ConnectionTimeOut: Cardinal read fConnectionTimeOut write fConnectionTimeOut;
/// if the socket connection is secured over TLS
property ConnectionTLS: boolean read fConnectionTLS;
/// allow automatic reconnection (with authentication, if applying), if the
// socket is closed (e.g. was dropped from the server)
property GracefulReconnect: boolean
read fGracefulReconnect.Enabled write fGracefulReconnect.Enabled;
/// how may bytes this client did received, among all its connections
property BytesReceived: Int64 read GetBytesReceived;
/// how may bytes this client did received, among all its connections
property BytesSent: Int64 read GetBytesSent;
/// how may bytes this client did transmit, adding both input and output
property BytesTransmitted: Int64 read GetBytesTransmitted;
/// if set to something else than default sllNone, will log each request
// with the corresponding logging event kind
// - will use the Log property for the destination log
// - you may also call the SetLog() method to set all options at once
property LogRequestEvent: TSynLogInfo read fLogRequestEvent write fLogRequestEvent;
/// if set to something else than default sllNone, will log each reply
// with the corresponding logging event kind
// - WARNING: logging all incoming data may be very verbose, e.g. when
// retrieving a document list - use it with care, not on production, but
// only for debugging purposes - or set LogReplyEventMaxSize to a low value
// - will use the Log property for the destination log
// - you may also call the SetLog() method to set all options at once
property LogReplyEvent: TSynLogInfo read fLogReplyEvent write fLogReplyEvent;
/// defines how many characters a LogReplyEvent entry may append in the log
// - is set by default to 1024, which sounds somewhat good for debugging
property LogReplyEventMaxSize: cardinal
read fLogReplyEventMaxSize write fLogReplyEventMaxSize;
end;
/// remote access to a MongoDB database
TMongoDatabase = class
protected
fClient: TMongoClient;
fName: RawUTF8;
fCollections: TRawUTF8ListHashed;
function GetCollection(const Name: RawUTF8): TMongoCollection;
function GetCollectionOrCreate(const Name: RawUTF8): TMongoCollection;
function GetCollectionOrNil(const Name: RawUTF8): TMongoCollection;
public
/// initialize a reference to a given MongoDB Database
// - you should not use this constructor directly, but rather use the
// TMongoClient.Database[] property
// - it will connect to the Client's primary host, then retrieve all
// collection names of this database
constructor Create(aClient: TMongoClient; const aDatabaseName: RawUTF8);
/// release all associated TMongoCollection instances
destructor Destroy; override;
/// run a database command, supplied as a TDocVariant, TBSONVariant or a
// string, and return a TDocVariant instance
// - this is the preferred method to issue database commands, as it provides
// a consistent interface between the MongoDB shell and this driver
// - see http://docs.mongodb.org/manual/reference/command for a list
// of all available commands
// - for instance:
// ! RunCommand(_ObjFast(['dbStats',1,'scale',1024],stats);
// ! RunCommand(BSONVariant(['dbStats',1,'scale',1024],stats);
// ! RunCommand('dbStats',stats);
// ! RunCommand('hostInfo',host);
// - the message will be returned by the server as a TDocVariant instance
// (since the associated TMongoRequestQuery.NumberToSkip=1)
// - in case of any error, the error message is returned as text
// - in case of success, this method will return ''
function RunCommand(const command: variant;
var returnedValue: variant): RawUTF8; overload;
/// run a database command, supplied as a TDocVariant, TBSONVariant or a
// string, and return the raw BSON document array of received items
// - this overloaded method can be used on huge content to avoid the slower
// conversion to an array of TDocVariant instances
// - in case of success, this method will return TRUE, or FALSE on error
function RunCommand(const command: variant;
var returnedValue: TBSONDocument): boolean; overload;
/// create the user in the database to which the user will belong
// - you could specify the roles to use, for this database or others:
// ! reportingDB.CreateUser('reportsUser','12345678',BSONVariant(
// ! '[{ role: "readWrite", db: "reporting" }, { role: "read", db: "products" }]'));
// - returns '' on sucess, an error message otherwise
function CreateUser(const UserName,Password: RawUTF8;
const roles: variant): RawUTF8;
/// create the user with a read or read/write role on the current database
// - returns '' on sucess, an error message otherwise
function CreateUserForThisDatabase(const UserName,Password: RawUTF8;
allowWrite: Boolean=true): RawUTF8;
/// deletes the supplied user on the current database
// - returns '' on sucess, an error message otherwise
function DropUser(const UserName: RawUTF8): RawUTF8;
/// access to a given MongoDB collection
// - raise an EMongoDatabaseException if the collection name does not exist
property Collection[const Name: RawUTF8]: TMongoCollection
read GetCollection; default;
/// access to a given MongoDB collection
// - if the collection name does not exist, it will return nil
property CollectionOrNil[const Name: RawUTF8]: TMongoCollection
read GetCollectionOrNil;
/// access to a given MongoDB collection
// - if the collection name does not exist, it will add use the name to
// create a TMongoCollection instance and register it to the internal list
property CollectionOrCreate[const Name: RawUTF8]: TMongoCollection
read GetCollectionOrCreate;
published
/// the database name
property Name: RawUTF8 read fName;
/// the associated MongoDB client instance
property Client: TMongoClient read fClient;
end;
/// remote access to a MongoDB collection
TMongoCollection = class
protected
fDatabase: TMongoDatabase;
fName: RawUTF8;
fFullCollectionName: RawUTF8;
function AggregateCallFromJSON(const pipelineJSON: RawUTF8; var reply,res: variant): boolean; overload;
function AggregateCallFromVariant(const pipelineArray: variant; var reply,res: variant): boolean; overload;
public
/// initialize a reference to a given MongoDB Collection
// - you should not use this constructor directly, but rather use
// TMongoClient.Database[].Collection[] property
constructor Create(aDatabase: TMongoDatabase; const aCollectionName: RawUTF8);
/// select documents in a collection and returns a dvArray TDocVariant
// instance containing the selected documents
// - Criteria can be null (to retrieve all documents) or a TDocVariant /
// TBSONVariant query selector:
// ! FindDoc(BSONVariant('{name:"John",age:{$gt:21}}'),null);
// ! FindDoc(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
// see http://docs.mongodb.org/manual/reference/operator for reference
// - Projection can be null (to retrieve all fields) or a CSV string to set
// field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
// ! FindDoc(BSONVariant(['name','John']),null);
// ! FindDoc(BSONVariant(['name','John']),'_id,name');
// ! FindDoc(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
// - NumberToReturn can be left to its default maxInt value to return all
// matching documents, or specify a limit (e.g. 1 for one document - in this
// case, the returned instance won't be a dvArray kind of TDocVariant, but
// either null or the single returned document)
// - if the query does not have any matching record, it will return null
function FindDoc(const Criteria, Projection: Variant;
NumberToReturn: integer=1; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]): variant; overload;
/// select documents in a collection and returns a dvArray TDocVariant
// instance containing the selected documents
// - Criteria can specify the query selector as (extended) JSON and
// parameters:
// ! FindDoc('{name:"John",age:{$gt:21}}',[]);
// ! FindDoc('{name:?,age:{$gt:?}}',['John',21]);
// see http://docs.mongodb.org/manual/reference/operator for reference
// - this overloaded method will use a null Projection, i.e. will retrieve
// all fields
// - NumberToReturn can be left to its default maxInt value to return all
// matching documents, or specify a limit (e.g. 1 for one document - in this
// case, the returned instance won't be a dvArray kind of TDocVariant, but
// either null or the single returned document)
// - if the query does not have any matching record, it will return null
function FindDoc(Criteria: PUTF8Char; const Params: array of const;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]): variant; overload;
/// find an existing document in a collection, by its _id field
// - _id will identify the unique document to be retrieved
// - returns null, or a TDocVariant instance
function FindOne(const _id: TBSONObjectID): variant; overload;
/// find an existing document in a collection, by its _id field
// - _id will identify the unique document to be retrieved
// - returns null, or a TDocVariant instance
function FindOne(const _id: variant): variant; overload;
/// find an existing document in a collection, by a custom Criteria value
// - Criteria object, specified as name/value pairs, will identify the
// unique document to be retrieved
// - returns the found TDocVariant instance
// - if the Criteria has no match, return either null or a new object with
// default values as NameValuePairs if ReturnNewObjectIfNotFound is true
function FindOne(const NameValuePairs: array of const;
ReturnNewObjectIfNotFound: boolean=false): variant; overload;
/// returns a dynamic array of TDocVariant instance containing
// all documents of a collection
// - Projection can be null (to retrieve all fields) or a CSV string to set
// field names to retrieve, or a TDocVariant or TBSONVariant with
// projection operators
procedure FindDocs(var result: TVariantDynArray; const Projection: variant;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]); overload;
/// select documents in a collection and returns a dynamic array of
// TDocVariant instance containing the selected documents
// - you can e.g. fill a res: TVariantDynArray with the following query:
// ! FindDocs('{name:?,age:{$gt:?}}',['John',21],res,null);
// - Projection can be null (to retrieve all fields) or a CSV string to set
// field names to retrieve, or a TDocVariant or TBSONVariant with
// projection operators
procedure FindDocs(Criteria: PUTF8Char; const Params: array of const;
var result: TVariantDynArray; const Projection: variant;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]); overload;
/// select documents in a collection and returns a dynamic array of
// TDocVariant instance containing the selected documents
// - could be used to fill a VCL grid using a TDocVariantArrayDataSet
// as defined in SynVirtualDataSet.pas:
// ! ds1.DataSet := ToDataSet(self,FindDocs('{name:?,age:{$gt:?}}',['John',21],null));
// - Projection can be null (to retrieve all fields) or a CSV string to set
// field names to retrieve, or a TDocVariant or TBSONVariant with
// projection operators
function FindDocs(Criteria: PUTF8Char; const Params: array of const;
const Projection: variant; NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]): TVariantDynArray; overload;
/// select documents in a collection and returns a JSON array of documents
// containing the selected documents
// - Criteria can be null (to retrieve all documents) or a TDocVariant /
// TBSONVariant query selector:
// ! FindJSON(BSONVariant('{name:"John",age:{$gt:21}}'),null);
// ! FindJSON(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
// see http://docs.mongodb.org/manual/reference/operator for reference
// - Projection can be null (to retrieve all fields) or a CSV string to set
// the field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
// ! FindJSON(BSONVariant(['name','John']),null);
// ! FindJSON(BSONVariant(['name','John']),'_id');
// ! FindJSON(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
// - NumberToReturn can be left to its default maxInt value to return all
// matching documents as a '[..]' JSON array, or specify a limit (e.g. 1
// for one document - in this case, the returned instance won't be a '[..]'
// JSON array, but either 'null' or a single '{..}' JSON object)
// - this method is very optimized and will convert the BSON binary content
// directly into JSON, in either modMongoStrict or modMongoShell layout
// (modNoMongo will do the same as modMongoStrict)
function FindJSON(const Criteria, Projection: Variant;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
/// select documents in a collection and returns a JSON array of documents
// containing the selected documents
// - Criteria can specify the query selector as (extended) JSON and
// parameters:
// ! FindJSON('{name:"John",age:{$gt:21}}',[]);
// ! FindJSON('{name:?,age:{$gt:?}}',['John',21]);
// see http://docs.mongodb.org/manual/reference/operator for reference
// - this overloaded method will use a null Projection, i.e. will retrieve
// all fields
// - NumberToReturn can be left to its default maxInt value to return all
// matching documents as a '[..]' JSON array, or specify a limit (e.g. 1
// for one document - in this case, the returned instance won't be a '[..]'
// JSON array, but either 'null' or a single '{..}' JSON object)
function FindJSON(Criteria: PUTF8Char; const Params: array of const;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
/// select documents in a collection and returns a JSON array of documents
// containing the selected documents
// - Criteria and Projection can specify the query selector as (extended)
// JSON and parameters
function FindJSON(Criteria: PUTF8Char; const CriteriaParams: array of const;
const Projection: variant; NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
/// select documents in a collection and returns a TBSONDocument instance
// containing the selected documents as a raw binary BSON array document
// - Criteria can be null (to retrieve all documents) or a TDocVariant /
// TBSONVariant query selector:
// ! FindBSON(BSONVariant('{name:"John",age:{$gt:21}}'),null);
// ! FindBSON(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
// - Projection can be null (to retrieve all fields) or a CSV string to set
// the field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
// ! FindBSON(BSONVariant(['name','John']),null);
// ! FindBSON(BSONVariant(['name','John']),'_id');
// ! FindBSON(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
// - NumberToReturn can be left to its default maxInt value to return all
// matching documents, or specify a limit (e.g. 1 for one document)
function FindBSON(const Criteria, Projection: Variant;
NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
Flags: TMongoQueryFlags=[]): TBSONDocument;
/// insert one document, supplied as (extended) JSON and parameters,
// in the collection
// - supplied JSON could be either strict or in MongoDB Shell syntax:
// ! products.insert('{ _id: ?, item: ?, qty: ? }',[1,'card',15]);
// ! // here _id is forced on the client side
// ! products.insert('{ item: ?, qty: ? }',[1,'card',15]);
// ! // here the _id will be created on the client side as an ObjectID
// - you can retrieve the client-side computed ObjectID, as such:
// ! var oid: TBSONObjectID;
// ! ...
// ! products.insert('{ item: ?, qty: ? }',['card',15],@oid);
// ! writeln(oid.ToText);
procedure Insert(const Document: RawUTF8; const Params: array of const;
CreatedObjectID: PBSONObjectID=nil); overload;
/// insert one or more documents in the collection
// - Documents is an array of TDocVariant (i.e. created via _JsonFast()
// or _JsonFastFmt()) - or of TBSONVariant (created via BSONVariant())
// - by default, it will follow Client.WriteConcern pattern - but you can
// set NoAcknowledge = TRUE to avoid calling the getLastError command and
// increase the execution speed, at the expense of a unsafe process
procedure Insert(const Documents: array of variant; Flags: TMongoInsertFlags=[];
NoAcknowledge: boolean=false); overload;
/// insert one or more documents in the collection
// - Documents is the low-level concatenation of BSON documents, created
// e.g. with a TBSONWriter stream
// - by default, it will follow Client.WriteConcern pattern - but you can
// set NoAcknowledge = TRUE to avoid calling the getLastError command and
// increase the execution speed, at the expense of a unsafe process
procedure Insert(const Documents: TBSONDocument;
Flags: TMongoInsertFlags=[]; NoAcknowledge: boolean=false); overload;
/// insert one or more documents in the collection
// - JSONDocuments is an array of JSON objects
// - by default, it will follow Client.WriteConcern pattern - but you can
// set NoAcknowledge = TRUE to avoid calling the getLastError command and
// increase the execution speed, at the expense of a unsafe process
procedure InsertJSON(const JSONDocuments: array of PUTF8Char;
Flags: TMongoInsertFlags=[]; NoAcknowledge: boolean=false);
/// updates an existing document or inserts a new document, depending on
// its document parameter
// - this document should be a TDocVariant (i.e. created via _JsonFast()
// or _JsonFastFmt()) since we need to check for the _id field, other types
// will be converted to a TDocVariant instance (via its JSON representation)
// so it is pointless to use BSONVariant() here
// - if the document does not contain an _id field, then the Save() method
// performs an insert; during the operation, the client will add to the
// Document variant the _id field and assign it a unique ObjectId - you can
// optionally retrieve it with the CreatedObjectID pointer - and the method
// returns FALSE
// - if the document contains an _id field, then the save() method performs
// an upsert, querying the collection on the _id field: if a document does
// not exist with the specified _id value, the save() method performs an
// insert; if a document exists with the specified _id value, the save()
// method performs an update that replaces ALL fields in the existing
// document with the fields from the document - and the method returns TRUE
function Save(var Document: variant; CreatedObjectID: PBSONObjectID=nil): boolean; overload;
/// updates an existing document or inserts a new document, depending on
// its document parameter, supplied as (extended) JSON and parameters
// - supplied JSON could be either strict or in MongoDB Shell syntax:
// - will perform either an insert or an update, depending of the
// presence of the _id field, as overloaded Save(const Document: variant)
procedure Save(const Document: RawUTF8; const Params: array of const;
CreatedObjectID: PBSONObjectID=nil); overload;
/// modifies an existing document or several documents in a collection
// - the method can modify specific fields of existing document or documents
// or replace an existing document entirely, depending on the update parameter
// - Query and Update parameters should be TDocVariant (i.e. created via
// _JsonFast() or _JsonFastFmt()) or TBSONVariant (created via BSONVariant())
// - Query is the selection criteria for the update; use the same query
// selectors as used in the Find() method
// - if Update contains a plain document, it will replace any existing data
// - if Update contains update operators (like $set), it will update the
// corresponding fields in the document
procedure Update(const Query, Update: variant; Flags: TMongoUpdateFlags=[]); overload;
/// modifies an existing document or several documents in a collection
// - the method can modify specific fields of existing document or documents
// or replace an existing document entirely, depending on the update parameter
// - since all content will be transformed into JSON internally, use this
// method only if the supplied parameters are simple types: any complex value
// (e.g. a TDateTime or a BSONVariant binary) won't be handled as expected -
// use the overloaded Update() with explicit BSONVariant() values instead
// - Query and Update parameters can be specified as JSON objects with
// parameters
// - Query is the selection criteria for the update; use the same query
// selectors as used in the Find() method
// - if Update contains a plain document, it will replace any existing data:
// ! people.update('{name:?}',['Andy'],'{name:?,age:? }',['Andy',25],[mufUpsert]);
// Warning: to avoid inserting the same document more than once, only use
// mufUpsert if the query field is uniquely indexed
// - if Update contains update operators (like $set), it will update the
// corresponding fields in the document:
// ! book.insert('{_id:?,item:?,stock:?}',[11,'Divine Comedy',2]);
// ! book.update('{item:?},['Divine Comedy'],'{$set:{price:?},$inc:{stock:?}},[18,5]);
// ! // the updated document is now:
// ! { "_id" : 11, "item" : "Divine Comedy", "price" : 18, "stock" : 7 }
procedure Update(Query: PUTF8Char; const QueryParams: array of const;
const Update: RawUTF8; const UpdateParams: array of const;
Flags: TMongoUpdateFlags=[]); overload;
/// modifies some fields of an existing document in a collection
// - by default, Update() or Save() will replace the whole document
// - this method will expect the identifier to be supplied as a variant -
// may be via the ObjectID() function
// - and will replace the specified fields, i.e. it will execute a $set:
// with the supplied UpdatedFields value
procedure UpdateOne(const _id, UpdatedFields: variant);
/// delete an existing document or several documents in a collection
// - Query parameter should be TDocVariant (i.e. created via _JsonFast() or
// _JsonFastFmt()) or TBSONVariant (created via BSONVariant())
// - Query is the selection criteria for the deletion; use the same query
// selectors as used in the Find() method
// - to limit the deletion to just one document, set Flags to [mdfSingleRemove]
// - to delete all documents matching the deletion criteria, leave it to []
procedure Remove(const Query: variant; Flags: TMongoDeleteFlags=[]); overload;
/// delete an existing document in a collection, by its _id field
// - _id will identify the unique document to be deleted
procedure RemoveOne(const _id: TBSONObjectID); overload;
/// delete an existing document in a collection, by its _id field
// - _id will identify the unique document to be deleted
procedure RemoveOne(const _id: variant); overload;
/// delete an existing document or several documents in a collection
// - Query parameter can be specified as JSON objects with parameters
// - Query is the selection criteria for the deletion; use the same query
// selectors as used in the Find() method
// - to limit the deletion to just one document, set Flags to [mdfSingleRemove]
// - to delete all documents matching the deletion criteria, leave it to []
procedure RemoveFmt(Query: PUTF8Char; const QueryParams: array of const;
Flags: TMongoDeleteFlags=[]);
/// creates an index on the specified field(s) if the index does
// not already exist
// - Keys and Options parameters should be TDocVariant (e.g. created via
// _JsonFast() or _JsonFastFmt()) - and not TBSONVariant values
// - for ascending/descending indexes, Keys is a document that contains pairs
// with the name of the field or fields to index and order of the index:
// value of 1 specifies ascending and of -1 specifies descending
// - options is a non-mandatory document that controls the creation
// of the index -
// - you can write e.g.
// ! book.EnsureIndex(_JsonFast('{ orderDate: 1 }'),null)
// ! book.EnsureIndex(_ObjFast(['orderDate',1]),null)
procedure EnsureIndex(const Keys, Options: variant); overload;
/// creates an index on the specified field(s) if the index does
// not already exist
// - Keys are the correspondiong field names
// - you can write e.g. to create an ascending index on a given field:
// ! book.EnsureIndex(['orderDate']);
procedure EnsureIndex(const Keys: array of RawUTF8; Ascending: boolean=true;
Unique: boolean=false); overload;
/// drops the entire collection from the database
// - once dropped, this TMongoCollection instance will be freed: never
// use this instance again after success (i.e. returned '')
// - in case of error, a textual message will be returned as result
// - once dropped, this collection will be removed from the parent
// Database.Collection[] internal list
// - Warning: this method obtains a write lock on the affected database
// and will block other operations until it has completed
function Drop: RawUTF8;
/// calculate the number of documents in the collection
// - be aware that this method may be somewhat slow for huge collections,
// since a full scan of an index is to be performed: if your purpose is
// to ensure that a collection contains items, use rather IsEmpty method
function Count: Int64;
/// calculate the number of documents in the collection that match
// a specific query
// - Criteria can specify the query selector as a BSONVariant/TDocVariant
function FindCount(const Query: variant): Int64; overload;
/// calculate the number of documents in the collection that match
// a specific query
// - Criteria can specify the query selector as (extended) JSON and
// parameters:
// ! FindCount('{name:?,age:{$gt:?}}',[],['John',21]);
// ! FindCount('{ ord_dt: { $gt: new Date(?) } }',[],[trunc(Now)-7]);
// - optional MaxNumberToReturn can specify a limit for the search (e.g. if
// you do not want an exact count, but only check for a specific limit)
// - optional NumberToSkip can specify the number of matching documents
// to skip before counting
function FindCount(Criteria: PUTF8Char; const Args,Params: array of const;
MaxNumberToReturn: integer=0; NumberToSkip: Integer=0): Int64; overload;
/// returns TRUE if the collection has no document, FALSE otherwise
// - is much faster than Count, especially for huge collections
function IsEmpty: boolean;
/// calculate aggregate values using the MongoDB aggregation framework
// and return the result as a TDocVariant instance
// - the Aggregation Framework was designed to be more efficient than the
// alternative map-reduce pattern, and is available since MongoDB 2.2 -
// see http://docs.mongodb.org/manual/reference/command/aggregate
// - you should specify the aggregation pipeline as a list of JSON object
// operators (without the [..]) - for reference of all available phases,
// see http://docs.mongodb.org/manual/core/aggregation-pipeline
// - if the server sent back no {result:...} member, will return null
// - if the server sent back one item as {result:[{..}]}, will return
// this single item as a TDocVariant
// - if the server sent back several items as {result:[{..},{..}]}, will
// return a dvArray kind of TDocVariant
function AggregateDoc(Operators: PUTF8Char; const Params: array of const): variant; overload;
/// calculate JSON aggregate values using the MongoDB aggregation framework
// - the Aggregation Framework was designed to be more efficient than the
// alternative map-reduce pattern, and is available since MongoDB 2.2 -
// see http://docs.mongodb.org/manual/reference/command/aggregate
// - you should specify the aggregation pipeline as a list of JSON object
// operators (without the [..]) - for reference of all available phases,
// see http://docs.mongodb.org/manual/core/aggregation-pipeline
// - for instance, the following will return as JSON a collection sorted in
// descending order according by the age field and then in ascending order
// according to the value in the posts field
// ! AggregateJSON('{ $sort : { age : -1, posts: 1 } }',[])
function AggregateJSON(Operators: PUTF8Char; const Params: array of const;
Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
/// calculate aggregate values using the MongoDB aggregation framework
// and return the result as a TDocVariant instance
// - overloaded method to specify the pipeline as a BSON raw document
// as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
function AggregateDocFromVariant(const pipelineArray: variant): variant;
/// calculate JSON aggregate values using the MongoDB aggregation framework
// - overloaded method to specify the pipeline as a BSON raw document
// as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
function AggregateJSONFromVariant(const pipelineArray: variant;
Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
/// calculate aggregate values using the MongoDB aggregation framework
// and return the result as a TDocVariant instance
// - overloaded method to specify the pipeline as a JSON text object
// as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
// - for instance, the following will return the maximum _id value of
// the collection:
// ! AggregateDoc('{$group:{_id:null,max:{$max:"$_id"}}}').max
function AggregateDocFromJson(const PipelineJSON: RawUTF8): variant;
/// calculate JSON aggregate values using the MongoDB aggregation framework
// - overloaded method to specify the pipeline as a JSON text object
// as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
function AggregateJSONFromJson(const PipelineJSON: RawUTF8;
Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
published
/// the collection name
property Name: RawUTF8 read fName;
/// the full collection name, e.g. 'dbname.collectionname'
property FullCollectionName: RawUTF8 read fFullCollectionName;
/// the associated MongoDB database instance
property Database: TMongoDatabase read fDatabase;
end;
/// exception type used for MongoDB process, once connected
EMongoConnectionException = class(EMongoException)
protected
fConnection: TMongoConnection;
public
/// initialize the Exception for a given request
constructor Create(const aMsg: string; aConnection: TMongoConnection); reintroduce; overload;
/// initialize the Exception for a given request
constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
aConnection: TMongoConnection); reintroduce;
published
/// the associated connection
property Connection: TMongoConnection read fConnection;
end;
EMongoDatabaseException = class(EMongoConnectionException)
protected
fDatabase: TMongoDatabase;
public
/// initialize the Exception for a given request
constructor Create(const aMsg: string; aDatabase: TMongoDatabase); reintroduce; overload;
/// initialize the Exception for a given request
constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
aDatabase: TMongoDatabase); reintroduce;
{$ifndef NOEXCEPTIONINTERCEPT}
/// used to customize the exception log to contain information about the Query
// - it will log the database parameters
function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; override;
{$endif}
published
/// the associated Database
property Database: TMongoDatabase read fDatabase;
end;
/// exception type used for MongoDB query process
EMongoRequestException = class(EMongoConnectionException)
protected
fRequest: TMongoRequest;
fError: TMongoReplyCursor;
fErrorDoc: variant;
function GetErrorDoc: variant;
public
/// initialize the Exception for a given request
constructor Create(const aMsg: string; aConnection: TMongoConnection;
aRequest: TMongoRequest=nil); reintroduce; overload;
/// initialize the Exception for a given request
constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
aConnection: TMongoConnection; aRequest: TMongoRequest); reintroduce;
/// initialize the Exception for a given request
constructor Create(const aMsg: string; aConnection: TMongoConnection;
aRequest: TMongoRequest; const aError: TMongoReplyCursor); reintroduce; overload;
/// initialize the Exception for a given request
constructor Create(const aMsg: string; aConnection: TMongoConnection;
aRequest: TMongoRequest; const aErrorDoc: TDocVariantData); reintroduce; overload;
{$ifndef NOEXCEPTIONINTERCEPT}
/// used to customize the exception log to contain information about the Query
// - it will log both the failing request and the returned error message
function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; override;
{$endif}
/// the associated error reply document
property ErrorReply: TMongoReplyCursor read fError;
published
/// the associated error reply document, as a TDocVariant instance
// - will return the first document available in ErrorReply, or the supplied
// aErrorDoc: TDocVariantData instance
property ErrorDoc: Variant read GetErrorDoc;
end;
/// exception type used for MongoDB query process after an Operating System
// error (e.g. in case of socket error)
EMongoRequestOSException = class(EMongoRequestException)
protected
fSystemLastError: cardinal;
public
/// initialize the Exception for a given request, including the last
// error message retrieved from the operating system
// - if such an exception is raised, you can use SystemLastError property
// to retrieve the corresponding Operating System error code
constructor Create(const aMsg: string; aConnection: TMongoConnection;
aRequest: TMongoRequest=nil); reintroduce;
/// contain the associated Operating System last error code
// - will specify e.g. the kind of communication/socket error
property SystemLastError: cardinal read fSystemLastError;
end;
{$M-}
/// ready-to-be displayed text of a TMongoOperation item
function ToText(op: TMongoOperation): PShortString; overload;
/// ready-to-be displayed text of a TMongoClientWriteConcern item
function ToText(wc: TMongoClientWriteConcern): PShortString; overload;
/// ready-to-be displayed text of a TMongoClientReplicaSetReadPreference item
function ToText(pref: TMongoClientReplicaSetReadPreference): PShortString; overload;
implementation
// used by TBSONElement.ToVariant() method and BSONToDoc() procedure
procedure BSONItemsToDocVariant(Kind: TBSONElementType; BSON: PByte;
var Doc: TDocVariantData; Option: TBSONDocArrayConversion);
const OPTIONS: array[TBSONDocArrayConversion] of TDocVariantOptions =
([],[dvoReturnNullForUnknownProperty],
[dvoReturnNullForUnknownProperty,dvoValueCopiedByReference],
[dvoReturnNullForUnknownProperty,dvoInternNames],
[dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,dvoInternNames]);
var k: TDocVariantKind;
i,n,cap: integer;
intnames: TRawUTF8Interning;
items: array[0..63] of TBSONElement;
begin // very fast optimized code
if BSON=nil then
TVarData(Doc).VType := varNull else begin
intnames := nil;
case Kind of
betDoc: begin
k := dvObject;
if dvoInternNames in Doc.Options then
intnames := DocVariantType.InternNames;
end;
betArray:
k := dvArray;
else exit; // leave Doc=varEmpty
end;
Doc.Init(OPTIONS[Option],k);
cap := 0;
repeat // will handle up to 64 TBSONElement per loop (via items[])
n := 0;
while items[n].FromNext(BSON) do begin
inc(n);
if n=length(items) then
break; // avoid buffer overflow
end;
if n=0 then
break;
inc(cap,n); // pre-allocate Doc.Names[]/Values[]
if cap<512 then
Doc.Capacity := cap else
if Doc.Capacity<cap then
Doc.Capacity := cap+cap shr 3; // faster for huge arrays
for i := 0 to n-1 do begin
if Kind=betDoc then
if intnames<>nil then
intnames.Unique(Doc.Names[i+Doc.Count],items[i].Name,items[i].NameLen) else
SetString(Doc.Names[i+Doc.Count],PAnsiChar(items[i].Name),items[i].NameLen);
items[i].ToVariant(Doc.Values[i+Doc.Count],Option);
end;
Doc.SetCount(Doc.Count+n);
until (BSON=nil) or (BSON^=byte(betEOF));
end;
end;
{ TBSONElement }
var
/// size (in bytes) of a BSON element
// - equals -1 for varying elements
BSON_ELEMENTSIZE: array[TBSONElementType] of integer = (
//betEOF, betFloat, betString, betDoc, betArray, betBinary,
0, sizeof(Double), -1, -1, -1, -1,
//betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
0, sizeof(TBSONObjectID), 1, sizeof(Int64),
//betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
0, -1, -1, -1, -1,
//betJSScope, betInt32, betTimestamp, betInt64, betDecimal128
-1, sizeof(Integer), sizeof(Int64), SizeOf(Int64), Sizeof(TDecimal128));
/// types which do not have an exact equivalency to a standard variant
// type will be mapped as varUnknown - and will be changed into
// BSONVariantType.VarType
BSON_ELEMENTTYPES: array[TBSONElementType] of word = (
//betEOF, betFloat, betString, betDoc, betArray, betBinary,
varEmpty, varDouble, varString, varUnknown, varUnknown, varUnknown,
//betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
varEmpty, varUnknown, varBoolean, varDate,
//betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
varNull, varUnknown, varUnknown, varUnknown, varUnknown,
//betJSScope, betInt32, betTimestamp, betInt64, betDecimal128
varUnknown, varInteger, varUnknown, varInt64, varUnknown);
function TBSONElement.ToVariant(DocArrayConversion: TBSONDocArrayConversion): variant;
begin
ToVariant(Result,DocArrayConversion);
end;
procedure TBSONElement.ToVariant(var result: variant;
DocArrayConversion: TBSONDocArrayConversion);
var res: TVarData absolute result;
resBSON: TBSONVariantData absolute result;
begin
if res.VType and VTYPE_STATIC<>0 then
VarClear(result);
ZeroFill(@result); // set result.VType=varEmpty and result.VAny=nil
case Kind of
betFloat:
res.VDouble := PDouble(Element)^;
betString:
SetString(RawUTF8(res.VAny),Data.Text,Data.TextLen);
betJS, betDeprecatedSymbol:
SetString(RawUTF8(resBSON.VText),Data.Text,Data.TextLen);
betDoc, betArray:
if DocArrayConversion=asBSONVariant then
SetString(TBSONDocument(resBSON.VBlob),PAnsiChar(Element),ElementBytes) else begin
BSONItemsToDocVariant(Kind,Data.DocList,TDocVariantData(result),DocArrayConversion);
exit;
end;
betBinary, betRegEx, betDeprecatedDbptr, betJSScope, betTimestamp, betDecimal128:
SetString(RawByteString(resBSON.VBlob),PAnsiChar(Element),ElementBytes);
betObjectID:
resBSON.VObjectID := PBSONObjectID(Element)^;
betBoolean:
res.VBoolean := PBoolean(Element)^;
betDateTime:
res.VDate := UnixMSTimeToDateTime(PUnixMSTime(Element)^);
betInt32:
res.VInteger := PInteger(Element)^;
betInt64:
res.VInt64 := PInt64(Element)^;
// betNull, betDeprecatedUndefined, betMinKey or betMaxKey has no data
end;
res.VType := BSON_ELEMENTTYPES[Kind];
if res.VType=varUnknown then begin
resBSON.VType := BSONVariantType.VarType;
resBSON.VKind := Kind;
end;
end;
function TBSONElement.ToInteger(const default: Int64=0): Int64;
begin
case Kind of
betBoolean:
result := PByte(Element)^;
betFloat:
result := Trunc(PDouble(Element)^);
betInt32:
result := PInteger(Element)^;
betInt64:
result := PInt64(Element)^;
else
result := default;
end;
end;
function TBSONElement.ToRawUTF8: RawUTF8;
procedure ComplexType;
var V: variant;
wasString: boolean;
begin
ToVariant(V);
VariantToUTF8(V,result,wasString);
end;
begin
case Kind of
betFloat:
ExtendedToStr(PDouble(Element)^,DOUBLE_PRECISION,result);
betString:
SetString(result,Data.Text,Data.TextLen);
betInt32:
Int32ToUtf8(PInteger(Element)^,result);
betInt64:
Int64ToUtf8(PInt64(Element)^,result);
betDecimal128:
PDecimal128(Element)^.ToText(result);
else ComplexType;
end;
end;
function TBSONElement.DocItemToVariant(const aName: RawUTF8; var aValue: variant;
DocArrayConversion: TBSONDocArrayConversion): boolean;
var item: TBSONElement;
begin
if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then begin
item.ToVariant(aValue,DocArrayConversion);
result := true;
end else
result := false;
end;
function TBSONElement.DocItemToRawUTF8(const aName: RawUTF8): RawUTF8;
var item: TBSONElement;
begin
if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then
result := item.ToRawUTF8 else
result := '';
end;
function TBSONElement.DocItemToInteger(const aName: RawUTF8; const default: Int64): Int64;
var item: TBSONElement;
begin
if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then
result := item.ToInteger(default) else
result := default;
end;
procedure TBSONElement.AddMongoJSON(W: TTextWriter; Mode: TMongoJSONMode);
label bin,regex;
begin
case Kind of
betFloat:
W.AddDouble(PDouble(Element)^);
betString, betJS, betDeprecatedSymbol: begin
W.Add('"');
W.AddJSONEscape(Data.Text,Data.TextLen);
W.Add('"');
end;
betDoc, betArray:
BSONListToJSON(Data.DocList,Kind,W,Mode);
betObjectID: begin
W.AddShort(BSON_JSON_OBJECTID[false,Mode]);
W.AddBinToHex(Element,SizeOf(TBSONObjectID));
W.AddShort(BSON_JSON_OBJECTID[true,Mode]);
end;
betDeprecatedUndefined:
W.AddShort(BSON_JSON_UNDEFINED[Mode=modMongoShell]);
betBinary:
case Mode of
modNoMongo:
W.WrBase64(Data.Blob,Data.BlobLen,true);
modMongoStrict: begin
W.AddShort(BSON_JSON_BINARY[false,false]);
W.WrBase64(Data.Blob,Data.BlobLen,false);
W.AddShort(BSON_JSON_BINARY[false,true]);
W.AddBinToHex(@Data.BlobSubType,1);
W.AddShort('"}');
end;
modMongoShell: begin
W.AddShort(BSON_JSON_BINARY[true,false]);
W.AddBinToHex(@Data.BlobSubType,1);
W.AddShort(BSON_JSON_BINARY[true,true]);
W.WrBase64(Data.Blob,Data.BlobLen,false);
W.AddShort('")');
end;
end;
betRegEx:
case Mode of
modNoMongo:
bin:W.WrBase64(Element,ElementBytes,true);
modMongoStrict:
goto regex;
modMongoShell:
if (PosChar(Data.RegEx,'/')=nil) and
(PosChar(Data.RegExOptions,'/')=nil) then begin
W.Add('/');
W.AddNoJSONEscape(Data.RegEx,Data.RegExLen);
W.Add('/');
W.AddNoJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
end else begin
regex: W.AddShort(BSON_JSON_REGEX[0]);
W.AddJSONEscape(Data.RegEx,Data.RegExLen);
W.AddShort(BSON_JSON_REGEX[1]);
W.AddJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
W.AddShort(BSON_JSON_REGEX[2]);
end;
end;
betDeprecatedDbptr:
goto bin; // no specific JSON construct for this deprecated item
betJSScope:
goto bin; // no specific JSON construct for this item yet
betTimestamp:
goto bin; // internal content will always be written as raw binary
betBoolean:
W.Add(PBoolean(Element)^);
betDateTime: begin
W.AddShort(BSON_JSON_DATE[Mode,false]);
W.AddUnixMSTime(Element,false);
W.AddShort(BSON_JSON_DATE[Mode,true]);
end;
betNull:
W.AddShort('null');
betInt32:
W.Add(PInteger(Element)^);
betInt64:
W.Add(PInt64(Element)^);
betDecimal128: begin
W.AddShort(BSON_JSON_DECIMAL[false,Mode]);
PDecimal128(Element)^.AddText(W);
W.AddShort(BSON_JSON_DECIMAL[true,Mode]);
end;
else
if Kind=betMinKey then
W.AddShort(BSON_JSON_MINKEY[Mode=modMongoShell]) else
if Kind=betMaxKey then
W.AddShort(BSON_JSON_MAXKEY[Mode=modMongoShell]) else
raise EBSONException.CreateUTF8('TBSONElement.AddMongoJSON: unexpected type %',
[ord(Kind)]);
end;
end;
procedure TBSONElement.FromVariant(const aName: RawUTF8; const aValue: Variant;
var aTemp: RawByteString);
const ELEMKIND: array[varEmpty..varWord64] of TBSONElementType = (
betEOF, betNull, betInt32, betInt32, betFloat, betFloat, betFloat, betDateTime,
betString, betEOF, betEOF, betBoolean, betEof, betEOF, betEOF, betEOF,
betInt32, betInt32, betInt32, betInt64, betInt64, betInt64);
var aVarData: TVarData absolute aValue;
aBson: TBSONVariantData absolute aValue;
aDoc: TDocVariantData absolute aValue;
label str, st2;
begin
if aVarData.VType=varByRef or varVariant then begin
FromVariant(aName,PVariant(aVarData.VPointer)^,aTemp);
exit;
end;
FillCharFast(self,sizeof(self),0);
Name := pointer(aName);
NameLen := length(aName);
case aVarData.VType of
0..varDate,varBoolean..high(ELEMKIND): begin // simple types
Element := @Data.InternalStorage;
Kind := ELEMKIND[aVarData.VType];
case Kind of
betFloat:
PDouble(Element)^ := double(aValue);
betDateTime:
PUnixMSTime(Element)^ := DateTimeToUnixMSTime(aVarData.VDate);
betBoolean:
PBoolean(Element)^ := aVarData.VBoolean;
betInt32:
if not VariantToInteger(aValue,PInteger(Element)^) then
raise EBSONException.Create('TBSONElement.FromVariant(betInt32)');
betInt64:
if not VariantToInt64(aValue,PInt64(Element)^) then
raise EBSONException.Create('TBSONElement.FromVariant(betInt64)');
end;
ElementBytes := BSON_ELEMENTSIZE[Kind];
end;
varString:
if (aVarData.VAny<>nil) and
(PInteger(aVarData.VAny)^ and $ffffff=JSON_SQLDATE_MAGIC) and
Iso8601CheckAndDecode(PUTF8Char(aVarData.VAny)+3,Length(RawUTF8(aVarData.VAny))-3,
PDateTime(@Data.InternalStorage)^) then begin
// recognized TTextWriter.AddDateTime(woDateTimeWithMagic) ISO-8601 format
Element := @Data.InternalStorage;
Kind := betDateTime;
ElementBytes := BSON_ELEMENTSIZE[betDateTime];
end else begin
Kind := betString;
Data.Text := aVarData.VAny;
Data.TextLen := Length(RawUTF8(aVarData.VAny));
st2: ElementBytes := Data.TextLen+1;
if aVarData.VAny=nil then
Data.InternalStorage := 1 else
Element := nil; // special case handled by TBSONWriter.BSONWrite()
end;
{$ifdef HASVARUSTRING}
varUString: begin
RawUnicodeToUtf8(aVarData.VAny,length(UnicodeString(aVarData.VAny)),RawUTF8(aTemp));
goto str;
end;
{$endif}
varOleStr: begin
RawUnicodeToUtf8(aVarData.VAny,length(WideString(aVarData.VAny)),RawUTF8(aTemp));
str:Kind := betString;
Data.Text := pointer(aTemp);
Data.TextLen := Length(aTemp);
goto st2;
end;
else
if aVarData.VType=BSONVariantType.VarType then begin
Kind := aBson.VKind;
case Kind of
betObjectID: FromBSON(@aBson.VObjectID); // stored inlined
else FromBSON(aBson.VBlob); // complex type stored as a RawByteString
end;
if ElementBytes<0 then
raise EBSONException.CreateUTF8('TBSONElement.FromVariant(bson,%)',[ToText(Kind)^]);
end else
if aVarData.VType=DocVariantType.VarType then begin
with TBSONWriter.Create(TRawByteStringStream) do // inlined BSON()
try
BSONWriteDoc(aDoc);
ToBSONDocument(aTemp);
finally
Free;
end;
if dvoIsObject in aDoc.Options then
Kind := betDoc else
if dvoIsArray in aDoc.Options then
Kind := betArray else
raise EBSONException.CreateUTF8('TBSONElement.FromVariant(doc,%)',[ToText(aDoc.Kind)^]);
FromBSON(pointer(aTemp));
if ElementBytes<0 then
raise EBSONException.CreateUTF8('TBSONElement.FromVariant(docbson,%)',[ToText(Kind)^]);
end else
raise EBSONException.CreateUTF8('TBSONElement.FromVariant(VType=%)',[aVarData.VType]);
end;
end;
function TBSONElement.FromDocument(const doc: TBSONDocument): boolean;
var n: Integer;
begin
FillCharFast(self,sizeof(self),0);
n := length(doc);
if (n>=4) and (PInteger(doc)^=n) then begin
Kind := betDoc;
FromBSON(pointer(doc));
result := true;
end else
result := false;
end;
const
NULCHAR: AnsiChar = #0;
procedure TBSONElement.FromBSON(bson: PByte);
begin // see http://bsonspec.org/#/specification
Element := bson;
case Kind of // handle variable-size storage
betString, betJS, betDeprecatedSymbol: begin // "\x02" e_name string
ElementBytes := PInteger(bson)^+sizeof(integer); // int32 (byte*) "\x00"
Data.TextLen := PInteger(bson)^-1;
inc(bson,sizeof(integer));
Data.Text := pointer(bson);
end;
betDoc, betArray: begin // "\x03" e_name document
ElementBytes := PInteger(bson)^;
inc(bson,sizeof(integer)); // points to a "e_list #0"
Data.DocList := bson;
end;
betBinary: begin // "\x05" e_name int32 subtype (byte*)
ElementBytes := PInteger(bson)^+(sizeof(integer)+1);
Data.BlobLen := PInteger(bson)^;
inc(bson,sizeof(integer));
Data.BlobSubType := TBSONElementBinaryType(bson^);
inc(bson);
Data.Blob := bson;
end;
betRegEx: begin // "\x0B" e_name cstring cstring
Data.RegEx := Element;
Data.RegExLen := StrLen(Data.RegEx);
Data.RegExOptions := Data.RegEx+Data.RegExLen+1;
Data.RegExOptionsLen := StrLen(Data.RegExOptions);
ElementBytes := Data.RegExLen+Data.RegExOptionsLen+2;
end;
betJSScope: begin // "\x0F" e_name int32 string document
ElementBytes := PInteger(bson)^;
inc(bson,sizeof(integer));
Data.JavaScriptLen := PInteger(bson)^-1;
inc(bson,sizeof(integer));
Data.JavaScript := pointer(bson);
inc(bson,Data.JavaScriptLen+1);
Data.ScopeDocument := bson;
end;
else
if Kind>high(BSON_ELEMENTSIZE) then // e.g. betMinKey betMaxKey
ElementBytes := 0 else
ElementBytes := BSON_ELEMENTSIZE[Kind]; // fixed size storage
end;
end;
function TBSONElement.FromNext(var BSON: PByte): boolean;
begin
if BSON=nil then begin
result := false;
exit;
end;
Kind := TBSONElementType(BSON^);
case ord(Kind) of
ord(betEOF):
result := false;
ord(betFloat)..ord(betDecimal128),ord(betMinKey),ord(betMaxKey): begin
inc(BSON);
Name := PUTF8Char(BSON);
NameLen := StrLen(PUTF8Char(BSON));
inc(BSON,NameLen+1);
FromBSON(BSON);
if ElementBytes<0 then
raise EBSONException.CreateUTF8(
'TBSONElement.FromNext: unexpected size % for type %',[ElementBytes,ord(Kind)]);
inc(BSON,ElementBytes);
inc(Index);
result := true;
end;
else raise EBSONException.CreateUTF8('TBSONElement.FromNext: unexpected type %',
[ord(Kind)]);
end;
end;
function TBSONElement.FromSearch(BSON: PByte; const aName: RawUTF8): boolean;
begin
result := true;
while FromNext(BSON) do
if IdemPropNameU(aName,Name,NameLen) then
exit;
result := false;
end;
{ TBSONIterator }
function TBSONIterator.Init(const doc: TBSONDocument; kind: TBSONElementType): boolean;
var n: integer;
begin
FillCharFast(self,sizeof(self),0);
n := length(doc);
if (kind in [betDoc,betArray]) and (n>=4) and (PInteger(doc)^=n) then begin
Item.Kind := kind;
Item.FromBSON(pointer(doc));
fBson := Item.Data.DocList;
result := true;
end else
result := false;
end;
function TBSONIterator.Next: boolean;
begin
result := Item.FromNext(fBson);
end;
function BSONParseLength(var BSON: PByte; ExpectedBSONLen: integer=0): integer;
begin
if (BSON=nil) or
((ExpectedBSONLen<>0) and (PInteger(BSON)^<>ExpectedBSONLen)) then
raise EBSONException.Create('Incorrect supplied BSON document content');
result := PInteger(BSON)^;
inc(PInteger(BSON));
end;
function BSONParseNextElement(var BSON: PByte; var name: RawUTF8; var element: variant;
DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;
var item: TBSONElement;
begin
result := item.FromNext(BSON);
if result then begin
SetString(name,PAnsiChar(item.Name),item.NameLen);
item.ToVariant(element,DocArrayConversion);
end;
end;
function BSONPerIndexElement(BSON: PByte; index: integer; var item: TBSONElement): boolean;
begin
result := true;
if (index>=0) and (BSON<>nil) and (BSONParseLength(BSON)<>0) then
while item.FromNext(BSON) do
if index=0 then
exit else
dec(index);
result := false;
end;
procedure BSONToDoc(BSON: PByte; var Result: Variant; ExpectedBSONLen: Integer;
Option: TBSONDocArrayConversion);
begin
if Option=asBSONVariant then
raise EBSONException.Create('BSONToDoc(option=asBSONVariant) is not allowed');
if TVarData(result).VType and VTYPE_STATIC<>0 then
VarClear(result);
BSONParseLength(BSON,ExpectedBSONLen);
BSONItemsToDocVariant(betDoc,BSON,TDocVariantData(Result),Option);
end;
function BSONDocumentToDoc(const BSON: TBSONDocument; Option: TBSONDocArrayConversion): variant;
begin
BSONToDoc(pointer(BSON),result,length(BSON));
end;
procedure BSONListToJSON(BSONList: PByte; Kind: TBSONElementType;
W: TTextWriter; Mode: TMongoJSONMode);
var item: TBSONElement;
begin
case Kind of
betDoc:
if BSONList^=byte(betEOF) then
W.Add('{','}') else begin
W.Add('{');
while item.FromNext(BSONList) do begin
if Mode=modMongoShell then begin
W.AddNoJSONEscape(item.Name,item.NameLen);
W.Add(':');
end else
W.AddFieldName(item.Name,item.NameLen);
item.AddMongoJSON(W,Mode);
W.Add(',');
end;
W.CancelLastComma;
W.Add('}');
end;
betArray: begin
W.Add('[');
while item.FromNext(BSONList) do begin
item.AddMongoJSON(W,Mode);
W.Add(',');
end;
W.CancelLastComma;
W.Add(']');
end;
else raise EBSONException.CreateUTF8('BSONListToJSON(Kind=%)',[ord(Kind)]);
end;
end;
function BSONDocumentToJSON(const BSON: TBSONDocument;
Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
begin
result := BSONToJSON(pointer(BSON),betDoc,length(BSON),Mode);
end;
function BSONToJSON(BSON: PByte; Kind: TBSONElementType; ExpectedBSONLen: integer;
Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
begin
BSONParseLength(BSON,ExpectedBSONLen);
W := TTextWriter.CreateOwnedStream;
try
BSONListToJSON(BSON,Kind,W,Mode);
W.SetText(result);
finally
W.Free;
end;
end;
procedure AddMongoJSON(const Value: variant; W: TTextWriter; Mode: TMongoJSONMode);
procedure AddCustom;
var item: TBSONElement;
temp: RawByteString;
begin
item.FromVariant('',Value,temp);
item.AddMongoJSON(W,Mode);
end;
begin
if TVarData(Value).VType<$10F then
W.AddVariant(Value,twJSONEscape) else
AddCustom;
end;
function VariantSaveMongoJSON(const Value: variant; Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
begin
W := TTextWriter.CreateOwnedStream;
try
AddMongoJSON(Value,W,Mode);
W.SetText(result);
finally
W.Free;
end;
end;
{ TBSONWriter }
procedure TBSONWriter.CancelAll;
begin
inherited;
fDocumentCount := 0;
end;
procedure TBSONWriter.WriteCollectionName(Flags: integer; const CollectionName: RawUTF8);
begin
Write4(Flags);
if CollectionName='' then
raise EBSONException.Create('Missing collection name');
Write(pointer(CollectionName),length(CollectionName)+1); // +1 for #0
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; elemtype: TBSONElementType);
begin
Write1(ord(elemtype));
if name='' then
write1(0) else // write only #0
{$ifdef HASINLINE}
Write(pointer(name),length(name)+1); // +1 for #0
{$else}
Write(pointer(name),PInteger(PtrInt(name)-sizeof(integer))^+1); // +1 for #0
{$endif}
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: integer);
begin
BSONWrite(name,betInt32);
Write4(value);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: Double);
begin
BSONWrite(name,betFloat);
Write8(value);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: boolean);
begin
BSONWrite(name,betBoolean);
Write1(ord(value));
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: Int64);
begin
if (value>=low(integer)) and (value<=high(integer)) then begin
BSONWrite(name,betInt32);
Write4(value);
end else begin
BSONWrite(name,betInt64);
Write8(value);
end;
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TBSONObjectID);
begin
BSONWrite(name,betObjectID);
Write(@value,sizeof(value));
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TDecimal128);
begin
BSONWrite(name,betDecimal128);
Write(@value,sizeof(value));
end;
procedure TBSONWriter.BSONWriteRegEx(const name: RawUTF8;
const RegEx,Options: RawByteString);
begin
BSONWrite(name,betRegEx); // cstring cstring
Write(pointer(RegEx),length(RegEx));
Write1(0);
Write(pointer(Options),length(Options));
Write1(0);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: RawUTF8;
isJavaScript: boolean=false);
const TYP: array[boolean] of TBSONElementType = (betString,betJS);
var L: integer;
begin
BSONWrite(name,TYP[isJavaScript]);
L := length(value)+1; // +1 for ending #0
Write4(L);
if L=1 then
Write1(0) else
Write(pointer(value),L);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; value: PUTF8Char);
var L: integer;
begin
BSONWrite(name,betString);
L := StrLen(Value)+1;
Write4(L);
if L=1 then
Write1(0) else
Write(value,L);
end;
procedure TBSONWriter.BSONWriteString(const name: RawUTF8; value: PUTF8Char; valueLen: integer);
begin
BSONWrite(name,betString);
inc(valueLen);
Write4(valueLen);
if valueLen=1 then
Write1(0) else
Write(value,valueLen);
end;
procedure TBSONWriter.BSONWriteDateTime(const name: RawUTF8; const value: TDateTime);
var UnixTime: TUnixMSTime;
begin
UnixTime := DateTimeToUnixMSTime(value);
BSONWrite(name,betDateTime);
Write8(UnixTime);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; Data: pointer; DataLen: integer);
begin
BSONWrite(name,betBinary);
Write4(DataLen);
Write1(ord(bbtGeneric));
Write(Data,DataLen);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const elem: TBSONElement);
begin
BSONWrite(name,elem.Kind);
if (elem.Element=nil) and // handle special case of TBSONElement.FromVariant()
(elem.Kind in [betString,betJS,betDeprecatedSymbol]) then begin
Write4(elem.Data.TextLen+1); // int32 (byte*) "\x00"
Write(elem.Data.Text,elem.Data.TextLen+1);
end else
Write(elem.Element,elem.ElementBytes);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const bson: TBSONVariantData);
begin
case bson.VKind of
betObjectID:
BSONWrite(name,bson.VObjectID);
else begin
BSONWrite(name,bson.VKind);
WriteBinary(RawByteString(bson.VBlob));
end;
end;
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const doc: TDocVariantData);
begin
if dvoIsObject in doc.Options then
BSONWrite(name,betDoc) else
if dvoIsArray in doc.Options then
BSONWrite(name,betArray) else
raise EBSONException.Create('Undefined nested document');
BSONWriteDoc(doc);
end;
procedure TBSONWriter.BSONWriteArray(const kind: TBSONElementType);
begin
BSONWrite(UInt32ToUtf8(fDocumentArray),kind);
inc(fDocumentArray);
if kind in [betDoc,betArray] then
BSONDocumentBegin;
end;
procedure TBSONWriter.BSONDocumentBegin;
begin
if fDocumentStack>=Length(fDocumentStackOffset) then
SetLength(fDocumentStackOffset,fDocumentStack+fDocumentStack shr 3+16);
fDocumentStackOffset[fDocumentStack] := TotalWritten;
inc(fDocumentStack);
Write4(0);
end;
procedure TBSONWriter.BSONDocumentBegin(const name: RawUTF8; kind: TBSONElementType);
begin
if not (kind in [betDoc,betArray]) then
raise EBSONException.Create('BSONDocumentBegin(?)');
BSONWrite(name,kind);
BSONDocumentBegin;
end;
procedure TBSONWriter.BSONDocumentBeginInArray(const name: RawUTF8; kind: TBSONElementType);
begin
if fDocumentArray>0 then
BSONDocumentEnd;
BSONWriteArray(kind);
BSONDocumentBegin(name);
end;
procedure TBSONWriter.BSONDocumentEnd(CloseNumber: integer; WriteEndingZero: boolean);
begin
while CloseNumber>0 do begin
if (CloseNumber>1) or WriteEndingZero then
Write1(0);
if fDocumentStack=0 then
raise EBSONException.CreateUTF8('Unexpected %.BSONDocumentEnd',[self]);
dec(fDocumentStack);
if fDocumentCount>=Length(fDocument) then
SetLength(fDocument,fDocumentCount+fDocumentCount shr 3+16);
with fDocument[fDocumentCount] do begin
Offset := fDocumentStackOffset[fDocumentStack];
Length := TotalWritten-Offset;
end;
inc(fDocumentCount);
dec(CloseNumber);
end;
end;
procedure TBSONWriter.BSONAdjustDocumentsSize(BSON: PByteArray);
var i: Integer;
begin
for i := 0 to fDocumentCount-1 do
with fDocument[i] do
PCardinal(@BSON[Offset])^ := Length;
end;
procedure TBSONWriter.ToBSONDocument(var result: TBSONDocument);
begin
Flush;
result := (Stream as TRawByteStringStream).DataString;
BSONAdjustDocumentsSize(pointer(result));
end;
procedure TBSONWriter.ToBSONVariant(var result: variant; Kind: TBSONElementType);
var doc: TBSONDocument;
begin
ToBSONDocument(doc);
BSONVariantType.FromBSONDocument(doc,result,Kind);
end;
procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TVarRec);
var tmp: RawUTF8;
begin
case value.VType of
vtBoolean: BSONWrite(name,value.VBoolean);
vtInteger: BSONWrite(name,value.VInteger);
vtCurrency: BSONWrite(name,value.VCurrency^);
vtExtended: BSONWrite(name,value.VExtended^);
vtVariant: BSONWriteVariant(name,value.VVariant^);
vtInt64{$ifdef FPC},vtQWord{$endif}:
BSONWrite(name,value.VInt64^);
vtString, vtAnsiString, {$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
vtPChar, vtChar, vtWideChar, vtWideString: begin
VarRecToUTF8(value,tmp);
BSONWrite(name,tmp);
end;
else raise EBSONException.CreateUtf8(
'%.BSONWrite(TVarRec.VType=%)',[self,value.VType]);
end;
end;
procedure TBSONWriter.BSONWriteVariant(const name: RawUTF8; const value: variant);
procedure WriteComplex;
var temp: RawUTF8;
JSON: PUTF8Char;
begin
with TVarData(value) do
case VType of
{$ifdef HASVARUSTRING}
varUString: begin
RawUnicodeToUtf8(VAny,length(UnicodeString(VAny)),temp);
BSONWrite(Name,temp);
end;
{$endif}
varOleStr: begin
RawUnicodeToUtf8(VAny,length(WideString(VAny)),temp);
BSONWrite(Name,temp);
end;
else begin
VariantSaveJSON(value,twJSONEscape,temp);
JSON := pointer(temp);
BSONWriteFromJSON(name,JSON,nil);
if JSON=nil then
raise EBSONException.CreateUTF8('%.BSONWriteVariant(VType=%)',[self,VType]);
end;
end;
end;
var dt: TDateTime;
begin
with TVarData(value) do begin
case VType of
varEmpty,
varNull: BSONWrite(Name,betNull);
varSmallint: BSONWrite(Name,VSmallInt);
{$ifndef DELPHI5OROLDER}
varShortInt: BSONWrite(Name,VShortInt);
varWord: BSONWrite(Name,VWord);
varLongWord: BSONWrite(Name,VLongWord);
{$endif}
varByte: BSONWrite(Name,VByte);
varBoolean: BSONWrite(Name,VBoolean);
varInteger: BSONWrite(Name,VInteger);
varWord64,
varInt64: BSONWrite(Name,VInt64);
varSingle: BSONWrite(Name,VSingle);
varDouble: BSONWrite(Name,VDouble);
varDate: BSONWriteDateTime(Name,VDate);
varCurrency: BSONWrite(Name,VCurrency);
varString:
if (VAny<>nil) and (PInteger(VAny)^ and $ffffff=JSON_SQLDATE_MAGIC) and
Iso8601CheckAndDecode(PUTF8Char(VAny)+3,Length(RawUTF8(VAny))-3,dt) then
// recognized TTextWriter.AddDateTime(woDateTimeWithMagic) ISO-8601 format
BSONWriteDateTime(Name,dt) else
BSONWrite(Name,RawUTF8(VAny)); // expect UTF-8 content
else
if VType=varByRef or varVariant then
BSONWriteVariant(name,PVariant(VPointer)^) else
if VType=BSONVariantType.VarType then
BSONWrite(name,TBSONVariantData(value)) else
if VType=DocVariantType.VarType then
BSONWrite(name,TDocVariantData(value)) else
WriteComplex;
end;
end;
end;
procedure TBSONWriter.BSONWriteDoc(const doc: TDocVariantData);
var Name: RawUTF8;
i: integer;
begin
BSONDocumentBegin;
if TVarData(doc).VType>varNull then // null,empty will write {}
if TVarData(doc).VType<>DocVariantType.VarType then
raise EBSONException.CreateUTF8('%.BSONWriteDoc(VType=%)',
[self,TVarData(doc).VType]) else
for i := 0 to doc.Count-1 do begin
if doc.Names<>nil then
Name := doc.Names[i] else
UInt32ToUtf8(i,Name);
BSONWriteVariant(Name,doc.Values[i]);
if TotalWritten>BSON_MAXDOCUMENTSIZE then
raise EBSONException.CreateUTF8('%.BSONWriteDoc(size=%>max %)',
[self,TotalWritten,BSON_MAXDOCUMENTSIZE]);
end;
BSONDocumentEnd;
end;
procedure TBSONWriter.BSONWriteProjection(const FieldNamesCSV: RawUTF8);
var FieldNames: TRawUTF8DynArray;
i: integer;
begin
CSVToRawUTF8DynArray(pointer(FieldNamesCSV),FieldNames);
BSONDocumentBegin;
for i := 0 to high(FieldNames) do
BSONWrite(FieldNames[i],1);
BSONDocumentEnd;
end;
function TBSONWriter.BSONWriteQueryOperator(name: RawUTF8; inverted: boolean;
operator: TSynTableStatementOperator; const Value: variant): boolean;
const
QUERY_OPS: array[opNotEqualTo..opIn] of RawUTF8 = (
'$ne','$lt','$lte','$gt','$gte','$in');
INVERT_OPS: array[opEqualTo..opGreaterThanOrEqualTo] of TSynTableStatementOperator = (