/// Virtual Tables for external DB access for mORMot // - this unit is a part of the freeware Synopse mORMot framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit mORMotDB; { This file is part of Synopse mORMot framework. Synopse mORMot framework. Copyright (C) 2020 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) 2020 the Initial Developer. All Rights Reserved. Contributor(s): - Maciej Izak (hnb) - yoanq 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 ***** } {$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER interface uses {$ifdef MSWINDOWS} Windows, {$else} {$ifdef KYLIX3} LibC, {$endif} {$ifdef FPC} SynFPCLinux, {$endif} {$endif} SysUtils, Classes, SynCommons, SynLog, SynTable, // for TSynTableStatement mORMot, SynDB; type TSQLRestStorageExternal = class; /// event handler called to customize the computation of a new ID // - should set Handled=TRUE if a new ID has been computed and returned // - Handled=FALSE would let the default ID computation take place // - note that execution of this method would be protected by a mutex, so // it would be thread-safe TOnEngineAddComputeID = function(Sender: TSQLRestStorageExternal; var Handled: Boolean): TID of object; /// REST server with direct access to a SynDB-based external database // - handle all REST commands, using the external SQL database connection, // and prepared statements // - is used by TSQLRestServer.URI for faster RESTful direct access // - for JOINed SQL statements, the external database is also defined as // a SQLite3 virtual table, via the TSQLVirtualTableExternal[Cursor] classes TSQLRestStorageExternal = class(TSQLRestStorage) protected /// values retrieved from fStoredClassProps.ExternalDB settings fTableName: RawUTF8; fProperties: TSQLDBConnectionProperties; fSelectOneDirectSQL, fSelectAllDirectSQL, fSelectTableHasRowsSQL: RawUTF8; fRetrieveBlobFieldsSQL, fUpdateBlobfieldsSQL: RawUTF8; // ID handling during Add/Insert fEngineAddUseSelectMaxID: Boolean; fEngineLockedMaxID: TID; fOnEngineAddComputeID: TOnEngineAddComputeID; fEngineAddForcedID: TID; /// external column layout as retrieved by fProperties // - used internaly to guess e.g. if the column is indexed // - fFieldsExternal[] contains the external table info, and the internal // column name is available via fFieldsExternalToInternal[] fFieldsExternal: TSQLDBColumnDefineDynArray; /// gives the index of each fFieldsExternal[] item in Props.Fields[] // - is >=0 for index in Props.Fields[], -1 for RowID/ID, -2 if unknown // - use InternalFieldNameToFieldExternalIndex() to convert from column name fFieldsExternalToInternal: TIntegerDynArray; /// gives the index of each in Props.Fields[]+1 in fFieldsExternal[] // - expects [0] of RowID/ID, [1..length(fFieldNames)] for others fFieldsInternalToExternal: TIntegerDynArray; // multi-thread BATCH process is secured via Lock/UnLock critical section fBatchMethod: TSQLURIMethod; fBatchCapacity, fBatchCount: integer; // BATCH sending uses TEXT storage for direct sending to database driver fBatchValues: TRawUTF8DynArray; fBatchIDs: TIDDynArray; /// get fFieldsExternal[] index using fFieldsExternalToInternal[] mapping // - do handle ID/RowID fields and published methods function InternalFieldNameToFieldExternalIndex(const InternalFieldName: RawUTF8): integer; /// create, prepare and bound inlined parameters to a thread-safe statement // - this implementation will call the ThreadSafeConnection virtual method, // then bound inlined parameters as :(1234): and call its Execute method // - should return nil on error, and not raise an exception function PrepareInlinedForRows(const aSQL: RawUTF8): ISQLDBStatement; /// overloaded method using FormatUTF8() and binding SynDB parameters function PrepareDirectForRows(SQLFormat: PUTF8Char; const Args, Params: array of const): ISQLDBStatement; /// create, prepare, bound inlined parameters and execute a thread-safe statement // - this implementation will call the ThreadSafeConnection virtual method, // then bound inlined parameters as :(1234): and call its Execute method // - should return nil on error, and not raise an exception function ExecuteInlined(const aSQL: RawUTF8; ExpectResults: Boolean): ISQLDBRows; overload; /// overloaded method using FormatUTF8() and inlined parameters function ExecuteInlined(SQLFormat: PUTF8Char; const Args: array of const; ExpectResults: Boolean): ISQLDBRows; overload; /// overloaded method using FormatUTF8() and binding SynDB parameters function ExecuteDirect(SQLFormat: PUTF8Char; const Args, Params: array of const; ExpectResults: Boolean): ISQLDBRows; /// overloaded method using FormatUTF8() and binding SynDB parameters function ExecuteDirectSQLVar(SQLFormat: PUTF8Char; const Args: array of const; var Params: TSQLVarDynArray; const LastIntegerParam: Int64; ParamsMatchCopiableFields: boolean): boolean; // overridden methods calling the external engine with SQL via Execute function EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; override; function EngineExecute(const aSQL: RawUTF8): boolean; override; function EngineLockedNextID: TID; virtual; function EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; override; function EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; override; function EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean; override; function EngineList(const SQL: RawUTF8; ForceAJAX: Boolean=false; ReturnedRowCount: PPtrInt=nil): RawUTF8; override; // BLOBs should be access 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; function EngineSearchField(const FieldName: ShortString; const FieldValue: array of const; out ResultID: TIDDynArray): boolean; // overridden method returning TRUE for next calls to EngineAdd/Update/Delete // will properly handle operations until InternalBatchStop is called // BatchOptions is ignored with external DB (syntax are too much specific) function InternalBatchStart(Method: TSQLURIMethod; BatchOptions: TSQLRestBatchOptions): boolean; override; // internal method called by TSQLRestServer.RunBatch() to process fast sending // to remote database engine (e.g. Oracle bound arrays or MS SQL Bulk insert) procedure InternalBatchStop; override; /// called internally by EngineAdd/EngineUpdate/EngineDelete in batch mode procedure InternalBatchAdd(const aValue: RawUTF8; const aID: TID); /// TSQLRestServer.URI use it for Static.EngineList to by-pass virtual table // - overridden method to handle most potential simple queries, e.g. like // $ SELECT Field1,RowID FROM table WHERE RowID=... AND/OR/NOT Field2= // - change 'RowID' into 'ID' column name, internal field names into // mapped external field names ('AS [InternalFieldName]' if needed), and // SQLTableName into fTableName // - any 'LIMIT #' clause will be changed into the appropriate SQL statement // - handle also statements to avoid slow virtual table full scan, e.g. // $ SELECT count(*) FROM table function AdaptSQLForEngineList(var SQL: RawUTF8): boolean; override; /// run INSERT of UPDATE from the corresponding JSON object // - Occasion parameter shall be only either soInsert or soUpate // - each JSON field will be bound with the proper SQL type corresponding to // the real external table columns (e.g. as TEXT for variant) // - returns 0 on error, or the Updated/Inserted ID function ExecuteFromJSON(const SentData: RawUTF8; Occasion: TSQLOccasion; UpdatedID: TID): TID; /// compute the INSERT or UPDATE statement as decoded from a JSON object function JSONDecodedPrepareToSQL(var Decoder: TJSONObjectDecoder; out ExternalFields: TRawUTF8DynArray; out Types: TSQLDBFieldTypeArray; Occasion: TSQLOccasion; BatchOptions: TSQLRestBatchOptions; BoundArray: boolean): RawUTF8; function GetConnectionProperties: TSQLDBConnectionProperties; /// check rpmClearPoolOnConnectionIssue in fStoredClassMapping.Options function HandleClearPoolOnConnectionIssue: boolean; public /// initialize the remote database connection // - you should not use this, but rather call VirtualTableExternalRegister() // - RecordProps.ExternalDatabase will map the associated TSQLDBConnectionProperties // - RecordProps.ExternalTableName will retrieve the real full table name, // e.g. including any databasnil) and (aExternalDB<>nil); if not result then exit; // avoid GPF opt := []; if regClearPoolOnConnectionIssue in aExternalOptions then include(opt,rpmClearPoolOnConnectionIssue); for i := 0 to high(aModel.Tables) do begin rec := aModel.Tables[i]; if (regDoNotRegisterUserGroupTables in aExternalOptions) and (rec.InheritsFrom(TSQLAuthGroup) or rec.InheritsFrom(TSQLAuthUser)) then continue else if not VirtualTableExternalRegister(aModel,rec,aExternalDB,'',opt) then result := false else if regMapAutoKeywordFields in aExternalOptions then aModel.TableProps[i].ExternalDB.MapAutoKeywordFields; end; end; function VirtualTableExternalMap(aModel: TSQLModel; aClass: TSQLRecordClass; aExternalDB: TSQLDBConnectionProperties; const aExternalTableName: RawUTF8; aMapping: TSQLRecordPropertiesMappingOptions): PSQLRecordPropertiesMapping; begin if VirtualTableExternalRegister(aModel,aClass,aExternalDB,aExternalTableName,aMapping) then result := @aModel.Props[aClass].ExternalDB else result := nil; end; function TSQLRestExternalDBCreate(aModel: TSQLModel; aDefinition: TSynConnectionDefinition; aHandleAuthentication: boolean; aExternalOptions: TVirtualTableExternalRegisterOptions): TSQLRest; var propsClass: TSQLDBConnectionPropertiesClass; props: TSQLDBConnectionProperties; begin result := nil; if aDefinition=nil then exit; propsClass := TSQLDBConnectionProperties.ClassFrom(aDefinition); if propsClass<>nil then begin props := nil; try // aDefinition.Kind was a TSQLDBConnectionProperties -> all external DB props := propsClass.Create(aDefinition.ServerName,aDefinition.DatabaseName, aDefinition.User,aDefinition.PassWordPlain); VirtualTableExternalRegisterAll(aModel,props,aExternalOptions); result := TSQLRestServer.CreateInMemoryForAllVirtualTables( aModel,aHandleAuthentication); except FreeAndNil(result); props.Free; // avoid memory leak end; end else // not external DB -> try if aDefinition.Kind is a TSQLRest class result := TSQLRest.CreateTryFrom(aModel,aDefinition,aHandleAuthentication); end; { TSQLRestStorageExternal } constructor TSQLRestStorageExternal.Create(aClass: TSQLRecordClass; aServer: TSQLRestServer); procedure FieldsInternalInit; var i,n,int: integer; begin n := length(fFieldsExternal); SetLength(fFieldsExternalToInternal,n); with fStoredClassMapping^ do begin SetLength(fFieldsInternalToExternal,length(ExtFieldNames)+1); for i := 0 to high(fFieldsInternalToExternal) do fFieldsInternalToExternal[i] := -1; for i := 0 to n-1 do begin int := ExternalToInternalIndex(fFieldsExternal[i].ColumnName); fFieldsExternalToInternal[i] := int; inc(int); // fFieldsInternalToExternal[0]=RowID, then follows fFieldsExternal[] if int>=0 then fFieldsInternalToExternal[int] := i; end; end; end; function PropInfoToExternalField(Prop: TSQLPropInfo; var Column: TSQLDBColumnCreate): boolean; const mORMotType: array[TSQLFieldType] of TSQLDBFieldType = // ftUnknown is used for Int32 values, ftInt64 for Int64 values (ftUnknown, // sftUnknown ftUTF8, // sftAnsiText ftUTF8, // sftUTF8Text ftUnknown, // sftEnumerate ftInt64, // sftSet ftInt64, // sftInteger ftInt64, // sftID ftInt64, // sftRecord ftUnknown, // sftBoolean ftDouble, // sftFloat ftDate, // sftDateTime ftInt64, // sftTimeLog ftCurrency, // sftCurrency ftUTF8, // sftObject {$ifndef NOVARIANTS} ftUTF8, // sftVariant ftUTF8, // sftNullable (retrieved from Prop.SQLFieldTypeStored) {$endif} ftBlob, // sftBlob ftBlob, // sftBlobDynArray ftBlob, // sftBlobCustom ftUTF8, // sftUTF8Comp ftInt64, // sftMany ftInt64, // sftModTime ftInt64, // sftCreateTime ftInt64, // sftTID ftInt64, // sftRecordVersion ftInt64, // sftSessionUserID ftDate, // sftDateTimeMS ftInt64, // sftUnixTime ftInt64); // sftUnixMSTime begin if Prop.SQLFieldType in [sftUnknown,sftMany] then begin result := false; exit; // ignore unknown/virtual fields end; Column.DBType := mORMotType[Prop.SQLFieldTypeStored]; Column.Name := fStoredClassMapping^.ExtFieldNames[Prop.PropertyIndex]; if Column.DBType=ftUTF8 then Column.Width := Prop.FieldWidth else Column.Width := 0; Column.Unique := aIsUnique in Prop.Attributes; Column.PrimaryKey := false; result := true; end; var SQL: RawUTF8; i,f: integer; nfo: TSQLPropInfo; Field: TSQLDBColumnCreate; TableCreated,FieldAdded: Boolean; CreateColumns: TSQLDBColumnCreateDynArray; options: TSQLRecordPropertiesMappingOptions; log: TSynLog; procedure GetFields; begin fProperties.GetFields(UnQuotedSQLSymbolName(fTableName),fFieldsExternal); log.Log(sllDebug,'GetFields',TypeInfo(TSQLDBColumnDefineDynArray),fFieldsExternal,self); end; function FieldsExternalIndexOf(const ColName: RawUTF8): integer; begin if rpmMissingFieldNameCaseSensitive in options then begin for result := 0 to high(fFieldsExternal) do if fFieldsExternal[result].ColumnName=ColName then exit; end else for result := 0 to high(fFieldsExternal) do if IdemPropNameU(fFieldsExternal[result].ColumnName,ColName) then exit; result := -1; end; begin {$ifdef WITHLOG} log := Owner.LogClass.Add; log.Enter('Create %',[aClass],self); {$else} log := nil; {$endif} inherited Create(aClass,aServer); // initialize external DB properties options := fStoredClassMapping^.Options; fTableName := fStoredClassMapping^.TableName; fProperties := fStoredClassMapping^.ConnectionProperties as TSQLDBConnectionProperties; log.Log(sllInfo,'% as % % Server=%',[StoredClass,fTableName,fProperties,Owner],self); if fProperties=nil then raise EBusinessLayerException.CreateUTF8( '%.Create: no external DB defined for %',[self,StoredClass]); // ensure external field names are compatible with the external DB keywords for f := 0 to StoredClassRecordProps.Fields.Count-1 do begin nfo := StoredClassRecordProps.Fields.List[f]; if nfo.SQLFieldType in COPIABLE_FIELDS then begin // ignore sftMany SQL := fStoredClassMapping^.ExtFieldNames[f]; if rpmQuoteFieldName in options then fStoredClassMapping^.MapField(nfo.Name,'"'+SQL+'"') else if fProperties.IsSQLKeyword(SQL) then begin log.Log(sllWarning,'%.%: Field name % is not compatible with %', [fStoredClass,nfo.Name,SQL,fProperties.DBMSEngineName],self); if rpmAutoMapKeywordFields in options then begin log.Log(sllWarning,'-> %.% mapped to %_',[fStoredClass,nfo.Name,SQL],self); fStoredClassMapping^.MapField(nfo.Name,SQL+'_'); end else log.Log(sllWarning,'-> you should better use MapAutoKeywordFields',self); end; end; end; // create corresponding external table if necessary, and retrieve its fields info TableCreated := false; GetFields; if not (rpmNoCreateMissingTable in options) then if fFieldsExternal=nil then begin // table is not yet existing -> try to create it with aClass.RecordProps do begin SetLength(CreateColumns,Fields.Count+1); CreateColumns[0].Name := fStoredClassMapping^.RowIDFieldName; CreateColumns[0].DBType := ftInt64; CreateColumns[0].Unique := true; CreateColumns[0].NonNullable := true; CreateColumns[0].PrimaryKey := true; f := 1; for i := 0 to Fields.Count-1 do if PropInfoToExternalField(Fields.List[i],CreateColumns[f]) then inc(f); if f<>Length(CreateColumns) then SetLength(CreateColumns,f); // just ignore non handled field types end; SQL := fProperties.SQLCreate(fTableName,CreateColumns,false); if SQL<>'' then if ExecuteDirect(pointer(SQL),[],[],false)<>nil then begin GetFields; if fFieldsExternal=nil then raise EORMException.CreateUTF8('%.Create: external table creation % failed:'+ ' GetFields() returned nil - SQL="%"',[self,StoredClass,fTableName,SQL]); TableCreated := true; end; end; FieldsInternalInit; // create any missing field if necessary if not (rpmNoCreateMissingField in options) then if not TableCreated then begin FieldAdded := false; with StoredClassRecordProps do for f := 0 to Fields.Count-1 do if Fields.List[f].SQLFieldType in COPIABLE_FIELDS then // ignore sftMany /// real database columns exist for Simple + Blob fields (not Many) if FieldsExternalIndexOf(fStoredClassMapping^.ExtFieldNamesUnQuotedSQL[f])<0 then begin // add new missing Field Finalize(Field); FillcharFast(Field,sizeof(Field),0); if PropInfoToExternalField(Fields.List[f],Field) then begin SQL := fProperties.SQLAddColumn(fTableName,Field); if (SQL<>'') and (ExecuteDirect(pointer(SQL),[],[],false)<>nil) then FieldAdded := true else raise EORMException.CreateUTF8('%.Create: %: unable to create external '+ 'missing field %.% - SQL="%"', [self,StoredClass,fTableName,Fields.List[f].Name,SQL]); end; end; if FieldAdded then begin GetFields; // get from DB after ALTER TABLE FieldsInternalInit; end; end; // compute the SQL statements used internaly for external DB requests with fStoredClassMapping^ do begin fSelectOneDirectSQL := FormatUTF8('select % from % where %=?', [SQL.TableSimpleFields[true,false],fTableName,RowIDFieldName]); fSelectAllDirectSQL := FormatUTF8('select %,% from %', [SQL.InsertSet,RowIDFieldName,fTableName]); fRetrieveBlobFieldsSQL := InternalCSVToExternalCSV( StoredClassRecordProps.SQLTableRetrieveBlobFields); fUpdateBlobFieldsSQL := InternalCSVToExternalCSV( StoredClassRecordProps.SQLTableUpdateBlobFields,'=?,','=?'); end; fSelectTableHasRowsSQL := FormatUTF8('select ID from % limit 1', [StoredClassRecordProps.SQLTableName]); AdaptSQLForEngineList(fSelectTableHasRowsSQL); end; destructor TSQLRestStorageExternal.Destroy; begin inherited Destroy; end; function TSQLRestStorageExternal.AdaptSQLForEngineList(var SQL: RawUTF8): boolean; var Stmt: TSynTableStatement; W: TTextWriter; limit: TSQLDBDefinitionLimitClause; limitSQL,name: RawUTF8; f,n: integer; tmp: TTextWriterStackBuffer; begin result := false; if SQL='' then exit; Stmt := TSynTableStatement.Create(SQL,fStoredClassRecordProps.Fields.IndexByName, fStoredClassRecordProps.SimpleFieldsBits[soSelect]); try if (Stmt.SQLStatement='') or // parsing failed not IdemPropNameU(Stmt.TableName,fStoredClassRecordProps.SQLTableName) then begin InternalLog('AdaptSQLForEngineList: complex statement -> switch to '+ 'SQLite3 virtual engine - check efficiency',[],sllDebug); exit; end; if Stmt.Offset<>0 then begin InternalLog('AdaptSQLForEngineList: unsupported OFFSET for [%]', [SQL],sllWarning); exit; end; if Stmt.Limit=0 then limit.Position := posNone else begin limit := fProperties.SQLLimitClause(Stmt); if limit.Position=posNone then begin InternalLog('AdaptSQLForEngineList: unknown % LIMIT syntax for [%]', [ToText(fProperties.DBMS)^,SQL],sllWarning); exit; end; if limit.Position = posOuter then FormatUTF8(limit.InsertFmt,['%', Stmt.Limit],limitSQL) else FormatUTF8(limit.InsertFmt,[Stmt.Limit],limitSQL); end; W := TTextWriter.CreateOwnedStream(tmp); try W.AddShort('select '); if limit.Position=posSelect then W.AddString(limitSQL); for f := 0 to high(Stmt.Select) do with Stmt.Select[f] do begin if FunctionName<>'' then begin W.AddString(FunctionName); W.Add('('); end; if FunctionKnown=funcCountStar then W.Add('*') else begin W.AddString(fStoredClassMapping^.FieldNameByIndex(Field-1)); W.AddString(SubField); end; if FunctionName<>'' then W.Add(')'); if ToBeAdded<>0 then begin if ToBeAdded>0 then W.Add('+'); W.Add(ToBeAdded); end; if Alias<>'' then begin W.AddShort(' as '); W.AddString(Alias); end else if not (Field in fStoredClassMapping^.FieldNamesMatchInternal) then begin if Field=0 then name := 'ID' else // RowID may be reserved (e.g. for Oracle) name := fStoredClassRecordProps.Fields.List[Field-1].Name; W.AddShort(' as '); if (FunctionName='') or (FunctionKnown in [funcDistinct,funcMax]) then W.AddString(name) else begin W.Add('"'); W.AddString(FunctionName); W.Add('('); W.AddString(name); W.Add(')','"'); end; end; W.Add(','); end; W.CancelLastComma; W.AddShort(' from '); W.AddString(fTableName); n := length(Stmt.Where); if n=0 then begin if limit.Position=posWhere then begin W.AddShort(' where '); W.AddString(limitSQL); end; end else begin dec(n); W.AddShort(' where '); if limit.Position=posWhere then begin W.AddString(limitSQL); W.AddShort(' and '); end; for f := 0 to n do with Stmt.Where[f] do begin if (FunctionName<>'') or (Operator>high(DB_SQLOPERATOR)) then begin InternalLog('AdaptSQLForEngineList: unsupported function %() for [%]', [FunctionName,SQL],sllWarning); exit; end; if f>0 then if JoinedOR then W.AddShort(' or ') else W.AddShort(' and '); if NotClause then W.AddShort('not '); if ParenthesisBefore<>'' then W.AddString(ParenthesisBefore); W.AddString(fStoredClassMapping^.FieldNameByIndex(Field-1)); W.AddString(SubField); W.AddString(DB_SQLOPERATOR[Operator]); if not (Operator in [opIsNull, opIsNotNull]) then W.AddNoJSONEscape(ValueSQL,ValueSQLLen); if ParenthesisAfter<>'' then W.AddString(ParenthesisAfter); end; end; if Stmt.GroupByField<>nil then begin W.AddShort(' group by '); for f := 0 to high(Stmt.GroupByField) do begin W.AddString(fStoredClassMapping^.FieldNameByIndex(Stmt.GroupByField[f]-1)); W.Add(','); end; W.CancelLastComma; end; if Stmt.OrderByField<>nil then begin W.AddShort(' order by '); for f := 0 to high(Stmt.OrderByField) do begin W.AddString(fStoredClassMapping^.FieldNameByIndex(Stmt.OrderByField[f]-1)); W.Add(','); end; W.CancelLastComma; if Stmt.OrderByDesc then W.AddShort(' desc'); end; if limit.Position=posAfter then W.AddString(limitSQL); W.SetText(SQL); if limit.Position=posOuter then SQL := FormatUTF8(limitSQL,[SQL]); result := true; finally W.Free; end; finally Stmt.Free; end; end; function TSQLRestStorageExternal.EngineLockedNextID: TID; procedure RetrieveFromDB; // fProperties.SQLCreate: ID Int64 PRIMARY KEY -> compute unique RowID // (not all DB engines handle autoincrement feature - e.g. Oracle does not) var rows: ISQLDBRows; begin rows := ExecuteDirect('select max(%) from %', [fStoredClassMapping^.RowIDFieldName,fTableName],[],true); if (rows<>nil) and rows.Step then fEngineLockedMaxID := rows.ColumnInt(0) else fEngineLockedMaxID := 0; end; var handled: boolean; begin if fEngineAddForcedID<>0 then begin result := fEngineAddForcedID; exit; end; if Assigned(fOnEngineAddComputeID) then begin result := fOnEngineAddComputeID(self,handled); if handled then exit; end; if (fEngineLockedMaxID=0) or EngineAddUseSelectMaxID then RetrieveFromDB; inc(fEngineLockedMaxID); result := fEngineLockedMaxID; end; function TSQLRestStorageExternal.InternalBatchStart( Method: TSQLURIMethod; BatchOptions: TSQLRestBatchOptions): boolean; const BATCH: array[mPOST..mDELETE] of TSQLDBStatementCRUD = ( cCreate, cUpdate, cDelete); begin result := false; // means BATCH mode not supported if (self<>nil) and (method in [mPOST..mDELETE]) and (BATCH[method] in fProperties.BatchSendingAbilities) then begin StorageLock(true,'InternalBatchStart'); // protected by try..finally in TSQLRestServer.RunBatch try if fBatchMethod<>mNone then raise EORMException.CreateUTF8('Missing previous %.InternalBatchStop(%)', [self,StoredClass]); fBatchMethod := Method; fBatchCount := 0; result := true; // means BATCH mode is supported finally if not result then StorageUnLock; end; end; end; procedure TSQLRestStorageExternal.InternalBatchStop; var i,j,n,max,BatchBegin,BatchEnd,ValuesMax: integer; Query: ISQLDBStatement; NotifySQLEvent: TSQLEvent; SQL: RawUTF8; P: PUTF8Char; Fields, ExternalFields: TRawUTF8DynArray; Types: TSQLDBFieldTypeArray; Values: TRawUTF8DynArrayDynArray; Occasion: TSQLOccasion; Decode: TJSONObjectDecoder; tmp: TSynTempBuffer; begin if fBatchMethod=mNone then raise EORMException.CreateUTF8('%.InternalBatchStop(%).BatchMethod=mNone', [self,StoredClass]); try if fBatchCount=0 then exit; // nothing to do if (Owner<>nil) and (fBatchMethod=mDelete) then // notify BEFORE deletion for i := 0 to fBatchCount-1 do Owner.InternalUpdateEvent(seDelete,fStoredClassProps.TableIndex,fBatchIDs[i],'',nil); with fProperties do if BatchMaxSentAtOnce>0 then max := BatchMaxSentAtOnce else max := 1000; BatchBegin := 0; BatchEnd := fBatchCount-1; repeat case fBatchMethod of mPost, mPut: begin assert(fBatchIDs<>nil); BatchEnd := fBatchCount-1; for i := BatchBegin to BatchEnd do begin tmp.Init(fBatchValues[i]); try P := tmp.buf; while P^ in [#1..' ','{','['] do inc(P); if fBatchMethod=mPost then Occasion := soInsert else Occasion := soUpdate; case Occasion of soInsert: // mPost=INSERT with the supplied fields and computed ID Decode.Decode(P,nil,pQuoted,fBatchIDs[i],true); soUpdate: // mPut=UPDATE with the supplied fields and ID set appart Decode.Decode(P,nil,pQuoted,0,true); end; RecordVersionFieldHandle(Occasion,Decode); if Fields=nil then begin Decode.AssignFieldNamesTo(Fields); SQL := JSONDecodedPrepareToSQL( Decode,ExternalFields,Types,Occasion,[],{array=}true); SetLength(Values,Decode.FieldCount); ValuesMax := fBatchCount-BatchBegin; if ValuesMax>max then ValuesMax := max; for j := 0 to Decode.FieldCount-1 do SetLength(Values[j],ValuesMax); end else if not Decode.SameFieldNames(Fields) then break; // this item would break the SQL statement n := i-BatchBegin; for j := 0 to high(Fields) do Values[j,n] := Decode.FieldValues[j]; // regroup by parameter if Occasion=soUpdate then // ?=ID parameter Values[length(Fields),n] := Int64ToUtf8(fBatchIDs[i]); // D2007 fails with var BatchEnd := i; // mark fBatchValues[i] has to be copied in Values[] if n+1>=max then break; // do not send too much items at once, for better speed finally tmp.Done; end; end; end; mDelete: begin if cPostgreBulkArray in fProperties.BatchSendingAbilities then // for SynDBPostgres array binding SQL := 'delete from % where %=ANY(?)' else // regular SQL SQL := 'delete from % where %=?'; SQL := FormatUTF8(SQL,[fTableName,fStoredClassMapping^.RowIDFieldName]); n := BatchEnd-BatchBegin+1; if n+1>=max then begin n := max; // do not send too much items at once, for better speed BatchEnd := BatchBegin+max-1; end; SetLength(Values,1); SetLength(Values[0],n); for i := 0 to n-1 do Values[0,i] := Int64ToUTF8(fBatchIDs[BatchBegin+i]); // var fails on D2007 end; end; n := BatchEnd-BatchBegin+1; if n<=0 then break; try if (fBatchMethod=mPost) and Assigned(fProperties.OnBatchInsert) then // use multiple insert dedicated function if available fProperties.OnBatchInsert( fProperties,fTableName,ExternalFields,Types,n,Values) else begin // use array binding Query := fProperties.NewThreadSafeStatementPrepared(SQL,{results=}false,{except=}true); case fBatchMethod of mPost, mPut: for i := 0 to high(Values) do Query.BindArray(i+1,Types[i],Values[i],n); mDelete: Query.BindArray(1,ftInt64,Values[0],n); end; Query.ExecutePrepared; Query.ReleaseRows; Query := nil; end; except Query := nil; HandleClearPoolOnConnectionIssue; raise; end; if Owner<>nil then begin // add/update/delete should flush DB cache Owner.FlushInternalDBCache; // force deletion coherency if fBatchMethod=mDelete then for i := 0 to high(Values) do Owner.AfterDeleteForceCoherency( fStoredClassProps.TableIndex,GetInt64(pointer(Values[i]))); end; Fields := nil; // force new sending block BatchBegin := BatchEnd+1; until BatchBegin>=fBatchCount; if Owner<>nil then begin if fBatchMethod in [mPost,mPut] then begin if fBatchMethod=mPost then NotifySQLEvent := seAdd else NotifySQLEvent := seUpdate; for i := 0 to fBatchCount-1 do Owner.InternalUpdateEvent(NotifySQLEvent,fStoredClassProps.TableIndex, fBatchIDs[i],fBatchValues[i],nil); end; Owner.FlushInternalDBCache; end; finally fBatchValues := nil; fBatchIDs := nil; fBatchCount := 0; fBatchCapacity := 0; fBatchMethod := mNone; StorageUnLock; end; end; procedure TSQLRestStorageExternal.InternalBatchAdd( const aValue: RawUTF8; const aID: TID); begin if fBatchCount>=fBatchCapacity then begin fBatchCapacity := fBatchCapacity+64+fBatchCount shr 3; SetLength(fBatchIDs,fBatchCapacity); if aValue<>'' then SetLength(fBatchValues,fBatchCapacity); end; if aValue<>'' then fBatchValues[fBatchCount] := aValue; fBatchIDs[fBatchCount] := aID; inc(fBatchCount); end; function TSQLRestStorageExternal.EngineAdd(TableModelIndex: integer; const SentData: RawUTF8): TID; begin if (TableModelIndex<0) or (fModel.Tables[TableModelIndex]<>fStoredClass) then result := 0 else // avoid GPF if fBatchMethod<>mNone then if fBatchMethod<>mPOST then result := 0 else begin if not JSONGetID(pointer(SentData),result) then result := EngineLockedNextID else if result>fEngineLockedMaxID then fEngineLockedMaxID := result; InternalBatchAdd(SentData,result); end else begin result := ExecuteFromJSON(SentData,soInsert,0); // UpdatedID=0 -> insert with EngineLockedNextID if (result>0) and (Owner<>nil) then begin if EngineAddForcedID=0 then // only worth it if result is a true ID Owner.InternalUpdateEvent(seAdd,TableModelIndex,result,SentData,nil); Owner.FlushInternalDBCache; end; end; end; function TSQLRestStorageExternal.EngineUpdate(TableModelIndex: integer; ID: TID; const SentData: RawUTF8): boolean; begin if (ID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else if fBatchMethod<>mNone then if fBatchMethod<>mPUT then result := false else begin InternalBatchAdd(SentData,ID); result := true; end else begin result := ExecuteFromJSON(SentData,soUpdate,ID)=ID; if result and (Owner<>nil) then begin Owner.InternalUpdateEvent(seUpdate,TableModelIndex,ID,SentData,nil); Owner.FlushInternalDBCache; end; end; end; function TSQLRestStorageExternal.EngineDelete(TableModelIndex: integer; ID: TID): boolean; begin if (ID<=0) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else if fBatchMethod<>mNone then if fBatchMethod<>mDELETE then result := false else begin InternalBatchAdd('',ID); result := true; end else begin if Owner<>nil then // notify BEFORE deletion Owner.InternalUpdateEvent(seDelete,TableModelIndex,ID,'',nil); result := ExecuteDirect('delete from % where %=?', [fTableName,fStoredClassMapping^.RowIDFieldName],[ID],false)<>nil; if result and (Owner<>nil) then Owner.FlushInternalDBCache; end; end; function TSQLRestStorageExternal.EngineDeleteWhere(TableModelIndex: integer; const SQLWhere: RawUTF8; const IDs: TIDDynArray): boolean; const CHUNK_SIZE = 200; var i,n,chunk,pos: integer; rowid: RawUTF8; begin result := false; if (IDs=nil) or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then exit; n := length(IDs); if fBatchMethod<>mNone then if fBatchMethod<>mDELETE then exit else for i := 0 to n-1 do InternalBatchAdd('',IDs[i]) else begin if Owner<>nil then // notify BEFORE deletion for i := 0 to n-1 do Owner.InternalUpdateEvent(seDelete,TableModelIndex,IDs[i],'',nil); rowid := fStoredClassMapping^.RowIDFieldName; pos := 0; repeat // delete by chunks using primary key chunk := n-pos; if chunk=0 then break; if chunk>CHUNK_SIZE then chunk := CHUNK_SIZE; if ExecuteInlined('delete from % where % in (%)',[fTableName,rowid, Int64DynArrayToCSV(pointer(@IDs[pos]),chunk)],false)=nil then exit; inc(pos,chunk); until false; if Owner<>nil then Owner.FlushInternalDBCache; end; result := true; end; function TSQLRestStorageExternal.EngineList(const SQL: RawUTF8; ForceAJAX: Boolean; ReturnedRowCount: PPtrInt): RawUTF8; var Stmt: ISQLDBStatement; begin result := ''; if ReturnedRowCount<>nil then raise ESQLDBException.CreateUTF8('%.EngineList(ReturnedRowCount<>nil) for %', [self,StoredClass]); Stmt := PrepareInlinedForRows(SQL); if Stmt<>nil then try Stmt.ExecutePreparedAndFetchAllAsJSON( ForceAJAX or (Owner=nil) or not Owner.NoAJAXJSON, result); except Stmt := nil; HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.EngineRetrieve(TableModelIndex: integer; ID: TID): RawUTF8; var Stmt: ISQLDBStatement; begin // TableModelIndex is not useful here result := ''; if (self=nil) or (ID<=0) then exit; Stmt := PrepareDirectForRows(pointer(fSelectOneDirectSQL),[],[ID]); if Stmt<>nil then try Stmt.ExecutePreparedAndFetchAllAsJSON(true,result); // Expanded=true -> '[{"ID":10,...}]'#10 if IsNotAjaxJSON(pointer(result)) then // '{"fieldCount":2,"values":["ID","FirstName"]}'#$A -> ID not found result := '' else // list '[{...}]'#10 -> object '{...}' result := copy(result,2,length(result)-3); except Stmt := nil; HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.EngineExecute(const aSQL: RawUTF8): boolean; begin if aSQL='' then result := false else result := ExecuteInlined(aSQL,false)<>nil; end; function TSQLRestStorageExternal.TableHasRows(Table: TSQLRecordClass): boolean; var rows: ISQLDBRows; begin if (self=nil) or (Table<>fStoredClass) then result := false else begin rows := ExecuteDirect(pointer(fSelectTableHasRowsSQL),[],[],true); if rows=nil then result := false else result := rows.Step; end; end; function TSQLRestStorageExternal.TableRowCount(Table: TSQLRecordClass): Int64; var rows: ISQLDBRows; begin if (self=nil) or (Table<>fStoredClass) then result := 0 else begin rows := ExecuteDirect('select count(*) from %',[fTableName],[],true); if (rows=nil) or not rows.Step then result := 0 else result := rows.ColumnInt(0); end; end; function TSQLRestStorageExternal.EngineRetrieveBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; out BlobData: TSQLRawBlob): boolean; var rows: ISQLDBRows; begin result := false; if (aID<=0) or not BlobField^.IsBlob or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then exit; with fStoredClassMapping^ do rows := ExecuteDirect('select % from % where %=?',[InternalToExternal(BlobField^.Name), fTableName,RowIDFieldName],[aID],{results=}true); if (rows<>nil) and rows.Step then try BlobData := rows.ColumnBlob(0); rows.ReleaseRows; rows := nil; result := true; // success except rows := nil; HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.RetrieveBlobFields(Value: TSQLRecord): boolean; var rows: ISQLDBRows; f: Integer; data: TSQLVar; temp: RawByteString; begin result := false; if (Value<>nil) and (Value.ID>0) and (PSQLRecordClass(Value)^=fStoredClass) then with Value.RecordProps do if BlobFields<>nil then begin rows := ExecuteDirect('select % from % where %=?', [fRetrieveBlobFieldsSQL,fTableName,fStoredClassMapping^.RowIDFieldName], [Value.ID],true); if (rows<>nil) and rows.Step then try for f := 0 to High(BlobFields) do begin rows.ColumnToSQLVar(f,data,temp); BlobFields[f].SetFieldSQLVar(Value,data); end; rows.ReleaseRows; rows := nil; result := true; // success except HandleClearPoolOnConnectionIssue; end; end; end; function TSQLRestStorageExternal.EngineUpdateField(TableModelIndex: integer; const SetFieldName, SetValue, WhereFieldName, WhereValue: RawUTF8): boolean; var rows: ISQLDBRows; ExtWhereFieldName, JSON: RawUTF8; begin if (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then result := false else with fStoredClassMapping^ do begin ExtWhereFieldName := InternalToExternal(WhereFieldName); result := ExecuteInlined('update % set %=:(%): where %=:(%):', [fTableName,InternalToExternal(SetFieldName),SetValue, ExtWhereFieldName,WhereValue],false)<>nil; if result and (Owner<>nil) then begin if Owner.InternalUpdateEventNeeded(TableModelIndex) then begin rows := ExecuteInlined('select % from % where %=:(%):', [RowIDFieldName,fTableName,ExtWhereFieldName,WhereValue],true); if rows=nil then exit; JSONEncodeNameSQLValue(SetFieldName,SetValue,JSON); while rows.Step do Owner.InternalUpdateEvent(seUpdate,TableModelIndex,rows.ColumnInt(0),JSON,nil); rows.ReleaseRows; end; Owner.FlushInternalDBCache; end; end; end; function TSQLRestStorageExternal.EngineUpdateFieldIncrement(TableModelIndex: integer; ID: TID; const FieldName: RawUTF8; Increment: Int64): boolean; var extField: RawUTF8; 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 with fStoredClassMapping^ do begin extField := InternalToExternal(FieldName); result := ExecuteInlined('update % set %=%+:(%): where %=:(%):', [fTableName,extField,extField,Increment,RowIDFieldName,ID],false)<>nil; end; if result and (Owner<>nil) then Owner.FlushInternalDBCache; except HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.EngineUpdateBlob(TableModelIndex: integer; aID: TID; BlobField: PPropInfo; const BlobData: TSQLRawBlob): boolean; var Statement: ISQLDBStatement; AffectedField: TSQLFieldBits; begin result := false; if (aID<=0) or not BlobField^.IsBlob or (TableModelIndex<0) or (Model.Tables[TableModelIndex]<>fStoredClass) then exit; try if Owner<>nil then Owner.FlushInternalDBCache; with fStoredClassMapping^ do Statement := fProperties.NewThreadSafeStatementPrepared( 'update % set %=? where %=?',[fTableName,InternalToExternal(BlobField^.Name), RowIDFieldName],{results=}false,{except=}true); if Statement<>nil then begin if BlobData='' then Statement.BindNull(1) else Statement.BindBlob(1,BlobData); // fast explicit BindBlob() call Statement.Bind(2,aID); Statement.ExecutePrepared; if Owner<>nil then begin fStoredClassRecordProps.FieldBitsFromBlobField(BlobField,AffectedField); Owner.InternalUpdateEvent(seUpdateBlob,TableModelIndex,aID,'',@AffectedField); Owner.FlushInternalDBCache; end; result := true; // success end; except Statement := nil; HandleClearPoolOnConnectionIssue; // leave result=false to notify error end; end; function TSQLRestStorageExternal.UpdateBlobFields(Value: TSQLRecord): boolean; var f: integer; aID: TID; temp: array of RawByteString; Params: TSQLVarDynArray; begin result := false; if (Value<>nil) and (PSQLRecordClass(Value)^=fStoredClass) then with Value.RecordProps do if BlobFields<>nil then begin aID := Value.ID; if aID<=0 then exit; if Owner<>nil then Owner.FlushInternalDBCache; SetLength(Params,length(BlobFields)); SetLength(temp,length(BlobFields)); for f := 0 to high(Params) do BlobFields[f].GetFieldSQLVar(Value,Params[f],temp[f]); result := ExecuteDirectSQLVar('update % set % where %=?', [fTableName,fUpdateBlobFieldsSQL,fStoredClassMapping^.RowIDFieldName], Params,aID,false); if result and (Owner<>nil) then begin Owner.InternalUpdateEvent(seUpdateBlob,fStoredClassProps.TableIndex,aID,'', @fStoredClassRecordProps.FieldBits[sftBlob]); Owner.FlushInternalDBCache; end; end else result := true; // as TSQLRest.UpdateblobFields() end; function TSQLRestStorageExternal.PrepareInlinedForRows(const aSQL: RawUTF8): ISQLDBStatement; var stmt: ISQLDBStatement; begin result := nil; // returns nil interface on error if self=nil then exit; try stmt := fProperties.PrepareInlined(aSQL,true); if (stmt<>nil) and (sftDateTimeMS in fStoredClassRecordProps.HasTypeFields) then stmt.ForceDateWithMS := true; result := stmt; except stmt := nil; HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.ExecuteInlined(const aSQL: RawUTF8; ExpectResults: Boolean): ISQLDBRows; var stmt: ISQLDBStatement; begin result := nil; // returns nil interface on error if self=nil then exit; if not ExpectResults and (Owner<>nil) then Owner.FlushInternalDBCache; // add/update/delete should flush DB cache try stmt := fProperties.PrepareInlined(aSQL,ExpectResults); if stmt=nil then exit; if ExpectResults and (sftDateTimeMS in fStoredClassRecordProps.HasTypeFields) then stmt.ForceDateWithMS := true; stmt.ExecutePrepared; if not ExpectResults then stmt.ReleaseRows; result := stmt; except stmt := nil; HandleClearPoolOnConnectionIssue; // leave result=nil to notify error end; end; function TSQLRestStorageExternal.ExecuteInlined(SQLFormat: PUTF8Char; const Args: array of const; ExpectResults: Boolean): ISQLDBRows; begin result := ExecuteInlined(FormatUTF8(SQLFormat,Args),ExpectResults); end; function TSQLRestStorageExternal.PrepareDirectForRows(SQLFormat: PUTF8Char; const Args, Params: array of const): ISQLDBStatement; var stmt: ISQLDBStatement; begin result := nil; if self<>nil then try stmt := fProperties.NewThreadSafeStatementPrepared(SQLFormat,Args,{results=}true,{except=}true); if stmt=nil then exit; stmt.Bind(Params); if sftDateTimeMS in fStoredClassRecordProps.HasTypeFields then stmt.ForceDateWithMS := true; result := stmt; except stmt := nil; HandleClearPoolOnConnectionIssue; end; end; function TSQLRestStorageExternal.ExecuteDirect(SQLFormat: PUTF8Char; const Args, Params: array of const; ExpectResults: Boolean): ISQLDBRows; var stmt: ISQLDBStatement; begin result := nil; if self=nil then exit; if not ExpectResults and (Owner<>nil) then Owner.FlushInternalDBCache; // add/update/delete should flush DB cache try stmt := fProperties.NewThreadSafeStatementPrepared(SQLFormat,Args,ExpectResults,{except=}true); stmt.Bind(Params); if ExpectResults and (sftDateTimeMS in fStoredClassRecordProps.HasTypeFields) then stmt.ForceDateWithMS := true; stmt.ExecutePrepared; if IdemPChar(SQLFormat, 'DROP TABLE ') then begin fEngineLockedMaxID := 0; end; result := stmt; except stmt := nil; HandleClearPoolOnConnectionIssue; // leave result=nil to notify error end; end; function TSQLRestStorageExternal.ExecuteDirectSQLVar(SQLFormat: PUTF8Char; const Args: array of const; var Params: TSQLVarDynArray; const LastIntegerParam: Int64; ParamsMatchCopiableFields: boolean): boolean; var stmt: ISQLDBStatement; ParamsCount, f: integer; begin result := false; if Self<>nil then try stmt := fProperties.NewThreadSafeStatementPrepared(SQLFormat,Args,{results=}false,{except=}true); if stmt=nil then exit; ParamsCount := length(Params); if ParamsMatchCopiableFields and (ParamsCount<>Length(fStoredClassRecordProps.CopiableFields)) then raise EORMException.CreateUTF8('%.ExecuteDirectSQLVar(ParamsMatchCopiableFields) for %', [self,StoredClass]); for f := 0 to ParamsCount-1 do if ParamsMatchCopiableFields and (fStoredClassRecordProps.CopiableFields[f].SQLFieldTypeStored in [sftDateTime,sftDateTimeMS]) and (Params[f].VType=ftUTF8) then stmt.BindDateTime(f+1,Iso8601ToDateTimePUTF8Char(Params[f].VText)) else stmt.Bind(f+1,Params[f]); if LastIntegerParam<>0 then stmt.Bind(ParamsCount+1,LastIntegerParam); stmt.ExecutePrepared; result := true; except stmt := nil; HandleClearPoolOnConnectionIssue; // leave result=false to notify error end; end; function TSQLRestStorageExternal.EngineSearchField(const FieldName: ShortString; const FieldValue: array of const; out ResultID: TIDDynArray): boolean; var n: Integer; rows: ISQLDBRows; begin result := false; try n := 0; rows := ExecuteDirect('select % from % where %=?', [fStoredClassMapping^.RowIDFieldName,fTableName,FieldName],FieldValue,true); if rows<>nil then begin while rows.Step do AddInt64(TInt64DynArray(ResultID),n,rows.ColumnInt(0)); rows.ReleaseRows; end; SetLength(ResultID,n); result := n>0; except rows := nil; HandleClearPoolOnConnectionIssue; // leave result=false to notify error end; end; function TSQLRestStorageExternal.SearchField(const FieldName: RawUTF8; FieldValue: Int64; out ResultID: TIDDynArray): boolean; begin result := EngineSearchField(FieldName,[FieldValue],ResultID); end; function TSQLRestStorageExternal.SearchField(const FieldName, FieldValue: RawUTF8; out ResultID: TIDDynArray): boolean; begin result := EngineSearchField(FieldName,[FieldValue],ResultID); end; function TSQLRestStorageExternal.TransactionBegin( aTable: TSQLRecordClass; SessionID: cardinal): boolean; begin if (aTable=fStoredClass) and inherited TransactionBegin(aTable,SessionID) then result := fProperties.SharedTransaction(SessionID,transBegin)<>nil else result := false; end; procedure TSQLRestStorageExternal.Commit(SessionID: cardinal; RaiseException: boolean); const ACTION: array[boolean] of TSQLDBSharedTransactionAction = ( transCommitWithoutException, transCommitWithException); begin inherited Commit(SessionID,RaiseException); // reset fTransactionActive + write all TSQLVirtualTableJSON fProperties.SharedTransaction(SessionID,ACTION[RaiseException]); end; procedure TSQLRestStorageExternal.RollBack(SessionID: cardinal); begin inherited RollBack(SessionID); // reset fTransactionActive fProperties.SharedTransaction(SessionID,transRollback); end; function TSQLRestStorageExternal.CreateSQLMultiIndex( Table: TSQLRecordClass; const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8): boolean; var SQL: RawUTF8; ExtFieldNames: TRawUTF8DynArray; IntFieldIndex: TIntegerDynArray; Descending: boolean; i,n,extfield: integer; begin result := false; Descending := false; n := length(FieldNames); if (self=nil) or (fProperties=nil) or (Table<>fStoredClass) or (n<=0) then exit; fStoredClassMapping^.InternalToExternalDynArray(FieldNames,ExtFieldNames,@IntFieldIndex); if n=1 then begin // handle case of index over a single column if IntFieldIndex[0]<0 then // ID/RowID? case fProperties.DBMS of dSQLite, // SQLite3 always generates an index for ID/RowID dPostgreSQL,dMSSQL,dMySQL,dOracle,dNexusDB: begin // as most DB on primary key result := true; exit; end; dFirebird: // see http://www.firebirdfaq.org/faq205 Descending := true; end; if not Descending then begin // we identify just if indexed, not the order extfield := fFieldsInternalToExternal[IntFieldIndex[0]+1]; if (extfield>=0) and (fFieldsExternal[extfield].ColumnIndexed) then begin result := true; // column already indexed exit; end; end; end; if not (fProperties.DBMS in DB_HANDLEINDEXONBLOBS) then // BLOB fields cannot be indexed (only in SQLite3+PostgreSQL) for i := 0 to n-1 do begin extfield := fFieldsInternalToExternal[IntFieldIndex[i]+1]; if (extfield>=0) and (fFieldsExternal[extfield].ColumnType in [ftBlob,ftUTF8]) and (fFieldsExternal[extfield].ColumnLength<=0) then begin if i=0 then exit; // impossible to create an index with no field! SetLength(ExtFieldNames,i); // truncate index to the last indexable field break; end; end; SQL := fProperties.SQLAddIndex(fTableName,ExtFieldNames,Unique,Descending,IndexName); if (SQL='') or (ExecuteDirect(pointer(SQL),[],[],false)=nil) then exit; result := true; extfield := fFieldsInternalToExternal[IntFieldIndex[0]+1]; if extfield>=0 then // mark first column as indexed by now fFieldsExternal[extfield].ColumnIndexed := true; end; class function TSQLRestStorageExternal.Instance( aClass: TSQLRecordClass; aServer: TSQLRestServer): TSQLRestStorageExternal; begin if (aClass=nil) or (aServer=nil) then result := nil else begin result := TSQLRestStorageExternal(aServer.StaticVirtualTable[aClass]); if result<>nil then if not result.InheritsFrom(TSQLRestStorageExternal) then result := nil; end; end; class function TSQLRestStorageExternal.ConnectionProperties( aClass: TSQLRecordClass; aServer: TSQLRestServer): TSQLDBConnectionProperties; begin result := Instance(aClass,aServer).GetConnectionProperties; end; function TSQLRestStorageExternal.GetConnectionProperties: TSQLDBConnectionProperties; begin if self=nil then result := nil else result := fProperties; end; function TSQLRestStorageExternal.HandleClearPoolOnConnectionIssue: boolean; var conn: TSQLDBConnection; begin result := false; if (self<>nil) and (fStoredClassMapping<>nil) and (rpmClearPoolOnConnectionIssue in fStoredClassMapping.Options) then begin conn := fProperties.ThreadSafeConnection; if conn.LastErrorWasAboutConnection then begin InternalLog('HandleClearPoolOnConnectionIssue: ClearConnectionPool after %', [conn.LastErrorException],sllDB); fProperties.ClearConnectionPool; result := true; end; end; end; function TSQLRestStorageExternal.ExecuteFromJSON( const SentData: RawUTF8; Occasion: TSQLOccasion; UpdatedID: TID): TID; var Decoder: TJSONObjectDecoder; SQL: RawUTF8; Types: TSQLDBFieldTypeArray; ExternalFields: TRawUTF8DynArray; InsertedID: TID; F: integer; stmt: ISQLDBStatement; begin result := 0; StorageLock(false,'ExecuteFromJson'); // avoid race condition against max(ID) try case Occasion of soInsert: if not JSONGetID(pointer(SentData),InsertedID) then // no specified "ID":... field value -> compute next InsertedID := EngineLockedNextID else if InsertedID>fEngineLockedMaxID then fEngineLockedMaxID := InsertedID; soUpdate: if UpdatedID<>0 then InsertedID := 0 else raise ESQLDBException.CreateUTF8('%.ExecuteFromJSON(%,soUpdate,UpdatedID=%)', [self,StoredClass,UpdatedID]); else raise ESQLDBException.CreateUTF8('%.ExecuteFromJSON(%,Occasion=%)?', [self,StoredClass,ToText(Occasion)^]); end; // decode fields if (fEngineAddForcedID<>0) and (InsertedID=fEngineAddForcedID) then Decoder.Decode(SentData,nil,pNonQuoted,0,true) else Decoder.Decode(SentData,nil,pNonQuoted,InsertedID,true); if (Decoder.FieldCount=0) and (Occasion=soUpdate) then begin result := UpdatedID; // SentData='' -> no column to update exit; end; RecordVersionFieldHandle(Occasion,Decoder); // compute SQL statement and associated bound parameters SQL := JSONDecodedPrepareToSQL( Decoder,ExternalFields,Types,Occasion,[],{array=}false); if Occasion=soUpdate then // Int64ToUTF8(var) fails on D2007 Decoder.FieldValues[Decoder.FieldCount-1] := Int64ToUTF8(UpdatedID); // execute statement try stmt := fProperties.NewThreadSafeStatementPrepared(SQL,{results=}false,{except=}true); if stmt=nil then exit; for F := 0 to Decoder.FieldCount-1 do if Decoder.FieldTypeApproximation[F]=ftaNull then stmt.BindNull(F+1) else stmt.Bind(F+1,Types[F],Decoder.FieldValues[F],true); stmt.ExecutePrepared; except stmt := nil; HandleClearPoolOnConnectionIssue; exit; // leave result=0 end; // mark success if UpdatedID=0 then result := InsertedID else result := UpdatedID; finally StorageUnLock; end; end; procedure TSQLRestStorageExternal.EndCurrentThread(Sender: TThread); begin if fProperties.InheritsFrom(TSQLDBConnectionPropertiesThreadSafe) then TSQLDBConnectionPropertiesThreadSafe(fProperties).EndCurrentThread; end; function TSQLRestStorageExternal.InternalFieldNameToFieldExternalIndex( const InternalFieldName: RawUTF8): integer; begin result := fStoredClassRecordProps.Fields.IndexByNameOrExcept(InternalFieldName); result := fFieldsInternalToExternal[result+1]; end; function TSQLRestStorageExternal.JSONDecodedPrepareToSQL( var Decoder: TJSONObjectDecoder; out ExternalFields: TRawUTF8DynArray; out Types: TSQLDBFieldTypeArray; Occasion: TSQLOccasion; BatchOptions: TSQLRestBatchOptions; BoundArray: boolean): RawUTF8; var f,k: Integer; begin SetLength(ExternalFields,Decoder.FieldCount); for f := 0 to Decoder.FieldCount-1 do begin k := fStoredClassRecordProps.Fields.IndexByNameOrExcept(Decoder.FieldNames[f]); ExternalFields[f] := fStoredClassMapping^.FieldNameByIndex(k); k := fFieldsInternalToExternal[k+1]; // retrieve exact Types[f] from SynDB if k<0 then raise ESQLDBException.CreateUTF8( '%.JSONDecodedPrepareToSQL(%): No column for [%] field in table %', [self,StoredClass,Decoder.FieldNames[f],fTableName]); Types[f] := fFieldsExternal[k].ColumnType; end; // compute SQL statement and associated bound parameters Decoder.DecodedFieldNames := pointer(ExternalFields); if BoundArray and (cPostgreBulkArray in fProperties.BatchSendingAbilities) then // SynDBPostgres array binding e.g. via 'insert into ... values (unnest...)' Decoder.DecodedFieldTypesToUnnest := @Types; result := Decoder.EncodeAsSQLPrepared(fTableName,Occasion, fStoredClassMapping^.RowIDFieldName,BatchOptions); if Occasion=soUpdate then if Decoder.FieldCount=MAX_SQLFIELDS then raise EParsingException.CreateUTF8('Too many fields for '+ '%.JSONDecodedPrepareToSQL',[self]) else begin Types[Decoder.FieldCount] := ftInt64; // add "where ID=?" parameter inc(Decoder.FieldCount); end; end; procedure TSQLRestStorageExternal.EngineAddForceSelectMaxID; begin StorageLock(true,'EngineAddForceSelectMaxID'); fEngineLockedMaxID := 0; StorageUnLock; end; const SQL_OPER_WITH_PARAM: array[soEqualTo..soGreaterThanOrEqualTo] of RawUTF8 = ( '=?','<>?','?','>=?'); function TSQLRestStorageExternal.ComputeSQL( const Prepared: TSQLVirtualTablePrepared): RawUTF8; var i: integer; constraint: PSQLVirtualTablePreparedConstraint; {$ifdef SQLVIRTUALLOGS} log: RawUTF8; {$endif} begin result := fSelectAllDirectSQL; for i := 0 to Prepared.WhereCount-1 do begin constraint := @Prepared.Where[i]; {$ifdef SQLVIRTUALLOGS} log := FormatUTF8('% [column=% oper=%]', [log,constraint^.Column,ToText(constraint^.Operation)^]); {$endif} if constraint^.Operation>high(SQL_OPER_WITH_PARAM) then exit; // invalid specified operator -> abort search if i=0 then result := result+' where ' else result := result+' and '; if fStoredClassMapping^.AppendFieldName(constraint^.Column,result) then exit; // invalid column index -> abort search result := result+SQL_OPER_WITH_PARAM[constraint^.Operation]; end; // e.g. 'select FirstName,..,ID from PeopleExternal where FirstName=? and LastName=?' for i := 0 to Prepared.OrderByCount-1 do with Prepared.OrderBy[i] do begin if i=0 then result := result+' order by ' else result := result+', '; if fStoredClassMapping^.AppendFieldName(Column,result) then exit; // invalid column index -> abort search if Desc then result := result+' desc'; end; {$ifdef SQLVIRTUALLOGS} SQLite3Log.Add.Log(sllDebug,'%.ComputeSQL [%] %',[ClassType,result,log],self); {$endif} end; { TSQLVirtualTableCursorExternal } procedure TSQLVirtualTableCursorExternal.HandleClearPoolOnConnectionIssue; begin fStatement := nil; fHasData := false; if (self<>nil) and (Table<>nil) and (Table.Static<>nil) then (Table.Static as TSQLRestStorageExternal).HandleClearPoolOnConnectionIssue; end; destructor TSQLVirtualTableCursorExternal.Destroy; begin if fStatement <> nil then fStatement.ReleaseRows; inherited Destroy; end; function TSQLVirtualTableCursorExternal.Column(aColumn: integer; var aResult: TSQLVar): boolean; var n: cardinal; begin result := false; if (self<>nil) and (fStatement<>nil) then try n := fStatement.ColumnCount-1; if aColumn=VIRTUAL_TABLE_ROWID_COLUMN then aColumn := n else // RowID is latest column (select %,RowID from..) if cardinal(aColumn)>=n then exit; // error if aColumn is out of range fStatement.ColumnToSQLVar(aColumn,aResult,fColumnTemp); result := aResult.VType<>ftUnknown; except HandleClearPoolOnConnectionIssue; end; end; function TSQLVirtualTableCursorExternal.HasData: boolean; begin result := (self<>nil) and (fStatement<>nil) and fHasData; end; function TSQLVirtualTableCursorExternal.Next: boolean; begin result := false; if (self<>nil) and (fStatement<>nil) then try fHasData := fStatement.Step; result := true; // success (may be with no more data) except HandleClearPoolOnConnectionIssue; end; end; function TSQLVirtualTableCursorExternal.Search( const Prepared: TSQLVirtualTablePrepared): boolean; var i: integer; storage: TSQLRestStorageExternal; begin result := false; if (Self<>nil) and (Table<>nil) and (Table.Static<>nil) then begin storage := Table.Static as TSQLRestStorageExternal; {$ifndef SQLVIRTUALLOGS} if fSQL='' then {$endif} fSQL := storage.ComputeSQL(Prepared); try fStatement := storage.fProperties.NewThreadSafeStatementPrepared( fSQL,{results=}true,{except=}true); if fStatement<>nil then begin if sftDateTimeMS in storage.fStoredClassRecordProps.HasTypeFields then fStatement.ForceDateWithMS := true; for i := 1 to Prepared.WhereCount do fStatement.Bind(i,Prepared.Where[i-1].Value); fStatement.ExecutePrepared; result := Next; // on execution success, go to the first row end; except self.HandleClearPoolOnConnectionIssue; end; end; end; { TSQLVirtualTableExternal } function TSQLVirtualTableExternal.Drop: boolean; begin if (self=nil) or (Static=nil) then result := false else with Static as TSQLRestStorageExternal do result := ExecuteDirect('drop table %',[fTableName],[],false)<>nil; end; class procedure TSQLVirtualTableExternal.GetTableModuleProperties( var aProperties: TVirtualTableModuleProperties); begin aProperties.Features := [vtWrite]; aProperties.CursorClass := TSQLVirtualTableCursorExternal; aProperties.StaticClass := TSQLRestStorageExternal; end; function TSQLVirtualTableExternal.Prepare(var Prepared: TSQLVirtualTablePrepared): boolean; var i, col: integer; Fields: TSQLPropInfoList; begin result := inherited Prepare(Prepared); // set costFullScan or costPrimaryIndex if result and (Static<>nil) then with Static as TSQLRestStorageExternal do begin // mark Where[] clauses will be handled by SQL Fields := StoredClassRecordProps.Fields; result := false; for i := 0 to Prepared.WhereCount-1 do with Prepared.Where[i] do if (Column<>VIRTUAL_TABLE_IGNORE_COLUMN) and (Operation<=high(SQL_OPER_WITH_PARAM)) then begin if Column=VIRTUAL_TABLE_ROWID_COLUMN then // is an indexed primary key Prepared.EstimatedCost := costPrimaryIndex else begin if cardinal(Column)>=cardinal(Fields.Count) then exit; // invalid column index -> abort query col := fFieldsInternalToExternal[Column+1]; if col<0 then exit; // column not known in the external database -> abort query if fFieldsExternal[col].ColumnIndexed then begin if Prepared.EstimatedCost ftUnknown end; // check the OrderBy[] clauses if Prepared.OrderByCount>0 then begin for i := 0 to Prepared.OrderByCount-1 do with Prepared.OrderBy[i] do if (Column<>VIRTUAL_TABLE_ROWID_COLUMN) and (cardinal(Column)>=cardinal(Fields.Count)) then exit; // invalid column index -> abort query Prepared.OmitOrderBy := true; // order handled via SQL query end; result := true; // success end; end; // here below, virtual write operations do not call Engine*() but direct SQL // -> InternalUpdateEvent() were already called by MainEngine*() methods function TSQLVirtualTableExternal.Delete(aRowID: Int64): boolean; begin if (self<>nil) and (Static<>nil) and (aRowID>0) then with Static as TSQLRestStorageExternal do result := ExecuteDirect('delete from % where %=?', [fTableName,fStoredClassMapping^.RowIDFieldName],[aRowID],false)<>nil else result := false; end; function TSQLVirtualTableExternal.Insert(aRowID: Int64; var Values: TSQLVarDynArray; out insertedRowID: Int64): boolean; begin // aRowID is just ignored here since IDs are always auto calculated result := false; if (self<>nil) and (Static<>nil) then with Static as TSQLRestStorageExternal do begin StorageLock(false,'Insert'); // to avoid race condition against max(RowID) try insertedRowID := EngineLockedNextID; with fStoredClassMapping^ do result := ExecuteDirectSQLVar('insert into % (%,%) values (%,?)', [fTableName,SQL.InsertSet,RowIDFieldName,CSVOfValue('?',length(Values))], Values,insertedRowID,true); finally StorageUnLock; end; end; end; function TSQLVirtualTableExternal.Update(oldRowID, newRowID: Int64; var Values: TSQLVarDynArray): boolean; begin if (self<>nil) and (Static<>nil) and (oldRowID=newRowID) and (newRowID>0) then // don't allow ID change with Static as TSQLRestStorageExternal, fStoredClassMapping^ do result := ExecuteDirectSQLVar('update % set % where %=?', [fTableName,SQL.UpdateSetAll,RowIDFieldName],Values,oldRowID,true) else result := false; end; initialization // all our SynDB related functions shall log to main TSQLLog SynDBLog := TSQLLog; end.