/// direct optimized MongoDB access for mORMot's ORM // - this unit is a part of the freeware Synopse mORMot framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit mORMotMongoDB; { This file is part of Synopse mORMot framework. Synopse mORMot framework. Copyright (C) 2022 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) 2022 the Initial Developer. All Rights Reserved. Contributor(s): Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. ***** END LICENSE BLOCK ***** TODO: - complex WHERE clause with a MongoDB Query object instead of SQL syntax; mitigated by the fact that most SQL queries are translated into BSON Query Object at runtime - needed only for most complex features like in-object inspection? - handle TSQLRawBlob fields with GridFS (and rely on TByteDynArray to store smaller BLOBs - < 16 MB - within the document, or in a separated collection) - allow PolyMorphic schemas: the same MongoDB collection may be able to store a hierarchy of TSQLRecord classes, storing only relevant fields in each document - this may be a huge benefit in common OOP work - could be implemented in mORMot.pas for any DB - see [bf459fe126] and [da0bccd89e] - SQLite3 Virtual Table mode, for full integration with mORMotDB - certainly in a dedicated mORMotDBMongoDB unit (but perhaps we may loose interest) } {$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER interface uses {$ifdef MSWINDOWS} Windows, {$endif} {$ifdef KYLIX3} LibC, {$endif} {$ifdef HASINLINENOTX86} Contnrs, {$endif} SysUtils, Classes, Variants, SynCommons, SynTable, // for TSynTableStatement SynLog, mORMot, SynMongoDB; type /// exception class raised by this units EORMMongoDBException = class(EORMException); /// how TSQLRestStorageMongoDB would compute the next ID to be inserted // - you may choose to retrieve the last inserted ID via // $ {$query:{},$orderby:{_id:-1}} // or search for the current maximum ID in the collection via // $ {$group:{_id:null,max:{$max:"$_id"}}} // - eacLastIDOnce and eacMaxIDOnce would execute the request once when // the storage instance is first started, whereas eacLastIDEachTime and // eacMaxIDEachTime would be execute before each insertion // - with big amount of data, retrieving the maximum ID (eacMaxID*) performs // a full scan, which would be very slow: the last inserted ID (eacLastID*) // would definitively be faster // - in all cases, to ensure that a centralized MongoDB server has unique // ID, you should better pre-compute the ID using your own algorithm // depending on your nodes topology, and not rely on the ORM, e.g. using // SetEngineAddComputeIdentifier() method, which would allocate a // TSynUniqueIdentifierGenerator and associate eacSynUniqueIdentifier TSQLRestStorageMongoDBEngineAddComputeID = ( eacLastIDOnce, eacLastIDEachTime, eacMaxIDOnce, eacMaxIDEachTime, eacSynUniqueIdentifier); /// REST server with direct access to a MongoDB external database // - handle all REST commands via direct SynMongoDB call // - is used by TSQLRestServer.URI for faster RESTful direct access // - JOINed SQL statements are not handled yet TSQLRestStorageMongoDB = class(TSQLRestStorage) protected fCollection: TMongoCollection; fEngineLastID: TID; fEngineGenerator: TSynUniqueIdentifierGenerator; fEngineAddCompute: TSQLRestStorageMongoDBEngineAddComputeID; fBSONProjectionSimpleFields: variant; fBSONProjectionBlobFields: variant; fBSONProjectionBlobFieldsNames: TRawUTF8DynArray; // multi-thread BATCH process is secured via Lock/UnLock critical section fBatchMethod: TSQLURIMethod; fBatchWriter: TBSONWriter; fBatchIDs: TIDDynArray; fBatchIDsCount: integer; function EngineNextID: TID; function DocFromJSON(const JSON: RawUTF8; Occasion: TSQLOccasion; var Doc: TDocVariantData): TID; procedure JSONFromDoc(var doc: TDocVariantData; var result: RawUTF8); function BSONProjectionSet(var Projection: variant; WithID: boolean; const Fields: TSQLFieldBits; BSONFieldNames: PRawUTF8DynArray; const SubFields: TRawUTF8DynArray): integer; function GetJSONValues(const Res: TBSONDocument; const extFieldNames: TRawUTF8DynArray; W: TJSONSerializer): integer; // overridden methods calling the MongoDB external server function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override; function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override; function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override; function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override; function EngineUpdateField(TableModelIndex: integer; const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; override; function EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean; override; function EngineDeleteWhere(TableModelIndex: Integer;const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean; override; // BLOBs should be accessed directly, not through slower JSON Base64 encoding function EngineRetrieveBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; override; function EngineUpdateBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; override; // method not implemented: always return false function EngineExecute(const aSQL: RawUTF8): boolean; override; /// TSQLRestServer.URI use it for Static.EngineList to by-pass virtual table // - overridden method which allows return TRUE, i.e. always by-pass // virtual tables process function AdaptSQLForEngineList(var SQL: RawUTF8): boolean; override; // overridden method returning TRUE for next calls to EngineAdd/Delete // will properly handle operations until InternalBatchStop is called // BatchOptions is ignored with MongoDB (yet) function InternalBatchStart(Method: TSQLURIMethod; BatchOptions: TSQLRestBatchOptions): boolean; override; // internal method called by TSQLRestServer.RunBatch() to process fast // BULK sending to remote MongoDB database procedure InternalBatchStop; override; public /// initialize the direct access to the MongoDB collection // - in practice, you should not have to call this constructor, but rather // StaticMongoDBRegister() with a TMongoDatabase instance constructor Create(aClass: TSQLRecordClass; aServer: TSQLRestServer); override; /// release used memory destructor Destroy; override; /// overridden method for one single update call to the MongoDB server function UpdateBlobFields(Value: TSQLRecord): boolean; override; /// overridden method for one single read call to the MongoDB server function RetrieveBlobFields(Value: TSQLRecord): boolean; override; /// get the row count of a specified table // - return -1 on error // - return the row count of the table on success function TableRowCount(Table: TSQLRecordClass): Int64; override; /// check if there is some data rows in a specified table function TableHasRows(Table: TSQLRecordClass): boolean; override; /// delete a row, calling the current MongoDB server // - made public since a TSQLRestStorage instance may be created // stand-alone, i.e. without any associated Model/TSQLRestServer function EngineDelete(TableModelIndex: integer; ID: TID): boolean; override; /// create one index for all specific FieldNames at once function CreateSQLMultiIndex(Table: TSQLRecordClass; const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8=''): boolean; override; /// search for a field value, according to its SQL content representation // - return true on success (i.e. if some values have been added to ResultID) // - store the results into the ResultID dynamic array // - faster than OneFieldValues method, which creates a temporary JSON content function SearchField(const FieldName, FieldValue: RawUTF8; out ResultID: TIDDynArray): boolean; override; /// drop the whole table content // - in practice, dropping the whole MongoDB database would be faster // - but you can still add items to it - whereas Collection.Drop would // trigger GPF issues procedure Drop; /// initialize an internal time-based unique ID generator, linked to // a genuine process identifier // - will allocate a local TSynUniqueIdentifierGenerator // - EngineAddCompute would be set to eacSynUniqueIdentifier procedure SetEngineAddComputeIdentifier(aIdentifier: word); published /// the associated MongoDB collection instance property Collection: TMongoCollection read fCollection; /// how the next ID would be compute at each insertion // - default eacLastIDOnce may be the fastest, but other options are // available, and may be used in some special cases // - consider using SetEngineAddComputeIdentifier() which is both safe // and fast, with a cloud of servers sharing the same MongoDB collection property EngineAddCompute: TSQLRestStorageMongoDBEngineAddComputeID read fEngineAddCompute write fEngineAddCompute; end; /// creates and register a static class on the Server-side to let a given // ORM class be stored on a remote MongoDB server // - will associate the supplied class with a MongoDB collection for a // specified MongoDB database // - to be called before Server.CreateMissingTables // - by default, the collection name will match TSQLRecord.SQLTableName, but // you can customize it with the corresponding parameter // - the TSQLRecord.ID (RowID) field is always mapped to MongoDB's _id field // - will call create needed indexes // - you can later call aServer.InitializeTables to create any missing index and // initialize the void tables (e.g. default TSQLAuthGroup and TSQLAuthUser records) // - after registration, you can tune the field-name mapping by calling // ! aModel.Props[aClass].ExternalDB.MapField(..) // (just a regular external DB as defined in mORMotDB.pas unit) - it may be // a good idea to use short field names on MongoDB side, to reduce the space // used for storage (since they will be embedded within the document data) // - it will return the corresponding TSQLRestStorageMongoDB instance - // you can access later to it and its associated collection e.g. via: // ! (aServer.StaticDataServer[TSQLMyTable] as TSQLRestStorageMongoDB) // - you can set aMapAutoFieldsIntoSmallerLength to compute a field name // mapping with minimal length, so that the stored BSON would be smaller: // by definition, ID/RowID will be mapped as 'id', but other fields will // use their first letter, and another other letter if needed (after a '_', // or in uppercase, or the next one) e.g. FirstName -> 'f', LastName -> 'l', // LockedAccount: 'la'... function StaticMongoDBRegister(aClass: TSQLRecordClass; aServer: TSQLRestServer; aMongoDatabase: TMongoDatabase; aMongoCollectionName: RawUTF8=''; aMapAutoFieldsIntoSmallerLength: boolean=false): TSQLRestStorageMongoDB; type /// all possible options for StaticMongoDBRegisterAll/TSQLRestMongoDBCreate functions // - by default, TSQLAuthUser and TSQLAuthGroup tables will be handled via the // external DB, but you can avoid it for speed when handling session and security // by setting mrDoNotRegisterUserGroupTables // - you can set mrMapAutoFieldsIntoSmallerLength to compute a field name // mapping with minimal length, so that the stored BSON would be smaller: // by definition, ID/RowID will be mapped as 'id', but other fields will // use their first letter, and another other letter if needed (after a '_', // or in uppercase, or the next one) e.g. FirstName -> 'f', LastName -> 'l', // LockedAccount: 'la'... - WARNING: not yet implemented TStaticMongoDBRegisterOption = ( mrDoNotRegisterUserGroupTables, mrMapAutoFieldsIntoSmallerLength ); /// set of options for StaticMongoDBRegisterAll/TSQLRestMongoDBCreate functions TStaticMongoDBRegisterOptions = set of TStaticMongoDBRegisterOption; /// create and register ALL classes of a given model to access a MongoDB server // - the collection names will follow the class names // - this function will call aServer.InitializeTables to create any missing // index or populate default collection content // - if aMongoDBIdentifier is not 0, then SetEngineAddComputeIdentifier() // would be called function StaticMongoDBRegisterAll(aServer: TSQLRestServer; aMongoDatabase: TMongoDatabase; aOptions: TStaticMongoDBRegisterOptions=[]; aMongoDBIdentifier: word=0): boolean; /// create a new TSQLRest instance, possibly using MongoDB for its ORM process // - if aDefinition.Kind matches a TSQLRest registered class, one new instance // of this kind will be created and returned // - if aDefinition.Kind is 'MongoDB' or 'MongoDBS', it will instantiate an // in-memory TSQLRestServerDB or a TSQLRestServerFullMemory instance (calling // TSQLRestServer.CreateInMemoryForAllVirtualTables), then call // StaticMongoDBRegisterAll() with a TMongoClient initialized from // aDefinition.ServerName ('server' or 'server:port') - optionally with TLS // enabled if Kind equals 'MongoDBS' - and a TMongoDatabase created from // aDefinition.DatabaseName, using authentication if aDefinition.User/Password // credentials are set // - it will return nil if the supplied aDefinition is invalid // - if aMongoDBIdentifier is not 0, then SetEngineAddComputeIdentifier() // would be called for all created TSQLRestStorageMongoDB function TSQLRestMongoDBCreate(aModel: TSQLModel; aDefinition: TSynConnectionDefinition; aHandleAuthentication: boolean; aOptions: TStaticMongoDBRegisterOptions; aMongoDBIdentifier: word=0): TSQLRest; overload; function ToText(eac: TSQLRestStorageMongoDBEngineAddComputeID): PShortString; overload; implementation function ToText(eac: TSQLRestStorageMongoDBEngineAddComputeID): PShortString; begin result := GetEnumName(TypeInfo(TSQLRestStorageMongoDBEngineAddComputeID),ord(eac)); end; function StaticMongoDBRegister(aClass: TSQLRecordClass; aServer: TSQLRestServer; aMongoDatabase: TMongoDatabase; aMongoCollectionName: RawUTF8; aMapAutoFieldsIntoSmallerLength: boolean): TSQLRestStorageMongoDB; var Props: TSQLModelRecordProperties; begin result := nil; if (aServer=nil) or (aClass=nil) or (aMongoDatabase=nil) then exit; // avoid GPF {$ifdef WITHLOG} if aMongoDatabase.Client.Log=nil then aMongoDatabase.Client.SetLog(aServer.LogClass); with aServer.LogClass.Enter do {$endif WITHLOG} begin Props := aServer.Model.Props[aClass]; if Props=nil then exit; // if aClass is not part of the model if aMongoCollectionName='' then aMongoCollectionName := Props.Props.SQLTableName; Props.ExternalDB.Init(aClass,aMongoCollectionName, aMongoDatabase.CollectionOrCreate[aMongoCollectionName],true,[]); Props.ExternalDB.MapField('ID','_id'); result := TSQLRestStorageMongoDB.Create(aClass,aServer); aServer.StaticDataAdd(result); end; end; function StaticMongoDBRegisterAll(aServer: TSQLRestServer; aMongoDatabase: TMongoDatabase; aOptions: TStaticMongoDBRegisterOptions; aMongoDBIdentifier: word): boolean; var i: integer; storage: TSQLRestStorageMongoDB; begin if (aServer=nil) or (aMongoDatabase=nil) then begin result := false; exit; // avoid GPF end; result := true; with aServer.Model do for i := 0 to high(Tables) do if (mrDoNotRegisterUserGroupTables in aOptions) and (Tables[i].InheritsFrom(TSQLAuthGroup) or Tables[i].InheritsFrom(TSQLAuthUser)) then continue else begin storage := StaticMongoDBRegister(Tables[i],aServer,aMongoDatabase,''); if storage=nil then result := false else if aMongoDBIdentifier<>0 then storage.SetEngineAddComputeIdentifier(aMongoDBIdentifier); end; if result then // ensure TSQLRecord.InitializeTable() is called aServer.InitializeTables([]); // will create indexes and default data end; function TSQLRestMongoDBCreate(aModel: TSQLModel; aDefinition: TSynConnectionDefinition; aHandleAuthentication: boolean; aOptions: TStaticMongoDBRegisterOptions; aMongoDBIdentifier: word): TSQLRest; var client: TMongoClient; database: TMongoDatabase; server,port, pwd: RawUTF8; tls: boolean; p: integer; begin result := nil; if aDefinition=nil then exit; if IdemPChar(pointer(aDefinition.Kind),'MONGODB') then begin Split(aDefinition.ServerName,':',server,port); if (server='') or (server[1] in ['?','*']) or (aDefinition.DatabaseName='') then exit; // check mandatory MongoDB IP and Database p := UTF8ToInteger(port,1024,65535,MONGODB_DEFAULTPORT); tls := ord(aDefinition.Kind[8]) in [ord('S'),ord('s')]; // 'MongoDBS' client := TMongoClient.Create(server,p,tls); try with aDefinition do if (User<>'') and (Password<>'') then begin pwd := PasswordPlain; database := client.OpenAuth(DatabaseName,User,pwd); end else database := client.Open(DatabaseName); result := TSQLRestServer.CreateInMemoryForAllVirtualTables( aModel,aHandleAuthentication); StaticMongoDBRegisterAll(TSQLRestServer(result),database,aOptions,aMongoDBIdentifier); result.PrivateGarbageCollector.Add(client); // connection owned by server except FreeAndNil(result); client.Free; // avoid memory leak end; end else // not MongoDB -> try if aDefinition.Kind is a TSQLRest class result := TSQLRest.CreateTryFrom(aModel,aDefinition,aHandleAuthentication); end; { TSQLRestStorageMongoDB } constructor TSQLRestStorageMongoDB.Create(aClass: TSQLRecordClass; aServer: TSQLRestServer); begin inherited Create(aClass,aServer); // ConnectionProperties should have been set in StaticMongoDBRegister() fCollection := fStoredClassMapping^.ConnectionProperties as TMongoCollection; InternalLog('will store % using %',[aClass,Collection],sllInfo); BSONProjectionSet(fBSONProjectionSimpleFields,true, fStoredClassRecordProps.SimpleFieldsBits[soSelect],nil,nil); BSONProjectionSet(fBSONProjectionBlobFields,false, fStoredClassRecordProps.FieldBits[sftBlob],@fBSONProjectionBlobFieldsNames,nil); end; function TSQLRestStorageMongoDB.BSONProjectionSet(var Projection: variant; WithID: boolean; const Fields: TSQLFieldBits; BSONFieldNames: PRawUTF8DynArray; const SubFields: TRawUTF8DynArray): integer; var i,n,sf: integer; W: TBSONWriter; name: RawUTF8; begin sf := length(SubFields); W := TBSONWriter.Create(TRawByteStringStream); try W.BSONDocumentBegin; if withID then result := 1 else result := 0; name := fStoredClassMapping^.RowIDFieldName; if sf>0 then name := name+SubFields[0]; W.BSONWrite(name,result); for i := 0 to fStoredClassRecordProps.Fields.Count-1 do if i in Fields then begin name := fStoredClassMapping^.ExtFieldNames[i]; if i+1nil then with fStoredClassMapping^ do begin SetLength(BSONFieldNames^,result); if WithID then begin BSONFieldNames^[0] := RowIDFieldName; n := 1; end else n := 0; for i := 0 to fStoredClassRecordProps.Fields.Count-1 do if i in Fields then begin BSONFieldNames^[n] := ExtFieldNames[i]; inc(n); end; end; finally W.Free; end; end; function TSQLRestStorageMongoDB.CreateSQLMultiIndex( Table: TSQLRecordClass; const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8): boolean; begin if (self=nil) or (fCollection=nil) or (Table<>fStoredClass) then begin result := false; exit; end; result := true; if (high(FieldNames)=0) and IsRowID(pointer(FieldNames[0])) then exit; // ID primary key is always indexed by MongoDB try fCollection.EnsureIndex(FieldNames,true,Unique); except result := false; end; end; procedure TSQLRestStorageMongoDB.Drop; var DB: TMongoDatabase; CollName: RawUTF8; begin DB := Collection.Database; CollName := Collection.Name; Collection.Drop; fCollection := DB.CollectionOrCreate[CollName]; fEngineLastID := 0; end; destructor TSQLRestStorageMongoDB.Destroy; begin inherited; FreeAndNil(fBatchWriter); fEngineGenerator.Free; InternalLog('Destroy for % using %',[fStoredClass,Collection],sllInfo); end; function TSQLRestStorageMongoDB.TableHasRows( Table: TSQLRecordClass): boolean; begin if (fCollection=nil) or (Table<>fStoredClass) then result := false else result := not fCollection.IsEmpty; end; function TSQLRestStorageMongoDB.TableRowCount( Table: TSQLRecordClass): Int64; begin if (fCollection=nil) or (Table<>fStoredClass) then result := 0 else result := fCollection.Count; end; procedure TSQLRestStorageMongoDB.SetEngineAddComputeIdentifier(aIdentifier: word); begin fEngineGenerator.Free; fEngineGenerator := TSynUniqueIdentifierGenerator.Create(aIdentifier); fEngineAddCompute := eacSynUniqueIdentifier; end; function TSQLRestStorageMongoDB.EngineNextID: TID; procedure ComputeMax_ID; var res: variant; timer: TPrecisionTimer; begin timer.Start; case fEngineAddCompute of eacLastIDOnce, eacLastIDEachTime: begin res := fCollection.FindDoc(BSONVariant('{$query:{},$orderby:{_id:-1}}'),BSONVariant(['_id',1])); if not VarIsEmptyOrNull(res) then fEngineLastID := _Safe(res)^.I['_id']; end; eacMaxIDOnce, eacMaxIDEachTime: begin res := fCollection.AggregateDocFromJson('{$group:{_id:null,max:{$max:"$_id"}}}'); if not VarIsEmptyOrNull(res) then fEngineLastID := _Safe(res)^.I['max']; end; else raise EORMMongoDBException.CreateUTF8('Unexpected %.EngineNextID with %', [self,ToText(fEngineAddCompute)^]); end; InternalLog('ComputeMax_ID=% in % using %', [fEngineLastID,timer.Stop,ToText(fEngineAddCompute)^],sllInfo); end; begin if (fEngineAddCompute=eacSynUniqueIdentifier) and (fEngineGenerator<>nil) then begin result := fEngineGenerator.ComputeNew; fEngineLastID := result; exit; end; EnterCriticalSection(fStorageCriticalSection); if (fEngineLastID=0) or (fEngineAddCompute in [eacLastIDEachTime,eacMaxIDEachTime]) then ComputeMax_ID; inc(fEngineLastID); result := fEngineLastID; LeaveCriticalSection(fStorageCriticalSection); end; function TSQLRestStorageMongoDB.DocFromJSON(const JSON: RawUTF8; Occasion: TSQLOccasion; var Doc: TDocVariantData): TID; var i, ndx: integer; dt: TDateTime; blob: RawByteString; info: TSQLPropInfo; typenfo: pointer; js, RecordVersionName: RawUTF8; MissingID: boolean; V: PVarData; begin doc.InitJSON(JSON,[dvoValueCopiedByReference,dvoAllowDoubleValue]); if (doc.Kind<>dvObject) and (Occasion<>soInsert) then raise EORMMongoDBException.CreateUTF8('%.DocFromJSON: invalid JSON context',[self]); if not (Occasion in [soInsert,soUpdate]) then raise EORMMongoDBException.CreateUTF8('Unexpected %.DocFromJSON(Occasion=%)', [self,ToText(Occasion)^]); MissingID := true; for i := doc.Count-1 downto 0 do // downwards for doc.Delete(i) below if IsRowID(pointer(doc.Names[i])) then begin doc.Names[i] := fStoredClassMapping^.RowIDFieldName; VariantToInt64(doc.Values[i],Int64(result)); if (Occasion=soUpdate) or (result=0) then doc.Delete(i) else // update does not expect any $set:{_id:..} MissingID := false; // leave true if value is not an integer (=0) end else begin ndx := fStoredClassRecordProps.Fields.IndexByName(doc.Names[i]); if ndx<0 then raise EORMMongoDBException.CreateUTF8( '%.DocFromJSON: unkwnown field name [%]',[self,doc.Names[i]]); doc.Names[i] := fStoredClassMapping^.ExtFieldNames[ndx]; info := fStoredClassRecordProps.Fields.List[ndx]; V := @doc.Values[i]; case V^.VType of varInteger: case info.SQLFieldType of sftBoolean: begin // doc.InitJSON/GetVariantFromJSON store 0,1 as varInteger if V^.VInteger=0 then // normalize to boolean BSON V^.VBoolean := false else V^.VBoolean := true; V^.VType := varBoolean; end; sftUnixTime: begin V^.VDate := UnixTimeToDateTime(V^.VInteger); // as MongoDB date/time V^.VType := varDate; // direct set to avoid unexpected EInvalidOp end; sftUnixMSTime: begin V^.VDate := UnixMSTimeToDateTime(V^.VInteger); // as MongoDB date/time V^.VType := varDate; end; end; varInt64: case info.SQLFieldType of sftUnixTime: begin V^.VDate := UnixTimeToDateTime(V^.VInt64); // as MongoDB date/time V^.VType := varDate; // direct set to avoid unexpected EInvalidOp end; sftUnixMSTime: begin V^.VDate := UnixMSTimeToDateTime(V^.VInt64); // as MongoDB date/time V^.VType := varDate; end; end; varString: // handle some TEXT values case info.SQLFieldType of sftDateTime, sftDateTimeMS: begin // ISO-8601 text as MongoDB date/time Iso8601ToDateTimePUTF8CharVar(V^.VAny,length(RawByteString(V^.VAny)),dt); RawByteString(V^.VAny) := ''; V^.VType := varDate; // direct set to avoid unexpected EInvalidOp V^.VDate := dt; end; sftBlob, sftBlobCustom: begin // store Base64-encoded BLOB as binary blob := BlobToTSQLRawBlob(RawByteString(V^.VAny)); BSONVariantType.FromBinary(blob,bbtGeneric,Variant(V^)); end; sftBlobDynArray: begin // store dynamic array as object (if has any JSON) blob := BlobToTSQLRawBlob(RawByteString(V^.VAny)); if blob='' then SetVariantNull(Variant(V^)) else begin typenfo := (info as TSQLPropInfoRTTIDynArray).PropType; if (typenfo=TypeInfo(TByteDynArray)) or (typenfo=TypeInfo(TBytes)) then js := '' else // embedded BLOB type stored as BSON binary js := DynArrayBlobSaveJSON(typenfo,pointer(blob)); if (js<>'') and (PInteger(js)^ and $00ffffff<>JSON_BASE64_MAGIC) then BSONVariantType.FromJSON(pointer(js),Variant(V^)) else BSONVariantType.FromBinary(blob,bbtGeneric,Variant(V^)); end; end; end; // sftObject,sftVariant,sftUTF8Custom were already converted to object from JSON end; end; if Occasion=soInsert then if MissingID then begin result := EngineNextID; doc.AddValue(fStoredClassMapping^.RowIDFieldName,result); end else begin if fEngineAddCompute=eacSynUniqueIdentifier then raise EORMMongoDBException.CreateUTF8('%.DocFromJSON: unexpected set '+ '%.ID=% with %',[self,fStoredClass,result,fEngineGenerator]); EnterCriticalSection(fStorageCriticalSection); if result>fEngineLastID then fEngineLastID := result; LeaveCriticalSection(fStorageCriticalSection); end; if fStoredClassRecordProps.RecordVersionField<>nil then begin RecordVersionName := fStoredClassMapping^.ExtFieldNames[ fStoredClassRecordProps.RecordVersionField.PropertyIndex]; if doc.GetValueIndex(RecordVersionName)<0 then if Owner=nil then raise EORMMongoDBException.CreateUTF8( '%.DocFromJSON: unexpected Owner=nil with %.%: TRecordVersion', [self,fStoredClass,fStoredClassRecordProps.RecordVersionField.Name]) else // compute new monotonic TRecordVersion value if not supplied by sender doc.AddValue(RecordVersionName,Owner.RecordVersionCompute); if (Owner<>nil) and (Owner.Services<>nil) then (Owner.Services as TServiceContainerServer).RecordVersionNotifyAddUpdate( Occasion,fStoredClassProps.TableIndex,doc); end; if doc.Kind<>dvObject then raise EORMMongoDBException.CreateUTF8('%.DocFromJSON: Invalid JSON context',[self]); end; function TSQLRestStorageMongoDB.EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; var doc: TDocVariantData; begin if (fCollection=nil) or (TableModelIndex<0) or (fModel.Tables[TableModelIndex]<>fStoredClass) then result := 0 else try result := DocFromJSON(SentData,soInsert,Doc); if fBatchMethod<>mNone then if (fBatchMethod<>mPOST) or (fBatchWriter=nil) then result := 0 else begin inc(fBatchIDsCount); fBatchWriter.BSONWriteDoc(doc); end else begin fCollection.Insert([variant(doc)]); if Owner<>nil then begin Owner.InternalUpdateEvent(seAdd,TableModelIndex,result,SentData,nil); Owner.FlushInternalDBCache; end; end; except result := 0; end; end; function TSQLRestStorageMongoDB.EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; var doc: TDocVariantData; query,update: variant; // use explicit TBSONVariant for type safety begin if (fCollection=nil) or (ID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else try DocFromJSON(SentData,soUpdate,doc); query := BSONVariant(['_id',ID]); update := BSONVariant(['$set',variant(doc)]); fCollection.Update(query,update); if Owner<>nil then begin Owner.InternalUpdateEvent(seUpdate,TableModelIndex,ID,SentData,nil); Owner.FlushInternalDBCache; end; result := true; except result := false; end; end; function TSQLRestStorageMongoDB.EngineUpdateField(TableModelIndex: integer; const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; var JSON: RawUTF8; query,update: variant; // use explicit TBSONVariant for type safety id: TBSONIterator; begin if (fCollection=nil) or (TableModelIndex<0) or (fModel.Tables[TableModelIndex]<>fStoredClass) or (SetFieldName='') or (SetValue='') or (WhereFieldName='') or (WhereValue='') then result := false else try // use {%:%} here since WhereValue/SetValue are already JSON encoded query := BSONVariant('{%:%}',[fStoredClassMapping^.InternalToExternal( WhereFieldName),WhereValue],[]); update := BSONVariant('{$set:{%:%}}',[fStoredClassMapping^.InternalToExternal( SetFieldName),SetValue],[]); fCollection.Update(query,update); if Owner<>nil then begin if Owner.InternalUpdateEventNeeded(TableModelIndex) and id.Init(fCollection.FindBSON(query,BSONVariant(['_id',1]))) then begin JSONEncodeNameSQLValue(SetFieldName,SetValue,JSON); while id.Next do Owner.InternalUpdateEvent(seUpdate,TableModelIndex, id.Item.DocItemToInteger('_id'),JSON,nil); end; Owner.FlushInternalDBCache; end; result := true; except result := false; end; end; function TSQLRestStorageMongoDB.EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean; var Value: Int64; begin result := false; if (ID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then exit; if (Owner<>nil) and Owner.InternalUpdateEventNeeded(TableModelIndex) then result := OneFieldValue(fStoredClass,FieldName,'ID=?',[],[ID],Value) and UpdateField(fStoredClass,ID,FieldName,[Value+Increment]) else try fCollection.Update(BSONVariant(['_id',ID]),BSONVariant('{$inc:{%:%}}', [fStoredClassMapping^.InternalToExternal(FieldName),Increment],[])); if Owner<>nil then Owner.FlushInternalDBCache; result := true; except on Exception do result := false; end; end; function TSQLRestStorageMongoDB.EngineUpdateBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; var query,update,blob: variant; // use explicit TBSONVariant for type safety FieldName: RawUTF8; AffectedField: TSQLFieldBits; begin if (fCollection=nil) or (BlobField=nil) or (aID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else try query := BSONVariant(['_id',aID]); FieldName := fStoredClassMapping^.InternalToExternal(BlobField^.Name); BSONVariantType.FromBinary(BlobData,bbtGeneric,blob); update := BSONVariant(['$set',BSONVariant([FieldName,blob])]); fCollection.Update(query,update); if Owner<>nil then begin fStoredClassRecordProps.FieldBitsFromBlobField(BlobField,AffectedField); Owner.InternalUpdateEvent(seUpdateBlob,TableModelIndex,aID,'',@AffectedField); Owner.FlushInternalDBCache; end; result := true; except result := false; end; end; function TSQLRestStorageMongoDB.UpdateBlobFields( Value: TSQLRecord): boolean; var query,blob: variant; update: TDocVariantData; info: TSQLPropInfo; blobRaw: RawByteString; aID, f: integer; begin result := false; if (fCollection=nil) or (PSQLRecordClass(Value)^<>fStoredClass) or (Value=nil) then exit; aID := Value.ID; if aID<=0 then exit; query := BSONVariant(['_id',aID]); update.Init(JSON_OPTIONS_FAST); for f := 0 to fStoredClassRecordProps.Fields.Count-1 do begin info := fStoredClassRecordProps.Fields.List[f]; if info.SQLFieldType=sftBlob then begin (info as TSQLPropInfoRTTIRawBlob).GetBlob(Value,blobRaw); BSONVariantType.FromBinary(blobRaw,bbtGeneric,blob); update.AddValue(fStoredClassMapping^.ExtFieldNames[f],blob); end; end; if update.Count>0 then try fCollection.Update(query,BSONVariant(['$set',variant(update)])); if Owner<>nil then begin Owner.InternalUpdateEvent(seUpdateBlob,fStoredClassProps.TableIndex,aID,'', @fStoredClassRecordProps.FieldBits[sftBlob]); Owner.FlushInternalDBCache; end; result := true; except result := false; end; end; function TSQLRestStorageMongoDB.EngineDelete(TableModelIndex: integer; ID: TID): boolean; begin result := false; if (fCollection<>nil) and (TableModelIndex>=0) and (Model.Tables[TableModelIndex]=fStoredClass) and (ID>0) then try if fBatchMethod<>mNone then if fBatchMethod<>mDelete then exit else AddID(fBatchIDs,fBatchIDsCount,ID) else begin if Owner<>nil then begin // notify BEFORE deletion Owner.InternalUpdateEvent(seDelete,TableModelIndex,ID,'',nil); Owner.FlushInternalDBCache; end; fCollection.RemoveOne(ID); end; result := true; except result := false; end; end; function TSQLRestStorageMongoDB.EngineDeleteWhere(TableModelIndex: Integer; const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean; var i: integer; begin // here we use the pre-computed IDs[] result := false; if (fCollection<>nil) and (TableModelIndex>=0) and (Model.Tables[TableModelIndex]=fStoredClass) and (IDs<>nil) then try if Owner<>nil then // notify BEFORE deletion for i := 0 to high(IDs) do Owner.InternalUpdateEvent(seDelete,TableModelIndex,IDs[i],'',nil); fCollection.Remove(BSONVariant( ['_id',BSONVariant(['$in',BSONVariantFromInt64s(TInt64DynArray(IDs))])])); if Owner<>nil then Owner.FlushInternalDBCache; result := true; except result := false; end; end; procedure TSQLRestStorageMongoDB.JSONFromDoc(var doc: TDocVariantData; var result: RawUTF8); var i: integer; name: RawUTF8; W: TTextWriter; tmp: TTextWriterStackBuffer; begin if (doc.VarType<>DocVariantType.VarType) or (doc.Kind<>dvObject) or (doc.Count=0) then begin result := ''; exit; end; W := TTextWriter.CreateOwnedStream(tmp); try W.Add('{'); for i := 0 to doc.Count-1 do begin name := fStoredClassMapping^.ExternalToInternalOrNull(doc.Names[i]); if name='' then raise EORMMongoDBException.CreateUTF8( '%.JSONFromDoc: Unknown field [%] for %',[self,doc.Names[i],fStoredClass]); W.AddProp(pointer(name),Length(name)); W.AddVariant(doc.Values[i],twJSONEscape); W.Add(','); end; W.CancelLastComma; W.Add('}'); W.SetText(result); finally W.Free; end; end; function TSQLRestStorageMongoDB.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; var doc: variant; begin result := ''; if (fCollection=nil) or (ID<=0) then exit; doc := fCollection.FindDoc(BSONVariant(['_id',ID]),fBSONProjectionSimpleFields,1); JSONFromDoc(_Safe(doc)^,result); end; function TSQLRestStorageMongoDB.EngineRetrieveBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; var doc: variant; data: TVarData; FieldName: RawUTF8; begin if (fCollection=nil) or (BlobField=nil) or (aID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else try FieldName := fStoredClassMapping^.InternalToExternal(BlobField^.Name); doc := fCollection.FindDoc(BSONVariant(['_id',aID]),BSONVariant([FieldName,1]),1); if _Safe(doc)^.GetVarData(FieldName,data) then BSONVariantType.ToBlob(variant(data),RawByteString(BlobData)); result := true; except result := false; end; end; function TSQLRestStorageMongoDB.RetrieveBlobFields( Value: TSQLRecord): boolean; var aID, f: Integer; doc: variant; docv: PDocVariantData; blob: TVarData; blobRaw: RawByteString; begin result := false; if (fCollection=nil) or (PSQLRecordClass(Value)^<>fStoredClass) or (Value=nil) then exit; aID := Value.ID; if aID<=0 then exit; try doc := fCollection.FindDoc(BSONVariant(['_id',aID]),fBSONProjectionBlobFields,1); docv := _Safe(doc); if docv^.Kind<>dvObject then exit; // not found for f := 0 to high(fStoredClassRecordProps.BlobFields) do begin if (f always accept end; function TSQLRestStorageMongoDB.SearchField(const FieldName, FieldValue: RawUTF8; out ResultID: TIDDynArray): boolean; var query: variant; id: TBSONIterator; n: integer; // an external count is actually faster begin if (fCollection = nil) or (FieldName = '') or (FieldValue = '') then result := false else try // use {%:%} here since FieldValue is already JSON encoded query := BSONVariant('{%:%}', [fStoredClassMapping^.InternalToExternal(FieldName), FieldValue], []); // retrieve the IDs for this query if id.Init(fCollection.FindBSON(query, BSONVariant(['_id', 1]))) then begin n := 0; while id.Next do AddInt64(TInt64DynArray(ResultID), n, id.Item.DocItemToInteger('_id')); SetLength(ResultID, n); result := true; end else result := false; except result := false; end; end; function TSQLRestStorageMongoDB.GetJSONValues(const Res: TBSONDocument; const extFieldNames: TRawUTF8DynArray; W: TJSONSerializer): integer; function itemFind(item: PBSONElement; itemcount,o1ndx: integer; const aName: RawUTF8): PBSONElement; var aNameLen, i: integer; begin aNameLen := length(aName); if aNameLen<>0 then begin if o1ndxlength(W.ColNames) then raise EORMMongoDBException.CreateUTF8( '%.GetJSONValues(%): column count concern %<>%', [self,StoredClass,colCount,length(W.ColNames)]); itemsize := colCount; SetLength(item,itemsize); while row.Next do begin // retrieve all values of this BSON document into item[] if (row.Item.Kind<>betDoc) or (row.Item.Data.DocList=nil) then raise EORMMongoDBException.CreateUTF8('%.GetJSONValues(%): invalid row kind=%', [self,StoredClass,ord(row.Item.Kind)]); itemcount := 0; while row.Item.Data.DocList^<>byte(betEOF) do begin if itemcount>=itemsize then begin inc(itemsize); Setlength(item,itemsize); // a field was deleted from TSQLRecord end; if not item[itemcount].FromNext(row.Item.Data.DocList) then break; inc(itemcount); end; // convert this BSON document as JSON, following expected column order if W.Expand then W.Add('{'); for col := 0 to colCount-1 do begin if W.Expand then W.AddString(W.ColNames[col]); itemfound := itemFind(pointer(item),itemcount,col,extFieldNames[col]); if itemfound=nil then // this field may not exist (e.g. older schema) W.AddShort('null') else itemfound^.AddMongoJSON(W,modNoMongo); W.Add(','); end; W.CancelLastComma; if W.Expand then W.Add('}',',') else W.Add(','); inc(result); end; end; if (result=0) and W.Expand then begin // we want the field names at least, even with no data W.Expand := false; // {"fieldCount":2,"values":["col1","col2"]} W.CancelAll; fStoredClassRecordProps.SetJSONWriterColumnNames(W,0); end; W.EndJSONObject(0,result); end; function TSQLRestStorageMongoDB.EngineList(const SQL: RawUTF8; ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8; var ResCount: PtrInt; Stmt: TSynTableStatement; Query: variant; TextOrderByField: RawUTF8; const ORDERBY_FIELD: array[boolean] of Integer=(1,-1); procedure AddWhereClause(B: TBSONWriter); var n,w: integer; FieldName: RawUTF8; joinedOR: boolean; begin n := Length(Stmt.Where); if (n>1) and Stmt.Where[1].JoinedOR then begin for w := 2 to n-1 do if not Stmt.Where[w].JoinedOR then begin InternalLog('%.EngineList: mixed AND/OR not supported for [%]', [ClassType,SQL],sllError); exit; end; B.BSONDocumentBegin('$or',betArray); // e.g. {$or:[{quantity:{$lt:20}},{price:10}]} joinedOR := true; end else joinedOR := false; for w := 0 to n-1 do begin if joinedOR then B.BSONDocumentBegin(UInt32ToUtf8(w)); with Stmt.Where[w] do begin FieldName := fStoredClassMapping^.FieldNameByIndex(Field-1)+SubField; if not B.BSONWriteQueryOperator(FieldName,NotClause,Operator,ValueVariant) then begin InternalLog('%.EngineList: operator % not supported for field [%] in [%]', [ClassType,ToText(Operator)^,FieldName,SQL],sllError); exit; end; end; if joinedOR then B.BSONDocumentEnd; end; if joinedOR then B.BSONDocumentEnd; B.BSONDocumentEnd; end; function ComputeQuery: boolean; var B: TBSONWriter; n,i: integer; begin // here we compute a BSON query, since it is the fastest result := false; if Stmt.SQLStatement='' then begin InternalLog('%.EngineList: Invalid SQL statement [%]',[ClassType,SQL],sllError); exit; end; if (Stmt.Where=nil) and (Stmt.OrderByField=nil) then begin // no WHERE clause result := true; SetVariantNull(Query); // void query -> returns all rows exit; end; if Stmt.WhereHasParenthesis then begin InternalLog('%.EngineList: parenthesis not supported in [%]',[ClassType,SQL],sllError); exit; end; B := TBSONWriter.Create(TRawByteStringStream); try B.BSONDocumentBegin; if Stmt.OrderByField<>nil then begin B.BSONDocumentBegin('$query'); AddWhereClause(B); n := high(Stmt.OrderByField); if (n=0) and (Stmt.OrderByField[0]>0) and (Stmt.Limit=0) and (Stmt.Offset=0) and (fStoredClassRecordProps.Fields.List[ Stmt.OrderByField[0]-1].SQLFieldType in [sftAnsiText,sftUTF8Text]) then TextOrderByField := fStoredClassMapping^.FieldNameByIndex(Stmt.OrderByField[0]-1) else if n>=0 then begin B.BSONDocumentBegin('$orderby'); for i := 0 to n do B.BSONWrite(fStoredClassMapping^.FieldNameByIndex(Stmt.OrderByField[i]-1),ORDERBY_FIELD[Stmt.OrderByDesc]); B.BSONDocumentEnd; end; B.BSONDocumentEnd; end else AddWhereClause(B); B.ToBSONVariant(Query); finally B.Free; end; result := true; // indicates success end; procedure SetCount(aCount: integer); begin result := FormatUTF8('[{"Count(*)":%}]'#$A,[aCount]); ResCount := 1; end; procedure ComputeAggregate; type TFunc = (funcMax,funcMin,funcAvg,funcSum,funcCount); const FUNCT: array[TFunc] of RawUTF8 = ('$max','$min','$avg','$sum','$sum'); var i: integer; func: TFunc; distinct: integer; B: TBSONWriter; distinctName,name,value: RawUTF8; begin distinct := -1; for i := 0 to high(Stmt.Select) do if IdemPropNameU(Stmt.Select[i].FunctionName,'distinct') then if distinct>=0 then begin InternalLog('%.EngineList: distinct() only allowed once in [%]', [ClassType,SQL],sllError); exit; end else begin distinct := Stmt.Select[i].Field; distinctName := fStoredClassMapping^.FieldNameByIndex(distinct-1); end; B := TBSONWriter.Create(TRawByteStringStream); try B.BSONDocumentBegin; if Stmt.Where<>nil then begin B.BSONDocumentBeginInArray('$match'); AddWhereClause(B); end; B.BSONDocumentBeginInArray('$group'); if distinct>=0 then begin for i := 0 to high(Stmt.GroupByField) do if Stmt.GroupByField[i]<>distinct then begin InternalLog('%.EngineList: Distinct(%) expected GROUP BY % in [%]', [ClassType,distinctName,distinctName,SQL],sllError); exit; end; B.BSONWrite('_id','$'+distinctName); end else if length(Stmt.GroupByField)=0 then B.BSONWrite('_id',betNull) else begin B.BSONDocumentBegin('_id'); for i := 0 to high(Stmt.GroupByField) do begin name := fStoredClassMapping^.FieldNameByIndex(Stmt.GroupByField[i]-1); B.BSONWrite(name,'$'+name); end; B.BSONDocumentEnd; end; for i := 0 to high(Stmt.Select) do with Stmt.Select[i] do begin if FunctionKnown=funcDistinct then continue; func := TFunc(FindPropName(['max','min','avg','sum','count'],FunctionName)); if ord(func)<0 then begin InternalLog('%.EngineList: unexpected function %() in [%]', [ClassType,FunctionName,SQL],sllError); exit; end; B.BSONDocumentBegin('f'+UInt32ToUTF8(i)); if func=funcCount then B.BSONWrite(FUNCT[func],1) else B.BSONWrite(FUNCT[func],'$'+fStoredClassMapping^.FieldNameByIndex(Field-1)); B.BSONDocumentEnd; end; B.BSONDocumentEnd; if Stmt.OrderByField<>nil then begin if (length(Stmt.OrderByField)<>1) or (Stmt.OrderByField[0]<>distinct) then begin InternalLog('%.EngineList: ORDER BY should match Distinct(%) in [%]', [ClassType,distinctName,SQL],sllError); exit; end; B.BSONDocumentBeginInArray('$sort'); B.BSONWrite('_id',ORDERBY_FIELD[Stmt.OrderByDesc]); B.BSONDocumentEnd; end; B.BSONDocumentBeginInArray('$project'); B.BSONWrite('_id',0); for i := 0 to high(Stmt.Select) do with Stmt.Select[i] do begin if Alias<>'' then // name is the output ODM TSQLRecord field name := Alias else begin if Field=0 then name := 'RowID' else name := fStoredClassRecordProps.Fields.List[Field-1].Name; if SubField<>'' then // 'field.subfield1.subfield2' name := name+SubField; if FunctionName<>'' then if FunctionKnown=funcDistinct then begin B.BSONWrite(name,'$_id'); continue; end else name := FunctionName+'('+name+')'; end; value := '$f'+UInt32ToUTF8(i); if ToBeAdded<>0 then begin B.BSONDocumentBegin(name); B.BSONDocumentBegin('$add',betArray); B.BSONWrite('0',value); B.BSONWrite('1',ToBeAdded); B.BSONDocumentEnd(2); end else B.BSONWrite(name,value); end; B.BSONDocumentEnd(3); B.ToBSONVariant(Query,betArray); finally B.Free; end; result := fCollection.AggregateJSONFromVariant(Query); end; var W: TJSONSerializer; MS: TRawByteStringStream; Res: TBSONDocument; limit: PtrInt; extFieldNames, subFields: TRawUTF8DynArray; bits: TSQLFieldBits; withID: boolean; Projection: variant; begin // same logic as in TSQLRestStorageInMemory.EngineList() result := ''; // indicates error occurred ResCount := 0; if self=nil then exit; InternalLog(SQL,sllSQL); StorageLock(false,'EngineList'); try if IdemPropNameU(fBasicSQLCount,SQL) then SetCount(TableRowCount(fStoredClass)) else if IdemPropNameU(fBasicSQLHasRows[false],SQL) or IdemPropNameU(fBasicSQLHasRows[true],SQL) then if TableRowCount(fStoredClass)=0 then begin result := '{"fieldCount":1,"values":["RowID"]}'#$A; ResCount := 0; end else begin // return one row with fake ID=1 result := '[{"RowID":1}]'#$A; ResCount := 1; end else begin Stmt := TSynTableStatement.Create(SQL, fStoredClassRecordProps.Fields.IndexByName, fStoredClassRecordProps.SimpleFieldsBits[soSelect]); try if (Stmt.SQLStatement='') or // parsing failed not IdemPropNameU(Stmt.TableName,fStoredClassRecordProps.SQLTableName) then // invalid request -> return '' to mark error exit; if Stmt.SelectFunctionCount<>0 then if (length(Stmt.Select)=1) and (Stmt.Select[0].Alias='') and IdemPropNameU(Stmt.Select[0].FunctionName,'count') then if Stmt.Where=nil then // was "SELECT Count(*) FROM TableName;" SetCount(TableRowCount(fStoredClass)) else // was "SELECT Count(*) FROM TableName WHERE ..." if ComputeQuery then SetCount(fCollection.FindCount(Query)) else exit else // e.g. SELECT Distinct(Age),max(RowID) FROM TableName GROUP BY Age ComputeAggregate else // save rows as JSON from returned BSON if ComputeQuery then begin if Stmt.HasSelectSubFields then SetLength(subFields,fStoredClassRecordProps.Fields.Count+1); Stmt.SelectFieldBits(bits,withID,pointer(subFields)); BSONProjectionSet(Projection,withID,bits,@extFieldNames,subFields); if Stmt.Limit=0 then limit := maxInt else limit := Stmt.Limit; Res := fCollection.FindBSON(Query,Projection,limit,Stmt.Offset); MS := TRawByteStringStream.Create; try W := fStoredClassRecordProps.CreateJSONWriter(MS, ForceAJAX or (Owner=nil) or not Owner.NoAJAXJSON,withID,bits,0); try ResCount := GetJSONValues(Res,extFieldNames,W); result := MS.DataString; finally W.Free; end; finally MS.Free; end; if TextOrderByField<>'' then // $orderby is case sensitive with MongoDB -> client-side sort with TSQLTableJSON.CreateFromTables( [fStoredClass],SQL,pointer(result),length(result)) do try SortFields(FieldIndex(TextOrderByField),not Stmt.OrderByDesc,nil,sftUTF8Text); result := GetJSONValues(W.Expand); finally Free; end; end; finally Stmt.Free; end; end; finally StorageUnLock; end; if ReturnedRowCount<>nil then ReturnedRowCount^ := ResCount; end; function TSQLRestStorageMongoDB.EngineExecute(const aSQL: RawUTF8): boolean; begin result := false; // it is a NO SQL engine, we said! :) end; function TSQLRestStorageMongoDB.InternalBatchStart( Method: TSQLURIMethod; BatchOptions: TSQLRestBatchOptions): boolean; begin result := false; // means BATCH mode not supported if method in [mPOST,mDELETE] then begin StorageLock(true,'InternalBatchStart'); // protected by try..finally in TSQLRestServer.RunBatch try if (fBatchMethod<>mNone) or (fBatchWriter<>nil) then raise EORMException.CreateUTF8('%.InternalBatchStop should have been called',[self]); fBatchIDsCount := 0; fBatchMethod := Method; case Method of mPOST: // POST=ADD=INSERT -> EngineAdd() will add to fBatchWriter fBatchWriter := TBSONWriter.Create(TRawByteStringStream); //mDELETE: // EngineDelete() will add deleted ID to fBatchIDs[] end; result := true; // means BATCH mode is supported finally if not result then // release lock on error StorageUnLock; end; end; end; procedure TSQLRestStorageMongoDB.InternalBatchStop; var docs: TBSONDocument; begin try case fBatchMethod of mPOST: begin // Add/Insert if fBatchWriter.TotalWritten=0 then exit; // nothing to add fBatchWriter.ToBSONDocument(docs); fCollection.Insert(docs); end; mDELETE: begin SetLength(fBatchIDs,fBatchIDsCount); fCollection.Remove(BSONVariant( ['_id',BSONVariant(['$in',BSONVariantFromInt64s(TInt64DynArray(fBatchIDs))])])); end; else raise EORMException.CreateUTF8('%.InternalBatchStop(%) with BatchMethod=%', [self,StoredClass,ToText(fBatchMethod)^]); end; finally FreeAndNil(fBatchWriter); fBatchIDs := nil; fBatchIDsCount := 0; fBatchMethod := mNone; StorageUnLock; end; end; end.