2018-09-25 15:36:53 +02:00
// *************************************************************************** }
//
// Delphi MVC Framework
//
2021-04-05 19:35:46 +02:00
// Copyright (c) 2010-2021 Daniele Teti and the DMVCFramework Team
2018-09-25 15:36:53 +02:00
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (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.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// ***************************************************************************
unit MVCFramework. ActiveRecord;
2019-08-05 12:55:44 +02:00
{$I dmvcframework.inc}
2018-09-25 15:36:53 +02:00
interface
uses
System. Generics. Defaults,
System. Generics. Collections,
System. RTTI,
FireDAC. DApt,
Data. DB,
2018-10-14 18:23:20 +02:00
FireDAC. Comp . Client,
2019-09-30 00:05:46 +02:00
FireDAC. Stan. Def,
FireDAC. Stan. Pool,
FireDAC. Stan. Async,
2018-11-21 22:11:58 +01:00
FireDAC. Stan. Param,
2019-02-21 20:17:11 +01:00
System. SysUtils,
MVCFramework,
MVCFramework. Commons,
MVCFramework. RQL. Parser,
2021-11-18 17:52:06 +01:00
MVCFramework. Cache,
2020-03-25 11:35:25 +01:00
MVCFramework. Serializer. Intf,
2021-11-18 17:52:06 +01:00
MVCFramework. Serializer. Commons, System. SyncObjs;
2018-09-25 15:36:53 +02:00
type
EMVCActiveRecord = class( EMVCException)
public
constructor Create( const AMsg: string ) ; reintroduce ; { do not override!! }
end ;
2019-01-18 18:11:27 +01:00
EMVCActiveRecordNotFound = class( EMVCActiveRecord)
2020-01-04 12:53:53 +01:00
public
procedure AfterConstruction; override ;
2019-01-18 18:11:27 +01:00
end ;
2018-09-25 15:36:53 +02:00
TMVCActiveRecordClass = class of TMVCActiveRecord;
2021-04-29 22:52:28 +02:00
TMVCActiveRecord = class ;
2020-08-28 18:04:29 +02:00
TMVCActiveRecordFieldOption = ( foPrimaryKey, { it's the primary key of the mapped table }
2020-08-11 00:54:42 +02:00
foAutoGenerated, { not written, read - similar to readonly }
foTransient, { not written, not read }
foReadOnly, { not written, read }
foWriteOnly) ; { written, not read }
2018-10-14 18:23:20 +02:00
TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
TMVCEntityAction = ( eaCreate, eaRetrieve, eaUpdate, eaDelete) ;
TMVCEntityActions = set of TMVCEntityAction;
2018-12-09 23:03:06 +01:00
TMVCActiveRecordLoadOption = ( loIgnoreNotExistentFields) ;
TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption;
2018-10-14 18:23:20 +02:00
2021-11-18 17:52:06 +01:00
TPartitionFieldNames = class( TList< String > )
end ;
TPartitionFieldValues = class( TList< String > )
end ;
TPartitionFieldTypes = class( TList< TFieldType> )
end ;
2021-11-18 00:49:12 +01:00
2018-10-14 18:23:20 +02:00
IMVCEntityProcessor = interface
[ '{E7CD11E6-9FF9-46D2-B7B0-DA5B38EAA14E}' ]
2021-05-03 19:29:01 +02:00
procedure GetEntities( const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string ;
2018-10-14 18:23:20 +02:00
var Handled: Boolean ) ;
2021-05-03 19:29:01 +02:00
procedure GetEntity( const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string ;
2019-03-05 20:55:37 +01:00
const id: Integer ; var Handled: Boolean ) ;
2021-05-03 19:29:01 +02:00
procedure CreateEntity( const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string ;
2018-10-14 18:23:20 +02:00
var Handled: Boolean ) ;
2021-05-03 19:29:01 +02:00
procedure UpdateEntity( const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string ;
2019-03-05 20:55:37 +01:00
const id: Integer ; var Handled: Boolean ) ;
2021-05-03 19:29:01 +02:00
procedure DeleteEntity( const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string ;
2019-03-05 20:55:37 +01:00
const id: Integer ; var Handled: Boolean ) ;
2018-10-14 18:23:20 +02:00
end ;
2018-09-25 15:36:53 +02:00
2020-03-25 11:35:25 +01:00
TFieldInfo = class
public
2020-08-11 00:54:42 +02:00
// TableName: string;
2020-03-25 11:35:25 +01:00
FieldName: string ;
FieldOptions: TMVCActiveRecordFieldOptions;
DataTypeName: string ;
Writeable, Readable: Boolean ;
procedure EndUpdates;
end ;
TFieldsMap = class( TObjectDictionary< TRTTIField, TFieldInfo> )
private
2020-08-11 00:54:42 +02:00
fWritableFieldsCount: Integer ;
fReadableFieldsCount: Integer ;
2020-03-25 11:35:25 +01:00
public
constructor Create;
procedure EndUpdates;
2020-08-11 00:54:42 +02:00
property WritableFieldsCount: Integer read fWritableFieldsCount;
2020-09-30 11:16:10 +02:00
property ReadableFieldsCount: Integer read fReadableFieldsCount;
2020-03-25 11:35:25 +01:00
function GetInfoByFieldName( const FieldName: string ) : TFieldInfo;
end ;
2018-10-14 18:23:20 +02:00
MVCActiveRecordCustomAttribute = class( TCustomAttribute)
2018-09-25 15:36:53 +02:00
end ;
2018-10-23 16:18:34 +02:00
MVCTableAttribute = class( MVCActiveRecordCustomAttribute)
2019-01-08 12:48:27 +01:00
public
2018-09-25 15:36:53 +02:00
Name : string ;
2021-11-17 15:36:20 +01:00
RQLFilter: string ;
constructor Create( aName: string ) ; overload ;
constructor Create( aName: string ; aRQLFilter: String ) ; overload ;
2018-09-25 15:36:53 +02:00
end ;
2021-11-18 00:49:12 +01:00
MVCPartitionAttribute = class( MVCActiveRecordCustomAttribute)
public
PartitionClause: String ;
constructor Create( const PartitionClause: String ) ;
end ;
2018-10-23 16:18:34 +02:00
MVCTableFieldAttribute = class( MVCActiveRecordCustomAttribute)
2018-09-25 15:36:53 +02:00
public
FieldName: string ;
2019-02-15 12:21:11 +01:00
FieldOptions: TMVCActiveRecordFieldOptions;
2020-03-12 20:37:48 +01:00
SequenceName, DataTypeName: string ;
2020-01-08 15:30:10 +01:00
constructor Create( const aFieldName: string ; const aFieldOptions: TMVCActiveRecordFieldOptions;
2020-03-23 18:51:57 +01:00
const aSequenceName: string = '' ; const aDataTypeName: string = '' ) ; overload ;
constructor Create( aFieldName: string ; const aDataTypeName: string = '' ) ; overload ;
2018-09-25 15:36:53 +02:00
end ;
2019-03-05 20:55:37 +01:00
MVCPrimaryKeyAttribute = MVCTableFieldAttribute deprecated '(ERROR) Use MVCTableFieldAttribute' ;
2018-09-25 15:36:53 +02:00
2018-10-23 16:18:34 +02:00
MVCEntityActionsAttribute = class( MVCActiveRecordCustomAttribute)
2018-10-14 18:23:20 +02:00
private
EntityAllowedActions: TMVCEntityActions;
public
constructor Create( const aEntityAllowedActions: TMVCEntityActions) ;
end ;
2018-11-02 21:43:09 +01:00
TMVCSQLGenerator = class ;
2021-11-18 00:49:12 +01:00
TPartitionInfo = class
2021-11-18 17:52:06 +01:00
private
class
var PartitionInfoCache: TMVCThreadedObjectCache< TPartitionInfo> ;
private
fRQLFilter: String ;
fSQLFilter: String ;
fFieldValues: TPartitionFieldValues;
fFieldTypes: TPartitionFieldTypes;
fFieldNames: TPartitionFieldNames;
public
property FieldNames: TPartitionFieldNames read fFieldNames;
property FieldValues: TPartitionFieldValues read fFieldValues;
property FieldTypes: TPartitionFieldTypes read fFieldTypes;
property RQLFilter: String read fRQLFilter;
property SQLFilter: String read fSQLFilter;
2021-11-18 00:49:12 +01:00
constructor Create;
2021-11-18 17:52:06 +01:00
destructor Destroy; override ;
class constructor Create;
class destructor Destroy;
procedure InitializeFilterStrings( const RQLCompiler: TRQLCompiler) ;
class function BuildPartitionClause( const PartitionClause: String ; const RQLCompilerClass: TRQLCompilerClass) : TPartitionInfo;
2021-11-18 00:49:12 +01:00
end ;
2018-10-23 16:18:34 +02:00
TMVCActiveRecordList = class( TObjectList< TMVCActiveRecord> )
public
constructor Create; virtual ;
end ;
2018-09-25 15:36:53 +02:00
TMVCActiveRecord = class
private
2020-05-04 09:42:16 +02:00
fChildren: TObjectList< TObject> ;
2018-09-25 15:36:53 +02:00
fConn: TFDConnection;
2018-11-02 21:43:09 +01:00
fSQLGenerator: TMVCSQLGenerator;
2018-09-25 15:36:53 +02:00
fPrimaryKeyFieldName: string ;
2018-10-14 18:23:20 +02:00
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
2020-03-23 18:51:57 +01:00
fPrimaryKeySequenceName: string ;
2020-03-31 16:23:22 +02:00
fPrimaryKeyFieldType: TFieldType;
2018-10-14 18:23:20 +02:00
fEntityAllowedActions: TMVCEntityActions;
2018-11-02 21:43:09 +01:00
fRQL2SQL: TRQL2SQL;
2020-01-06 16:49:18 +01:00
procedure MapTValueToParam( aValue: TValue; const aParam: TFDParam) ;
2020-08-28 18:04:29 +02:00
function MapNullableTValueToParam( aValue: TValue; const aParam: TFDParam) : Boolean ;
2020-01-06 16:49:18 +01:00
function GetPrimaryKeyIsAutogenerated: Boolean ;
procedure SetPrimaryKeyIsAutogenerated( const Value: Boolean ) ;
2020-08-11 00:54:42 +02:00
procedure SetTableName( const Value: string ) ;
2020-08-28 18:04:29 +02:00
function GetAttributes( const AttrName: string ) : TValue;
procedure SetAttributes( const AttrName: string ; const Value: TValue) ;
2018-09-25 15:36:53 +02:00
protected
2020-02-03 10:51:40 +01:00
fRTTIType: TRttiInstanceType;
2020-03-25 11:35:25 +01:00
fProps: TArray< TRTTIField> ;
2018-09-25 15:36:53 +02:00
fObjAttributes: TArray< TCustomAttribute> ;
fPropsAttributes: TArray< TCustomAttribute> ;
fTableName: string ;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter: string ;
2020-03-25 11:35:25 +01:00
fMap: TFieldsMap;
fPrimaryKey: TRTTIField;
2018-11-02 21:43:09 +01:00
fBackendDriver: string ;
fMapping: TMVCFieldsMapping;
2021-11-18 17:52:06 +01:00
fPartitionInfoInternal: TPartitionInfo;
fPartitionClause: String ;
function GetPartitionInfo: TPartitionInfo;
2018-11-02 21:43:09 +01:00
function GetBackEnd: string ;
2020-02-03 10:51:40 +01:00
function GetConnection: TFDConnection;
2018-09-25 15:36:53 +02:00
procedure InitTableInfo;
2019-03-05 20:55:37 +01:00
class function ExecQuery( const SQL: string ; const Values: array of Variant ) : TDataSet; overload ;
2021-05-03 19:29:01 +02:00
class function ExecQuery( const SQL: string ; const Values: array of Variant ;
const Connection: TFDConnection)
2018-11-24 16:56:21 +01:00
: TDataSet; overload ;
2021-05-03 19:29:01 +02:00
class function ExecQuery( const SQL: string ; const Values: array of Variant ;
const ValueTypes: array of TFieldType)
2020-08-28 18:04:29 +02:00
: TDataSet; overload ;
2021-05-03 19:29:01 +02:00
class function ExecQuery( const SQL: string ; const Values: array of Variant ;
const ValueTypes: array of TFieldType;
2020-03-23 18:51:57 +01:00
const Connection: TFDConnection) : TDataSet; overload ;
procedure FillPrimaryKey( const SequenceName: string ) ;
2021-05-03 19:29:01 +02:00
function ExecNonQuery( const SQL: string ; RefreshAutoGenerated: Boolean = false ) : int64 ;
overload ;
2018-09-25 15:36:53 +02:00
// load events
/// <summary>
/// Called everywhere before persist object into database
/// </summary>
2020-03-30 13:30:45 +02:00
procedure OnValidation( const EntityAction: TMVCEntityAction) ; virtual ;
2018-09-25 15:36:53 +02:00
/// <summary>
/// Called just after load the object state from database
/// </summary>
procedure OnAfterLoad; virtual ;
/// <summary>
/// Called before load the object state from database
/// </summary>
procedure OnBeforeLoad; virtual ;
/// <summary>
/// Called before insert the object state to database
/// </summary>
procedure OnBeforeInsert; virtual ;
2018-10-23 16:18:34 +02:00
2018-09-25 15:36:53 +02:00
/// <summary>
2018-10-23 16:18:34 +02:00
/// Called after insert the object state to database
2018-09-25 15:36:53 +02:00
/// </summary>
2018-10-23 16:18:34 +02:00
procedure OnAfterInsert; virtual ;
2018-09-25 15:36:53 +02:00
2018-10-23 16:18:34 +02:00
/// <summary>
/// Called before update the object state to database
/// </summary>
2018-09-25 15:36:53 +02:00
procedure OnBeforeUpdate; virtual ;
2018-10-23 16:18:34 +02:00
/// <summary>
/// Called after update the object state to database
/// </summary>
procedure OnAfterUpdate; virtual ;
2018-09-25 15:36:53 +02:00
/// <summary>
/// Called before delete object from database
/// </summary>
procedure OnBeforeDelete; virtual ;
2018-10-23 16:18:34 +02:00
/// <summary>
/// Called after delete object from database
/// </summary>
procedure OnAfterDelete; virtual ;
2018-09-25 15:36:53 +02:00
/// <summary>
/// Called before insert or update the object to the database
/// </summary>
procedure OnBeforeInsertOrUpdate; virtual ;
2019-03-18 14:08:34 +01:00
/// <summary>
/// Called before execute sql
/// </summary>
2020-03-23 18:51:57 +01:00
procedure OnBeforeExecuteSQL( var SQL: string ) ; virtual ;
2019-03-18 14:08:34 +01:00
2018-10-23 16:18:34 +02:00
/// <summary>
/// Called after insert or update the object to the database
/// </summary>
procedure OnAfterInsertOrUpdate; virtual ;
2019-11-27 19:04:06 +01:00
procedure MapObjectToParams( const Params: TFDParams; var Handled: Boolean ) ; virtual ;
2020-01-04 12:53:53 +01:00
procedure MapDatasetToObject( const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean ) ; virtual ;
2019-11-27 19:04:06 +01:00
2018-11-02 21:43:09 +01:00
function GenerateSelectSQL: string ;
2018-11-24 16:56:21 +01:00
function SQLGenerator: TMVCSQLGenerator;
2019-08-02 12:32:23 +02:00
2020-03-23 18:51:57 +01:00
function InternalCount( const RQL: string ) : int64 ;
2021-05-03 19:29:01 +02:00
function InternalSelectRQL( const RQL: string ; const MaxRecordCount: Integer )
: TMVCActiveRecordList;
2018-09-25 15:36:53 +02:00
public
2018-11-24 16:56:21 +01:00
constructor Create( aLazyLoadConnection: Boolean ) ; overload ;
{ cannot be virtual! }
2018-09-28 13:01:46 +02:00
constructor Create; overload ; virtual ;
2018-09-25 15:36:53 +02:00
destructor Destroy; override ;
2020-02-03 10:51:40 +01:00
procedure EnsureConnection;
2020-03-30 13:30:45 +02:00
procedure InvalidateConnection( const ReacquireAfterInvalidate: Boolean = false ) ;
2020-02-03 13:19:55 +01:00
/// <summary>
2020-04-08 18:04:45 +02:00
/// Executes an Insert (pk is null) or an Update (pk is not null)
2020-02-03 13:19:55 +01:00
/// </summary>
procedure Store;
2021-05-03 19:29:01 +02:00
function CheckAction( const aEntityAction: TMVCEntityAction;
const aRaiseException: Boolean = True ) : Boolean ;
2018-09-25 15:36:53 +02:00
procedure Insert;
2018-09-28 13:01:46 +02:00
function GetMapping: TMVCFieldsMapping;
2020-03-31 16:23:22 +02:00
function LoadByPK( const id: int64 ) : Boolean ; overload ; virtual ;
function LoadByPK( const id: string ) : Boolean ; overload ; virtual ;
2021-06-27 15:14:37 +02:00
procedure Update( const RaiseExceptionIfNotFound: Boolean = True ) ;
procedure Delete( const RaiseExceptionIfNotFound: Boolean = True ) ;
2018-09-25 15:36:53 +02:00
function TableInfo: string ;
2021-05-03 19:29:01 +02:00
procedure LoadByDataset( const aDataSet: TDataSet;
const aOptions: TMVCActiveRecordLoadOptions = [ ] ) ;
2018-09-25 15:36:53 +02:00
procedure SetPK( const aValue: TValue) ;
2020-08-28 18:04:29 +02:00
procedure SetPropertyValue( const aProp: TRttiProperty; const aValue: TValue) ;
2018-09-25 15:36:53 +02:00
function GetPK: TValue;
2020-02-03 13:19:55 +01:00
function TryGetPKValue( var Value: TValue; out IsNullableType: Boolean ) : Boolean ;
2021-04-25 22:40:06 +02:00
function PKIsNullable( out PKValue: TValue) : Boolean ;
function PKIsNull: Boolean ;
2020-05-04 09:42:16 +02:00
procedure AddChildren( const ChildObject: TObject) ;
procedure RemoveChildren( const ChildObject: TObject) ;
2021-05-03 19:29:01 +02:00
function GetPrimaryKeyFieldType: TFieldType;
2020-08-28 18:04:29 +02:00
// dynamic access
property Attributes[ const AttrName: string ] : TValue read GetAttributes write SetAttributes;
2020-07-18 20:14:58 +02:00
[ MVCDoNotSerialize]
2020-08-11 00:54:42 +02:00
property TableName: string read fTableName write SetTableName;
2020-02-03 10:51:40 +01:00
[ MVCDoNotSerialize]
2021-05-03 19:29:01 +02:00
property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated
write SetPrimaryKeyIsAutogenerated;
2020-01-04 12:53:53 +01:00
class function GetByPK( const aClass: TMVCActiveRecordClass; const aValue: int64 ;
const RaiseExceptionIfNotFound: Boolean = True ) : TMVCActiveRecord; overload ;
2020-03-31 16:23:22 +02:00
class function GetByPK( const aClass: TMVCActiveRecordClass; const aValue: string ;
const RaiseExceptionIfNotFound: Boolean = True ) : TMVCActiveRecord; overload ;
2019-03-05 20:55:37 +01:00
class function GetScalar( const SQL: string ; const Params: array of Variant ) : Variant ;
2021-05-03 19:29:01 +02:00
class function Select( const aClass: TMVCActiveRecordClass; const SQL: string ;
const Params: array of Variant )
2018-11-24 16:56:21 +01:00
: TMVCActiveRecordList; overload ;
2021-05-03 19:29:01 +02:00
class function Select( const aClass: TMVCActiveRecordClass; const SQL: string ;
const Params: array of Variant ;
2018-11-24 16:56:21 +01:00
const Connection: TFDConnection) : TMVCActiveRecordList; overload ;
2021-05-03 19:29:01 +02:00
class function SelectRQL( const aClass: TMVCActiveRecordClass; const RQL: string ;
const MaxRecordCount: Integer )
2018-11-24 16:56:21 +01:00
: TMVCActiveRecordList; overload ;
2019-03-05 20:55:37 +01:00
class function DeleteRQL( const aClass: TMVCActiveRecordClass; const RQL: string ) : int64 ;
2021-05-03 19:29:01 +02:00
function SelectRQL( const RQL: string ; const MaxRecordCount: Integer )
2019-02-21 18:11:14 +01:00
: TMVCActiveRecordList; overload ;
2021-05-03 19:29:01 +02:00
class function Where( const aClass: TMVCActiveRecordClass; const SQLWhere: string ;
const Params: array of Variant )
: TMVCActiveRecordList; overload ;
class function Where( const aClass: TMVCActiveRecordClass; const SQLWhere: string ;
const Params: array of Variant ;
2018-11-02 21:43:09 +01:00
const Connection: TFDConnection) : TMVCActiveRecordList; overload ;
2021-05-03 19:29:01 +02:00
class function All( const aClass: TMVCActiveRecordClass) : TObjectList< TMVCActiveRecord> ;
overload ;
2019-03-05 20:55:37 +01:00
class function DeleteAll( const aClass: TMVCActiveRecordClass) : int64 ; overload ;
2020-03-23 18:51:57 +01:00
function Count( const RQL: string = '' ) : int64 ; overload ;
2021-05-03 19:29:01 +02:00
class function Count( const aClass: TMVCActiveRecordClass; const RQL: string = '' )
: int64 ; overload ;
class function SelectDataSet( const SQL: string ; const Params: array of Variant )
: TDataSet; overload ;
2020-03-23 18:51:57 +01:00
class function SelectDataSet( const SQL: string ; const Params: array of Variant ;
const ParamTypes: array of TFieldType) : TDataSet; overload ;
2018-10-23 16:18:34 +02:00
class function CurrentConnection: TFDConnection;
2018-09-25 15:36:53 +02:00
end ;
2021-07-16 23:55:33 +02:00
IMVCUnitOfWork< T: TMVCActiveRecord> = interface
[ '{68B55DD3-57F6-4CC0-A4DE-BFDE7C3AA287}' ]
procedure RegisterDelete( const Value: T) ; overload ;
procedure RegisterDelete( const Enumerable: TEnumerable< T> ) ; overload ;
procedure RegisterUpdate( const Value: T) ;
procedure RegisterInsert( const Value: T) ;
procedure UnregisterDelete( const Value: T) ;
procedure UnregisterUpdate( const Value: T) ;
procedure UnregisterInsert( const Value: T) ;
end ;
TMVCItemApplyAction< T: TMVCActiveRecord> = reference to procedure( const Obj: T;
const EntityAction: TMVCEntityAction; var Handled: Boolean ) ;
IMVCMultiExecutor< T: TMVCActiveRecord> = interface
[ '{C815246B-19CA-4F6C-AA67-8E491F809340}' ]
procedure Apply( const ItemApplyAction: TMVCItemApplyAction< T> = nil ) ;
end ;
2019-08-02 12:32:23 +02:00
TMVCActiveRecordHelper = class helper for TMVCActiveRecord
2020-01-04 12:53:53 +01:00
class function GetByPK< T: TMVCActiveRecord, constructor > ( const aValue: int64 ;
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2020-03-31 16:23:22 +02:00
class function GetByPK< T: TMVCActiveRecord, constructor > ( const aValue: string ;
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2021-05-03 19:29:01 +02:00
class function Select< T: TMVCActiveRecord, constructor > ( const SQL: string ;
const Params: array of Variant ;
2019-08-02 12:32:23 +02:00
const Options: TMVCActiveRecordLoadOptions = [ ] ) : TObjectList< T> ; overload ;
2021-05-03 19:29:01 +02:00
class function Select< T: TMVCActiveRecord, constructor > ( const SQL: string ;
const Params: array of Variant ;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [ ] )
: TObjectList< T> ; overload ;
class function SelectOne< T: TMVCActiveRecord, constructor > ( const SQL: string ;
const Params: array of Variant ;
2020-08-28 18:04:29 +02:00
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [ ] ;
2020-03-30 13:30:45 +02:00
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2021-05-03 19:29:01 +02:00
class function SelectOne< T: TMVCActiveRecord, constructor > ( const SQL: string ;
const Params: array of Variant ;
2020-03-30 13:30:45 +02:00
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2021-05-03 19:29:01 +02:00
class function SelectRQL< T: constructor , TMVCActiveRecord> ( const RQL: string ;
const MaxRecordCount: Integer )
2019-08-02 12:32:23 +02:00
: TObjectList< T> ; overload ;
2020-08-28 18:04:29 +02:00
class function SelectOneByRQL< T: constructor , TMVCActiveRecord> ( const RQL: string ;
2021-11-19 00:34:37 +01:00
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2019-08-02 12:32:23 +02:00
class function All< T: TMVCActiveRecord, constructor > : TObjectList< T> ; overload ;
2020-03-23 18:51:57 +01:00
class function Count< T: TMVCActiveRecord> ( const RQL: string = '' ) : int64 ; overload ;
2021-05-03 19:29:01 +02:00
class function Where< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
const Params: array of Variant )
2020-08-28 18:04:29 +02:00
: TObjectList< T> ; overload ;
2021-11-19 00:34:37 +01:00
/// <summary>
/// Executes a SQL select using the SQLWhere parameter as where clause. This method is partitioning safe.
/// Returns TObjectList<EntityType>.
/// </summary>
2021-05-03 19:29:01 +02:00
class function Where< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
const Params: array of Variant ;
2020-03-23 18:51:57 +01:00
const ParamTypes: array of TFieldType) : TObjectList< T> ; overload ;
2019-08-02 12:32:23 +02:00
class function GetOneByWhere< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
2020-08-28 18:04:29 +02:00
const Params: array of Variant ; const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
class function GetOneByWhere< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
const Params: array of Variant ; const ParamTypes: array of TFieldType;
2020-03-23 18:51:57 +01:00
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2020-08-28 18:04:29 +02:00
class function GetFirstByWhere< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
const Params: array of Variant ; const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
class function GetFirstByWhere< T: TMVCActiveRecord, constructor > ( const SQLWhere: string ;
const Params: array of Variant ; const ParamTypes: array of TFieldType;
2020-03-23 18:51:57 +01:00
const RaiseExceptionIfNotFound: Boolean = True ) : T; overload ;
2021-04-29 22:52:28 +02:00
class function Merge< T: TMVCActiveRecord> ( CurrentList,
NewList: TObjectList< T> ) : IMVCMultiExecutor< T> ;
2019-08-02 12:32:23 +02:00
end ;
2018-09-25 15:36:53 +02:00
IMVCEntitiesRegistry = interface
[ '{BB227BEB-A74A-4637-8897-B13BA938C07B}' ]
2019-03-05 20:55:37 +01:00
procedure AddEntity( const aURLSegment: string ; const aActiveRecordClass: TMVCActiveRecordClass) ;
2021-05-03 19:29:01 +02:00
procedure AddEntityProcessor( const aURLSegment: string ;
const aEntityProcessor: IMVCEntityProcessor) ;
2018-11-24 16:56:21 +01:00
function FindEntityClassByURLSegment( const aURLSegment: string ;
out aMVCActiveRecordClass: TMVCActiveRecordClass) : Boolean ;
2021-05-03 19:29:01 +02:00
function FindProcessorByURLSegment( const aURLSegment: string ;
out aMVCEntityProcessor: IMVCEntityProcessor)
2019-03-05 20:55:37 +01:00
: Boolean ;
2021-04-07 23:58:02 +02:00
function GetEntities: TArray< String > ;
2018-09-25 15:36:53 +02:00
end ;
TMVCEntitiesRegistry = class( TInterfacedObject, IMVCEntitiesRegistry)
private
fEntitiesDict: TDictionary< string , TMVCActiveRecordClass> ;
2018-10-14 18:23:20 +02:00
fProcessorsDict: TDictionary< string , IMVCEntityProcessor> ;
2018-09-25 15:36:53 +02:00
public
constructor Create; virtual ;
destructor Destroy; override ;
protected
2021-05-03 19:29:01 +02:00
procedure AddEntityProcessor( const aURLSegment: string ;
const aEntityProcessor: IMVCEntityProcessor) ;
2019-03-05 20:55:37 +01:00
procedure AddEntity( const aURLSegment: string ; const aActiveRecordClass: TMVCActiveRecordClass) ;
2018-11-24 16:56:21 +01:00
function FindEntityClassByURLSegment( const aURLSegment: string ;
out aMVCActiveRecordClass: TMVCActiveRecordClass) : Boolean ;
2021-05-03 19:29:01 +02:00
function FindProcessorByURLSegment( const aURLSegment: string ;
out aMVCEntityProcessor: IMVCEntityProcessor)
2019-03-05 20:55:37 +01:00
: Boolean ;
2021-04-07 23:58:02 +02:00
function GetEntities: TArray< String > ;
2018-09-25 15:36:53 +02:00
end ;
2018-09-28 13:01:46 +02:00
IMVCActiveRecordConnections = interface
2018-09-25 15:36:53 +02:00
[ '{7B87473C-1784-489F-A838-925E7DDD0DE2}' ]
2021-05-03 19:29:01 +02:00
procedure AddConnection( const aName: string ; const aConnection: TFDConnection;
const Owns: Boolean = false ) ;
2021-10-20 11:29:49 +02:00
procedure AddDefaultConnection( const aConnection: TFDConnection; const Owns: Boolean = false ) ; overload ;
procedure AddDefaultConnection( const aConnectionDefName: String ) ; overload ;
2021-08-13 18:05:48 +02:00
procedure RemoveConnection( const aName: string ; const RaiseExceptionIfNotAvailable: Boolean = True ) ;
procedure RemoveDefaultConnection( const RaiseExceptionIfNotAvailable: Boolean = True ) ;
2018-10-14 18:23:20 +02:00
procedure SetCurrent( const aName: string ) ;
2020-10-17 23:19:05 +02:00
function GetCurrent( const RaiseExceptionIfNotAvailable: Boolean = True ) : TFDConnection;
2018-11-02 21:43:09 +01:00
function GetCurrentBackend: string ;
2020-03-30 13:30:45 +02:00
procedure SetDefault;
2018-09-25 15:36:53 +02:00
end ;
2019-03-05 20:55:37 +01:00
TMVCConnectionsRepository = class( TInterfacedObject, IMVCActiveRecordConnections)
2018-11-24 16:56:21 +01:00
private type
2018-11-09 18:11:59 +01:00
TConnHolder = class
2019-01-08 12:48:27 +01:00
public
2018-11-09 18:11:59 +01:00
Connection: TFDConnection;
OwnsConnection: Boolean ;
destructor Destroy; override ;
end ;
var
2018-10-14 18:23:20 +02:00
fMREW: TMultiReadExclusiveWriteSynchronizer;
2018-11-09 18:11:59 +01:00
fConnectionsDict: TDictionary< string , TConnHolder> ;
2018-10-14 18:23:20 +02:00
fCurrentConnectionsByThread: TDictionary< TThreadID, string > ;
function GetKeyName( const aName: string ) : string ;
2018-09-25 15:36:53 +02:00
public
constructor Create; virtual ;
destructor Destroy; override ;
2021-05-03 19:29:01 +02:00
procedure AddConnection( const aName: string ; const aConnection: TFDConnection;
const aOwns: Boolean = false ) ;
2021-10-20 11:29:49 +02:00
procedure AddDefaultConnection( const aConnection: TFDConnection; const aOwns: Boolean = false ) ; overload ;
procedure AddDefaultConnection( const aConnectionDefName: String ) ; overload ;
2021-08-13 18:05:48 +02:00
procedure RemoveConnection( const aName: string ; const RaiseExceptionIfNotAvailable: Boolean = True ) ;
procedure RemoveDefaultConnection( const RaiseExceptionIfNotAvailable: Boolean = True ) ;
2018-10-14 18:23:20 +02:00
procedure SetCurrent( const aName: string ) ;
2020-10-17 23:19:05 +02:00
function GetCurrent( const RaiseExceptionIfNotAvailable: Boolean = True ) : TFDConnection;
2018-10-14 18:23:20 +02:00
function GetByName( const aName: string ) : TFDConnection;
2018-11-02 21:43:09 +01:00
function GetCurrentBackend: string ;
2020-03-30 13:30:45 +02:00
procedure SetDefault;
2018-11-02 21:43:09 +01:00
end ;
TMVCSQLGenerator = class abstract
private
fMapping: TMVCFieldsMapping;
2021-11-17 15:36:20 +01:00
fDefaultSQLFilter: String ;
fDefaultRQLFilter: String ;
2018-11-02 21:43:09 +01:00
fCompiler: TRQLCompiler;
fRQL2SQL: TRQL2SQL;
protected
2021-11-18 00:49:12 +01:00
fPartitionInfo: TPartitionInfo;
2021-11-17 15:36:20 +01:00
function GetDefaultSQLFilter( const IncludeWhereClause: Boolean ; const IncludeAndClauseBeforeFilter: Boolean = False ) : String ; //inline;
function MergeDefaultRQLFilter( const RQL: String ) : String ; //inline;
2021-11-18 00:49:12 +01:00
function MergeSQLFilter( const SQL1, SQL2: String ) : String ;
function GetRQLParser: TRQL2SQL;
2018-11-02 21:43:09 +01:00
function GetCompiler: TRQLCompiler;
function GetCompilerClass: TRQLCompilerClass; virtual ; abstract ;
function GetMapping: TMVCFieldsMapping;
2021-05-03 19:29:01 +02:00
function TableFieldsDelimited( const Map: TFieldsMap; const PKFieldName: string ;
const Delimiter: string ) : string ;
2018-11-02 21:43:09 +01:00
public
2021-11-18 00:49:12 +01:00
constructor Create( Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string ; const PartitionInfo: TPartitionInfo) ; virtual ;
2018-11-02 21:43:09 +01:00
destructor Destroy; override ;
2020-01-08 15:30:10 +01:00
// capabilities
function HasSequences: Boolean ; virtual ;
function HasReturning: Boolean ; virtual ;
// end-capabilities
2021-11-21 19:27:06 +01:00
// abstract SQL generator methods
2019-03-05 20:55:37 +01:00
function CreateSQLWhereByRQL( const RQL: string ; const Mapping: TMVCFieldsMapping;
2020-09-30 11:16:10 +02:00
const UseArtificialLimit: Boolean = True ; const UseFilterOnly: Boolean = false ;
2021-11-21 19:27:06 +01:00
const MaxRecordCount: Int32 = TMVCConstants. MAX_RECORD_COUNT) : string ;
2021-05-03 19:29:01 +02:00
function CreateSelectSQL( const TableName: string ; const Map: TFieldsMap;
const PKFieldName: string ;
2021-11-21 19:27:06 +01:00
const PKOptions: TMVCActiveRecordFieldOptions) : string ; virtual ;
2021-05-03 19:29:01 +02:00
function CreateInsertSQL( const TableName: string ; const Map: TFieldsMap;
const PKFieldName: string ;
2020-08-28 18:04:29 +02:00
const PKOptions: TMVCActiveRecordFieldOptions) : string ; virtual ; abstract ;
2021-11-21 19:27:06 +01:00
// virtual methods with default implementation
function CreateSelectByPKSQL( const TableName: string ; const Map: TFieldsMap;
2021-05-03 19:29:01 +02:00
const PKFieldName: string ;
2021-11-21 19:27:06 +01:00
const PKOptions: TMVCActiveRecordFieldOptions) : string ; virtual ;
2021-05-03 19:29:01 +02:00
function CreateDeleteSQL( const TableName: string ; const Map: TFieldsMap;
const PKFieldName: string ;
2021-11-21 19:27:06 +01:00
const PKOptions: TMVCActiveRecordFieldOptions) : string ; virtual ;
function CreateDeleteAllSQL( const TableName: string ) : string ; virtual ;
function CreateSelectCount( const TableName: string ) : string ; virtual ;
function CreateUpdateSQL( const TableName: string ; const Map: TFieldsMap;
const PKFieldName: string ;
const PKOptions: TMVCActiveRecordFieldOptions) : string ; virtual ;
2021-05-03 19:29:01 +02:00
function GetSequenceValueSQL( const PKFieldName: string ; const SequenceName: string ;
2021-11-21 19:27:06 +01:00
const Step: Integer = 1 ) : string ; virtual ;
2020-04-08 18:04:45 +02:00
// Overwritten by descendant if the SQL syntaxt requires more than the simple table name
// or if the table name contains spaces.
function GetTableNameForSQL( const TableName: string ) : string ; virtual ;
// Overwritten by descendant if the SQL syntaxt requires more than the simple field name
// or if the field name contains spaces.
function GetFieldNameForSQL( const FieldName: string ) : string ; virtual ;
function GetParamNameForSQL( const FieldName: string ) : string ; virtual ;
2021-11-17 15:36:20 +01:00
//helper methods
class function RemoveInitialWhereKeyword( const SQLFilter: String ) : String ;
2018-11-02 21:43:09 +01:00
end ;
TMVCSQLGeneratorClass = class of TMVCSQLGenerator;
TMVCSQLGeneratorRegistry = class sealed
private
2018-11-09 18:11:59 +01:00
class var cInstance: TMVCSQLGeneratorRegistry;
2018-11-02 21:43:09 +01:00
class var
2018-11-09 18:11:59 +01:00
cLock: TObject;
2018-11-02 21:43:09 +01:00
fSQLGenerators: TDictionary< string , TMVCSQLGeneratorClass> ;
protected
constructor Create;
public
destructor Destroy; override ;
class function Instance: TMVCSQLGeneratorRegistry;
class destructor Destroy;
class constructor Create;
2021-05-03 19:29:01 +02:00
procedure RegisterSQLGenerator( const aBackend: string ;
const aRQLBackendClass: TMVCSQLGeneratorClass) ;
2018-11-02 21:43:09 +01:00
procedure UnRegisterSQLGenerator( const aBackend: string ) ;
function GetSQLGenerator( const aBackend: string ) : TMVCSQLGeneratorClass;
2018-09-25 15:36:53 +02:00
end ;
2021-05-03 19:29:01 +02:00
TMVCUnitOfWork< T: TMVCActiveRecord> = class( TInterfacedObject, IMVCUnitOfWork< T> ,
IMVCMultiExecutor< T> )
2021-04-26 23:01:31 +02:00
private
2021-04-27 22:57:15 +02:00
fListToDelete: TObjectList< T> ;
fListToUpdate: TObjectList< T> ;
fListToInsert: TObjectList< T> ;
2021-04-26 23:01:31 +02:00
protected
2021-05-03 19:29:01 +02:00
// multiexecutor
2021-04-29 22:52:28 +02:00
procedure Apply( const ItemApplyAction: TMVCItemApplyAction< T> = nil ) ;
2021-05-03 19:29:01 +02:00
// unitofwork
2021-04-27 22:57:15 +02:00
procedure RegisterDelete( const Value: T) ; overload ;
procedure RegisterDelete( const Enumerable: TEnumerable< T> ) ; overload ;
procedure RegisterUpdate( const Value: T) ;
procedure RegisterInsert( const Value: T) ;
procedure UnregisterDelete( const Value: T) ;
procedure UnregisterUpdate( const Value: T) ;
procedure UnregisterInsert( const Value: T) ;
2021-05-03 19:29:01 +02:00
// events
procedure DoItemApplyAction( const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction< T> ; var Handled: Boolean ) ;
2021-04-29 22:52:28 +02:00
2021-05-03 19:29:01 +02:00
class function KeyExistsInt( const NewList: TObjectList< T> ; const KeyValue: Integer ;
out Index : Integer ) : Boolean ;
class function KeyExistsInt64( const NewList: TObjectList< T> ; const KeyValue: int64 ;
out Index : Integer ) : Boolean ;
class function KeyExistsString( const NewList: TObjectList< T> ; const KeyValue: String ;
2021-04-27 22:57:15 +02:00
out Index : Integer ) : Boolean ;
2021-04-26 23:01:31 +02:00
public
constructor Create; virtual ;
destructor Destroy; override ;
end ;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
2018-09-25 15:36:53 +02:00
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
2018-11-02 21:43:09 +01:00
function GetBackEndByConnection( aConnection: TFDConnection) : string ;
2018-10-14 18:23:20 +02:00
2018-09-25 15:36:53 +02:00
implementation
uses
2018-09-28 18:33:19 +02:00
System. TypInfo,
System. IOUtils,
System. Classes,
2018-09-25 15:36:53 +02:00
MVCFramework. DataSet. Utils,
MVCFramework. Logger,
2020-01-04 12:53:53 +01:00
MVCFramework. Nullables,
2020-08-28 18:04:29 +02:00
MVCFramework. RTTI. Utils,
2018-10-14 18:23:20 +02:00
FireDAC. Stan. Option,
2020-01-08 15:30:10 +01:00
Data. FmtBcd, System. Variants;
2018-09-25 15:36:53 +02:00
var
2018-10-14 18:23:20 +02:00
gCtx: TRttiContext;
2018-09-25 15:36:53 +02:00
gEntitiesRegistry: IMVCEntitiesRegistry;
2018-10-14 18:23:20 +02:00
gConnections: IMVCActiveRecordConnections;
2018-09-25 15:36:53 +02:00
gLock: TObject;
2018-11-02 21:43:09 +01:00
function GetBackEndByConnection( aConnection: TFDConnection) : string ;
begin
2019-08-02 12:32:23 +02:00
case Ord( aConnection. RDBMSKind) of
2018-11-02 21:43:09 +01:00
0 :
Exit( 'unknown' ) ;
1 :
Exit( 'oracle' ) ;
2 :
2018-11-09 18:11:59 +01:00
Exit( 'mssql' ) ;
2018-11-02 21:43:09 +01:00
3 :
Exit( 'msaccess' ) ;
4 :
Exit( 'mysql' ) ;
5 :
Exit( 'db2' ) ;
6 :
Exit( 'sqlanywhere' ) ;
7 :
Exit( 'advantage' ) ;
8 :
Exit( 'interbase' ) ;
9 :
Exit( 'firebird' ) ;
1 0 :
Exit( 'sqlite' ) ;
1 1 :
Exit( 'postgresql' ) ;
1 2 :
Exit( 'nexusdb' ) ;
1 3 :
Exit( 'dataSnap' ) ;
1 4 :
Exit( 'informix' ) ;
1 5 :
Exit( 'teradata' ) ;
1 6 :
Exit( 'mongodb' ) ;
1 7 :
Exit( 'other' ) ;
else
raise EMVCActiveRecord. Create( 'Unknown RDBMS Kind' ) ;
end ;
2018-10-14 18:23:20 +02:00
end ;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
if gConnections = nil then // double check here
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
TMonitor. Enter( gLock) ;
try
if gConnections = nil then
begin
gConnections : = TMVCConnectionsRepository. Create;
end ;
finally
TMonitor. Exit( gLock) ;
end ;
2018-09-25 15:36:53 +02:00
end ;
Result : = gConnections;
end ;
2020-01-08 15:30:10 +01:00
function IntToNullableInt( const Value: Integer ) : NullableInt32;
begin
Result . SetValue( Value) ;
end ;
2018-09-25 15:36:53 +02:00
{ TConnectionsRepository }
2021-05-03 19:29:01 +02:00
procedure TMVCConnectionsRepository. AddConnection( const aName: string ;
const aConnection: TFDConnection;
2019-03-05 20:55:37 +01:00
const aOwns: Boolean = false ) ;
2018-09-25 15:36:53 +02:00
var
lName: string ;
2018-10-14 18:23:20 +02:00
lConnKeyName: string ;
2018-11-09 18:11:59 +01:00
lConnHolder: TConnHolder;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
lName : = aName. ToLower;
lConnKeyName : = GetKeyName( lName) ;
2020-08-11 00:54:42 +02:00
{ If the transaction is not started, initialize TxIsolation as ReadCommitted }
if aConnection. Transaction = nil then
begin
{ needed for Delphi 10.4 Sydney+ }
aConnection. TxOptions. Isolation : = TFDTxIsolation. xiReadCommitted;
end ;
2018-10-14 18:23:20 +02:00
fMREW. BeginWrite;
try
2018-11-09 18:11:59 +01:00
lConnHolder : = TConnHolder. Create;
lConnHolder. Connection : = aConnection;
lConnHolder. OwnsConnection : = aOwns;
2018-11-24 16:56:21 +01:00
fConnectionsDict. Add( lConnKeyName, lConnHolder) ;
// raise exception on duplicates
2021-05-03 19:29:01 +02:00
if ( lName = 'default' ) and
( not fCurrentConnectionsByThread. ContainsKey( TThread. CurrentThread. ThreadID) ) then
2018-10-14 18:23:20 +02:00
begin
2019-03-05 20:55:37 +01:00
fCurrentConnectionsByThread. AddOrSetValue( TThread. CurrentThread. ThreadID, lName) ;
2018-10-14 18:23:20 +02:00
end ;
finally
fMREW. EndWrite;
2018-09-25 15:36:53 +02:00
end ;
end ;
2021-05-03 19:29:01 +02:00
procedure TMVCConnectionsRepository. AddDefaultConnection( const aConnection: TFDConnection;
const aOwns: Boolean ) ;
2019-05-09 20:53:52 +02:00
begin
AddConnection( 'default' , aConnection, aOwns) ;
end ;
2021-10-20 11:29:49 +02:00
procedure TMVCConnectionsRepository. AddDefaultConnection(
const aConnectionDefName: String ) ;
var
lConn: TFDConnection;
begin
lConn : = TFDConnection. Create( nil ) ;
try
lConn. ConnectionDefName : = aConnectionDefName;
AddDefaultConnection( lConn, True ) ;
except
on E: Exception do
begin
lConn. Free;
raise ;
end ;
end ;
end ;
2018-09-25 15:36:53 +02:00
constructor TMVCConnectionsRepository. Create;
begin
inherited ;
2018-10-14 18:23:20 +02:00
fMREW : = TMultiReadExclusiveWriteSynchronizer. Create;
2018-11-09 18:11:59 +01:00
fConnectionsDict : = TDictionary< string , TConnHolder> . Create;
2018-10-14 18:23:20 +02:00
fCurrentConnectionsByThread : = TDictionary< TThreadID, string > . Create;
2018-09-25 15:36:53 +02:00
end ;
destructor TMVCConnectionsRepository. Destroy;
begin
fConnectionsDict. Free;
2018-10-14 18:23:20 +02:00
fCurrentConnectionsByThread. Free;
fMREW. Free;
2018-09-25 15:36:53 +02:00
inherited ;
end ;
2019-03-05 20:55:37 +01:00
function TMVCConnectionsRepository. GetByName( const aName: string ) : TFDConnection;
2018-10-14 18:23:20 +02:00
var
lKeyName: string ;
2018-11-09 18:11:59 +01:00
lConnHolder: TConnHolder;
2018-09-25 15:36:53 +02:00
begin
2020-02-21 20:14:15 +01:00
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result : = nil ;
2019-08-05 12:55:44 +02:00
{$ENDIF}
2018-10-14 18:23:20 +02:00
lKeyName : = GetKeyName( aName. ToLower) ;
fMREW. BeginRead;
try
2018-11-09 18:11:59 +01:00
if not fConnectionsDict. TryGetValue( lKeyName, lConnHolder) then
2018-10-14 18:23:20 +02:00
raise Exception. CreateFmt( 'Unknown connection %s' , [ aName] ) ;
2018-11-09 18:11:59 +01:00
Result : = lConnHolder. Connection;
2018-10-14 18:23:20 +02:00
finally
fMREW. EndRead;
end ;
2018-09-25 15:36:53 +02:00
end ;
2021-05-03 19:29:01 +02:00
function TMVCConnectionsRepository. GetCurrent( const RaiseExceptionIfNotAvailable: Boolean )
: TFDConnection;
2018-10-14 18:23:20 +02:00
var
lName: string ;
2018-09-25 15:36:53 +02:00
begin
2020-02-21 20:14:15 +01:00
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result : = nil ;
2019-08-05 12:55:44 +02:00
{$ENDIF}
2018-10-14 18:23:20 +02:00
fMREW. BeginRead;
try
2019-08-02 12:32:23 +02:00
if fCurrentConnectionsByThread. TryGetValue( TThread. CurrentThread. ThreadID, lName) then
2018-10-14 18:23:20 +02:00
begin
Result : = GetByName( lName) ;
end
else
begin
2020-10-17 23:19:05 +02:00
if RaiseExceptionIfNotAvailable then
raise EMVCActiveRecord. Create( 'No current connection for thread' )
else
Result : = nil ;
2018-10-14 18:23:20 +02:00
end ;
finally
fMREW. EndRead;
end ;
end ;
2018-11-02 21:43:09 +01:00
function TMVCConnectionsRepository. GetCurrentBackend: string ;
begin
Result : = GetBackEndByConnection( GetCurrent) ;
end ;
2018-10-14 18:23:20 +02:00
function TMVCConnectionsRepository. GetKeyName( const aName: string ) : string ;
begin
2019-08-02 12:32:23 +02:00
Result : = Format( '%10.10d::%s' , [ TThread. CurrentThread. ThreadID, aName] ) ;
2018-09-25 15:36:53 +02:00
end ;
2021-08-13 18:05:48 +02:00
procedure TMVCConnectionsRepository. RemoveConnection( const aName: string ; const RaiseExceptionIfNotAvailable: Boolean = True ) ;
2018-09-25 15:36:53 +02:00
var
lName: string ;
2018-10-14 18:23:20 +02:00
lKeyName: string ;
2018-11-09 18:11:59 +01:00
lConnHolder: TConnHolder;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
lName : = aName. ToLower;
lKeyName : = GetKeyName( lName) ;
fMREW. BeginWrite;
2018-09-25 15:36:53 +02:00
try
2018-11-09 18:11:59 +01:00
if not fConnectionsDict. TryGetValue( lKeyName, lConnHolder) then
2021-08-13 18:05:48 +02:00
begin
if RaiseExceptionIfNotAvailable then
begin
raise Exception. CreateFmt( 'Unknown connection %s' , [ aName] )
end
else
begin
Exit;
end ;
end ;
2018-10-14 18:23:20 +02:00
fConnectionsDict. Remove( lKeyName) ;
try
2018-11-09 18:11:59 +01:00
FreeAndNil( lConnHolder) ;
2018-10-14 18:23:20 +02:00
except
on E: Exception do
begin
LogE( 'ActiveRecord: ' + E. ClassName + ' > ' + E. Message ) ;
raise ;
end ;
2018-09-25 15:36:53 +02:00
end ;
2018-10-14 18:23:20 +02:00
finally
fMREW. EndWrite;
2018-09-25 15:36:53 +02:00
end ;
end ;
2021-08-13 18:05:48 +02:00
procedure TMVCConnectionsRepository. RemoveDefaultConnection( const RaiseExceptionIfNotAvailable: Boolean = True ) ;
2019-05-09 20:53:52 +02:00
begin
2021-08-13 18:05:48 +02:00
RemoveConnection( 'default' , RaiseExceptionIfNotAvailable) ;
2019-05-09 20:53:52 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCConnectionsRepository. SetCurrent( const aName: string ) ;
2018-09-25 15:36:53 +02:00
var
lName: string ;
2018-10-14 18:23:20 +02:00
lKeyName: string ;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
lName : = aName. ToLower;
lKeyName : = GetKeyName( lName) ;
fMREW. BeginWrite;
try
if not fConnectionsDict. ContainsKey( lKeyName) then
raise Exception. CreateFmt( 'Unknown connection %s' , [ aName] ) ;
2019-08-02 12:32:23 +02:00
fCurrentConnectionsByThread. AddOrSetValue( TThread. CurrentThread. ThreadID, lName) ;
2018-10-14 18:23:20 +02:00
finally
fMREW. EndWrite;
end ;
2018-09-25 15:36:53 +02:00
end ;
2020-03-30 13:30:45 +02:00
procedure TMVCConnectionsRepository. SetDefault;
begin
SetCurrent( 'default' ) ;
end ;
2018-09-25 15:36:53 +02:00
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
begin
if gEntitiesRegistry = nil then
begin
TMonitor. Enter( gLock) ;
try
if gEntitiesRegistry = nil then
begin
gEntitiesRegistry : = TMVCEntitiesRegistry. Create;
end ;
finally
TMonitor. Exit( gLock) ;
end ;
end ;
Result : = gEntitiesRegistry;
end ;
{ TableFieldAttribute }
2020-03-23 18:51:57 +01:00
constructor MVCTableFieldAttribute. Create( aFieldName: string ; const aDataTypeName: string = '' ) ;
2018-09-25 15:36:53 +02:00
begin
2020-03-12 20:37:48 +01:00
Create( aFieldName, [ ] , '' , aDataTypeName) ;
2018-09-25 15:36:53 +02:00
end ;
{ TableAttribute }
2018-10-23 16:18:34 +02:00
constructor MVCTableAttribute. Create( aName: string ) ;
2018-09-25 15:36:53 +02:00
begin
2021-11-17 15:36:20 +01:00
Create( aName, '' ) ;
2018-09-25 15:36:53 +02:00
end ;
{ TActiveRecord }
destructor TMVCActiveRecord. Destroy;
begin
2020-05-04 09:42:16 +02:00
fChildren. Free;
2018-09-25 15:36:53 +02:00
fMap. Free;
2018-11-02 21:43:09 +01:00
fSQLGenerator. Free;
fRQL2SQL. Free;
fConn : = nil ; // do not free it!!
2018-09-25 15:36:53 +02:00
inherited ;
end ;
2020-02-03 10:51:40 +01:00
procedure TMVCActiveRecord. EnsureConnection;
begin
GetConnection;
end ;
2021-05-03 19:29:01 +02:00
function TMVCActiveRecord. ExecNonQuery( const SQL: string ;
RefreshAutoGenerated: Boolean = false ) : int64 ;
2018-09-25 15:36:53 +02:00
var
lQry: TFDQuery;
lPar: TFDParam;
2020-03-25 11:35:25 +01:00
lPair: TPair< TRTTIField, TFieldInfo> ;
2018-09-25 15:36:53 +02:00
lValue: TValue;
2020-03-23 18:51:57 +01:00
lSQL: string ;
2019-11-27 19:04:06 +01:00
lHandled: Boolean ;
2021-11-18 00:49:12 +01:00
I: Integer ;
2018-09-25 15:36:53 +02:00
begin
lQry : = TFDQuery. Create( nil ) ;
try
2020-02-03 10:51:40 +01:00
lQry. Connection : = GetConnection;
2019-03-18 14:08:34 +01:00
lSQL : = SQL;
OnBeforeExecuteSQL( lSQL) ;
lQry. SQL. Text : = lSQL;
2019-11-27 19:04:06 +01:00
2020-01-04 12:53:53 +01:00
lHandled : = false ;
// lQry.Prepare;
2019-11-27 19:04:06 +01:00
MapObjectToParams( lQry. Params, lHandled) ;
if not lHandled then
2018-09-25 15:36:53 +02:00
begin
2021-11-18 00:49:12 +01:00
{partitioning}
2021-11-18 17:52:06 +01:00
for I : = 0 to GetPartitionInfo. FieldNames. Count - 1 do
2021-11-18 00:49:12 +01:00
begin
2021-11-18 17:52:06 +01:00
lPar : = lQry. FindParam( SQLGenerator. GetParamNameForSQL( GetPartitionInfo. FieldNames[ I] ) ) ;
2021-11-18 00:49:12 +01:00
if lPar < > nil then
begin
2021-11-18 17:52:06 +01:00
if GetPartitionInfo. FieldTypes[ I] = ftInteger then
lValue : = StrToInt( GetPartitionInfo. FieldValues[ I] )
2021-11-18 00:49:12 +01:00
else
2021-11-18 17:52:06 +01:00
lValue : = GetPartitionInfo. FieldValues[ I] ;
2021-11-18 00:49:12 +01:00
//lPar.DataTypeName := fPartitionInfo.FieldValues[I];
MapTValueToParam( lValue, lPar) ;
end
end ;
{end-partitioning}
2019-11-27 19:04:06 +01:00
for lPair in fMap do
2018-09-25 15:36:53 +02:00
begin
2020-04-08 18:04:45 +02:00
lPar : = lQry. FindParam( SQLGenerator. GetParamNameForSQL( lPair. Value. FieldName) ) ;
2019-11-27 19:04:06 +01:00
if lPar < > nil then
begin
lValue : = lPair. Key. GetValue( Self) ;
2020-04-08 18:04:45 +02:00
lPar. DataTypeName : = fMap. GetInfoByFieldName( lPair. Value. FieldName) . DataTypeName;
2019-11-27 19:04:06 +01:00
MapTValueToParam( lValue, lPar) ;
end
end ;
2018-10-14 18:23:20 +02:00
2019-11-27 19:04:06 +01:00
// check if it's the primary key
2020-04-08 18:04:45 +02:00
lPar : = lQry. FindParam( SQLGenerator. GetParamNameForSQL( fPrimaryKeyFieldName) ) ;
2019-11-27 19:04:06 +01:00
if lPar < > nil then
2018-09-25 15:36:53 +02:00
begin
2019-11-27 19:04:06 +01:00
if lPar. DataType = ftUnknown then
begin
{ TODO -oDanieleT -cGeneral : Let's find a smarter way to do this if the engine cannot recognize parameter's datatype }
2020-03-31 16:23:22 +02:00
lPar. DataType : = GetPrimaryKeyFieldType;
2019-11-27 19:04:06 +01:00
end ;
MapTValueToParam( fPrimaryKey. GetValue( Self) , lPar) ;
2018-09-25 15:36:53 +02:00
end ;
end ;
2020-01-08 15:30:10 +01:00
if RefreshAutoGenerated and ( TMVCActiveRecordFieldOption. foAutoGenerated in fPrimaryKeyOptions) and
fPrimaryKeySequenceName. IsEmpty then
2018-09-25 15:36:53 +02:00
begin
2020-01-04 12:53:53 +01:00
lValue : = fPrimaryKey. GetValue( Self) ;
2020-01-08 15:30:10 +01:00
lQry. Open;
2020-02-03 10:51:40 +01:00
2020-01-08 15:30:10 +01:00
if ( lValue. Kind = tkRecord) then
2020-01-04 12:53:53 +01:00
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToNullableRTTIField( lValue, lQry. Fields[ 0 ] , fPrimaryKey, Self) ;
2020-01-04 12:53:53 +01:00
end
else
begin
lValue : = lQry. FieldByName( fPrimaryKeyFieldName) . AsInteger;
2020-02-03 10:51:40 +01:00
fPrimaryKey. SetValue( Self, lValue) ;
2020-01-04 12:53:53 +01:00
end ;
2018-09-25 15:36:53 +02:00
end
else
begin
2019-03-18 14:08:34 +01:00
lQry. ExecSQL( lSQL) ;
2018-09-25 15:36:53 +02:00
end ;
Result : = lQry. RowsAffected;
2018-10-14 18:23:20 +02:00
finally
2018-09-25 15:36:53 +02:00
lQry. Free;
end ;
end ;
2019-03-05 20:55:37 +01:00
class function TMVCActiveRecord. ExecQuery( const SQL: string ; const Values: array of Variant ;
const Connection: TFDConnection) : TDataSet;
2018-09-25 15:36:53 +02:00
begin
2020-03-23 18:51:57 +01:00
Result : = ExecQuery( SQL, Values, [ ] , Connection) ;
2018-09-25 15:36:53 +02:00
end ;
2020-03-23 18:51:57 +01:00
procedure TMVCActiveRecord. FillPrimaryKey( const SequenceName: string ) ;
2020-01-08 15:30:10 +01:00
var
lDS: TDataSet;
lSQL: string ;
begin
if not SequenceName. IsEmpty then
begin
lSQL : = SQLGenerator. GetSequenceValueSQL( fPrimaryKeyFieldName, SequenceName) ;
if lSQL. IsEmpty then
begin
Exit;
end ;
lDS : = ExecQuery( lSQL, [ ] ) ;
try
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField( lDS. Fields[ 0 ] , fPrimaryKey, Self) ;
2020-01-08 15:30:10 +01:00
finally
lDS. Free;
end ;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. ExecQuery( const SQL: string ; const Values: array of Variant )
: TDataSet;
2018-09-25 15:36:53 +02:00
begin
2018-09-28 13:01:46 +02:00
Result : = ExecQuery( SQL, Values, nil ) ;
2018-09-25 15:36:53 +02:00
end ;
procedure TMVCActiveRecord. InitTableInfo;
var
2018-10-14 18:23:20 +02:00
lAttribute: TCustomAttribute;
2020-03-25 11:35:25 +01:00
lRTTIField: TRTTIField;
lFieldInfo: TFieldInfo;
2020-03-31 16:23:22 +02:00
lPrimaryFieldTypeAsStr: string ;
2018-09-25 15:36:53 +02:00
begin
2021-11-18 17:52:06 +01:00
fPartitionInfoInternal : = nil ;
2021-05-03 19:29:01 +02:00
fEntityAllowedActions : = [ TMVCEntityAction. eaCreate, TMVCEntityAction. eaRetrieve,
TMVCEntityAction. eaUpdate,
2018-11-02 21:43:09 +01:00
TMVCEntityAction. eaDelete] ;
2018-09-25 15:36:53 +02:00
fTableName : = '' ;
2021-11-18 17:52:06 +01:00
fPartitionClause : = '' ;
2020-02-03 10:51:40 +01:00
fRTTIType : = gCtx. GetType( Self. ClassInfo) as TRttiInstanceType;
2018-09-25 15:36:53 +02:00
fObjAttributes : = fRTTIType. GetAttributes;
2018-10-14 18:23:20 +02:00
for lAttribute in fObjAttributes do
begin
2018-10-23 16:18:34 +02:00
if lAttribute is MVCTableAttribute then
2018-10-14 18:23:20 +02:00
begin
2018-10-23 16:18:34 +02:00
fTableName : = MVCTableAttribute( lAttribute) . Name ;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter : = MVCTableAttribute( lAttribute) . RQLFilter;
Continue;
2018-10-14 18:23:20 +02:00
end ;
2018-10-23 16:18:34 +02:00
if lAttribute is MVCEntityActionsAttribute then
2018-09-25 15:36:53 +02:00
begin
2019-03-05 20:55:37 +01:00
fEntityAllowedActions : = MVCEntityActionsAttribute( lAttribute) . EntityAllowedActions;
2018-09-25 15:36:53 +02:00
end ;
2021-11-18 00:49:12 +01:00
if lAttribute is MVCPartitionAttribute then
begin
2021-11-18 17:52:06 +01:00
fPartitionClause : = MVCPartitionAttribute( lAttribute) . PartitionClause;
2021-11-18 00:49:12 +01:00
Continue;
end ;
end ;
2018-09-25 15:36:53 +02:00
if fTableName = '' then
2020-03-30 13:30:45 +02:00
begin
if [ eaCreate, eaUpdate, eaDelete] * fEntityAllowedActions < > [ ] then
begin
raise Exception. Create( 'Cannot find TableNameAttribute' ) ;
end ;
end ;
2018-09-25 15:36:53 +02:00
fProps : = fRTTIType. GetFields;
2018-10-14 18:23:20 +02:00
for lRTTIField in fProps do
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
fPropsAttributes : = lRTTIField. GetAttributes;
2018-09-25 15:36:53 +02:00
if Length( fPropsAttributes) = 0 then
2018-10-14 18:23:20 +02:00
continue;
for lAttribute in fPropsAttributes do
2018-09-25 15:36:53 +02:00
begin
2018-10-23 16:18:34 +02:00
if lAttribute is MVCTableFieldAttribute then
2018-09-25 15:36:53 +02:00
begin
2019-03-05 20:55:37 +01:00
if foPrimaryKey in MVCTableFieldAttribute( lAttribute) . FieldOptions then
begin
fPrimaryKey : = lRTTIField;
2020-03-31 16:23:22 +02:00
lPrimaryFieldTypeAsStr : = fPrimaryKey. FieldType. ToString. ToLower;
if lPrimaryFieldTypeAsStr. EndsWith( 'int64' ) then
begin
fPrimaryKeyFieldType : = ftLargeInt;
end
2021-05-03 19:29:01 +02:00
else if lPrimaryFieldTypeAsStr. EndsWith( 'integer' ) or
lPrimaryFieldTypeAsStr. EndsWith( 'int32' ) then
2020-03-31 16:23:22 +02:00
begin
fPrimaryKeyFieldType : = ftInteger;
end
else if lPrimaryFieldTypeAsStr. EndsWith( 'string' ) then
begin
fPrimaryKeyFieldType : = ftString;
end
else
begin
raise EMVCActiveRecord. Create
2021-05-03 19:29:01 +02:00
( 'Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String - found: '
+
2020-03-31 16:23:22 +02:00
lPrimaryFieldTypeAsStr) ;
end ;
2019-03-05 20:55:37 +01:00
fPrimaryKeyFieldName : = MVCTableFieldAttribute( lAttribute) . FieldName;
fPrimaryKeyOptions : = MVCTableFieldAttribute( lAttribute) . FieldOptions;
2020-01-08 15:30:10 +01:00
fPrimaryKeySequenceName : = MVCTableFieldAttribute( lAttribute) . SequenceName;
2019-03-05 20:55:37 +01:00
continue;
end ;
2020-03-25 11:35:25 +01:00
lFieldInfo : = TFieldInfo. Create;
2020-08-11 00:54:42 +02:00
// lFieldInfo.TableName := fTableName;
2020-03-25 11:35:25 +01:00
lFieldInfo. FieldName : = MVCTableFieldAttribute( lAttribute) . FieldName;
lFieldInfo. FieldOptions : = MVCTableFieldAttribute( lAttribute) . FieldOptions;
lFieldInfo. DataTypeName : = MVCTableFieldAttribute( lAttribute) . DataTypeName;
fMap. Add( lRTTIField, lFieldInfo) ;
// if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then
// begin
// lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
// fMapNonTransientFields.Add(lRTTIField, lFieldInfo);
// end;
//
// if not MVCTableFieldAttribute(lAttribute).DataTypeName.IsEmpty then
// begin
// fMapFieldDataTypes.Add(MVCTableFieldAttribute(lAttribute).FieldName.ToUpper,
// MVCTableFieldAttribute(lAttribute).DataTypeName);
// end;
2018-09-25 15:36:53 +02:00
end ;
end ;
end ;
2020-03-25 11:35:25 +01:00
fMap. EndUpdates;
2020-09-25 00:32:55 +02:00
Assert( fMap. WritableFieldsCount + fMap. ReadableFieldsCount > 0 ,
'No fields defined [HINT] Use MVCTableField in private fields' ) ;
2021-11-18 17:52:06 +01:00
fPartitionInfoInternal : = nil ;
2018-09-25 15:36:53 +02:00
end ;
procedure TMVCActiveRecord. Insert;
var
SQL: string ;
begin
2018-10-14 18:23:20 +02:00
CheckAction( TMVCEntityAction. eaCreate) ;
2020-03-30 13:30:45 +02:00
OnValidation( TMVCEntityAction. eaCreate) ;
2018-09-25 15:36:53 +02:00
OnBeforeInsert;
OnBeforeInsertOrUpdate;
2020-08-11 00:54:42 +02:00
if fMap. WritableFieldsCount = 0 then
2019-02-21 20:17:11 +01:00
begin
raise EMVCActiveRecord. CreateFmt
2020-08-11 00:54:42 +02:00
( 'Cannot insert an entity if all fields are not writable or transient. Class [%s] mapped on table [%s]' ,
[ ClassName, fTableName] ) ;
2019-02-21 20:17:11 +01:00
end ;
2020-01-08 15:30:10 +01:00
if ( foAutoGenerated in fPrimaryKeyOptions) then
begin
if not SQLGenerator. HasReturning then
begin
if not SQLGenerator. HasSequences then
begin
raise EMVCActiveRecord. Create
( 'Cannot use AutoGenerated primary keys if the engine doesn' 't support returning clause nor sequences' ) ;
end
else
begin
if fPrimaryKeySequenceName. IsEmpty then
begin
2021-05-03 19:29:01 +02:00
raise EMVCActiveRecord. Create( 'SequenceName is empty for entity ' + ClassName + ' but ' +
GetBackEnd +
2020-01-08 15:30:10 +01:00
' requires it' ) ;
end ;
FillPrimaryKey( fPrimaryKeySequenceName) ;
end ;
end ;
end ;
2020-03-25 11:35:25 +01:00
SQL : = SQLGenerator. CreateInsertSQL( fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions) ;
2018-09-25 15:36:53 +02:00
ExecNonQuery( SQL, True ) ;
2018-10-23 16:18:34 +02:00
OnAfterInsert;
OnAfterInsertOrUpdate;
2018-09-25 15:36:53 +02:00
end ;
2020-03-23 18:51:57 +01:00
function TMVCActiveRecord. InternalCount( const RQL: string ) : int64 ;
2019-08-02 12:32:23 +02:00
var
lSQL: string ;
begin
lSQL : = Self. SQLGenerator. CreateSelectCount( fTableName) ;
2021-11-17 15:36:20 +01:00
lSQL : = lSQL + fSQLGenerator. CreateSQLWhereByRQL( RQL, GetMapping, false , True ) ;
2019-08-02 12:32:23 +02:00
Result : = GetScalar( lSQL, [ ] ) ;
end ;
2021-05-03 19:29:01 +02:00
function TMVCActiveRecord. InternalSelectRQL( const RQL: string ; const MaxRecordCount: Integer )
: TMVCActiveRecordList;
2019-08-02 12:32:23 +02:00
var
lSQL: string ;
begin
2020-12-18 14:41:01 +01:00
lSQL : = SQLGenerator. CreateSQLWhereByRQL( RQL, GetMapping, True , false , MaxRecordCount) ;
2019-08-02 12:32:23 +02:00
LogD( Format( 'RQL [%s] => SQL [%s]' , [ RQL, lSQL] ) ) ;
Result : = Where( TMVCActiveRecordClass( Self. ClassType) , lSQL, [ ] ) ;
end ;
2018-10-14 18:23:20 +02:00
constructor TMVCActiveRecord. Create( aLazyLoadConnection: Boolean ) ;
2018-09-25 15:36:53 +02:00
begin
2018-09-28 13:01:46 +02:00
inherited Create;
fConn : = nil ;
2018-11-02 21:43:09 +01:00
SetLength( fMapping, 0 ) ;
{ TODO -oDanieleT -cGeneral : Consider lazyconnection }
2020-02-03 10:51:40 +01:00
if not aLazyLoadConnection then
begin
GetConnection;
end ;
2020-03-25 11:35:25 +01:00
fMap : = TFieldsMap. Create;
// fMapNonTransientFields := TFieldsMap.Create;
// fMapFieldDataTypes := TDictionary<string, string>.Create;
2018-09-25 15:36:53 +02:00
InitTableInfo;
end ;
2018-11-02 21:43:09 +01:00
function TMVCActiveRecord. GenerateSelectSQL: string ;
2018-09-25 15:36:53 +02:00
begin
2021-05-03 19:29:01 +02:00
Result : = SQLGenerator. CreateSelectSQL( fTableName, fMap, fPrimaryKeyFieldName,
fPrimaryKeyOptions) ;
2018-11-02 21:43:09 +01:00
end ;
2020-08-28 18:04:29 +02:00
function TMVCActiveRecord. GetAttributes( const AttrName: string ) : TValue;
var
lProperty: TRttiProperty;
begin
if not TRttiUtils. ExistsProperty( Self, AttrName, lProperty) then
begin
raise EMVCActiveRecord. CreateFmt( 'Attribute [%s] not found' , [ AttrName] ) ;
end ;
Result : = lProperty. GetValue( Self) ;
end ;
2018-11-02 21:43:09 +01:00
function TMVCActiveRecord. GetBackEnd: string ;
begin
if fBackendDriver. IsEmpty then
2018-09-25 15:36:53 +02:00
begin
2020-02-03 10:51:40 +01:00
fBackendDriver : = GetBackEndByConnection( GetConnection) ;
2018-09-25 15:36:53 +02:00
end ;
2018-11-02 21:43:09 +01:00
Result : = fBackendDriver;
2018-09-25 15:36:53 +02:00
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. GetByPK( const aClass: TMVCActiveRecordClass; const aValue: string ;
2020-03-31 16:23:22 +02:00
const RaiseExceptionIfNotFound: Boolean ) : TMVCActiveRecord;
begin
Result : = aClass. Create;
if not Result . LoadByPK( aValue) then
begin
Result . Free;
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound. Create( 'Data not found' ) ;
end
else
begin
Result : = nil ;
end ;
end ;
end ;
2020-01-04 12:53:53 +01:00
class function TMVCActiveRecord. GetByPK( const aClass: TMVCActiveRecordClass; const aValue: int64 ;
const RaiseExceptionIfNotFound: Boolean ) : TMVCActiveRecord;
2018-09-25 15:36:53 +02:00
begin
Result : = aClass. Create;
2019-01-18 18:11:27 +01:00
if not Result . LoadByPK( aValue) then
begin
Result . Free;
2020-01-04 12:53:53 +01:00
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound. Create( 'Data not found' ) ;
end
else
begin
Result : = nil ;
end ;
2019-01-18 18:11:27 +01:00
end ;
2018-09-25 15:36:53 +02:00
end ;
2020-01-04 12:53:53 +01:00
class function TMVCActiveRecordHelper. GetByPK< T> ( const aValue: int64 ;
const RaiseExceptionIfNotFound: Boolean = True ) : T;
2018-09-25 15:36:53 +02:00
var
lActiveRecord: TMVCActiveRecord;
2020-08-11 00:54:42 +02:00
lLoaded: Boolean ;
2018-09-25 15:36:53 +02:00
begin
Result : = T. Create;
lActiveRecord : = TMVCActiveRecord( Result ) ;
2020-08-11 00:54:42 +02:00
try
lLoaded : = lActiveRecord. LoadByPK( aValue) ;
except
FreeAndNil( Result ) ;
raise ;
end ;
if not lLoaded then
2019-01-18 18:11:27 +01:00
begin
2020-08-11 00:54:42 +02:00
FreeAndNil( Result ) ;
2020-01-04 12:53:53 +01:00
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound. Create( 'Data not found' ) ;
end ;
2019-01-18 18:11:27 +01:00
end ;
2018-09-25 15:36:53 +02:00
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. GetByPK< T> ( const aValue: string ;
const RaiseExceptionIfNotFound: Boolean ) : T;
2020-03-31 16:23:22 +02:00
var
lActiveRecord: TMVCActiveRecord;
begin
Result : = T. Create;
lActiveRecord : = TMVCActiveRecord( Result ) ;
if not lActiveRecord. LoadByPK( aValue) then
begin
Result . Free;
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound. Create( 'Data not found' ) ;
end
else
begin
Result : = nil ;
end ;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. GetFirstByWhere< T> ( const SQLWhere: string ;
const Params: array of Variant ;
2020-08-28 18:04:29 +02:00
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean ) : T;
2018-10-23 16:18:34 +02:00
var
lList: TObjectList< T> ;
begin
2020-03-23 18:51:57 +01:00
lList : = Where< T> ( SQLWhere, Params, ParamTypes) ;
2018-10-23 16:18:34 +02:00
try
if lList. Count = 0 then
begin
if RaiseExceptionIfNotFound then
2020-03-23 18:51:57 +01:00
raise EMVCActiveRecordNotFound. Create( 'Got 0 rows when at least 1 was expected' ) ;
2018-10-23 16:18:34 +02:00
Exit( nil ) ;
end ;
2020-02-05 23:46:38 +01:00
Result : = lList. Extract( lList. First) ;
2018-10-23 16:18:34 +02:00
finally
lList. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. GetFirstByWhere< T> ( const SQLWhere: string ;
const Params: array of Variant ;
2020-03-23 18:51:57 +01:00
const RaiseExceptionIfNotFound: Boolean ) : T;
begin
Result : = GetFirstByWhere< T> ( SQLWhere, Params, [ ] , RaiseExceptionIfNotFound) ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. GetOneByWhere< T> ( const SQLWhere: string ;
const Params: array of Variant ;
2020-08-28 18:04:29 +02:00
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean ) : T;
2020-03-23 18:51:57 +01:00
begin
Result : = GetFirstByWhere< T> ( SQLWhere, Params, ParamTypes, false ) ;
if Result = nil then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound. Create( 'Got 0 rows when exactly 1 was expected' ) ;
end ;
end ;
2018-09-28 13:01:46 +02:00
function TMVCActiveRecord. GetMapping: TMVCFieldsMapping;
var
2020-03-25 11:35:25 +01:00
lPair: TPair< TRTTIField, TFieldInfo> ;
2018-09-28 13:01:46 +02:00
i: Integer ;
begin
2020-04-08 18:04:45 +02:00
{ TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
2021-04-08 00:33:27 +02:00
{ TODO -oDanieleT -cGeneral : Add NameAs in the TFieldInfo because the user needs to use the property name he see }
2018-11-02 21:43:09 +01:00
if Length( fMapping) = 0 then
2018-09-28 13:01:46 +02:00
begin
2018-11-02 21:43:09 +01:00
if not fPrimaryKeyFieldName. IsEmpty then
2019-02-05 18:08:21 +01:00
begin
SetLength( fMapping, fMap. Count + 1 ) ;
fMapping[ 0 ] . InstanceFieldName : = fPrimaryKey. Name . Substring( 1 ) . ToLower;
fMapping[ 0 ] . DatabaseFieldName : = fPrimaryKeyFieldName;
i : = 1 ;
end
2018-11-02 21:43:09 +01:00
else
2019-02-05 18:08:21 +01:00
begin
2018-11-02 21:43:09 +01:00
SetLength( fMapping, fMap. Count) ;
2019-02-05 18:08:21 +01:00
i : = 0 ;
end ;
2018-09-28 13:01:46 +02:00
2018-11-02 21:43:09 +01:00
for lPair in fMap do
begin
fMapping[ i] . InstanceFieldName : = lPair. Key. Name . Substring( 1 ) . ToLower;
2020-03-25 11:35:25 +01:00
fMapping[ i] . DatabaseFieldName : = lPair. Value. FieldName;
Inc( i) ;
2018-11-02 21:43:09 +01:00
end ;
2018-09-28 13:01:46 +02:00
end ;
2018-11-02 21:43:09 +01:00
Result : = fMapping;
2018-09-28 13:01:46 +02:00
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. GetOneByWhere< T> ( const SQLWhere: string ;
const Params: array of Variant ;
2019-03-05 20:55:37 +01:00
const RaiseExceptionIfNotFound: Boolean ) : T;
2018-10-23 16:18:34 +02:00
begin
Result : = GetFirstByWhere< T> ( SQLWhere, Params, false ) ;
if Result = nil then
begin
if RaiseExceptionIfNotFound then
2020-03-23 18:51:57 +01:00
raise EMVCActiveRecordNotFound. Create( 'Got 0 rows when exactly 1 was expected' ) ;
2018-10-23 16:18:34 +02:00
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. SelectOneByRQL< T> ( const RQL: string ;
const RaiseExceptionIfNotFound: Boolean ) : T;
2020-06-22 15:24:20 +02:00
var
lAR: TMVCActiveRecord;
lSQL: string ;
begin
lAR : = T. Create;
try
lSQL : = lAR. SQLGenerator. CreateSQLWhereByRQL( RQL, lAR. GetMapping) . Trim;
2021-11-17 15:36:20 +01:00
lSQL : = TMVCSQLGenerator. RemoveInitialWhereKeyword( lSQL) ;
2020-06-22 15:24:20 +02:00
Result : = GetFirstByWhere< T> ( lSQL, [ ] , RaiseExceptionIfNotFound) ;
if Result = nil then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound. Create( 'Got 0 rows when exactly 1 was expected' ) ;
end ;
finally
lAR. Free;
end ;
end ;
2021-11-18 17:52:06 +01:00
function TMVCActiveRecord. GetPartitionInfo: TPartitionInfo;
var
lRQLCompilerClass: TRQLCompilerClass;
begin
if fPartitionInfoInternal = nil then
begin
lRQLCompilerClass : = TRQLCompilerRegistry. Instance. GetCompiler( GetBackEnd) ;
fPartitionInfoInternal : = TPartitionInfo. BuildPartitionClause( fPartitionClause, lRQLCompilerClass) ;
end ;
Result : = fPartitionInfoInternal;
end ;
2018-09-25 15:36:53 +02:00
function TMVCActiveRecord. GetPK: TValue;
2020-02-03 13:19:55 +01:00
var
lIsNullableType: Boolean ;
2018-09-25 15:36:53 +02:00
begin
2020-02-03 13:19:55 +01:00
if not TryGetPKValue( Result , lIsNullableType) then
2020-01-04 12:53:53 +01:00
begin
2020-02-03 13:19:55 +01:00
if not lIsNullableType then
begin
raise EMVCActiveRecord. Create( 'Primary key not available' ) ;
end ;
2020-01-04 12:53:53 +01:00
end ;
end ;
2021-04-25 22:40:06 +02:00
function TMVCActiveRecord. PKIsNull: Boolean ;
var
lValue: TValue;
lIsNullableType: Boolean ;
begin
if not PKIsNullable( lValue) then
begin
raise EMVCActiveRecord. Create( 'PK is not nullable' ) ;
end ;
Result : = not TryGetPKValue( lValue, lIsNullableType) ;
end ;
function TMVCActiveRecord. PKIsNullable( out PKValue: TValue) : Boolean ;
var
lValue: TValue;
begin
PKValue : = TryGetPKValue( lValue, Result ) ;
end ;
2020-03-31 16:23:22 +02:00
function TMVCActiveRecord. GetPrimaryKeyFieldType: TFieldType;
begin
Result : = fPrimaryKeyFieldType;
end ;
2020-01-04 12:53:53 +01:00
function TMVCActiveRecord. GetPrimaryKeyIsAutogenerated: Boolean ;
begin
Result : = foAutoGenerated in fPrimaryKeyOptions;
2018-09-25 15:36:53 +02:00
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. GetScalar( const SQL: string ;
const Params: array of Variant ) : Variant ;
2019-01-08 12:48:27 +01:00
begin
Result : = CurrentConnection. ExecSQLScalar( SQL, Params) ;
end ;
2021-05-03 19:29:01 +02:00
function TMVCActiveRecord. CheckAction( const aEntityAction: TMVCEntityAction;
const aRaiseException: Boolean ) : Boolean ;
2018-10-14 18:23:20 +02:00
begin
Result : = aEntityAction in fEntityAllowedActions;
if ( not Result ) and aRaiseException then
2020-09-30 11:16:10 +02:00
raise EMVCActiveRecord. CreateFmt
( 'Action [%s] not allowed on entity [%s]. [HINT] Add the entity action in MVCEntityActions attribute.' ,
2020-08-30 08:52:21 +02:00
[ GetEnumName( TypeInfo( TMVCEntityAction) , Ord( aEntityAction) ) , ClassName] ) ;
2018-10-14 18:23:20 +02:00
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. Count( const aClass: TMVCActiveRecordClass;
const RQL: string ) : int64 ;
2019-01-13 19:18:57 +01:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create;
try
2020-08-30 08:52:21 +02:00
// Up to 10.1 Berlin, here the compiler try to call the Count<T> introduced by the class helper
2020-01-04 12:53:53 +01:00
// Instead of the Count() which exists in "TMVCActiveRecord"
2019-08-02 12:32:23 +02:00
Result : = lAR. InternalCount( RQL) ;
2019-01-13 19:18:57 +01:00
finally
lAR. Free;
end ;
end ;
2020-03-23 18:51:57 +01:00
function TMVCActiveRecord. Count( const RQL: string = '' ) : int64 ;
2019-05-09 20:53:52 +02:00
begin
2019-08-02 12:32:23 +02:00
Result : = InternalCount( RQL) ;
2019-05-09 20:53:52 +02:00
end ;
2020-03-23 18:51:57 +01:00
class function TMVCActiveRecordHelper. Count< T> ( const RQL: string = '' ) : int64 ;
2019-05-09 20:53:52 +02:00
begin
Result : = TMVCActiveRecord. Count( TMVCActiveRecordClass( T) , RQL) ;
2019-01-13 19:18:57 +01:00
end ;
2018-11-24 16:56:21 +01:00
class function TMVCActiveRecord. CurrentConnection: TFDConnection;
2018-10-23 16:18:34 +02:00
begin
Result : = ActiveRecordConnectionsRegistry. GetCurrent;
end ;
2020-02-03 10:51:40 +01:00
function TMVCActiveRecord. GetConnection: TFDConnection;
2018-09-28 13:01:46 +02:00
begin
if fConn = nil then
begin
fConn : = ActiveRecordConnectionsRegistry. GetCurrent;
end ;
Result : = fConn;
end ;
constructor TMVCActiveRecord. Create;
begin
2020-02-03 10:51:40 +01:00
Create( True ) ;
2018-09-28 13:01:46 +02:00
end ;
2021-06-27 15:14:37 +02:00
procedure TMVCActiveRecord. Delete( const RaiseExceptionIfNotFound: Boolean ) ;
2018-09-25 15:36:53 +02:00
var
SQL: string ;
2021-06-27 15:14:37 +02:00
lAffectedRows: Int64 ;
2018-09-25 15:36:53 +02:00
begin
2020-03-30 13:30:45 +02:00
CheckAction( TMVCEntityAction. eaDelete) ;
OnValidation( TMVCEntityAction. eaDelete) ;
2018-10-23 16:18:34 +02:00
OnBeforeDelete;
2018-09-25 15:36:53 +02:00
if not Assigned( fPrimaryKey) then
2019-03-05 20:55:37 +01:00
raise Exception. CreateFmt( 'Cannot delete %s without a primary key' , [ ClassName] ) ;
2020-03-31 16:23:22 +02:00
SQL : = SQLGenerator. CreateDeleteSQL( fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions) ;
2021-06-27 15:14:37 +02:00
lAffectedRows : = ExecNonQuery( SQL, false ) ;
if ( lAffectedRows = 0 ) and RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound. CreateFmt( 'No record deleted for key [Entity: %s][PK: %s]' ,
[ ClassName, fPrimaryKeyFieldName] ) ;
end ;
2018-10-23 16:18:34 +02:00
OnAfterDelete;
2018-09-25 15:36:53 +02:00
end ;
2019-03-05 20:55:37 +01:00
class function TMVCActiveRecord. DeleteAll( const aClass: TMVCActiveRecordClass) : int64 ;
2019-02-21 18:11:14 +01:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create;
try
2021-11-18 17:52:06 +01:00
Result : = lAR. ExecNonQuery(
lAR. SQLGenerator. CreateDeleteAllSQL( lAR. fTableName) +
lAR. SQLGenerator. GetDefaultSQLFilter( True )
) ;
2019-02-21 18:11:14 +01:00
finally
lAR. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. DeleteRQL( const aClass: TMVCActiveRecordClass;
const RQL: string ) : int64 ;
2019-02-21 18:11:14 +01:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create( True ) ;
try
2019-03-05 20:55:37 +01:00
Result : = lAR. ExecNonQuery( lAR. SQLGenerator. CreateDeleteAllSQL( lAR. fTableName) +
lAR. SQLGenerator. CreateSQLWhereByRQL( RQL, lAR. GetMapping, false ) ) ;
2019-02-21 18:11:14 +01:00
finally
lAR. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
procedure TMVCActiveRecord. MapDatasetToObject( const DataSet: TDataSet;
const Options: TMVCActiveRecordLoadOptions;
2019-11-27 19:04:06 +01:00
var Handled: Boolean ) ;
begin
2020-01-04 12:53:53 +01:00
// do nothing
2019-11-27 19:04:06 +01:00
end ;
2020-08-28 18:04:29 +02:00
procedure TMVCActiveRecord. MapObjectToParams( const Params: TFDParams; var Handled: Boolean ) ;
2019-11-27 19:04:06 +01:00
begin
2020-01-04 12:53:53 +01:00
// do nothing
2019-11-27 19:04:06 +01:00
end ;
2020-01-04 12:53:53 +01:00
function TMVCActiveRecord. MapNullableTValueToParam( aValue: TValue; const aParam: TFDParam) : Boolean ;
begin
Assert( aValue. Kind = tkRecord) ;
Result : = false ;
if aValue. IsType( TypeInfo( NullableString) ) then
begin
if not aValue. AsType< NullableString> ( ) . HasValue then
begin
aParam. DataType : = ftString;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableString> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableInt32) ) then
begin
if not aValue. AsType< NullableInt32> ( ) . HasValue then
begin
aParam. DataType : = ftInteger;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableInt32> ( ) . Value;
Result : = True ;
end ;
end
2020-02-03 10:51:40 +01:00
else if aValue. IsType( TypeInfo( NullableTDate) ) then
2020-01-04 12:53:53 +01:00
begin
2020-02-03 10:51:40 +01:00
if not aValue. AsType< NullableTDate> ( ) . HasValue then
2020-01-04 12:53:53 +01:00
begin
aParam. DataType : = ftDate;
aParam. Clear;
Exit( True ) ;
end
else
begin
2020-02-03 10:51:40 +01:00
aValue : = TValue. From< TDate> ( aValue. AsType< NullableTDate> ( ) . Value) ;
2020-01-04 12:53:53 +01:00
Result : = True ;
end ;
end
2020-02-03 10:51:40 +01:00
else if aValue. IsType( TypeInfo( NullableTTime) ) then
2020-01-04 12:53:53 +01:00
begin
2020-02-03 10:51:40 +01:00
if not aValue. AsType< NullableTTime> ( ) . HasValue then
2020-01-04 12:53:53 +01:00
begin
aParam. DataType : = ftTime;
aParam. Clear;
Exit( True ) ;
end
else
begin
2020-02-03 10:51:40 +01:00
aValue : = TValue. From< TTime> ( aValue. AsType< NullableTTime> ( ) . Value) ;
2020-01-04 12:53:53 +01:00
Result : = True ;
end ;
end
2020-02-03 10:51:40 +01:00
else if aValue. IsType( TypeInfo( NullableTDateTime) ) then
2020-01-04 12:53:53 +01:00
begin
2020-02-03 10:51:40 +01:00
if not aValue. AsType< NullableTDateTime> ( ) . HasValue then
2020-01-04 12:53:53 +01:00
begin
aParam. DataType : = ftDateTime;
aParam. Clear;
Exit( True ) ;
end
else
begin
2020-02-03 10:51:40 +01:00
aValue : = TValue. From< TDateTime> ( aValue. AsType< NullableTDateTime> ( ) . Value) ;
2020-01-04 12:53:53 +01:00
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableUInt32) ) then
begin
if not aValue. AsType< NullableUInt32> ( ) . HasValue then
begin
aParam. DataType : = ftInteger;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableUInt32> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableInt64) ) then
begin
if not aValue. AsType< NullableInt64> ( ) . HasValue then
begin
2020-03-31 16:23:22 +02:00
aParam. DataType : = ftLargeInt;
2020-01-04 12:53:53 +01:00
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableInt64> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableInt16) ) then
begin
if not aValue. AsType< NullableInt16> ( ) . HasValue then
begin
aParam. DataType : = ftInteger;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableInt16> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableUInt64) ) then
begin
if not aValue. AsType< NullableUInt64> ( ) . HasValue then
begin
2020-03-31 16:23:22 +02:00
aParam. DataType : = ftLargeInt;
2020-01-04 12:53:53 +01:00
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableUInt64> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableUInt16) ) then
begin
if not aValue. AsType< NullableUInt16> ( ) . HasValue then
begin
aParam. DataType : = ftInteger;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableUInt16> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableBoolean) ) then
begin
if not aValue. AsType< NullableBoolean> ( ) . HasValue then
begin
aParam. DataType : = ftBoolean;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = TValue. From< Boolean > ( aValue. AsType< NullableBoolean> ( ) . Value) ;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableSingle) ) then
begin
if not aValue. AsType< NullableSingle> ( ) . HasValue then
begin
aParam. DataType : = TFieldType. ftSingle;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableSingle> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableDouble) ) then
begin
if not aValue. AsType< NullableDouble> ( ) . HasValue then
begin
aParam. DataType : = TFieldType. ftFloat;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableDouble> ( ) . Value;
Result : = True ;
end ;
end
else if aValue. IsType( TypeInfo( NullableCurrency) ) then
begin
if not aValue. AsType< NullableCurrency> ( ) . HasValue then
begin
aParam. DataType : = TFieldType. ftCurrency;
aParam. Clear;
Exit( True ) ;
end
else
begin
aValue : = aValue. AsType< NullableCurrency> ( ) . Value;
Result : = True ;
end ;
end ;
if Result then
begin
MapTValueToParam( aValue, aParam) ;
end ;
end ;
procedure TMVCActiveRecord. MapTValueToParam( aValue: TValue; const aParam: TFDParam) ;
2021-08-02 14:53:11 +02:00
const
MAX_STRING_PARAM_LENGTH = 1 0 0 0 ; { Arbitrary value }
2018-09-25 15:36:53 +02:00
var
lStream: TStream;
2020-03-23 18:51:57 +01:00
lName: string ;
2018-09-25 15:36:53 +02:00
begin
2019-05-09 20:53:52 +02:00
{$IFDEF NEXTGEN}
lName : = aValue. TypeInfo. NameFld. ToString;
{$ELSE}
2020-03-23 18:51:57 +01:00
lName : = string( aValue. TypeInfo. Name ) ;
2019-05-09 20:53:52 +02:00
{$ENDIF}
2020-01-04 12:53:53 +01:00
if ( aValue. TypeInfo. Kind = tkRecord) then
begin
if MapNullableTValueToParam( aValue, aParam) then
begin
Exit;
end ;
end ;
2018-10-14 18:23:20 +02:00
case aValue. TypeInfo. Kind of
2020-12-18 14:41:01 +01:00
tkUString:
2018-09-25 15:36:53 +02:00
begin
2019-12-17 14:52:11 +01:00
case aParam. DataType of
2021-04-05 19:35:46 +02:00
ftUnknown, ftWideString:
2020-12-18 14:41:01 +01:00
begin
2021-08-02 14:53:11 +02:00
if aValue. AsString. Length > MAX_STRING_PARAM_LENGTH then
begin
aParam. AsWideMemo : = aValue. AsString;
end
else
begin
aParam. AsWideString : = aValue. AsString;
end ;
2020-12-18 14:41:01 +01:00
end ;
2021-04-05 19:35:46 +02:00
ftString:
2020-12-18 14:41:01 +01:00
begin
2021-08-02 14:53:11 +02:00
if aValue. AsString. Length > MAX_STRING_PARAM_LENGTH then
begin
aParam. AsMemo : = AnsiString( aValue. AsString) ;
end
else
begin
aParam. AsString : = aValue. AsString;
end ;
2020-12-18 14:41:01 +01:00
end ;
ftWideMemo:
begin
aParam. AsWideMemo : = aValue. AsString;
end ;
ftMemo:
begin
aParam. AsMemo : = AnsiString( aValue. AsString) ;
end ;
else
begin
2021-05-03 19:29:01 +02:00
raise EMVCActiveRecord. CreateFmt( 'Invalid parameter type for (tkUString) [%s]' ,
[ lName] ) ;
2020-12-18 14:41:01 +01:00
end ;
end ;
end ;
tkString:
begin
case aParam. DataType of
2021-04-05 19:35:46 +02:00
ftUnknown, ftWideString:
2020-01-04 12:53:53 +01:00
begin
2021-08-02 14:53:11 +02:00
if aValue. AsString. Length > MAX_STRING_PARAM_LENGTH then
begin
aParam. AsWideMemo : = aValue. AsString;
end
else
begin
aParam. AsWideString : = aValue. AsString;
end ;
2020-01-04 12:53:53 +01:00
end ;
2021-04-05 19:35:46 +02:00
ftString:
2020-12-18 14:41:01 +01:00
begin
2021-08-02 14:53:11 +02:00
if aValue. AsString. Length > MAX_STRING_PARAM_LENGTH then
begin
aParam. AsMemo : = AnsiString( aValue. AsString) ;
end
else
begin
aParam. AsString : = aValue. AsString;
end ;
2020-12-18 14:41:01 +01:00
end ;
2020-01-04 12:53:53 +01:00
ftWideMemo:
begin
aParam. AsWideMemo : = aValue. AsString;
end ;
ftMemo:
begin
aParam. AsMemo : = AnsiString( aValue. AsString) ;
end ;
2019-12-17 14:52:11 +01:00
else
begin
2020-12-18 14:41:01 +01:00
raise EMVCActiveRecord. CreateFmt( 'Invalid parameter type for (tkString) [%s]' , [ lName] ) ;
2019-12-17 14:52:11 +01:00
end ;
end ;
2018-09-25 15:36:53 +02:00
end ;
2019-08-02 12:32:23 +02:00
{$IF Defined(SeattleOrBetter)}
2018-10-14 18:23:20 +02:00
tkWideString:
2018-09-25 15:36:53 +02:00
begin
2021-08-02 14:53:11 +02:00
if aValue. AsString. Length > MAX_STRING_PARAM_LENGTH then
begin
aParam. AsWideMemo : = aValue. AsString;
end
else
begin
aParam. AsWideString : = aValue. AsString;
end
2018-09-25 15:36:53 +02:00
end ;
2019-08-02 12:32:23 +02:00
{$ENDIF}
2018-10-14 18:23:20 +02:00
tkInt64:
2018-09-25 15:36:53 +02:00
begin
aParam. AsLargeInt : = aValue. AsInt64;
end ;
2018-10-14 18:23:20 +02:00
tkInteger:
2018-09-25 15:36:53 +02:00
begin
aParam. AsInteger : = aValue. AsInteger;
end ;
2018-10-14 18:23:20 +02:00
tkEnumeration:
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
if aValue. TypeInfo = TypeInfo( System. Boolean ) then
begin
aParam. AsBoolean : = aValue. AsBoolean;
end
else
begin
aParam. AsInteger : = Ord( aValue. AsInteger) ;
end ;
2018-09-25 15:36:53 +02:00
end ;
2018-10-14 18:23:20 +02:00
tkFloat:
2018-09-25 15:36:53 +02:00
begin
2019-05-09 20:53:52 +02:00
if lName = 'TDate' then
2018-10-14 18:23:20 +02:00
begin
aParam. AsDate : = Trunc( aValue. AsExtended) ;
end
2020-08-28 18:04:29 +02:00
else if lName = 'TDateTime' then
2020-01-04 12:53:53 +01:00
begin
aParam. AsDateTime : = aValue. AsExtended;
end
2020-08-28 18:04:29 +02:00
else if lName = 'TTime' then
2020-01-04 12:53:53 +01:00
begin
aParam. AsTime : = aValue. AsExtended;
end
2020-08-28 18:04:29 +02:00
else if lName = 'Currency' then
2020-01-04 12:53:53 +01:00
begin
aParam. AsCurrency : = aValue. AsCurrency;
end
else
begin
aParam. AsFloat : = aValue. AsExtended;
end ;
2018-09-25 15:36:53 +02:00
end ;
2018-10-14 18:23:20 +02:00
tkClass:
2018-09-25 15:36:53 +02:00
begin
2020-01-06 16:49:18 +01:00
if ( aValue. AsObject < > nil ) and ( not aValue. IsInstanceOf( TStream) ) then
2019-03-05 20:55:37 +01:00
raise EMVCActiveRecord. CreateFmt( 'Unsupported reference type for param %s: %s' ,
2018-11-24 16:56:21 +01:00
[ aParam. Name , aValue. AsObject. ClassName] ) ;
2020-12-18 14:41:01 +01:00
{ .$IF Defined(SeattleOrBetter) }
// lStream := aValue.AsType<TStream>();
{ .$ELSE }
2020-01-04 12:53:53 +01:00
lStream : = aValue. AsType< TStream> ( ) ;
2020-12-18 14:41:01 +01:00
{ .$ENDIF }
2018-09-25 15:36:53 +02:00
if Assigned( lStream) then
begin
lStream. Position : = 0 ;
aParam. LoadFromStream( lStream, ftBlob) ;
end
else
begin
2020-01-06 16:49:18 +01:00
aParam. DataType : = TFieldType. ftBlob;
2018-09-25 15:36:53 +02:00
aParam. Clear;
end ;
end ;
2019-03-05 20:55:37 +01:00
tkRecord:
begin
if aValue. IsType( TypeInfo( TGUID) ) then
begin
aParam. AsGuid : = aValue. AsType< TGUID> ;
end
else
begin
raise Exception. CreateFmt( 'Unsupported Record TypeKind (%d) for param %s' ,
[ Ord( aValue. TypeInfo. Kind) , aParam. Name ] ) ;
end ;
end ;
2018-09-25 15:36:53 +02:00
else
2021-05-03 19:29:01 +02:00
raise Exception. CreateFmt( 'Unsupported TypeKind (%d) for param %s' ,
[ Ord( aValue. TypeInfo. Kind) , aParam. Name ] ) ;
2018-09-25 15:36:53 +02:00
end ;
end ;
2021-05-03 19:29:01 +02:00
procedure TMVCActiveRecord. LoadByDataset( const aDataSet: TDataSet;
const aOptions: TMVCActiveRecordLoadOptions) ;
2018-09-25 15:36:53 +02:00
var
2020-03-25 11:35:25 +01:00
lItem: TPair< TRTTIField, TFieldInfo> ;
2018-12-09 23:03:06 +01:00
lField: TField;
2019-11-27 19:04:06 +01:00
lHandled: Boolean ;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
CheckAction( TMVCEntityAction. eaRetrieve) ;
2018-09-25 15:36:53 +02:00
OnBeforeLoad;
2019-11-27 19:04:06 +01:00
2020-01-04 12:53:53 +01:00
lHandled : = false ;
2019-11-27 19:04:06 +01:00
MapDatasetToObject( aDataSet, aOptions, lHandled) ;
if not lHandled then
2018-09-25 15:36:53 +02:00
begin
2019-11-27 19:04:06 +01:00
for lItem in fMap do
2019-11-05 16:57:22 +01:00
begin
2020-03-25 11:35:25 +01:00
if not lItem. Value. Readable then
2019-11-27 19:04:06 +01:00
begin
2020-01-04 12:53:53 +01:00
continue;
2019-11-27 19:04:06 +01:00
end ;
2020-03-25 11:35:25 +01:00
lField : = aDataSet. FindField( lItem. Value. FieldName) ;
2019-11-27 19:04:06 +01:00
if lField = nil then
begin
if TMVCActiveRecordLoadOption. loIgnoreNotExistentFields in aOptions then
continue
else
raise EMVCActiveRecord. CreateFmt
2020-01-04 12:53:53 +01:00
( 'Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields' ,
2020-03-25 11:35:25 +01:00
[ lItem. Value. FieldName] ) ;
2019-11-27 19:04:06 +01:00
end ;
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField( lField, lItem. Key, Self) ;
2019-11-05 16:57:22 +01:00
end ;
2019-11-27 19:04:06 +01:00
if not fPrimaryKeyFieldName. IsEmpty then
2018-12-09 23:03:06 +01:00
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField( aDataSet. FieldByName( fPrimaryKeyFieldName) , fPrimaryKey, Self) ;
2018-12-09 23:03:06 +01:00
end ;
2018-09-25 15:36:53 +02:00
end ;
OnAfterLoad;
end ;
2020-03-31 16:23:22 +02:00
function TMVCActiveRecord. LoadByPK( const id: string ) : Boolean ;
2018-09-25 15:36:53 +02:00
var
SQL: string ;
lDataSet: TDataSet;
begin
2018-10-14 18:23:20 +02:00
CheckAction( TMVCEntityAction. eaRetrieve) ;
2021-05-03 19:29:01 +02:00
SQL : = SQLGenerator. CreateSelectByPKSQL( fTableName, fMap, fPrimaryKeyFieldName,
fPrimaryKeyOptions) ;
2020-03-31 16:23:22 +02:00
lDataSet : = ExecQuery( SQL, [ id] , GetConnection) ;
try
Result : = not lDataSet. Eof;
if Result then
begin
LoadByDataset( lDataSet) ;
end ;
finally
lDataSet. Free;
end ;
end ;
function TMVCActiveRecord. LoadByPK( const id: int64 ) : Boolean ;
var
SQL: string ;
lDataSet: TDataSet;
begin
CheckAction( TMVCEntityAction. eaRetrieve) ;
2021-05-03 19:29:01 +02:00
SQL : = SQLGenerator. CreateSelectByPKSQL( fTableName, fMap, fPrimaryKeyFieldName,
fPrimaryKeyOptions) ;
2020-02-03 10:51:40 +01:00
lDataSet : = ExecQuery( SQL, [ id] , GetConnection) ;
2018-09-25 15:36:53 +02:00
try
Result : = not lDataSet. Eof;
if Result then
begin
LoadByDataset( lDataSet) ;
end ;
finally
lDataSet. Free;
end ;
end ;
2018-10-23 16:18:34 +02:00
procedure TMVCActiveRecord. OnAfterDelete;
begin
// do nothing
end ;
procedure TMVCActiveRecord. OnAfterInsert;
begin
// do nothing
end ;
procedure TMVCActiveRecord. OnAfterInsertOrUpdate;
begin
// do nothing
end ;
2018-09-25 15:36:53 +02:00
procedure TMVCActiveRecord. OnAfterLoad;
begin
// do nothing
end ;
2018-10-23 16:18:34 +02:00
procedure TMVCActiveRecord. OnAfterUpdate;
begin
// do nothing
end ;
2018-09-25 15:36:53 +02:00
procedure TMVCActiveRecord. OnBeforeDelete;
begin
// do nothing
end ;
2020-03-23 18:51:57 +01:00
procedure TMVCActiveRecord. OnBeforeExecuteSQL( var SQL: string ) ;
2019-03-18 14:08:34 +01:00
begin
// do nothing
end ;
2018-09-25 15:36:53 +02:00
procedure TMVCActiveRecord. OnBeforeInsert;
begin
// do nothing
end ;
procedure TMVCActiveRecord. OnBeforeInsertOrUpdate;
begin
// do nothing
end ;
procedure TMVCActiveRecord. OnBeforeLoad;
begin
// do nothing
end ;
procedure TMVCActiveRecord. OnBeforeUpdate;
begin
// do nothing
end ;
2020-03-30 13:30:45 +02:00
procedure TMVCActiveRecord. OnValidation( const EntityAction: TMVCEntityAction) ;
2018-09-25 15:36:53 +02:00
begin
// do nothing
end ;
2020-05-04 09:42:16 +02:00
procedure TMVCActiveRecord. RemoveChildren( const ChildObject: TObject) ;
begin
if fChildren < > nil then
begin
fChildren. Extract( ChildObject) ;
end ;
end ;
2020-03-30 13:30:45 +02:00
procedure TMVCActiveRecord. InvalidateConnection( const ReacquireAfterInvalidate: Boolean = false ) ;
begin
FreeAndNil( fConn) ;
if ReacquireAfterInvalidate then
begin
EnsureConnection;
end ;
end ;
2019-03-05 20:55:37 +01:00
class function TMVCActiveRecord. Select( const aClass: TMVCActiveRecordClass; const SQL: string ;
const Params: array of Variant ) : TMVCActiveRecordList;
2018-09-28 13:01:46 +02:00
begin
Result : = Select( aClass, SQL, Params, nil ) ;
end ;
2019-03-05 20:55:37 +01:00
class function TMVCActiveRecord. Select( const aClass: TMVCActiveRecordClass; const SQL: string ;
const Params: array of Variant ; const Connection: TFDConnection) : TMVCActiveRecordList;
2018-09-25 15:36:53 +02:00
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
2018-10-23 16:18:34 +02:00
Result : = TMVCActiveRecordList. Create;
2018-09-25 15:36:53 +02:00
try
2018-09-28 13:01:46 +02:00
lDataSet : = ExecQuery( SQL, Params, Connection) ;
2018-09-25 15:36:53 +02:00
try
while not lDataSet. Eof do
begin
lAR : = aClass. Create;
Result . Add( lAR) ;
lAR. LoadByDataset( lDataSet) ;
lDataSet. Next;
end ;
finally
lDataSet. Free;
end ;
except
Result . Free;
raise ;
end ;
2018-09-28 13:01:46 +02:00
2018-09-25 15:36:53 +02:00
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. SelectDataSet( const SQL: string ; const Params: array of Variant ;
2020-03-23 18:51:57 +01:00
const ParamTypes: array of TFieldType) : TDataSet;
begin
Result : = TMVCActiveRecord. ExecQuery( SQL, Params, ParamTypes) ;
end ;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper. Select< T> ( const SQL: string ; const Params: array of Variant ;
2019-03-05 20:55:37 +01:00
const Options: TMVCActiveRecordLoadOptions) : TObjectList< T> ;
2020-03-23 18:51:57 +01:00
begin
Result : = Select< T> ( SQL, Params, [ ] , Options) ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. SelectDataSet( const SQL: string ; const Params: array of Variant )
: TDataSet;
2020-03-23 18:51:57 +01:00
begin
Result : = TMVCActiveRecord. ExecQuery( SQL, Params) ;
end ;
2021-05-03 19:29:01 +02:00
function TMVCActiveRecord. SelectRQL( const RQL: string ; const MaxRecordCount: Integer )
: TMVCActiveRecordList;
2020-03-23 18:51:57 +01:00
begin
Result : = InternalSelectRQL( RQL, MaxRecordCount) ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecordHelper. Select< T> ( const SQL: string ; const Params: array of Variant ;
2021-05-03 19:29:01 +02:00
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions)
: TObjectList< T> ;
2018-09-25 15:36:53 +02:00
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
2019-11-27 19:04:06 +01:00
lHandled: Boolean ;
2018-09-25 15:36:53 +02:00
begin
Result : = TObjectList< T> . Create( True ) ;
try
2020-03-23 18:51:57 +01:00
lDataSet : = ExecQuery( SQL, Params, ParamTypes) ;
2018-09-25 15:36:53 +02:00
try
while not lDataSet. Eof do
begin
lAR : = T. Create;
Result . Add( lAR) ;
2018-12-09 23:03:06 +01:00
lAR. LoadByDataset( lDataSet, Options) ;
2018-09-25 15:36:53 +02:00
lDataSet. Next;
end ;
finally
lDataSet. Free;
end ;
except
Result . Free;
raise ;
end ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecordHelper. SelectOne< T> ( const SQL: string ; const Params: array of Variant ;
const RaiseExceptionIfNotFound: Boolean ) : T;
2020-03-30 13:30:45 +02:00
begin
Result : = SelectOne< T> ( SQL, Params, [ ] , [ ] , RaiseExceptionIfNotFound) ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecordHelper. SelectOne< T> ( const SQL: string ; const Params: array of Variant ;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
2020-03-30 13:30:45 +02:00
const RaiseExceptionIfNotFound: Boolean ) : T;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
lHandled: Boolean ;
lList: TObjectList< T> ;
begin
Result : = nil ;
lList : = Select< T> ( SQL, Params, ParamTypes, Options) ;
try
if ( lList. Count = 0 ) then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound. Create( 'Got 0 rows when exactly 1 was expected' )
else
Exit( nil ) ;
end ;
if lList. Count > 1 then
begin
2021-05-03 19:29:01 +02:00
raise EMVCActiveRecordNotFound. CreateFmt( 'Got %d rows when exactly 1 was expected' ,
[ lList. Count] ) ;
2020-03-30 13:30:45 +02:00
end ;
2020-04-02 19:26:04 +02:00
Result : = lList. Extract( lList. First) ;
2020-03-30 13:30:45 +02:00
finally
lList. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. SelectRQL< T> ( const RQL: string ; const MaxRecordCount: Integer )
: TObjectList< T> ;
2018-11-09 18:11:59 +01:00
var
lAR: TMVCActiveRecord;
lSQL: string ;
begin
lAR : = T. Create;
try
2021-11-18 00:49:12 +01:00
lSQL : = lAR. SQLGenerator. CreateSQLWhereByRQL( RQL, lAR. GetMapping,
MaxRecordCount > - 1 , False , MaxRecordCount) . Trim;
2021-11-17 15:36:20 +01:00
lSQL : = TMVCSQLGenerator. RemoveInitialWhereKeyword( lSQL) ;
2018-11-09 18:11:59 +01:00
Result : = Where< T> ( lSQL, [ ] ) ;
finally
lAR. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. Where< T> ( const SQLWhere: string ;
const Params: array of Variant ;
2020-03-23 18:51:57 +01:00
const ParamTypes: array of TFieldType) : TObjectList< T> ;
var
lAR: TMVCActiveRecord;
2021-11-19 00:34:37 +01:00
lFilter: string ;
2020-03-23 18:51:57 +01:00
begin
lAR : = T. Create;
try
2021-11-19 00:34:37 +01:00
lFilter : = lAR. SQLGenerator. GetDefaultSQLFilter( True ) ;
2021-05-03 19:29:01 +02:00
if SQLWhere. Trim. IsEmpty( ) or SQLWhere. Trim. StartsWith( '/*limit*/' ) or
SQLWhere. Trim. StartsWith( '/*sort*/' ) then
2020-03-23 18:51:57 +01:00
begin
2021-11-19 00:34:37 +01:00
Result : = Select< T> ( lAR. GenerateSelectSQL +
lFilter + SQLWhere, Params, ParamTypes)
2020-03-23 18:51:57 +01:00
end
else
begin
2021-11-19 00:34:37 +01:00
if lFilter. IsEmpty then
Result : = Select< T> ( lAR. GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes)
else
begin
Result : = Select< T> ( lAR. GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes) ;
end ;
2020-03-23 18:51:57 +01:00
end ;
finally
lAR. Free;
end ;
end ;
2019-03-05 20:55:37 +01:00
class function TMVCActiveRecord. SelectRQL( const aClass: TMVCActiveRecordClass; const RQL: string ;
const MaxRecordCount: Integer ) : TMVCActiveRecordList;
2018-11-02 21:43:09 +01:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create( True ) ;
2018-09-27 12:26:50 +02:00
try
2019-08-02 12:32:23 +02:00
Result : = lAR. InternalSelectRQL( RQL, MaxRecordCount) ;
2018-09-27 12:26:50 +02:00
finally
2018-11-02 21:43:09 +01:00
lAR. Free;
2018-09-27 12:26:50 +02:00
end ;
end ;
2020-08-28 18:04:29 +02:00
procedure TMVCActiveRecord. SetAttributes( const AttrName: string ; const Value: TValue) ;
var
lProperty: TRttiProperty;
begin
if not TRttiUtils. ExistsProperty( Self, AttrName, lProperty) then
begin
raise EMVCActiveRecord. CreateFmt( 'Attribute [%s] not found' , [ AttrName] ) ;
end ;
SetPropertyValue( lProperty, Value) ;
end ;
procedure TMVCActiveRecord. SetPropertyValue( const aProp: TRttiProperty; const aValue: TValue) ;
var
lCurrValue: TValue;
lNullableString: NullableString;
lNullableUInt32: NullableUInt32;
lNullableUInt64: NullableUInt64;
lNullableInt64: NullableInt64;
lNullableBoolean: NullableBoolean;
lNullableTDateTime: NullableTDateTime;
lNullableTDate: NullableTDate;
lNullableTTime: NullableTTime;
begin
if aProp. GetValue( Self) . Kind = tkRecord then
begin
lCurrValue : = aProp. GetValue( Self) ;
if lCurrValue. IsType< NullableInt32> then
begin
if aValue. IsType< NullableInt32> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lCurrValue : = TValue. From< NullableInt32> ( IntToNullableInt( aValue. AsInteger) ) ;
end
end
else if lCurrValue. IsType< NullableInt64> then
begin
if aValue. IsType< NullableInt64> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lNullableInt64 : = aValue. AsInt64;
lCurrValue : = TValue. From< NullableInt64> ( lNullableInt64) ;
end ;
end
else if lCurrValue. IsType< NullableString> then
begin
if aValue. IsType< NullableString> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lNullableString : = aValue. AsString;
lCurrValue : = TValue. From< NullableString> ( lNullableString) ;
end ;
end
else if lCurrValue. IsType< NullableUInt32> then
begin
if aValue. IsType< NullableUInt32> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lNullableUInt32 : = aValue. AsInteger;
lCurrValue. From< NullableUInt32> ( lNullableUInt32) ;
end ;
end
else if lCurrValue. IsType< NullableUInt64> then
begin
if aValue. IsType< NullableUInt64> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lNullableUInt64 : = aValue. AsUInt64;
lCurrValue. From< NullableUInt64> ( lNullableUInt64) ;
end ;
end
else if lCurrValue. IsType< NullableBoolean> then
begin
if aValue. IsType< NullableBoolean> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
lNullableBoolean : = aValue. AsBoolean;
lCurrValue. From< NullableBoolean> ( lNullableBoolean) ;
end ;
end
else if lCurrValue. IsType< NullableTDateTime> then
begin
if aValue. IsType< NullableTDateTime> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
2021-05-03 19:29:01 +02:00
{$IF Defined(TOKYOORBETTER)}
2020-08-28 18:04:29 +02:00
lNullableTDateTime : = TDateTime( aValue. AsExtended) ;
2021-05-03 19:29:01 +02:00
{$ELSE}
2021-01-05 17:01:08 +01:00
lNullableTDateTime : = aValue. AsExtended;
2021-05-03 19:29:01 +02:00
{$ENDIF}
2020-08-28 18:04:29 +02:00
lCurrValue. From< NullableTDateTime> ( lNullableTDateTime) ;
end ;
end
else if lCurrValue. IsType< NullableTDate> then
begin
if aValue. IsType< NullableTDate> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
2021-05-03 19:29:01 +02:00
{$IF Defined(TOKYOORBETTER)}
2020-08-28 18:04:29 +02:00
lNullableTDate : = TDate( aValue. AsExtended) ;
2021-05-03 19:29:01 +02:00
{$ELSE}
2021-01-05 17:01:08 +01:00
lNullableTDate : = aValue. AsExtended;
2021-05-03 19:29:01 +02:00
{$ENDIF}
2020-08-28 18:04:29 +02:00
lCurrValue. From< NullableTDate> ( lNullableTDate) ;
end ;
end
else if lCurrValue. IsType< NullableTTime> then
begin
if aValue. IsType< NullableTTime> ( ) then
begin
lCurrValue : = aValue;
end
else
begin
2021-05-03 19:29:01 +02:00
{$IF Defined(TOKYOORBETTER)}
2020-08-28 18:04:29 +02:00
lNullableTTime : = TTime( aValue. AsExtended) ;
2021-05-03 19:29:01 +02:00
{$ELSE}
2021-01-05 17:01:08 +01:00
lNullableTTime : = aValue. AsExtended;
2021-05-03 19:29:01 +02:00
{$ENDIF}
2020-08-28 18:04:29 +02:00
lCurrValue. From< NullableTTime> ( lNullableTTime) ;
end ;
end
else
begin
raise EMVCActiveRecord. Create( 'Invalid data type for dynamic property access' ) ;
end ;
aProp. SetValue( Self, lCurrValue) ;
end
else
begin
aProp. SetValue( Self, aValue)
end ;
end ;
2018-09-25 15:36:53 +02:00
procedure TMVCActiveRecord. SetPK( const aValue: TValue) ;
2020-01-08 15:30:10 +01:00
var
lPKValue: TValue;
2018-09-25 15:36:53 +02:00
begin
if fPrimaryKeyFieldName. IsEmpty then
2020-01-08 15:30:10 +01:00
begin
2018-09-25 15:36:53 +02:00
raise Exception. Create( 'No primary key defined' ) ;
2020-01-08 15:30:10 +01:00
end ;
2020-08-28 18:04:29 +02:00
2020-01-08 15:30:10 +01:00
if fPrimaryKey. GetValue( Self) . Kind = tkRecord then
begin
lPKValue : = fPrimaryKey. GetValue( Self) ;
2020-08-13 17:40:02 +02:00
if lPKValue. IsType< NullableInt32> and aValue. IsType< NullableInt32> ( ) then
2020-01-08 15:30:10 +01:00
begin
if aValue. IsType< UInt32 > then
begin
lPKValue : = TValue. From< NullableInt32> ( IntToNullableInt( aValue. AsInteger) ) ;
end ;
end
2020-08-13 17:40:02 +02:00
else if lPKValue. IsType< NullableInt64> and aValue. IsType< NullableInt64> ( ) then
2020-01-08 15:30:10 +01:00
begin
if aValue. AsType< NullableInt64> ( ) . HasValue then
begin
lPKValue : = aValue;
end
else
begin
lPKValue. AsType< NullableInt64> ( ) . Clear;
end ;
end
2020-08-13 17:40:02 +02:00
else if lPKValue. IsType< NullableString> and aValue. IsType< NullableString> ( ) then
begin
if aValue. AsType< NullableString> ( ) . HasValue then
begin
lPKValue : = aValue;
end
else
begin
lPKValue. AsType< NullableString> ( ) . Clear;
end ;
end
else if lPKValue. IsType< NullableUInt32> and aValue. IsType< NullableUInt32> ( ) then
2020-01-08 15:30:10 +01:00
begin
if aValue. AsType< NullableUInt32> ( ) . HasValue then
begin
lPKValue : = aValue;
end
else
begin
lPKValue. AsType< NullableUInt32> ( ) . Clear;
end ;
end
2020-08-13 17:40:02 +02:00
else if lPKValue. IsType< NullableUInt64> and aValue. IsType< NullableUInt64> ( ) then
2020-01-08 15:30:10 +01:00
begin
if aValue. AsType< NullableUInt64> ( ) . HasValue then
begin
lPKValue : = aValue;
end
else
begin
lPKValue. AsType< NullableUInt64> ( ) . Clear;
end ;
end
else
2020-08-13 17:40:02 +02:00
begin
2020-08-28 18:04:29 +02:00
raise EMVCActiveRecord. Create
( 'Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)' ) ;
2020-08-13 17:40:02 +02:00
end ;
2020-01-08 15:30:10 +01:00
fPrimaryKey. SetValue( Self, lPKValue) ;
end
else
begin
fPrimaryKey. SetValue( Self, aValue)
end ;
2018-09-25 15:36:53 +02:00
end ;
2020-01-04 12:53:53 +01:00
procedure TMVCActiveRecord. SetPrimaryKeyIsAutogenerated( const Value: Boolean ) ;
begin
if Value then
begin
Include( fPrimaryKeyOptions, foAutoGenerated) ;
end
else
begin
Exclude( fPrimaryKeyOptions, foAutoGenerated) ;
end ;
end ;
2020-08-11 00:54:42 +02:00
procedure TMVCActiveRecord. SetTableName( const Value: string ) ;
2020-07-02 23:19:36 +02:00
begin
fTableName : = Value;
end ;
2018-11-24 16:56:21 +01:00
function TMVCActiveRecord. SQLGenerator: TMVCSQLGenerator;
begin
if not Assigned( fSQLGenerator) then
begin
2020-02-03 10:51:40 +01:00
GetConnection. Connected : = True ;
2021-05-03 19:29:01 +02:00
fSQLGenerator : = TMVCSQLGeneratorRegistry. Instance. GetSQLGenerator( GetBackEnd)
2021-11-18 17:52:06 +01:00
. Create( GetMapping, fDefaultRQLFilter, GetPartitionInfo) ;
2018-11-24 16:56:21 +01:00
end ;
Result : = fSQLGenerator;
end ;
2020-02-03 13:19:55 +01:00
procedure TMVCActiveRecord. Store;
var
lValue: TValue;
lRes: Boolean ;
lIsNullableType: Boolean ;
begin
lRes : = TryGetPKValue( lValue, lIsNullableType) ;
if not lIsNullableType then
begin
2021-05-03 19:29:01 +02:00
raise EMVCActiveRecord. Create
( 'Store can be used only with nullable PKs [HINT] Use NullableInt64 as PK' ) ;
2020-02-03 13:19:55 +01:00
end ;
if lRes then
begin
Update;
end
else
begin
Insert;
end ;
end ;
2018-09-25 15:36:53 +02:00
function TMVCActiveRecord. TableInfo: string ;
var
2021-05-03 19:29:01 +02:00
KeyValue: TPair< TRTTIField, TFieldInfo> ;
2018-09-25 15:36:53 +02:00
begin
Result : = 'Table Name: ' + fTableName;
2021-05-03 19:29:01 +02:00
for KeyValue in fMap do
Result : = Result + sLineBreak + #9 + KeyValue. Key. Name + ' = ' + KeyValue. Value. FieldName;
2018-09-25 15:36:53 +02:00
end ;
2020-02-03 13:19:55 +01:00
function TMVCActiveRecord. TryGetPKValue( var Value: TValue; out IsNullableType: Boolean ) : Boolean ;
begin
IsNullableType : = false ;
if fPrimaryKeyFieldName. IsEmpty then
raise Exception. Create( 'No primary key defined' ) ;
Value : = fPrimaryKey. GetValue( Self) ;
if Value. Kind = tkRecord then
begin
if Value. IsType< NullableInt32> ( ) then
begin
Result : = Value. AsType< NullableInt32> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableInt32> ( ) . Value;
end
else if Value. IsType< NullableInt64> ( ) then
begin
Result : = Value. AsType< NullableInt64> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableInt64> ( ) . Value;
end
else if Value. IsType< NullableUInt32> ( ) then
begin
Result : = Value. AsType< NullableUInt32> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableUInt32> ( ) . Value;
end
else if Value. IsType< NullableUInt64> ( ) then
begin
Result : = Value. AsType< NullableUInt64> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableUInt64> ( ) . Value;
end
else if Value. IsType< NullableInt16> ( ) then
begin
Result : = Value. AsType< NullableInt16> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableInt16> ( ) . Value;
end
else if Value. IsType< NullableUInt16> ( ) then
begin
Result : = Value. AsType< NullableUInt16> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableUInt16> ( ) . Value;
end
2020-03-31 16:23:22 +02:00
else if Value. IsType< NullableString> ( ) then
begin
Result : = Value. AsType< NullableString> ( ) . HasValue;
if Result then
Value : = Value. AsType< NullableString> ( ) . Value;
end
2020-02-03 13:19:55 +01:00
else
2020-03-23 18:51:57 +01:00
raise EMVCActiveRecord. Create
2020-03-31 16:23:22 +02:00
( 'Invalid primary key type [HINT: Use Int64, String, NullableInt64 or NullableString, so that Store method is available too.]' ) ;
2020-02-03 13:19:55 +01:00
IsNullableType : = True ;
end
else
begin
Result : = not Value. IsEmpty;
end ;
end ;
2021-06-27 15:14:37 +02:00
procedure TMVCActiveRecord. Update( const RaiseExceptionIfNotFound: Boolean = True ) ;
2018-09-25 15:36:53 +02:00
var
SQL: string ;
2021-06-27 15:14:37 +02:00
lAffectedRows: Int64 ;
2018-09-25 15:36:53 +02:00
begin
2018-10-14 18:23:20 +02:00
CheckAction( TMVCEntityAction. eaUpdate) ;
2020-03-30 13:30:45 +02:00
OnValidation( TMVCEntityAction. eaUpdate) ;
2018-09-25 15:36:53 +02:00
OnBeforeUpdate;
OnBeforeInsertOrUpdate;
2020-08-11 00:54:42 +02:00
if fMap. WritableFieldsCount = 0 then
2019-02-21 20:17:11 +01:00
begin
raise EMVCActiveRecord. CreateFmt
2021-05-03 19:29:01 +02:00
( 'Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]' ,
[ ClassName, fTableName] ) ;
2019-02-21 20:17:11 +01:00
end ;
2020-03-25 11:35:25 +01:00
SQL : = SQLGenerator. CreateUpdateSQL( fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions) ;
2021-06-27 15:14:37 +02:00
lAffectedRows : = ExecNonQuery( SQL, false ) ;
if ( lAffectedRows = 0 ) and RaiseExceptionIfNotFound then
2020-12-11 18:53:37 +01:00
begin
2020-12-18 14:41:01 +01:00
raise EMVCActiveRecordNotFound. CreateFmt( 'No record updated for key [Entity: %s][PK: %s]' ,
[ ClassName, fPrimaryKeyFieldName] ) ;
2020-12-11 18:53:37 +01:00
end ;
2018-10-23 16:18:34 +02:00
OnAfterUpdate;
OnAfterInsertOrUpdate;
2018-09-25 15:36:53 +02:00
end ;
2020-05-04 09:42:16 +02:00
procedure TMVCActiveRecord. AddChildren( const ChildObject: TObject) ;
begin
if fChildren = nil then
begin
fChildren : = TObjectList< TObject> . Create( True ) ;
end ;
2020-08-11 00:54:42 +02:00
if not( fChildren. Contains( ChildObject) ) and ( not( ChildObject = Self) ) then
2020-05-04 09:42:16 +02:00
begin
fChildren. Add( ChildObject) ;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecord. All( const aClass: TMVCActiveRecordClass)
: TObjectList< TMVCActiveRecord> ;
2018-09-25 15:36:53 +02:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create;
try
2018-11-02 21:43:09 +01:00
Result : = Select( aClass, lAR. GenerateSelectSQL, [ ] ) ;
2018-09-25 15:36:53 +02:00
finally
lAR. Free;
end ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecordHelper. All< T> : TObjectList< T> ;
2018-09-25 15:36:53 +02:00
var
lAR: TMVCActiveRecord;
begin
lAR : = T. Create;
try
2018-11-02 21:43:09 +01:00
Result : = Select< T> ( lAR. GenerateSelectSQL, [ ] ) ;
2018-09-25 15:36:53 +02:00
finally
lAR. Free;
end ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. Where( const aClass: TMVCActiveRecordClass; const SQLWhere: string ;
2019-03-05 20:55:37 +01:00
const Params: array of Variant ) : TMVCActiveRecordList;
2018-09-28 13:01:46 +02:00
begin
2018-10-23 16:18:34 +02:00
Result : = Where( aClass, SQLWhere, Params, nil ) ;
2018-09-28 13:01:46 +02:00
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. Where( const aClass: TMVCActiveRecordClass; const SQLWhere: string ;
2019-03-05 20:55:37 +01:00
const Params: array of Variant ; const Connection: TFDConnection) : TMVCActiveRecordList;
2018-09-27 12:26:50 +02:00
var
lAR: TMVCActiveRecord;
begin
lAR : = aClass. Create;
try
2019-03-05 20:55:37 +01:00
Result : = Select( aClass, lAR. GenerateSelectSQL + SQLWhere, Params, Connection) ;
2018-09-27 12:26:50 +02:00
finally
lAR. Free;
end ;
end ;
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. Where< T> ( const SQLWhere: string ;
const Params: array of Variant ) : TObjectList< T> ;
2018-09-25 15:36:53 +02:00
begin
2020-03-23 18:51:57 +01:00
Result : = Where< T> ( SQLWhere, Params, [ ] ) ;
2018-09-25 15:36:53 +02:00
end ;
2021-04-29 22:52:28 +02:00
2021-05-03 19:29:01 +02:00
class function TMVCActiveRecordHelper. Merge< T> ( CurrentList, NewList: TObjectList< T> )
: IMVCMultiExecutor< T> ;
2021-04-29 22:52:28 +02:00
var
2021-05-03 19:29:01 +02:00
i: Integer ;
2021-04-29 22:52:28 +02:00
lFoundAtIndex: Integer ;
lCurrPKValue: Integer ;
lPKValue: TValue;
lUnitOfWork: IMVCUnitOfWork< T> ;
2021-05-03 19:29:01 +02:00
lPKType: TFieldType;
lNeedsToBeUpdated: Boolean ;
2021-04-29 22:52:28 +02:00
begin
lUnitOfWork : = TMVCUnitOfWork< T> . Create;
lUnitOfWork. RegisterDelete( CurrentList) ;
2021-09-23 22:52:28 +02:00
if NewList. Count > 0 then
2021-05-03 19:29:01 +02:00
begin
2021-09-23 22:52:28 +02:00
lPKType : = NewList[ 0 ] . GetPrimaryKeyFieldType;
for i : = 0 to NewList. Count - 1 do
2021-04-29 22:52:28 +02:00
begin
2021-09-23 22:52:28 +02:00
if NewList[ i] . PKIsNull then
begin
lUnitOfWork. RegisterInsert( NewList[ i] ) ;
continue;
end ;
2021-05-03 19:29:01 +02:00
2021-09-23 22:52:28 +02:00
case lPKType of
ftString:
begin
lNeedsToBeUpdated : = TMVCUnitOfWork< T> . KeyExistsString( CurrentList,
NewList[ i] . GetPK. AsString, lFoundAtIndex) ;
end ;
ftInteger:
begin
lNeedsToBeUpdated : = TMVCUnitOfWork< T> . KeyExistsInt( CurrentList,
NewList[ i] . GetPK. AsInteger, lFoundAtIndex) ;
end ;
ftLargeInt:
begin
lNeedsToBeUpdated : = TMVCUnitOfWork< T> . KeyExistsInt64( CurrentList,
NewList[ i] . GetPK. AsInt64, lFoundAtIndex) ;
end ;
else
raise EMVCActiveRecord. Create( 'Invalid primary key type' ) ;
end ;
2021-05-03 19:29:01 +02:00
2021-09-23 22:52:28 +02:00
if lNeedsToBeUpdated then
lUnitOfWork. RegisterUpdate( NewList[ i] )
else
lUnitOfWork. RegisterInsert( NewList[ i] ) ;
end ;
2021-04-29 22:52:28 +02:00
end ;
Result : = lUnitOfWork as IMVCMultiExecutor< T> ;
end ;
2018-09-25 15:36:53 +02:00
{ TMVCEntitiesRegistry }
2021-05-03 19:29:01 +02:00
procedure TMVCEntitiesRegistry. AddEntity( const aURLSegment: string ;
const aActiveRecordClass: TMVCActiveRecordClass) ;
2018-09-25 15:36:53 +02:00
begin
fEntitiesDict. AddOrSetValue( aURLSegment. ToLower, aActiveRecordClass) ;
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCEntitiesRegistry. AddEntityProcessor( const aURLSegment: string ;
const aEntityProcessor: IMVCEntityProcessor) ;
begin
fProcessorsDict. Add( aURLSegment, aEntityProcessor) ;
end ;
2018-09-25 15:36:53 +02:00
constructor TMVCEntitiesRegistry. Create;
begin
inherited ;
fEntitiesDict : = TDictionary< string , TMVCActiveRecordClass> . Create;
2018-10-14 18:23:20 +02:00
fProcessorsDict : = TDictionary< string , IMVCEntityProcessor> . Create;
2018-09-25 15:36:53 +02:00
end ;
destructor TMVCEntitiesRegistry. Destroy;
begin
fEntitiesDict. Free;
2018-10-14 18:23:20 +02:00
fProcessorsDict. Free;
2018-09-25 15:36:53 +02:00
inherited ;
end ;
2019-03-05 20:55:37 +01:00
function TMVCEntitiesRegistry. FindEntityClassByURLSegment( const aURLSegment: string ;
out aMVCActiveRecordClass: TMVCActiveRecordClass) : Boolean ;
2018-09-25 15:36:53 +02:00
begin
2019-03-05 20:55:37 +01:00
Result : = fEntitiesDict. TryGetValue( aURLSegment. ToLower, aMVCActiveRecordClass) ;
2018-10-14 18:23:20 +02:00
end ;
2019-03-05 20:55:37 +01:00
function TMVCEntitiesRegistry. FindProcessorByURLSegment( const aURLSegment: string ;
out aMVCEntityProcessor: IMVCEntityProcessor) : Boolean ;
2018-10-14 18:23:20 +02:00
begin
2019-03-05 20:55:37 +01:00
Result : = fProcessorsDict. TryGetValue( aURLSegment. ToLower, aMVCEntityProcessor) ;
2018-09-25 15:36:53 +02:00
end ;
2021-04-07 23:58:02 +02:00
function TMVCEntitiesRegistry. GetEntities: TArray< String > ;
begin
Result : = fEntitiesDict. Keys. ToArray;
end ;
2018-09-25 15:36:53 +02:00
{ EMVCActiveRecord }
constructor EMVCActiveRecord. Create( const AMsg: string ) ;
begin
inherited Create( http_status. BadRequest, AMsg) ;
end ;
2018-10-14 18:23:20 +02:00
{ EntityActionsAttribute }
2019-03-05 20:55:37 +01:00
constructor MVCEntityActionsAttribute. Create( const aEntityAllowedActions: TMVCEntityActions) ;
2018-10-14 18:23:20 +02:00
begin
inherited Create;
EntityAllowedActions : = aEntityAllowedActions;
end ;
2018-10-23 16:18:34 +02:00
{ TMVCActiveRecordList }
constructor TMVCActiveRecordList. Create;
begin
inherited Create( True ) ;
end ;
2018-11-02 21:43:09 +01:00
{ TMVCSQLGeneratorRegistry }
constructor TMVCSQLGeneratorRegistry. Create;
begin
inherited ;
fSQLGenerators : = TDictionary< string , TMVCSQLGeneratorClass> . Create;
end ;
class constructor TMVCSQLGeneratorRegistry. Create;
begin
2018-11-09 18:11:59 +01:00
cLock : = TObject. Create;
2018-11-02 21:43:09 +01:00
end ;
class destructor TMVCSQLGeneratorRegistry. Destroy;
begin
2018-11-09 18:11:59 +01:00
cLock. Free;
cInstance. Free;
2018-11-02 21:43:09 +01:00
end ;
destructor TMVCSQLGeneratorRegistry. Destroy;
begin
fSQLGenerators. Free;
inherited ;
end ;
2019-03-05 20:55:37 +01:00
function TMVCSQLGeneratorRegistry. GetSQLGenerator( const aBackend: string ) : TMVCSQLGeneratorClass;
2018-11-02 21:43:09 +01:00
begin
if not fSQLGenerators. TryGetValue( aBackend, Result ) then
begin
2019-03-05 20:55:37 +01:00
raise ERQLCompilerNotFound. CreateFmt( 'SQLGenerator not found for "%s"' , [ aBackend] ) ;
2018-11-02 21:43:09 +01:00
end ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCSQLGeneratorRegistry. Instance: TMVCSQLGeneratorRegistry;
2018-11-02 21:43:09 +01:00
begin
2018-11-09 18:11:59 +01:00
if not Assigned( cInstance) then
2018-11-02 21:43:09 +01:00
begin
2018-11-09 18:11:59 +01:00
TMonitor. Enter( cLock) ;
2018-11-02 21:43:09 +01:00
try
2018-11-09 18:11:59 +01:00
if not Assigned( cInstance) then
2018-11-02 21:43:09 +01:00
begin
2018-11-09 18:11:59 +01:00
cInstance : = TMVCSQLGeneratorRegistry. Create;
2018-11-02 21:43:09 +01:00
end ;
finally
2018-11-09 18:11:59 +01:00
TMonitor. Exit( cLock) ;
2018-11-02 21:43:09 +01:00
end ;
end ;
2018-11-09 18:11:59 +01:00
Result : = cInstance;
2018-11-02 21:43:09 +01:00
end ;
procedure TMVCSQLGeneratorRegistry. RegisterSQLGenerator( const aBackend: string ;
const aRQLBackendClass: TMVCSQLGeneratorClass) ;
begin
2018-11-24 16:56:21 +01:00
fSQLGenerators. AddOrSetValue( aBackend, aRQLBackendClass) ;
2018-11-02 21:43:09 +01:00
end ;
2019-03-05 20:55:37 +01:00
procedure TMVCSQLGeneratorRegistry. UnRegisterSQLGenerator( const aBackend: string ) ;
2018-11-02 21:43:09 +01:00
begin
fSQLGenerators. Remove( aBackend) ;
end ;
{ TMVCSQLGenerator }
2021-11-18 00:49:12 +01:00
constructor TMVCSQLGenerator. Create( Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string ; const PartitionInfo: TPartitionInfo) ;
2018-11-02 21:43:09 +01:00
begin
inherited Create;
fMapping : = Mapping;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter : = DefaultRQLFilter;
2021-11-18 00:49:12 +01:00
fPartitionInfo : = PartitionInfo;
2020-04-08 18:04:45 +02:00
GetCompiler;
2021-11-17 15:36:20 +01:00
if not fDefaultRQLFilter. IsEmpty then
begin
2021-11-18 00:49:12 +01:00
GetRQLParser. Execute( fDefaultRQLFilter, fDefaultSQLFilter, GetCompiler, False , True ) ;
2021-11-17 15:36:20 +01:00
fDefaultSQLFilter : = TMVCSQLGenerator. RemoveInitialWhereKeyword( fDefaultSQLFilter) ;
end ;
2018-11-02 21:43:09 +01:00
end ;
function TMVCSQLGenerator. GetMapping: TMVCFieldsMapping;
begin
Result : = fMapping;
end ;
2020-04-08 18:04:45 +02:00
function TMVCSQLGenerator. GetParamNameForSQL( const FieldName: string ) : string ;
begin
Result : = fCompiler. GetParamNameForSQL( FieldName) ;
end ;
2021-11-21 19:27:06 +01:00
function TMVCSQLGenerator. CreateDeleteAllSQL( const TableName: string ) : string ;
begin
Result : = 'DELETE FROM ' + GetTableNameForSQL( TableName) ;
end ;
function TMVCSQLGenerator. CreateDeleteSQL( const TableName: string ;
const Map: TFieldsMap; const PKFieldName: string ;
const PKOptions: TMVCActiveRecordFieldOptions) : string ;
begin
Result : = CreateDeleteAllSQL( TableName) + ' WHERE ' + GetFieldNameForSQL( PKFieldName) + '=:' +
GetParamNameForSQL( PKFieldName) ;
end ;
function TMVCSQLGenerator. CreateSelectByPKSQL( const TableName: string ;
const Map: TFieldsMap; const PKFieldName: string ;
const PKOptions: TMVCActiveRecordFieldOptions) : string ;
begin
if PKFieldName. IsEmpty then
begin
raise EMVCActiveRecord. Create( 'No primary key provided. [HINT] Define a primary key field adding foPrimaryKey in field options.' ) ;
end ;
Result : = CreateSelectSQL( TableName, Map, PKFieldName, PKOptions) + ' WHERE ' +
GetFieldNameForSQL( PKFieldName) + '= :' + GetParamNameForSQL( PKFieldName) +
GetDefaultSQLFilter( False , True ) ;
end ;
function TMVCSQLGenerator. CreateSelectCount( const TableName: string ) : string ;
begin
{do not add SQLFilter here!}
Result : = 'SELECT count(*) FROM ' + GetTableNameForSQL( TableName) ;
end ;
function TMVCSQLGenerator. CreateSelectSQL( const TableName: string ;
const Map: TFieldsMap; const PKFieldName: string ;
const PKOptions: TMVCActiveRecordFieldOptions) : string ;
begin
Result : = 'SELECT ' + TableFieldsDelimited( Map, PKFieldName, ',' ) + ' FROM ' + GetTableNameForSQL( TableName) ;
end ;
function TMVCSQLGenerator. CreateSQLWhereByRQL( const RQL: string ;
const Mapping: TMVCFieldsMapping; const UseArtificialLimit,
UseFilterOnly: Boolean ; const MaxRecordCount: Int32 ) : string ;
begin
GetRQLParser. Execute( MergeDefaultRQLFilter( RQL) , Result , GetCompiler, UseArtificialLimit, UseFilterOnly, MaxRecordCount) ;
end ;
function TMVCSQLGenerator. CreateUpdateSQL( const TableName: string ;
const Map: TFieldsMap; const PKFieldName: string ;
const PKOptions: TMVCActiveRecordFieldOptions) : string ;
var
lPair: TPair< TRttiField, TFieldInfo> ;
I: Integer ;
begin
Result : = 'UPDATE ' + GetTableNameForSQL( TableName) + ' SET ' ;
for lPair in Map do
begin
if lPair. Value. Writeable then
begin
Result : = Result + GetFieldNameForSQL( lPair. Value. FieldName) + ' = :' +
GetParamNameForSQL( lPair. Value. FieldName) + ',' ;
end ;
end ;
{partition}
for I : = 0 to fPartitionInfo. FieldNames. Count - 1 do
begin
Result : = Result + GetFieldNameForSQL( fPartitionInfo. FieldNames[ I] ) + ' = :' +
GetParamNameForSQL( fPartitionInfo. FieldNames[ I] ) + ',' ;
end ;
{end-partitioning}
Result [ Length( Result ) ] : = ' ' ;
if not PKFieldName. IsEmpty then
begin
Result : = Result + ' where ' + GetFieldNameForSQL( PKFieldName) + '= :' + GetParamNameForSQL( PKFieldName) ;
end ;
end ;
2018-11-02 21:43:09 +01:00
destructor TMVCSQLGenerator. Destroy;
begin
fCompiler. Free;
fRQL2SQL. Free;
inherited ;
end ;
function TMVCSQLGenerator. GetCompiler: TRQLCompiler;
begin
if fCompiler = nil then
begin
fCompiler : = GetCompilerClass. Create( fMapping) ;
end ;
Result : = fCompiler;
end ;
2021-11-17 15:36:20 +01:00
function TMVCSQLGenerator. GetDefaultSQLFilter( const IncludeWhereClause: Boolean ; const IncludeAndClauseBeforeFilter: Boolean ) : String ;
begin
2021-11-18 00:49:12 +01:00
Result : = MergeSQLFilter( fPartitionInfo. SQLFilter, fDefaultSQLFilter) ;
if not Result . IsEmpty then
2021-11-17 15:36:20 +01:00
begin
if IncludeWhereClause then
begin
2021-11-18 00:49:12 +01:00
Result : = ' WHERE ' + Result ;
2021-11-17 15:36:20 +01:00
end
else
begin
if IncludeAndClauseBeforeFilter then
2021-11-18 00:49:12 +01:00
Result : = ' and ' + Result ;
2021-11-17 15:36:20 +01:00
end ;
end ;
end ;
2020-04-08 18:04:45 +02:00
function TMVCSQLGenerator. GetFieldNameForSQL( const FieldName: string ) : string ;
begin
Result : = fCompiler. GetFieldNameForSQL( FieldName) ;
end ;
2021-11-18 00:49:12 +01:00
function TMVCSQLGenerator. GetRQLParser: TRQL2SQL;
2018-11-02 21:43:09 +01:00
begin
if fRQL2SQL = nil then
begin
2021-11-18 00:49:12 +01:00
fRQL2SQL : = TRQL2SQL. Create;
2018-11-02 21:43:09 +01:00
end ;
Result : = fRQL2SQL;
end ;
2020-08-28 18:04:29 +02:00
function TMVCSQLGenerator. GetSequenceValueSQL( const PKFieldName: string ; const SequenceName: string ;
const Step: Integer = 1 ) : string ;
2020-01-08 15:30:10 +01:00
begin
Result : = '' ;
end ;
2020-04-08 18:04:45 +02:00
function TMVCSQLGenerator. GetTableNameForSQL( const TableName: string ) : string ;
begin
Result : = fCompiler. GetTableNameForSQL( TableName) ;
end ;
2020-01-08 15:30:10 +01:00
function TMVCSQLGenerator. HasReturning: Boolean ;
begin
Result : = True ;
end ;
function TMVCSQLGenerator. HasSequences: Boolean ;
begin
Result : = True ;
end ;
2021-11-17 15:36:20 +01:00
function TMVCSQLGenerator. MergeDefaultRQLFilter( const RQL: String ) : String ;
2021-11-18 17:52:06 +01:00
var
lRQLFilterPart, lRQLSortingAndLimitPart: String ;
lSemicolonPos: Integer ;
2021-11-17 15:36:20 +01:00
begin
2021-11-18 17:52:06 +01:00
lRQLFilterPart : = RQL;
lRQLSortingAndLimitPart : = '' ;
lSemicolonPos : = RQL. IndexOf( ';' ) ;
if lSemicolonPos > - 1 then
begin
lRQLFilterPart : = RQL. Substring( 0 , lSemicolonPos) ;
lRQLSortingAndLimitPart : = RQL. Substring( lSemicolonPos + 1 , 1 0 0 0 ) ;
end ;
{this is not the best solution, but it works...}
if lRQLFilterPart. Contains( 'sort' ) or lRQLFilterPart. Contains( 'limit' ) then
begin
lRQLSortingAndLimitPart : = lRQLFilterPart;
lRQLFilterPart : = '' ;
end ;
if ( not fDefaultRQLFilter. IsEmpty) or ( not fPartitionInfo. RQLFilter. IsEmpty) then
2021-11-17 15:36:20 +01:00
begin
2021-11-18 17:52:06 +01:00
Result : = 'and(' ;
if not fDefaultRQLFilter. IsEmpty then
2021-11-17 15:36:20 +01:00
begin
2021-11-18 17:52:06 +01:00
Result : = Result + fDefaultRQLFilter;
end ;
if not fPartitionInfo. RQLFilter. IsEmpty then
2021-11-17 15:36:20 +01:00
begin
2021-11-18 17:52:06 +01:00
Result : = Result + ',' + fPartitionInfo. RQLFilter;
end ;
if not lRQLFilterPart. IsEmpty then
begin
Result : = Result + ',' + lRQLFilterPart;
2021-11-17 15:36:20 +01:00
end ;
2021-11-18 17:52:06 +01:00
Result : = Result + ')' ;
2021-11-17 15:36:20 +01:00
end
else
begin
2021-11-18 17:52:06 +01:00
Exit( RQL) ;
2021-11-17 15:36:20 +01:00
end ;
2021-11-18 00:49:12 +01:00
2021-11-18 17:52:06 +01:00
if not lRQLSortingAndLimitPart. IsEmpty then
2021-11-18 00:49:12 +01:00
begin
2021-11-18 17:52:06 +01:00
Result : = Result + ';' + lRQLSortingAndLimitPart;
2021-11-18 00:49:12 +01:00
end ;
2021-11-18 17:52:06 +01:00
//
// var Pieces := RQL.Split([';']);
// if Pieces[0].Trim.Length > 0 then
// begin
// Result := 'and('+fDefaultRQLFilter + ',' + Pieces[0] + ');' + string.Join(';', Pieces, 1, Length(Pieces)-1);
// end
// else
// begin
// Result := fDefaultRQLFilter + ';' + string.Join(';', Pieces, 1, Length(Pieces)-1);
// end;
// end
//
//
//
// if not fDefaultRQLFilter.IsEmpty then
// begin
// if RQL.Contains(';') then
// begin
// var Pieces := RQL.Split([';']);
// if Pieces[0].Trim.Length > 0 then
// begin
// Result := 'and('+fDefaultRQLFilter + ',' + Pieces[0] + ');' + string.Join(';', Pieces, 1, Length(Pieces)-1);
// end
// else
// begin
// Result := fDefaultRQLFilter + ';' + string.Join(';', Pieces, 1, Length(Pieces)-1);
// end;
// end
// else
// begin
// if RQL.IsEmpty then
// begin
// Result := fDefaultRQLFilter
// end
// else
// begin
// Result := MergeRQL(Result, fPartitionInfo.RQLFilter);
// end;
// //Result := 'and('+fDefaultRQLFilter + ',' + RQL + ')';
// end;
// end
// else
// begin
// Result := RQL;
// end;
// Result := MergeRQL(Result, fPartitionInfo.RQLFilter);
2021-11-18 00:49:12 +01:00
end ;
function TMVCSQLGenerator. MergeSQLFilter( const SQL1, SQL2: String ) : String ;
begin
if SQL1 + SQL2 = '' then
begin
Exit( '' ) ;
end ;
if SQL1. IsEmpty and ( not SQL2. IsEmpty) then
begin
Exit( SQL2) ;
end ;
if SQL2. IsEmpty and ( not SQL1. IsEmpty) then
begin
Exit( SQL1) ;
end ;
Result : = '((' + SQL1 + ') and (' + SQL2 + '))' ;
2021-11-17 15:36:20 +01:00
end ;
class function TMVCSQLGenerator. RemoveInitialWhereKeyword(
const SQLFilter: String ) : String ;
begin
Result : = SQLFilter. TrimLeft;
if Result . StartsWith( 'where' , true ) then
begin
Result : = Result . Remove( 0 , 5 ) ;
end ;
end ;
2020-03-25 11:35:25 +01:00
function TMVCSQLGenerator. TableFieldsDelimited( const Map: TFieldsMap; const PKFieldName: string ;
2018-11-02 21:43:09 +01:00
const Delimiter: string ) : string ;
var
2020-03-25 11:35:25 +01:00
lPair: TPair< TRTTIField, TFieldInfo> ;
2018-11-02 21:43:09 +01:00
begin
for lPair in Map do
begin
2020-03-25 11:35:25 +01:00
// if not lPair.Value.FieldName.IsEmpty then
if lPair. Value. Readable then
2019-11-05 16:57:22 +01:00
begin
2020-04-08 18:04:45 +02:00
Result : = Result + GetFieldNameForSQL( lPair. Value. FieldName) + Delimiter;
2019-11-05 16:57:22 +01:00
end ;
2018-11-02 21:43:09 +01:00
end ;
Result : = Copy( Result , 1 , Length( Result ) - Length( Delimiter) ) ;
if not PKFieldName. IsEmpty then
begin
2020-08-11 00:54:42 +02:00
if not Result . IsEmpty then
begin
Result : = GetFieldNameForSQL( PKFieldName) + ', ' + Result
end
else
begin
Result : = GetFieldNameForSQL( PKFieldName)
end ;
2018-11-02 21:43:09 +01:00
end ;
end ;
2018-11-09 18:11:59 +01:00
{ TMVCConnectionsRepository.TConnHolder }
destructor TMVCConnectionsRepository. TConnHolder. Destroy;
begin
if OwnsConnection then
2020-03-23 18:51:57 +01:00
begin
2019-05-09 20:53:52 +02:00
if Connection. Connected then
Connection. Connected : = false ;
2018-11-09 18:11:59 +01:00
FreeAndNil( Connection) ;
2020-03-23 18:51:57 +01:00
end ;
2018-11-09 18:11:59 +01:00
inherited ;
end ;
2021-05-03 19:29:01 +02:00
constructor MVCTableFieldAttribute. Create( const aFieldName: string ;
const aFieldOptions: TMVCActiveRecordFieldOptions;
2020-03-23 18:51:57 +01:00
const aSequenceName: string ; const aDataTypeName: string ) ;
2019-02-15 12:21:11 +01:00
begin
inherited Create;
FieldName : = aFieldName;
FieldOptions : = aFieldOptions;
2020-01-08 15:30:10 +01:00
SequenceName : = aSequenceName;
2020-03-12 20:37:48 +01:00
DataTypeName : = aDataTypeName;
2019-02-15 12:21:11 +01:00
end ;
2020-01-04 12:53:53 +01:00
{ EMVCActiveRecordNotFound }
procedure EMVCActiveRecordNotFound. AfterConstruction;
begin
inherited ;
fHttpErrorCode : = http_status. NotFound;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. ExecQuery( const SQL: string ; const Values: array of Variant ;
const ValueTypes: array of TFieldType; const Connection: TFDConnection) : TDataSet;
2020-03-23 18:51:57 +01:00
var
lQry: TFDQuery;
begin
lQry : = TFDQuery. Create( nil ) ;
try
lQry. FetchOptions. Unidirectional : = false ; // True;
if Connection = nil then
begin
lQry. Connection : = ActiveRecordConnectionsRegistry. GetCurrent;
end
else
begin
lQry. Connection : = Connection;
end ;
lQry. SQL. Text : = SQL;
// lQry.Prepare;
if Length( ValueTypes) = 0 then
begin
lQry. Open( SQL, Values) ;
end
else
begin
lQry. Open( SQL, Values, ValueTypes) ;
end ;
Result : = lQry;
except
lQry. Free;
raise ;
end ;
end ;
2020-08-28 18:04:29 +02:00
class function TMVCActiveRecord. ExecQuery( const SQL: string ; const Values: array of Variant ;
2020-03-23 18:51:57 +01:00
const ValueTypes: array of TFieldType) : TDataSet;
begin
Result : = ExecQuery( SQL, Values, ValueTypes, nil ) ;
end ;
2020-03-25 11:35:25 +01:00
{ TFieldsMap }
constructor TFieldsMap. Create;
begin
inherited Create( [ doOwnsValues] ) ;
2020-08-11 00:54:42 +02:00
fWritableFieldsCount : = - 1 ;
fReadableFieldsCount : = - 1 ;
2020-03-25 11:35:25 +01:00
end ;
procedure TFieldsMap. EndUpdates;
var
lPair: TPair< TRTTIField, TFieldInfo> ;
begin
2020-08-11 00:54:42 +02:00
fWritableFieldsCount : = 0 ;
fReadableFieldsCount : = 0 ;
2020-03-25 11:35:25 +01:00
for lPair in Self do
begin
lPair. Value. EndUpdates;
2020-08-11 00:54:42 +02:00
// if not(foTransient in lPair.Value.FieldOptions) then
if lPair. Value. Writeable then
begin
Inc( fWritableFieldsCount) ;
end ;
if lPair. Value. Readable then
2020-03-25 11:35:25 +01:00
begin
2020-08-11 00:54:42 +02:00
Inc( fReadableFieldsCount) ;
2020-03-25 11:35:25 +01:00
end ;
end ;
end ;
function TFieldsMap. GetInfoByFieldName( const FieldName: string ) : TFieldInfo;
var
lPair: TPair< TRTTIField, TFieldInfo> ;
begin
for lPair in Self do
begin
if SameText( FieldName, lPair. Value. FieldName) then
begin
Result : = Items[ lPair. Key] ;
Exit;
end ;
end ;
raise EMVCActiveRecord. CreateFmt( 'FieldName not found in table [%s]' , [ FieldName] ) ;
end ;
{ TFieldInfo }
procedure TFieldInfo. EndUpdates;
begin
2020-08-11 00:54:42 +02:00
if FieldName. IsEmpty then
begin
Writeable : = false ;
Readable : = false ;
end
else
begin
// Writeable := (not (foReadOnly in FieldOptions)) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
Writeable : = ( ( FieldOptions * [ foReadOnly, foTransient, foAutoGenerated] ) = [ ] ) ;
// Readable := (not (foWriteOnly in FieldOptions)) and (not(foTransient in FieldOptions));
Readable : = ( FieldOptions * [ foWriteOnly, foTransient] ) = [ ] ;
end ;
2020-03-25 11:35:25 +01:00
end ;
2021-04-26 23:01:31 +02:00
{ TMVCUnitOfWork<T> }
2021-04-29 22:52:28 +02:00
procedure TMVCUnitOfWork< T> . Apply( const ItemApplyAction: TMVCItemApplyAction< T> ) ;
2021-04-26 23:01:31 +02:00
var
2021-09-23 22:52:28 +02:00
i: Integer ;
2021-04-29 22:52:28 +02:00
lHandled: Boolean ;
2021-04-26 23:01:31 +02:00
begin
2021-05-03 19:29:01 +02:00
for i : = 0 to fListToInsert. Count - 1 do
2021-04-26 23:01:31 +02:00
begin
2021-05-03 19:29:01 +02:00
lHandled : = false ;
DoItemApplyAction( fListToInsert[ i] , eaCreate, ItemApplyAction, lHandled) ;
2021-04-29 22:52:28 +02:00
if not lHandled then
begin
2021-05-03 19:29:01 +02:00
fListToInsert[ i] . Insert;
2021-04-29 22:52:28 +02:00
end ;
2021-04-26 23:01:31 +02:00
end ;
2021-05-03 19:29:01 +02:00
for i : = 0 to fListToUpdate. Count - 1 do
2021-04-26 23:01:31 +02:00
begin
2021-05-03 19:29:01 +02:00
lHandled : = false ;
DoItemApplyAction( fListToUpdate[ i] , eaUpdate, ItemApplyAction, lHandled) ;
2021-04-29 22:52:28 +02:00
if not lHandled then
begin
2021-09-23 22:52:28 +02:00
fListToUpdate[ i] . Update( True ) ;
2021-04-29 22:52:28 +02:00
end ;
2021-04-26 23:01:31 +02:00
end ;
2021-05-03 19:29:01 +02:00
for i : = 0 to fListToDelete. Count - 1 do
2021-04-26 23:01:31 +02:00
begin
2021-05-03 19:29:01 +02:00
lHandled : = false ;
DoItemApplyAction( fListToDelete[ i] , eaDelete, ItemApplyAction, lHandled) ;
2021-04-29 22:52:28 +02:00
if not lHandled then
begin
2021-09-23 22:52:28 +02:00
fListToDelete[ i] . Delete( True ) ;
2021-04-29 22:52:28 +02:00
end ;
2021-04-26 23:01:31 +02:00
end ;
end ;
constructor TMVCUnitOfWork< T> . Create;
begin
inherited ;
2021-05-03 19:29:01 +02:00
fListToDelete : = TObjectList< T> . Create( false ) ;
fListToUpdate : = TObjectList< T> . Create( false ) ;
fListToInsert : = TObjectList< T> . Create( false ) ;
2021-04-26 23:01:31 +02:00
end ;
destructor TMVCUnitOfWork< T> . Destroy;
begin
fListToDelete. Free;
fListToUpdate. Free;
fListToInsert. Free;
inherited ;
end ;
2021-04-29 22:52:28 +02:00
procedure TMVCUnitOfWork< T> . DoItemApplyAction( const Obj: TMVCActiveRecord;
const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction< T> ;
var Handled: Boolean ) ;
2021-04-26 23:01:31 +02:00
begin
2021-04-29 22:52:28 +02:00
if Assigned( ItemApplyAction) then
begin
ItemApplyAction( Obj, EntityAction, Handled) ;
end ;
2021-04-26 23:01:31 +02:00
end ;
2021-05-03 19:29:01 +02:00
// function TMVCUnitOfWork<T>.GetListToDelete: TList<T>;
// begin
// Result := fListToDelete;
// end;
2021-04-29 22:52:28 +02:00
//
2021-05-03 19:29:01 +02:00
// function TMVCUnitOfWork<T>.GetListToInsert: TList<T>;
// begin
// Result := fListToInsert;
// end;
2021-04-29 22:52:28 +02:00
//
2021-05-03 19:29:01 +02:00
// function TMVCUnitOfWork<T>.GetListToUpdate: TList<T>;
// begin
// Result := fListToUpdate;
// end;
2021-04-26 23:01:31 +02:00
2021-05-03 19:29:01 +02:00
class function TMVCUnitOfWork< T> . KeyExistsInt( const NewList: TObjectList< T> ;
2021-04-27 22:57:15 +02:00
const KeyValue: Integer ; out Index : Integer ) : Boolean ;
var
2021-05-03 19:29:01 +02:00
i: Integer ;
2021-04-27 22:57:15 +02:00
begin
2021-05-03 19:29:01 +02:00
Result : = false ;
for i : = 0 to NewList. Count - 1 do
begin
if NewList[ i] . GetPK. AsInteger = KeyValue then
begin
Index : = i;
Exit( True ) ;
end ;
end ;
end ;
class function TMVCUnitOfWork< T> . KeyExistsInt64( const NewList: TObjectList< T> ;
const KeyValue: int64 ; out Index : Integer ) : Boolean ;
var
i: Integer ;
begin
Result : = false ;
for i : = 0 to NewList. Count - 1 do
begin
2021-09-23 22:52:28 +02:00
if ( not NewList[ i] . PKIsNull) and ( NewList[ i] . GetPK. AsInt64 = KeyValue) then
2021-05-03 19:29:01 +02:00
begin
Index : = i;
Exit( True ) ;
end ;
end ;
end ;
class function TMVCUnitOfWork< T> . KeyExistsString( const NewList: TObjectList< T> ;
const KeyValue: String ; out Index : Integer ) : Boolean ;
var
i: Integer ;
begin
Result : = false ;
for i : = 0 to NewList. Count - 1 do
2021-04-27 22:57:15 +02:00
begin
2021-05-03 19:29:01 +02:00
if NewList[ i] . GetPK. AsString = KeyValue then
2021-04-27 22:57:15 +02:00
begin
2021-05-03 19:29:01 +02:00
Index : = i;
2021-04-27 22:57:15 +02:00
Exit( True ) ;
end ;
end ;
end ;
procedure TMVCUnitOfWork< T> . RegisterDelete( const Value: T) ;
begin
2021-04-29 22:52:28 +02:00
fListToDelete. Add( Value) ;
2021-04-27 22:57:15 +02:00
end ;
procedure TMVCUnitOfWork< T> . RegisterDelete( const Enumerable: TEnumerable< T> ) ;
begin
2021-04-29 22:52:28 +02:00
fListToDelete. AddRange( Enumerable) ;
2021-04-27 22:57:15 +02:00
end ;
procedure TMVCUnitOfWork< T> . RegisterInsert( const Value: T) ;
begin
2021-04-29 22:52:28 +02:00
fListToInsert. Add( Value) ;
2021-04-27 22:57:15 +02:00
end ;
procedure TMVCUnitOfWork< T> . RegisterUpdate( const Value: T) ;
var
lCurrPKValue: Integer ;
lFoundAtIndex: Integer ;
begin
2021-04-29 22:52:28 +02:00
fListToUpdate. Add( Value) ;
2021-04-27 22:57:15 +02:00
lCurrPKValue : = Value. GetPK. AsInteger;
2021-05-03 19:29:01 +02:00
if KeyExistsInt( fListToDelete, lCurrPKValue, lFoundAtIndex) then
2021-04-27 22:57:15 +02:00
begin
fListToDelete. Delete( lFoundAtIndex) ;
end ;
end ;
procedure TMVCUnitOfWork< T> . UnregisterDelete( const Value: T) ;
begin
2021-04-29 22:52:28 +02:00
fListToDelete. Remove( Value) ;
2021-04-27 22:57:15 +02:00
end ;
procedure TMVCUnitOfWork< T> . UnregisterInsert( const Value: T) ;
begin
2021-04-29 22:52:28 +02:00
fListToInsert. Remove( Value) ;
2021-04-27 22:57:15 +02:00
end ;
procedure TMVCUnitOfWork< T> . UnregisterUpdate( const Value: T) ;
begin
2021-04-29 22:52:28 +02:00
fListToUpdate. Remove( Value) ;
2021-04-27 22:57:15 +02:00
end ;
2021-11-17 15:36:20 +01:00
constructor MVCTableAttribute. Create( aName, aRQLFilter: String ) ;
begin
inherited Create;
Name : = aName;
RQLFilter : = aRQLFilter;
end ;
2021-11-18 00:49:12 +01:00
{ MVCPartitionAttribute }
constructor MVCPartitionAttribute. Create( const PartitionClause: String ) ;
begin
inherited Create;
Self. PartitionClause : = PartitionClause;
end ;
{ TPartitionInfo }
constructor TPartitionInfo. Create;
begin
inherited ;
2021-11-18 17:52:06 +01:00
fFieldNames : = TPartitionFieldNames. Create;
fFieldValues : = TPartitionFieldValues. Create;
fFieldTypes : = TPartitionFieldTypes. Create;
end ;
destructor TPartitionInfo. Destroy;
begin
fFieldNames. Free;
fFieldValues. Free;
fFieldTypes. Free;
inherited ;
end ;
class destructor TPartitionInfo. Destroy;
begin
PartitionInfoCache. Free;
2021-11-18 00:49:12 +01:00
end ;
procedure TPartitionInfo. InitializeFilterStrings(
2021-11-18 17:52:06 +01:00
const RQLCompiler: TRQLCompiler) ;
2021-11-18 00:49:12 +01:00
var
lFieldCount, I: Integer ;
2021-11-23 18:03:48 +01:00
lRQL2SQL: TRQL2SQL;
2021-11-18 00:49:12 +01:00
begin
2021-11-18 17:52:06 +01:00
fRQLFilter : = '' ;
lFieldCount : = FieldNames. Count;
2021-11-18 00:49:12 +01:00
if lFieldCount > 0 then
begin
for I : = 0 to lFieldCount - 1 do
begin
2021-11-19 00:34:37 +01:00
case FieldTypes[ I] of
ftString:
begin
fRQLFilter : = fRQLFilter + 'eq(' + FieldNames[ i] + ',' + FieldValues[ i] . QuotedString( '"' ) + '),' ;
end ;
ftInteger:
begin
fRQLFilter : = fRQLFilter + 'eq(' + FieldNames[ i] + ',' + FieldValues[ i] + '),' ;
end ;
else
raise ERQLException. CreateFmt( 'DataType for field [%s] not supported in partition clause' , [ fFieldNames[ I] ] ) ;
end ;
2021-11-18 00:49:12 +01:00
end ;
2021-11-18 17:52:06 +01:00
fRQLFilter : = fRQLFilter. Remove( fRQLFilter. Length - 1 , 1 ) ;
2021-11-18 00:49:12 +01:00
if lFieldCount > 1 then
begin
2021-11-18 17:52:06 +01:00
fRQLFilter : = 'and(' + fRQLFilter + ')' ;
2021-11-18 00:49:12 +01:00
end ;
end ;
2021-11-23 18:03:48 +01:00
lRQL2SQL : = TRQL2SQL. Create;
2021-11-18 17:52:06 +01:00
try
2021-11-23 18:03:48 +01:00
lRQL2SQL. Execute( fRQLFilter, fSQLFilter, RQLCompiler, False , True )
2021-11-18 17:52:06 +01:00
finally
2021-11-23 18:03:48 +01:00
lRQL2SQL. Free;
2021-11-18 17:52:06 +01:00
end ;
fSQLFilter : = TMVCSQLGenerator. RemoveInitialWhereKeyword( fSQLFilter) ;
end ;
class function TPartitionInfo. BuildPartitionClause(
const PartitionClause: String ; const RQLCompilerClass: TRQLCompilerClass) : TPartitionInfo;
var
lPieces, lItems: TArray< String > ;
lPiece: String ;
lRQLCompiler: TRQLCompiler;
begin
{
Needs to parse [ MVCPartition( 'rating=(integer)4;classname=(string)persona' ) ]
}
if not PartitionInfoCache. TryGetValue( PartitionClause + '|' + RQLCompilerClass. ClassName, Result ) then
begin
lRQLCompiler : = RQLCompilerClass. Create( nil ) ;
try
Result : = TPartitionInfo. Create;
try
lPieces : = PartitionClause. Split( [ ';' ] ) ;
for lPiece in lPieces do
begin
lItems : = lPiece. Split( [ '=' , '(' , ')' ] , TStringSplitOptions. ExcludeEmpty) ;
if Length( lItems) < > 3 then
begin
raise EMVCActiveRecord. Create( 'Invalid partitioning clause: ' + lPiece + '. [HINT] Paritioning must be in the form: "[fieldname1=(integer|string)value1]"' ) ;
end ;
Result . FieldNames. Add( lItems[ 0 ] ) ;
if lItems[ 1 ] = 'integer' then
Result . FieldTypes. Add( ftInteger)
else if lItems[ 1 ] = 'string' then
begin
Result . FieldTypes. Add( ftString)
end
else
begin
raise EMVCActiveRecord. Create( 'Unknown data type in partitioning: ' + lItems[ 1 ] + '. [HINT] data type can be "integer" or "string"' ) ;
end ;
Result . FieldValues. Add( lItems[ 2 ] ) ;
end ;
except
Result . Free;
raise ;
end ;
Result . InitializeFilterStrings( lRQLCompiler) ;
PartitionInfoCache. Add( PartitionClause + '|' + RQLCompilerClass. ClassName, Result ) ;
finally
lRQLCompiler. Free;
end ;
end ;
end ;
class constructor TPartitionInfo. Create;
begin
PartitionInfoCache : = TMVCThreadedObjectCache< TPartitionInfo> . Create;
2021-11-18 00:49:12 +01:00
end ;
2018-09-25 15:36:53 +02:00
initialization
gLock : = TObject. Create;
2018-10-14 18:23:20 +02:00
gCtx : = TRttiContext. Create;
gCtx. FindType( '' ) ;
2018-09-25 15:36:53 +02:00
finalization
2018-10-14 18:23:20 +02:00
gCtx. Free;
2018-09-25 15:36:53 +02:00
gLock. Free;
end .