1461 lines
56 KiB
ObjectPascal
1461 lines
56 KiB
ObjectPascal
/// 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+1<sf then
|
|
name := name+SubFields[i+1];
|
|
W.BSONWrite(name,1);
|
|
inc(result);
|
|
end;
|
|
W.BSONDocumentEnd;
|
|
W.ToBSONVariant(Projection);
|
|
if BSONFieldNames<>nil 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<docv^.Count) and // optimistic O(1) search
|
|
IdemPropNameU(docv^.Names[f],fBSONProjectionBlobFieldsNames[f]) then
|
|
BSONVariantType.ToBlob(docv^.Values[f],blobRaw) else
|
|
if docv^.GetVarData(fBSONProjectionBlobFieldsNames[f],blob) then
|
|
BSONVariantType.ToBlob(variant(blob),blobRaw) else
|
|
raise EORMMongoDBException.CreateUTF8(
|
|
'%.RetrieveBlobFields(%): field [%] not found',
|
|
[self,Value,fBSONProjectionBlobFieldsNames[f]]);
|
|
(fStoredClassRecordProps.BlobFields[f] as TSQLPropInfoRTTIRawBlob).
|
|
SetBlob(Value,blobRaw);
|
|
end;
|
|
result := true;
|
|
except
|
|
result := false;
|
|
end;
|
|
end;
|
|
|
|
function TSQLRestStorageMongoDB.AdaptSQLForEngineList(
|
|
var SQL: RawUTF8): boolean;
|
|
begin
|
|
result := true; // we do not have any Virtual Table yet -> 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 o1ndx<itemcount then begin // O(1) optimistic search
|
|
result := @PAnsiChar(item)[o1ndx*sizeof(item^)];
|
|
if (result^.NameLen=aNameLen) and
|
|
IdemPropNameUSameLen(pointer(aName),result^.Name,aNameLen) then
|
|
exit;
|
|
end;
|
|
result := item;
|
|
for i := 1 to itemcount do // O(n) search if field missing or moved
|
|
if (result^.NameLen=aNameLen) and
|
|
IdemPropNameUSameLen(pointer(aName),result^.Name,aNameLen) then
|
|
exit else
|
|
inc(result);
|
|
end;
|
|
result := nil;
|
|
end;
|
|
var col, colCount: integer;
|
|
row: TBSONIterator;
|
|
item: array of TBSONElement;
|
|
itemcount, itemsize: integer;
|
|
itemfound: PBSONElement;
|
|
begin
|
|
result := 0; // number of data rows in JSON output
|
|
if W.Expand then
|
|
W.Add('[');
|
|
if row.Init(Res) then begin
|
|
colCount := length(extFieldNames);
|
|
if colCount<>length(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.
|