delphimvcframework/sources/MVCFramework.ActiveRecord.pas

3855 lines
111 KiB
ObjectPascal
Raw Normal View History

// *************************************************************************** }
//
// Delphi MVC Framework
//
2022-01-04 15:44:47 +01:00
// Copyright (c) 2010-2022 Daniele Teti and the DMVCFramework Team
//
// 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;
{$I dmvcframework.inc}
interface
uses
System.Generics.Defaults,
System.Generics.Collections,
System.RTTI,
FireDAC.DApt,
Data.DB,
FireDAC.Comp.Client,
FireDAC.Stan.Def,
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
System.SysUtils,
MVCFramework,
MVCFramework.Commons,
MVCFramework.RQL.Parser,
2021-11-18 17:52:06 +01:00
MVCFramework.Cache,
MVCFramework.Serializer.Intf,
2021-11-18 17:52:06 +01:00
MVCFramework.Serializer.Commons, System.SyncObjs;
type
EMVCActiveRecord = class(EMVCException)
public
constructor Create(const AMsg: string); reintroduce; { do not override!! }
end;
EMVCActiveRecordNotFound = class(EMVCActiveRecord)
public
procedure AfterConstruction; override;
end;
TMVCActiveRecordClass = class of TMVCActiveRecord;
TMVCActiveRecord = class;
TMVCActiveRecordFieldOption = (foPrimaryKey, { it's the primary key of the mapped table }
foAutoGenerated, { not written, read - similar to readonly }
foTransient, { not written, not read }
foReadOnly, { not written, read }
foWriteOnly); { written, not read }
TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete);
TMVCEntityActions = set of TMVCEntityAction;
TMVCActiveRecordLoadOption = (loIgnoreNotExistentFields);
TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption;
2021-11-18 17:52:06 +01:00
TPartitionFieldNames = class(TList<String>)
end;
TPartitionFieldValues = class(TList<String>)
end;
TPartitionFieldTypes = class(TList<TFieldType>)
end;
IMVCEntityProcessor = interface
['{E7CD11E6-9FF9-46D2-B7B0-DA5B38EAA14E}']
procedure GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string;
var Handled: Boolean);
procedure GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string;
const id: Integer; var Handled: Boolean);
procedure CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string;
var Handled: Boolean);
procedure UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string;
const id: Integer; var Handled: Boolean);
procedure DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer;
const entityname: string;
const id: Integer; var Handled: Boolean);
end;
TFieldInfo = class
public
// TableName: string;
FieldName: string;
FieldOptions: TMVCActiveRecordFieldOptions;
DataTypeName: string;
Writeable, Readable: Boolean;
procedure EndUpdates;
end;
TFieldsMap = class(TObjectDictionary<TRTTIField, TFieldInfo>)
private
fWritableFieldsCount: Integer;
fReadableFieldsCount: Integer;
public
constructor Create;
procedure EndUpdates;
property WritableFieldsCount: Integer read fWritableFieldsCount;
property ReadableFieldsCount: Integer read fReadableFieldsCount;
function GetInfoByFieldName(const FieldName: string): TFieldInfo;
end;
MVCActiveRecordCustomAttribute = class(TCustomAttribute)
end;
MVCTableAttribute = class(MVCActiveRecordCustomAttribute)
2019-01-08 12:48:27 +01:00
public
Name: string;
2021-11-17 15:36:20 +01:00
RQLFilter: string;
constructor Create(aName: string); overload;
constructor Create(aName: string; aRQLFilter: String); overload;
end;
MVCPartitionAttribute = class(MVCActiveRecordCustomAttribute)
public
PartitionClause: String;
constructor Create(const PartitionClause: String);
end;
MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
public
FieldName: string;
2019-02-15 12:21:11 +01:00
FieldOptions: TMVCActiveRecordFieldOptions;
SequenceName, DataTypeName: string;
constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
const aSequenceName: string = ''; const aDataTypeName: string = ''); overload;
constructor Create(aFieldName: string; const aDataTypeName: string = ''); overload;
end;
MVCPrimaryKeyAttribute = MVCTableFieldAttribute deprecated '(ERROR) Use MVCTableFieldAttribute';
MVCEntityActionsAttribute = class(MVCActiveRecordCustomAttribute)
private
EntityAllowedActions: TMVCEntityActions;
public
constructor Create(const aEntityAllowedActions: TMVCEntityActions);
end;
TMVCSQLGenerator = class;
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;
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;
end;
TMVCActiveRecordList = class(TObjectList<TMVCActiveRecord>)
public
constructor Create; virtual;
end;
TMVCActiveRecord = class
private
fChildren: TObjectList<TObject>;
fConn: TFDConnection;
fSQLGenerator: TMVCSQLGenerator;
fPrimaryKeyFieldName: string;
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
fPrimaryKeySequenceName: string;
fPrimaryKeyFieldType: TFieldType;
fEntityAllowedActions: TMVCEntityActions;
fRQL2SQL: TRQL2SQL;
procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam);
function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
function GetPrimaryKeyIsAutogenerated: Boolean;
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
procedure SetTableName(const Value: string);
function GetAttributes(const AttrName: string): TValue;
procedure SetAttributes(const AttrName: string; const Value: TValue);
protected
fRTTIType: TRttiInstanceType;
fProps: TArray<TRTTIField>;
fObjAttributes: TArray<TCustomAttribute>;
fPropsAttributes: TArray<TCustomAttribute>;
fTableName: string;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter: string;
fMap: TFieldsMap;
fPrimaryKey: TRTTIField;
fBackendDriver: string;
fMapping: TMVCFieldsMapping;
2021-11-18 17:52:06 +01:00
fPartitionInfoInternal: TPartitionInfo;
fPartitionClause: String;
function GetPartitionInfo: TPartitionInfo;
function GetBackEnd: string;
function GetConnection: TFDConnection;
procedure InitTableInfo;
2022-06-19 18:57:47 +02:00
class function ExecQuery(
const SQL: string;
const Values: array of Variant;
const Unidirectional: Boolean): TDataSet; overload;
class function ExecQuery(
const SQL: string;
const Values: array of Variant;
const Connection: TFDConnection; const Unidirectional: Boolean)
: TDataSet; overload;
class function ExecQuery(const SQL: string; const Values: array of Variant;
2022-06-19 18:57:47 +02:00
const ValueTypes: array of TFieldType; const Unidirectional: Boolean)
: TDataSet; overload;
2022-06-19 18:57:47 +02:00
class function ExecQuery(
const SQL: string;
const Values: array of Variant;
const ValueTypes: array of TFieldType;
2022-06-19 18:57:47 +02:00
const Connection: TFDConnection;
const Unidirectional: Boolean): TDataSet; overload;
procedure FillPrimaryKey(const SequenceName: string);
function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
overload;
class function GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string; const aFieldType: TFieldType;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord; overload;
// load events
/// <summary>
/// Called everywhere before persist object into database
/// </summary>
procedure OnValidation(const EntityAction: TMVCEntityAction); virtual;
/// <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;
/// <summary>
/// Called after insert the object state to database
/// </summary>
procedure OnAfterInsert; virtual;
/// <summary>
/// Called before update the object state to database
/// </summary>
procedure OnBeforeUpdate; virtual;
/// <summary>
/// Called after update the object state to database
/// </summary>
procedure OnAfterUpdate; virtual;
/// <summary>
/// Called before delete object from database
/// </summary>
procedure OnBeforeDelete; virtual;
/// <summary>
/// Called after delete object from database
/// </summary>
procedure OnAfterDelete; virtual;
/// <summary>
/// Called before insert or update the object to the database
/// </summary>
procedure OnBeforeInsertOrUpdate; virtual;
/// <summary>
/// Called before execute sql
/// </summary>
procedure OnBeforeExecuteSQL(var SQL: string); virtual;
/// <summary>
/// Called after insert or update the object to the database
/// </summary>
procedure OnAfterInsertOrUpdate; virtual;
procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean); virtual;
function GenerateSelectSQL: string;
function SQLGenerator: TMVCSQLGenerator;
2019-08-02 12:32:23 +02:00
function InternalCount(const RQL: string): int64;
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList;
public
constructor Create(aLazyLoadConnection: Boolean); overload;
{ cannot be virtual! }
2018-09-28 13:01:46 +02:00
constructor Create; overload; virtual;
destructor Destroy; override;
procedure EnsureConnection;
procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
/// <summary>
/// Executes an Insert (pk is null) or an Update (pk is not null)
/// </summary>
procedure Store;
function CheckAction(const aEntityAction: TMVCEntityAction;
const aRaiseException: Boolean = True): Boolean;
procedure Insert;
2018-09-28 13:01:46 +02:00
function GetMapping: TMVCFieldsMapping;
function LoadByPK(const id: int64): Boolean; overload; virtual;
function LoadByPK(const id: string): Boolean; overload; virtual;
function LoadByPK(const id: TGuid): Boolean; overload; virtual;
function LoadByPK(const id: string; const aFieldType: TFieldType): Boolean; overload; virtual;
procedure Update(const RaiseExceptionIfNotFound: Boolean = True);
procedure Delete(const RaiseExceptionIfNotFound: Boolean = True);
function TableInfo: string;
procedure LoadByDataset(const aDataSet: TDataSet;
const aOptions: TMVCActiveRecordLoadOptions = []);
procedure SetPK(const aValue: TValue);
procedure SetPropertyValue(const aProp: TRttiProperty; const aValue: TValue);
function GetPK: TValue;
function TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
function PKIsNullable(out PKValue: TValue): Boolean;
function PKIsNull: Boolean;
procedure AddChildren(const ChildObject: TObject);
procedure RemoveChildren(const ChildObject: TObject);
function GetPrimaryKeyFieldType: TFieldType;
// dynamic access
property Attributes[const AttrName: string]: TValue read GetAttributes write SetAttributes;
[MVCDoNotSerialize]
property TableName: string read fTableName write SetTableName;
[MVCDoNotSerialize]
property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated
write SetPrimaryKeyIsAutogenerated;
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant)
: TMVCActiveRecordList; overload;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
const MaxRecordCount: Integer)
: TMVCActiveRecordList; overload;
class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList; overload;
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;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
overload;
class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload;
function Count(const RQL: string = ''): int64; overload;
class function Count(const aClass: TMVCActiveRecordClass; const RQL: string = '')
: int64; overload;
class function SelectDataSet(const SQL: string; const Params: array of Variant;
2022-06-19 18:57:47 +02:00
const Unidirectional: Boolean = False): TDataSet; overload;
class function SelectDataSet(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType;
const Unidirectional: Boolean = False): TDataSet; overload;
class function CurrentConnection: TFDConnection;
end;
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
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string; const aFieldType: TFieldType;
const RaiseExceptionIfNotFound: Boolean): T; overload;
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
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;
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;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [];
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
const MaxRecordCount: Integer)
2019-08-02 12:32:23 +02:00
: TObjectList<T>; overload;
class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
2019-08-02 12:32:23 +02:00
class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
class function Count<T: TMVCActiveRecord>(const RQL: string = ''): int64; overload;
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant)
: TObjectList<T>; overload;
/// <summary>
/// Executes a SQL select using the SQLWhere parameter as where clause. This method is partitioning safe.
/// Returns TObjectList<EntityType>.
/// </summary>
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant;
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;
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;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
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;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
class function Merge<T: TMVCActiveRecord>(CurrentList,
NewList: TObjectList<T>): IMVCMultiExecutor<T>;
2019-08-02 12:32:23 +02:00
end;
IMVCEntitiesRegistry = interface
['{BB227BEB-A74A-4637-8897-B13BA938C07B}']
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
procedure AddEntityProcessor(const aURLSegment: string;
const aEntityProcessor: IMVCEntityProcessor);
function FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
function FindProcessorByURLSegment(const aURLSegment: string;
out aMVCEntityProcessor: IMVCEntityProcessor)
: Boolean;
function GetEntities: TArray<String>;
end;
TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
private
fEntitiesDict: TDictionary<string, TMVCActiveRecordClass>;
fProcessorsDict: TDictionary<string, IMVCEntityProcessor>;
public
constructor Create; virtual;
destructor Destroy; override;
protected
procedure AddEntityProcessor(const aURLSegment: string;
const aEntityProcessor: IMVCEntityProcessor);
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
function FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
function FindProcessorByURLSegment(const aURLSegment: string;
out aMVCEntityProcessor: IMVCEntityProcessor)
: Boolean;
function GetEntities: TArray<String>;
end;
2018-09-28 13:01:46 +02:00
IMVCActiveRecordConnections = interface
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
procedure AddConnection(const aName: string; const aConnection: TFDConnection;
const Owns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
procedure SetCurrent(const aName: string);
function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
function GetCurrentBackend: string;
procedure SetDefault;
end;
TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections)
private type
TConnHolder = class
2019-01-08 12:48:27 +01:00
public
Connection: TFDConnection;
OwnsConnection: Boolean;
destructor Destroy; override;
end;
var
fMREW: TMultiReadExclusiveWriteSynchronizer;
fConnectionsDict: TDictionary<string, TConnHolder>;
fCurrentConnectionsByThread: TDictionary<TThreadID, string>;
function GetKeyName(const aName: string): string;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddConnection(const aName: string; const aConnection: TFDConnection;
const aOwns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
procedure SetCurrent(const aName: string);
function GetCurrent(const RaiseExceptionIfNotAvailable: Boolean = True): TFDConnection;
function GetByName(const aName: string): TFDConnection;
function GetCurrentBackend: string;
procedure SetDefault;
end;
TMVCSQLGenerator = class abstract
private
fMapping: TMVCFieldsMapping;
2021-11-17 15:36:20 +01:00
fDefaultSQLFilter: String;
fDefaultRQLFilter: String;
fCompiler: TRQLCompiler;
fRQL2SQL: TRQL2SQL;
protected
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;
function MergeSQLFilter(const SQL1, SQL2: String): String;
function GetRQLParser: TRQL2SQL;
function GetCompiler: TRQLCompiler;
function GetCompilerClass: TRQLCompilerClass; virtual; abstract;
function GetMapping: TMVCFieldsMapping;
function TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string;
const Delimiter: string): string;
public
constructor Create(Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string; const PartitionInfo: TPartitionInfo); virtual;
destructor Destroy; override;
// capabilities
function HasSequences: Boolean; virtual;
function HasReturning: Boolean; virtual;
function HasNativeUUID: Boolean; virtual;
// end-capabilities
// abstract SQL generator methods
function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
const UseArtificialLimit: Boolean = True; const UseFilterOnly: Boolean = false;
const MaxRecordCount: Int32 = TMVCConstants.MAX_RECORD_COUNT): string;
function CreateSelectSQL(const TableName: string; const Map: TFieldsMap;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
function CreateInsertSQL(const TableName: string; const Map: TFieldsMap;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
// virtual methods with default implementation
function CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
function CreateDeleteSQL(const TableName: string; const Map: TFieldsMap;
const PKFieldName: string;
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;
function GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string;
const Step: Integer = 1): string; virtual;
// 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;
end;
TMVCSQLGeneratorClass = class of TMVCSQLGenerator;
TMVCSQLGeneratorRegistry = class sealed
private
class var cInstance: TMVCSQLGeneratorRegistry;
class var
cLock: TObject;
fSQLGenerators: TDictionary<string, TMVCSQLGeneratorClass>;
protected
constructor Create;
public
destructor Destroy; override;
class function Instance: TMVCSQLGeneratorRegistry;
class destructor Destroy;
class constructor Create;
procedure RegisterSQLGenerator(const aBackend: string;
const aRQLBackendClass: TMVCSQLGeneratorClass);
procedure UnRegisterSQLGenerator(const aBackend: string);
function GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
end;
TMVCUnitOfWork<T: TMVCActiveRecord> = class(TInterfacedObject, IMVCUnitOfWork<T>,
IMVCMultiExecutor<T>)
private
fListToDelete: TObjectList<T>;
fListToUpdate: TObjectList<T>;
fListToInsert: TObjectList<T>;
protected
// multiexecutor
procedure Apply(const ItemApplyAction: TMVCItemApplyAction<T> = nil);
// unitofwork
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);
// events
procedure DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction<T>; var Handled: Boolean);
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;
out Index: Integer): Boolean;
public
constructor Create; virtual;
destructor Destroy; override;
end;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
function GetBackEndByConnection(aConnection: TFDConnection): string;
implementation
uses
System.TypInfo,
System.IOUtils,
System.Classes,
MVCFramework.DataSet.Utils,
MVCFramework.Logger,
MVCFramework.Nullables,
MVCFramework.RTTI.Utils,
FireDAC.Stan.Option,
Data.FmtBcd, System.Variants;
var
gCtx: TRttiContext;
gEntitiesRegistry: IMVCEntitiesRegistry;
gConnections: IMVCActiveRecordConnections;
gLock: TObject;
function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
2019-08-02 12:32:23 +02:00
case Ord(aConnection.RDBMSKind) of
0:
Exit('unknown');
1:
Exit('oracle');
2:
Exit('mssql');
3:
Exit('msaccess');
4:
Exit('mysql');
5:
Exit('db2');
6:
Exit('sqlanywhere');
7:
Exit('advantage');
8:
Exit('interbase');
9:
Exit('firebird');
10:
Exit('sqlite');
11:
Exit('postgresql');
12:
Exit('nexusdb');
13:
Exit('dataSnap');
14:
Exit('informix');
15:
Exit('teradata');
16:
Exit('mongodb');
17:
Exit('other');
else
raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
end;
end;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
begin
if gConnections = nil then // double check here
begin
TMonitor.Enter(gLock);
try
if gConnections = nil then
begin
gConnections := TMVCConnectionsRepository.Create;
end;
finally
TMonitor.Exit(gLock);
end;
end;
Result := gConnections;
end;
function IntToNullableInt(const Value: Integer): NullableInt32;
begin
Result.SetValue(Value);
end;
{ TConnectionsRepository }
procedure TMVCConnectionsRepository.AddConnection(const aName: string;
const aConnection: TFDConnection;
const aOwns: Boolean = false);
var
lName: string;
lConnKeyName: string;
lConnHolder: TConnHolder;
begin
lName := aName.ToLower;
lConnKeyName := GetKeyName(lName);
{ 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;
fMREW.BeginWrite;
try
lConnHolder := TConnHolder.Create;
lConnHolder.Connection := aConnection;
lConnHolder.OwnsConnection := aOwns;
fConnectionsDict.Add(lConnKeyName, lConnHolder);
// raise exception on duplicates
if (lName = 'default') and
(not fCurrentConnectionsByThread.ContainsKey(TThread.CurrentThread.ThreadID)) then
begin
fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
end;
finally
fMREW.EndWrite;
end;
end;
procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection;
const aOwns: Boolean);
2019-05-09 20:53:52 +02:00
begin
AddConnection('default', aConnection, aOwns);
end;
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;
constructor TMVCConnectionsRepository.Create;
begin
inherited;
fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
fConnectionsDict := TDictionary<string, TConnHolder>.Create;
fCurrentConnectionsByThread := TDictionary<TThreadID, string>.Create;
end;
destructor TMVCConnectionsRepository.Destroy;
begin
fConnectionsDict.Free;
fCurrentConnectionsByThread.Free;
fMREW.Free;
inherited;
end;
function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection;
var
lKeyName: string;
lConnHolder: TConnHolder;
begin
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result := nil;
{$ENDIF}
lKeyName := GetKeyName(aName.ToLower);
fMREW.BeginRead;
try
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
raise Exception.CreateFmt('Unknown connection %s', [aName]);
Result := lConnHolder.Connection;
finally
fMREW.EndRead;
end;
end;
function TMVCConnectionsRepository.GetCurrent(const RaiseExceptionIfNotAvailable: Boolean)
: TFDConnection;
var
lName: string;
begin
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result := nil;
{$ENDIF}
fMREW.BeginRead;
try
2019-08-02 12:32:23 +02:00
if fCurrentConnectionsByThread.TryGetValue(TThread.CurrentThread.ThreadID, lName) then
begin
Result := GetByName(lName);
end
else
begin
if RaiseExceptionIfNotAvailable then
raise EMVCActiveRecord.Create('No current connection for thread')
else
Result := nil;
end;
finally
fMREW.EndRead;
end;
end;
function TMVCConnectionsRepository.GetCurrentBackend: string;
begin
Result := GetBackEndByConnection(GetCurrent);
end;
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]);
end;
procedure TMVCConnectionsRepository.RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
var
lName: string;
lKeyName: string;
lConnHolder: TConnHolder;
begin
lName := aName.ToLower;
lKeyName := GetKeyName(lName);
fMREW.BeginWrite;
try
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
begin
if RaiseExceptionIfNotAvailable then
begin
raise Exception.CreateFmt('Unknown connection %s', [aName])
end
else
begin
Exit;
end;
end;
fConnectionsDict.Remove(lKeyName);
try
FreeAndNil(lConnHolder);
except
on E: Exception do
begin
LogE('ActiveRecord: ' + E.ClassName + ' > ' + E.Message);
raise;
end;
end;
finally
fMREW.EndWrite;
end;
end;
procedure TMVCConnectionsRepository.RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
2019-05-09 20:53:52 +02:00
begin
RemoveConnection('default', RaiseExceptionIfNotAvailable);
2019-05-09 20:53:52 +02:00
end;
procedure TMVCConnectionsRepository.SetCurrent(const aName: string);
var
lName: string;
lKeyName: string;
begin
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);
finally
fMREW.EndWrite;
end;
end;
procedure TMVCConnectionsRepository.SetDefault;
begin
SetCurrent('default');
end;
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 }
constructor MVCTableFieldAttribute.Create(aFieldName: string; const aDataTypeName: string = '');
begin
Create(aFieldName, [], '', aDataTypeName);
end;
{ TableAttribute }
constructor MVCTableAttribute.Create(aName: string);
begin
2021-11-17 15:36:20 +01:00
Create(aName, '');
end;
{ TActiveRecord }
destructor TMVCActiveRecord.Destroy;
begin
fChildren.Free;
fMap.Free;
fSQLGenerator.Free;
fRQL2SQL.Free;
fConn := nil; // do not free it!!
inherited;
end;
procedure TMVCActiveRecord.EnsureConnection;
begin
GetConnection;
end;
function TMVCActiveRecord.ExecNonQuery(const SQL: string;
RefreshAutoGenerated: Boolean = false): int64;
var
lQry: TFDQuery;
lPar: TFDParam;
lPair: TPair<TRTTIField, TFieldInfo>;
lValue: TValue;
lSQL: string;
lHandled: Boolean;
I: Integer;
begin
2022-06-19 18:57:47 +02:00
{TODO -oDanieleT -cGeneral : Why not a TFDCommand?}
lQry := TFDQuery.Create(nil);
try
lQry.Connection := GetConnection;
lSQL := SQL;
OnBeforeExecuteSQL(lSQL);
lQry.SQL.Text := lSQL;
lHandled := false;
// lQry.Prepare;
MapObjectToParams(lQry.Params, lHandled);
if not lHandled then
begin
{partitioning}
2021-11-18 17:52:06 +01:00
for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do
begin
2021-11-18 17:52:06 +01:00
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I]));
if lPar <> nil then
begin
2021-11-18 17:52:06 +01:00
if GetPartitionInfo.FieldTypes[I] = ftInteger then
lValue := StrToInt(GetPartitionInfo.FieldValues[I])
else
2021-11-18 17:52:06 +01:00
lValue := GetPartitionInfo.FieldValues[I];
//lPar.DataTypeName := fPartitionInfo.FieldValues[I];
MapTValueToParam(lValue, lPar);
end
end;
{end-partitioning}
for lPair in fMap do
begin
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
if lPar <> nil then
begin
lValue := lPair.Key.GetValue(Self);
lPar.DataTypeName := fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
MapTValueToParam(lValue, lPar);
end
end;
// check if it's the primary key
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(fPrimaryKeyFieldName));
if lPar <> nil then
begin
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 }
lPar.DataType := GetPrimaryKeyFieldType;
end;
MapTValueToParam(fPrimaryKey.GetValue(Self), lPar);
end;
end;
if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fPrimaryKeyOptions) and
fPrimaryKeySequenceName.IsEmpty then
begin
lValue := fPrimaryKey.GetValue(Self);
lQry.Open;
if (lValue.Kind = tkRecord) then
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fPrimaryKey, Self);
end
else
begin
lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger;
fPrimaryKey.SetValue(Self, lValue);
end;
end
else
begin
lQry.ExecSQL(lSQL);
end;
Result := lQry.RowsAffected;
finally
lQry.Free;
end;
end;
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
2022-06-19 18:57:47 +02:00
const Connection: TFDConnection; const Unidirectional: Boolean): TDataSet;
begin
2022-06-19 18:57:47 +02:00
Result := ExecQuery(SQL, Values, [], Connection, Unidirectional);
end;
procedure TMVCActiveRecord.FillPrimaryKey(const SequenceName: string);
var
lDS: TDataSet;
lSQL: string;
begin
if not SequenceName.IsEmpty then
begin
lSQL := SQLGenerator.GetSequenceValueSQL(fPrimaryKeyFieldName, SequenceName);
if lSQL.IsEmpty then
begin
Exit;
end;
2022-06-19 18:57:47 +02:00
lDS := ExecQuery(lSQL, [], True);
try
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(lDS.Fields[0], fPrimaryKey, Self);
finally
lDS.Free;
end;
end;
end;
2022-06-19 18:57:47 +02:00
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant; const Unidirectional: Boolean)
: TDataSet;
begin
2022-06-19 18:57:47 +02:00
Result := ExecQuery(SQL, Values, nil, Unidirectional);
end;
procedure TMVCActiveRecord.InitTableInfo;
var
lAttribute: TCustomAttribute;
lRTTIField: TRTTIField;
lFieldInfo: TFieldInfo;
lPrimaryFieldTypeAsStr: string;
begin
2021-11-18 17:52:06 +01:00
fPartitionInfoInternal := nil;
fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve,
TMVCEntityAction.eaUpdate,
TMVCEntityAction.eaDelete];
fTableName := '';
2021-11-18 17:52:06 +01:00
fPartitionClause := '';
fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
fObjAttributes := fRTTIType.GetAttributes;
for lAttribute in fObjAttributes do
begin
if lAttribute is MVCTableAttribute then
begin
fTableName := MVCTableAttribute(lAttribute).Name;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter := MVCTableAttribute(lAttribute).RQLFilter;
Continue;
end;
if lAttribute is MVCEntityActionsAttribute then
begin
fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
end;
if lAttribute is MVCPartitionAttribute then
begin
2021-11-18 17:52:06 +01:00
fPartitionClause := MVCPartitionAttribute(lAttribute).PartitionClause;
Continue;
end;
end;
if fTableName = '' then
begin
if [eaCreate, eaUpdate, eaDelete] * fEntityAllowedActions <> [] then
begin
raise Exception.Create('Cannot find TableNameAttribute');
end;
end;
fProps := fRTTIType.GetFields;
for lRTTIField in fProps do
begin
fPropsAttributes := lRTTIField.GetAttributes;
if Length(fPropsAttributes) = 0 then
continue;
for lAttribute in fPropsAttributes do
begin
if lAttribute is MVCTableFieldAttribute then
begin
if foPrimaryKey in MVCTableFieldAttribute(lAttribute).FieldOptions then
begin
fPrimaryKey := lRTTIField;
lPrimaryFieldTypeAsStr := fPrimaryKey.FieldType.ToString.ToLower;
if lPrimaryFieldTypeAsStr.EndsWith('int64') then
begin
fPrimaryKeyFieldType := ftLargeInt;
end
else if lPrimaryFieldTypeAsStr.EndsWith('integer') or
lPrimaryFieldTypeAsStr.EndsWith('int32') then
begin
fPrimaryKeyFieldType := ftInteger;
end
else if lPrimaryFieldTypeAsStr.EndsWith('string') then
begin
fPrimaryKeyFieldType := ftString;
end
else if lPrimaryFieldTypeAsStr.EndsWith('guid') then
begin
fPrimaryKeyFieldType := ftGuid;
end
else
begin
raise EMVCActiveRecord.Create
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String, GUID - found: '
+
lPrimaryFieldTypeAsStr);
end;
fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
continue;
end;
lFieldInfo := TFieldInfo.Create;
// lFieldInfo.TableName := fTableName;
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;
end;
end;
end;
fMap.EndUpdates;
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;
end;
procedure TMVCActiveRecord.Insert;
var
SQL: string;
begin
CheckAction(TMVCEntityAction.eaCreate);
OnValidation(TMVCEntityAction.eaCreate);
OnBeforeInsert;
OnBeforeInsertOrUpdate;
if fMap.WritableFieldsCount = 0 then
begin
raise EMVCActiveRecord.CreateFmt
('Cannot insert an entity if all fields are not writable or transient. Class [%s] mapped on table [%s]',
[ClassName, fTableName]);
end;
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
raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' +
GetBackEnd +
' requires it');
end;
if foReadOnly in fPrimaryKeyOptions then
begin
raise EMVCActiveRecord.Create('Cannot define a read-only primary key when a sequence is used for the class ' + ClassName);
end;
FillPrimaryKey(fPrimaryKeySequenceName);
end;
end;
end;
SQL := SQLGenerator.CreateInsertSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
ExecNonQuery(SQL, True);
OnAfterInsert;
OnAfterInsertOrUpdate;
end;
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;
function TMVCActiveRecord.InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList;
2019-08-02 12:32:23 +02:00
var
lSQL: string;
begin
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;
constructor TMVCActiveRecord.Create(aLazyLoadConnection: Boolean);
begin
2018-09-28 13:01:46 +02:00
inherited Create;
fConn := nil;
SetLength(fMapping, 0);
{ TODO -oDanieleT -cGeneral : Consider lazyconnection }
if not aLazyLoadConnection then
begin
GetConnection;
end;
fMap := TFieldsMap.Create;
// fMapNonTransientFields := TFieldsMap.Create;
// fMapFieldDataTypes := TDictionary<string, string>.Create;
InitTableInfo;
end;
function TMVCActiveRecord.GenerateSelectSQL: string;
begin
Result := SQLGenerator.CreateSelectSQL(fTableName, fMap, fPrimaryKeyFieldName,
fPrimaryKeyOptions);
end;
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;
function TMVCActiveRecord.GetBackEnd: string;
begin
if fBackendDriver.IsEmpty then
begin
fBackendDriver := GetBackEndByConnection(GetConnection);
end;
Result := fBackendDriver;
end;
class function TMVCActiveRecord.GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string; const aFieldType: TFieldType;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
var
lFound: Boolean;
begin
Result := aActiveRecord;
try
if Result.SQLGenerator.HasNativeUUID then
begin
lFound := Result.LoadByPK(aValue, aFieldType)
end
else
begin
lFound := Result.LoadByPK(aValue);
end;
if not lFound then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound.Create('No data found')
else
FreeAndNil(Result);
end;
except
FreeAndNil(Result);
raise;
end;
end;
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
Result := GetByPK(aClass.Create, aValue, ftString, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
Result := GetByPK(aClass.Create, aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
Result := GetByPK(aClass.Create, aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
const RaiseExceptionIfNotFound: Boolean = True): T;
begin
Result := GetByPK<T>(aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := GetByPK<T>(aValue, ftString, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: TGuid;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := GetByPK<T>(aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string; const aFieldType: TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := T(GetByPK(T.Create, aValue, aFieldType, RaiseExceptionIfNotFound));
end;
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
var
lList: TObjectList<T>;
begin
lList := Where<T>(SQLWhere, Params, ParamTypes);
try
if lList.Count = 0 then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound.Create('Got 0 rows when at least 1 was expected');
Exit(nil);
end;
2020-02-05 23:46:38 +01:00
Result := lList.Extract(lList.First);
finally
lList.Free;
end;
end;
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string;
const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := GetFirstByWhere<T>(SQLWhere, Params, [], RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
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
lPair: TPair<TRTTIField, TFieldInfo>;
2018-09-28 13:01:46 +02:00
i: Integer;
begin
{ 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 }
if Length(fMapping) = 0 then
2018-09-28 13:01:46 +02:00
begin
if not fPrimaryKeyFieldName.IsEmpty then
begin
SetLength(fMapping, fMap.Count + 1);
fMapping[0].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
fMapping[0].DatabaseFieldName := fPrimaryKeyFieldName;
i := 1;
end
else
begin
SetLength(fMapping, fMap.Count);
i := 0;
end;
2018-09-28 13:01:46 +02:00
for lPair in fMap do
begin
fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
fMapping[i].DatabaseFieldName := lPair.Value.FieldName;
Inc(i);
end;
2018-09-28 13:01:46 +02:00
end;
Result := fMapping;
2018-09-28 13:01:46 +02:00
end;
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string;
const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := GetFirstByWhere<T>(SQLWhere, Params, false);
if Result = nil then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
end;
end;
class function TMVCActiveRecordHelper.SelectOneByRQL<T>(const RQL: string;
const RaiseExceptionIfNotFound: Boolean): T;
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);
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;
function TMVCActiveRecord.GetPK: TValue;
var
lIsNullableType: Boolean;
begin
if not TryGetPKValue(Result, lIsNullableType) then
begin
if not lIsNullableType then
begin
raise EMVCActiveRecord.Create('Primary key not available');
end;
end;
end;
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;
function TMVCActiveRecord.GetPrimaryKeyFieldType: TFieldType;
begin
Result := fPrimaryKeyFieldType;
end;
function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean;
begin
Result := foAutoGenerated in fPrimaryKeyOptions;
end;
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;
function TMVCActiveRecord.CheckAction(const aEntityAction: TMVCEntityAction;
const aRaiseException: Boolean): Boolean;
begin
Result := aEntityAction in fEntityAllowedActions;
if (not Result) and aRaiseException then
raise EMVCActiveRecord.CreateFmt
('Action [%s] not allowed on entity [%s]. [HINT] Add the entity action in MVCEntityActions attribute.',
[GetEnumName(TypeInfo(TMVCEntityAction), Ord(aEntityAction)), ClassName]);
end;
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
// Up to 10.1 Berlin, here the compiler try to call the Count<T> introduced by the class helper
// 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;
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;
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;
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
begin
Result := ActiveRecordConnectionsRegistry.GetCurrent;
end;
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
Create(True);
2018-09-28 13:01:46 +02:00
end;
procedure TMVCActiveRecord.Delete(const RaiseExceptionIfNotFound: Boolean);
var
SQL: string;
lAffectedRows: Int64;
begin
CheckAction(TMVCEntityAction.eaDelete);
OnValidation(TMVCEntityAction.eaDelete);
OnBeforeDelete;
if not Assigned(fPrimaryKey) then
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
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;
OnAfterDelete;
end;
class function TMVCActiveRecord.DeleteAll(const aClass: TMVCActiveRecordClass): int64;
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)
);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.DeleteRQL(const aClass: TMVCActiveRecordClass;
const RQL: string): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create(True);
try
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableName) +
lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, false));
finally
lAR.Free;
end;
end;
procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet;
const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean);
begin
// do nothing
end;
procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean);
begin
// do nothing
end;
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
else if aValue.IsType(TypeInfo(NullableTDate)) then
begin
if not aValue.AsType<NullableTDate>().HasValue then
begin
aParam.DataType := ftDate;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TDate>(aValue.AsType<NullableTDate>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableTTime)) then
begin
if not aValue.AsType<NullableTTime>().HasValue then
begin
aParam.DataType := ftTime;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TTime>(aValue.AsType<NullableTTime>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableTDateTime)) then
begin
if not aValue.AsType<NullableTDateTime>().HasValue then
begin
aParam.DataType := ftDateTime;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TDateTime>(aValue.AsType<NullableTDateTime>().Value);
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
aParam.DataType := ftLargeInt;
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
aParam.DataType := ftLargeInt;
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;
2022-06-19 18:57:47 +02:00
end
else if aValue.IsType(TypeInfo(NullableTGUID)) then
begin
if not aValue.AsType<NullableTGUID>().HasValue then
begin
aParam.DataType := TFieldType.ftCurrency;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TGUID>(aValue.AsType<NullableTGUID>().Value);
Result := True;
end;
end;
2022-06-19 18:57:47 +02:00
if Result then
begin
MapTValueToParam(aValue, aParam);
end;
end;
procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
const
MAX_STRING_PARAM_LENGTH = 1000; { Arbitrary value }
var
lStream: TStream;
lName: string;
begin
2019-05-09 20:53:52 +02:00
{$IFDEF NEXTGEN}
lName := aValue.TypeInfo.NameFld.ToString;
{$ELSE}
lName := string(aValue.TypeInfo.Name);
2019-05-09 20:53:52 +02:00
{$ENDIF}
2022-06-19 18:57:47 +02:00
if (lName.StartsWith('Nullable', True) and (aValue.TypeInfo.Kind = tkRecord)) then
begin
if MapNullableTValueToParam(aValue, aParam) then
begin
Exit;
end;
end;
case aValue.TypeInfo.Kind of
tkUString:
begin
case aParam.DataType of
2021-04-05 19:35:46 +02:00
ftUnknown, ftWideString:
begin
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
begin
aParam.AsWideMemo := aValue.AsString;
end
else
begin
aParam.AsWideString := aValue.AsString;
end;
end;
2021-04-05 19:35:46 +02:00
ftString:
begin
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
begin
aParam.AsMemo := AnsiString(aValue.AsString);
end
else
begin
aParam.AsString := aValue.AsString;
end;
end;
ftWideMemo:
begin
aParam.AsWideMemo := aValue.AsString;
end;
ftMemo:
begin
aParam.AsMemo := AnsiString(aValue.AsString);
end;
else
begin
raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkUString) [%s]',
[lName]);
end;
end;
end;
tkString:
begin
case aParam.DataType of
2021-04-05 19:35:46 +02:00
ftUnknown, ftWideString:
begin
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
begin
aParam.AsWideMemo := aValue.AsString;
end
else
begin
aParam.AsWideString := aValue.AsString;
end;
end;
2021-04-05 19:35:46 +02:00
ftString:
begin
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
begin
aParam.AsMemo := AnsiString(aValue.AsString);
end
else
begin
aParam.AsString := aValue.AsString;
end;
end;
ftWideMemo:
begin
aParam.AsWideMemo := aValue.AsString;
end;
ftMemo:
begin
aParam.AsMemo := AnsiString(aValue.AsString);
end;
else
begin
raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkString) [%s]', [lName]);
end;
end;
end;
2019-08-02 12:32:23 +02:00
{$IF Defined(SeattleOrBetter)}
tkWideString:
begin
if aValue.AsString.Length > MAX_STRING_PARAM_LENGTH then
begin
aParam.AsWideMemo := aValue.AsString;
end
else
begin
aParam.AsWideString := aValue.AsString;
end
end;
2019-08-02 12:32:23 +02:00
{$ENDIF}
tkInt64:
begin
aParam.AsLargeInt := aValue.AsInt64;
end;
tkInteger:
begin
aParam.AsInteger := aValue.AsInteger;
end;
tkEnumeration:
begin
if aValue.TypeInfo = TypeInfo(System.Boolean) then
begin
aParam.AsBoolean := aValue.AsBoolean;
end
else
begin
aParam.AsInteger := Ord(aValue.AsInteger);
end;
end;
tkFloat:
begin
2019-05-09 20:53:52 +02:00
if lName = 'TDate' then
begin
aParam.AsDate := Trunc(aValue.AsExtended);
end
else if lName = 'TDateTime' then
begin
aParam.AsDateTime := aValue.AsExtended;
end
else if lName = 'TTime' then
begin
aParam.AsTime := aValue.AsExtended;
end
else if lName = 'Currency' then
begin
aParam.AsCurrency := aValue.AsCurrency;
end
else
begin
aParam.AsFloat := aValue.AsExtended;
end;
end;
tkClass:
begin
if (aValue.AsObject <> nil) and (not aValue.IsInstanceOf(TStream)) then
raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s',
[aParam.Name, aValue.AsObject.ClassName]);
{ .$IF Defined(SeattleOrBetter) }
// lStream := aValue.AsType<TStream>();
{ .$ELSE }
lStream := aValue.AsType<TStream>();
{ .$ENDIF }
if Assigned(lStream) then
begin
lStream.Position := 0;
aParam.LoadFromStream(lStream, ftBlob);
end
else
begin
aParam.DataType := TFieldType.ftBlob;
aParam.Clear;
end;
end;
tkRecord:
begin
if aValue.IsType(TypeInfo(TGUID)) then
begin
if SQLGenerator.HasNativeUUID then
begin
aParam.AsGuid := aValue.AsType<TGUID>
end
else
begin
aParam.AsString := GUIDToString(aValue.AsType<TGUID>);
end;
end
else if aValue.IsType(TypeInfo(NullableTGUID)) then
begin
if aValue.AsType<NullableTGUID>.HasValue then
aParam.AsGuid := aValue.AsType<NullableTGUID>.Value
else
aParam.Clear();
end
else
begin
raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
[Ord(aValue.TypeInfo.Kind), aParam.Name]);
end;
end;
else
raise Exception.CreateFmt('Unsupported TypeKind (%d) for param %s',
[Ord(aValue.TypeInfo.Kind), aParam.Name]);
end;
end;
procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet;
const aOptions: TMVCActiveRecordLoadOptions);
var
lItem: TPair<TRTTIField, TFieldInfo>;
lField: TField;
lHandled: Boolean;
begin
CheckAction(TMVCEntityAction.eaRetrieve);
OnBeforeLoad;
lHandled := false;
MapDatasetToObject(aDataSet, aOptions, lHandled);
if not lHandled then
begin
for lItem in fMap do
begin
if not lItem.Value.Readable then
begin
continue;
end;
lField := aDataSet.FindField(lItem.Value.FieldName);
if lField = nil then
begin
if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then
continue
else
raise EMVCActiveRecord.CreateFmt
('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields',
[lItem.Value.FieldName]);
end;
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
end;
if not fPrimaryKeyFieldName.IsEmpty then
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey, Self);
end;
end;
OnAfterLoad;
end;
function TMVCActiveRecord.LoadByPK(const id: string; const aFieldType: TFieldType): Boolean;
var
SQL: string;
lDataSet: TDataSet;
begin
CheckAction(TMVCEntityAction.eaRetrieve);
SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName,
fPrimaryKeyOptions);
2022-06-19 18:57:47 +02:00
lDataSet := ExecQuery(SQL, [id], [aFieldType], GetConnection, True);
try
Result := not lDataSet.Eof;
if Result then
begin
LoadByDataset(lDataSet);
end;
finally
lDataSet.Free;
end;
end;
function TMVCActiveRecord.LoadByPK(const id: string): Boolean;
begin
Result := LoadByPK(id, ftString);
end;
function TMVCActiveRecord.LoadByPK(const id: int64): Boolean;
begin
Result := LoadByPK(id.ToString, ftInteger);
end;
function TMVCActiveRecord.LoadByPK(const id: TGuid): Boolean;
begin
Result := LoadByPK(id.ToString, ftGuid);
end;
procedure TMVCActiveRecord.OnAfterDelete;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterInsert;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterInsertOrUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterLoad;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeDelete;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL: string);
begin
// do nothing
end;
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;
procedure TMVCActiveRecord.OnValidation(const EntityAction: TMVCEntityAction);
begin
// do nothing
end;
procedure TMVCActiveRecord.RemoveChildren(const ChildObject: TObject);
begin
if fChildren <> nil then
begin
fChildren.Extract(ChildObject);
end;
end;
procedure TMVCActiveRecord.InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
begin
FreeAndNil(fConn);
if ReacquireAfterInvalidate then
begin
EnsureConnection;
end;
end;
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;
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
Result := TMVCActiveRecordList.Create;
try
2022-06-19 18:57:47 +02:00
lDataSet := ExecQuery(SQL, Params, Connection, True);
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
end;
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
2022-06-19 18:57:47 +02:00
const ParamTypes: array of TFieldType; const Unidirectional: Boolean): TDataSet;
begin
2022-06-19 18:57:47 +02:00
Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes, Unidirectional);
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
begin
Result := Select<T>(SQL, Params, [], Options);
end;
2022-06-19 18:57:47 +02:00
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
const Unidirectional: Boolean)
: TDataSet;
begin
2022-06-19 18:57:47 +02:00
{TODO -odanielet -cGeneral : gestire unidirectional}
Result := TMVCActiveRecord.ExecQuery(SQL, Params, Unidirectional);
end;
function TMVCActiveRecord.SelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList;
begin
Result := InternalSelectRQL(RQL, MaxRecordCount);
end;
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions)
: TObjectList<T>;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
lHandled: Boolean;
begin
Result := TObjectList<T>.Create(True);
try
2022-06-19 18:57:47 +02:00
lDataSet := ExecQuery(SQL, Params, ParamTypes, False);
try
while not lDataSet.Eof do
begin
lAR := T.Create;
Result.Add(lAR);
lAR.LoadByDataset(lDataSet, Options);
lDataSet.Next;
end;
finally
lDataSet.Free;
end;
except
Result.Free;
raise;
end;
end;
class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := SelectOne<T>(SQL, Params, [], [], RaiseExceptionIfNotFound);
end;
class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
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
raise EMVCActiveRecordNotFound.CreateFmt('Got %d rows when exactly 1 was expected',
[lList.Count]);
end;
Result := lList.Extract(lList.First);
finally
lList.Free;
end;
end;
class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string; const MaxRecordCount: Integer)
: TObjectList<T>;
var
lAR: TMVCActiveRecord;
lSQL: string;
begin
lAR := T.Create;
try
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping,
MaxRecordCount > -1, False, MaxRecordCount).Trim;
2021-11-17 15:36:20 +01:00
lSQL := TMVCSQLGenerator.RemoveInitialWhereKeyword(lSQL);
Result := Where<T>(lSQL, []);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
const Params: array of Variant;
const ParamTypes: array of TFieldType): TObjectList<T>;
var
lAR: TMVCActiveRecord;
lFilter: string;
begin
lAR := T.Create;
try
lFilter := lAR.SQLGenerator.GetDefaultSQLFilter(True);
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or
SQLWhere.Trim.StartsWith('/*sort*/') then
begin
Result := Select<T>(lAR.GenerateSelectSQL +
lFilter + SQLWhere, Params, ParamTypes)
end
else
begin
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;
end;
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
const MaxRecordCount: Integer): TMVCActiveRecordList;
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
lAR.Free;
2018-09-27 12:26:50 +02:00
end;
end;
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
{$IF Defined(TOKYOORBETTER)}
lNullableTDateTime := TDateTime(aValue.AsExtended);
{$ELSE}
lNullableTDateTime := aValue.AsExtended;
{$ENDIF}
lCurrValue.From<NullableTDateTime>(lNullableTDateTime);
end;
end
else if lCurrValue.IsType<NullableTDate> then
begin
if aValue.IsType<NullableTDate>() then
begin
lCurrValue := aValue;
end
else
begin
{$IF Defined(TOKYOORBETTER)}
lNullableTDate := TDate(aValue.AsExtended);
{$ELSE}
lNullableTDate := aValue.AsExtended;
{$ENDIF}
lCurrValue.From<NullableTDate>(lNullableTDate);
end;
end
else if lCurrValue.IsType<NullableTTime> then
begin
if aValue.IsType<NullableTTime>() then
begin
lCurrValue := aValue;
end
else
begin
{$IF Defined(TOKYOORBETTER)}
lNullableTTime := TTime(aValue.AsExtended);
{$ELSE}
lNullableTTime := aValue.AsExtended;
{$ENDIF}
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;
procedure TMVCActiveRecord.SetPK(const aValue: TValue);
var
lPKValue: TValue;
begin
if fPrimaryKeyFieldName.IsEmpty then
begin
raise Exception.Create('No primary key defined');
end;
if fPrimaryKey.GetValue(Self).Kind = tkRecord then
begin
lPKValue := fPrimaryKey.GetValue(Self);
if lPKValue.IsType<NullableInt32> and aValue.IsType<NullableInt32>() then
begin
if aValue.IsType<UInt32> then
begin
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
end;
end
else if lPKValue.IsType<NullableInt64> and aValue.IsType<NullableInt64>() then
begin
if aValue.AsType<NullableInt64>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableInt64>().Clear;
end;
end
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
begin
if aValue.AsType<NullableUInt32>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableUInt32>().Clear;
end;
end
else if lPKValue.IsType<NullableUInt64> and aValue.IsType<NullableUInt64>() then
begin
if aValue.AsType<NullableUInt64>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableUInt64>().Clear;
end;
end
else
begin
raise EMVCActiveRecord.Create
('Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)');
end;
fPrimaryKey.SetValue(Self, lPKValue);
end
else
begin
fPrimaryKey.SetValue(Self, aValue)
end;
end;
procedure TMVCActiveRecord.SetPrimaryKeyIsAutogenerated(const Value: Boolean);
begin
if Value then
begin
Include(fPrimaryKeyOptions, foAutoGenerated);
end
else
begin
Exclude(fPrimaryKeyOptions, foAutoGenerated);
end;
end;
procedure TMVCActiveRecord.SetTableName(const Value: string);
begin
fTableName := Value;
end;
function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
begin
if not Assigned(fSQLGenerator) then
begin
GetConnection.Connected := True;
fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd)
2021-11-18 17:52:06 +01:00
.Create(GetMapping, fDefaultRQLFilter, GetPartitionInfo);
end;
Result := fSQLGenerator;
end;
procedure TMVCActiveRecord.Store;
var
lValue: TValue;
lRes: Boolean;
lIsNullableType: Boolean;
begin
lRes := TryGetPKValue(lValue, lIsNullableType);
if not lIsNullableType then
begin
raise EMVCActiveRecord.Create
('Store can be used only with nullable PKs [HINT] Use NullableInt64 as PK');
end;
if lRes then
begin
Update;
end
else
begin
Insert;
end;
end;
function TMVCActiveRecord.TableInfo: string;
var
KeyValue: TPair<TRTTIField, TFieldInfo>;
begin
Result := 'Table Name: ' + fTableName;
for KeyValue in fMap do
Result := Result + sLineBreak + #9 + KeyValue.Key.Name + ' = ' + KeyValue.Value.FieldName;
end;
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
else if Value.IsType<NullableString>() then
begin
Result := Value.AsType<NullableString>().HasValue;
if Result then
Value := Value.AsType<NullableString>().Value;
end
else if Value.IsType<NullableTGUID>() then
begin
Result := Value.AsType<NullableTGUID>().HasValue;
if Result then
Value := TValue.From<TGUID>(Value.AsType<NullableTGUID>().Value);
end
else
raise EMVCActiveRecord.Create
('Invalid primary key type [HINT: Use Int64, String, NullableInt64 or NullableString, so that Store method is available too.]');
IsNullableType := True;
end
else
begin
Result := not Value.IsEmpty;
end;
end;
procedure TMVCActiveRecord.Update(const RaiseExceptionIfNotFound: Boolean = True);
var
SQL: string;
lAffectedRows: Int64;
begin
CheckAction(TMVCEntityAction.eaUpdate);
OnValidation(TMVCEntityAction.eaUpdate);
OnBeforeUpdate;
OnBeforeInsertOrUpdate;
if fMap.WritableFieldsCount = 0 then
begin
raise EMVCActiveRecord.CreateFmt
('Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]',
[ClassName, fTableName]);
end;
SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
lAffectedRows := ExecNonQuery(SQL, false);
if (lAffectedRows = 0) and RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound.CreateFmt('No record updated for key [Entity: %s][PK: %s]',
[ClassName, fPrimaryKeyFieldName]);
end;
OnAfterUpdate;
OnAfterInsertOrUpdate;
end;
procedure TMVCActiveRecord.AddChildren(const ChildObject: TObject);
begin
if fChildren = nil then
begin
fChildren := TObjectList<TObject>.Create(True);
end;
if not(fChildren.Contains(ChildObject)) and (not(ChildObject = Self)) then
begin
fChildren.Add(ChildObject);
end;
end;
class function TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass)
: TObjectList<TMVCActiveRecord>;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := Select(aClass, lAR.GenerateSelectSQL, []);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecordHelper.All<T>: TObjectList<T>;
var
lAR: TMVCActiveRecord;
begin
lAR := T.Create;
try
Result := Select<T>(lAR.GenerateSelectSQL, []);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
const Params: array of Variant): TMVCActiveRecordList;
2018-09-28 13:01:46 +02:00
begin
Result := Where(aClass, SQLWhere, Params, nil);
2018-09-28 13:01:46 +02:00
end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
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
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
2018-09-27 12:26:50 +02:00
finally
lAR.Free;
end;
end;
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
const Params: array of Variant): TObjectList<T>;
begin
Result := Where<T>(SQLWhere, Params, []);
end;
class function TMVCActiveRecordHelper.Merge<T>(CurrentList, NewList: TObjectList<T>)
: IMVCMultiExecutor<T>;
var
i: Integer;
lFoundAtIndex: Integer;
lCurrPKValue: Integer;
lPKValue: TValue;
lUnitOfWork: IMVCUnitOfWork<T>;
lPKType: TFieldType;
lNeedsToBeUpdated: Boolean;
begin
lUnitOfWork := TMVCUnitOfWork<T>.Create;
lUnitOfWork.RegisterDelete(CurrentList);
if NewList.Count > 0 then
begin
lPKType := NewList[0].GetPrimaryKeyFieldType;
for i := 0 to NewList.Count - 1 do
begin
if NewList[i].PKIsNull then
begin
lUnitOfWork.RegisterInsert(NewList[i]);
continue;
end;
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;
if lNeedsToBeUpdated then
lUnitOfWork.RegisterUpdate(NewList[i])
else
lUnitOfWork.RegisterInsert(NewList[i]);
end;
end;
Result := lUnitOfWork as IMVCMultiExecutor<T>;
end;
{ TMVCEntitiesRegistry }
procedure TMVCEntitiesRegistry.AddEntity(const aURLSegment: string;
const aActiveRecordClass: TMVCActiveRecordClass);
begin
fEntitiesDict.AddOrSetValue(aURLSegment.ToLower, aActiveRecordClass);
end;
procedure TMVCEntitiesRegistry.AddEntityProcessor(const aURLSegment: string;
const aEntityProcessor: IMVCEntityProcessor);
begin
fProcessorsDict.Add(aURLSegment, aEntityProcessor);
end;
constructor TMVCEntitiesRegistry.Create;
begin
inherited;
fEntitiesDict := TDictionary<string, TMVCActiveRecordClass>.Create;
fProcessorsDict := TDictionary<string, IMVCEntityProcessor>.Create;
end;
destructor TMVCEntitiesRegistry.Destroy;
begin
fEntitiesDict.Free;
fProcessorsDict.Free;
inherited;
end;
function TMVCEntitiesRegistry.FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
begin
Result := fEntitiesDict.TryGetValue(aURLSegment.ToLower, aMVCActiveRecordClass);
end;
function TMVCEntitiesRegistry.FindProcessorByURLSegment(const aURLSegment: string;
out aMVCEntityProcessor: IMVCEntityProcessor): Boolean;
begin
Result := fProcessorsDict.TryGetValue(aURLSegment.ToLower, aMVCEntityProcessor);
end;
function TMVCEntitiesRegistry.GetEntities: TArray<String>;
begin
Result := fEntitiesDict.Keys.ToArray;
end;
{ EMVCActiveRecord }
constructor EMVCActiveRecord.Create(const AMsg: string);
begin
inherited Create(http_status.BadRequest, AMsg);
end;
{ EntityActionsAttribute }
constructor MVCEntityActionsAttribute.Create(const aEntityAllowedActions: TMVCEntityActions);
begin
inherited Create;
EntityAllowedActions := aEntityAllowedActions;
end;
{ TMVCActiveRecordList }
constructor TMVCActiveRecordList.Create;
begin
inherited Create(True);
end;
{ TMVCSQLGeneratorRegistry }
constructor TMVCSQLGeneratorRegistry.Create;
begin
inherited;
fSQLGenerators := TDictionary<string, TMVCSQLGeneratorClass>.Create;
end;
class constructor TMVCSQLGeneratorRegistry.Create;
begin
cLock := TObject.Create;
end;
class destructor TMVCSQLGeneratorRegistry.Destroy;
begin
cLock.Free;
cInstance.Free;
end;
destructor TMVCSQLGeneratorRegistry.Destroy;
begin
fSQLGenerators.Free;
inherited;
end;
function TMVCSQLGeneratorRegistry.GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
begin
if not fSQLGenerators.TryGetValue(aBackend, Result) then
begin
raise ERQLCompilerNotFound.CreateFmt('SQLGenerator not found for "%s"', [aBackend]);
end;
end;
class function TMVCSQLGeneratorRegistry.Instance: TMVCSQLGeneratorRegistry;
begin
if not Assigned(cInstance) then
begin
TMonitor.Enter(cLock);
try
if not Assigned(cInstance) then
begin
cInstance := TMVCSQLGeneratorRegistry.Create;
end;
finally
TMonitor.Exit(cLock);
end;
end;
Result := cInstance;
end;
procedure TMVCSQLGeneratorRegistry.RegisterSQLGenerator(const aBackend: string;
const aRQLBackendClass: TMVCSQLGeneratorClass);
begin
fSQLGenerators.AddOrSetValue(aBackend, aRQLBackendClass);
end;
procedure TMVCSQLGeneratorRegistry.UnRegisterSQLGenerator(const aBackend: string);
begin
fSQLGenerators.Remove(aBackend);
end;
{ TMVCSQLGenerator }
constructor TMVCSQLGenerator.Create(Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string; const PartitionInfo: TPartitionInfo);
begin
inherited Create;
fMapping := Mapping;
2021-11-17 15:36:20 +01:00
fDefaultRQLFilter := DefaultRQLFilter;
fPartitionInfo := PartitionInfo;
GetCompiler;
2021-11-17 15:36:20 +01:00
if not fDefaultRQLFilter.IsEmpty then
begin
GetRQLParser.Execute(fDefaultRQLFilter,fDefaultSQLFilter, GetCompiler, False, True);
2021-11-17 15:36:20 +01:00
fDefaultSQLFilter := TMVCSQLGenerator.RemoveInitialWhereKeyword(fDefaultSQLFilter);
end;
end;
function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
begin
Result := fMapping;
end;
function TMVCSQLGenerator.GetParamNameForSQL(const FieldName: string): string;
begin
Result := fCompiler.GetParamNameForSQL(FieldName);
end;
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;
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
Result := MergeSQLFilter(fPartitionInfo.SQLFilter, fDefaultSQLFilter);
if not Result.IsEmpty then
2021-11-17 15:36:20 +01:00
begin
if IncludeWhereClause then
begin
Result := ' WHERE ' + Result;
2021-11-17 15:36:20 +01:00
end
else
begin
if IncludeAndClauseBeforeFilter then
Result := ' and ' + Result;
2021-11-17 15:36:20 +01:00
end;
end;
end;
function TMVCSQLGenerator.GetFieldNameForSQL(const FieldName: string): string;
begin
Result := fCompiler.GetFieldNameForSQL(FieldName);
end;
function TMVCSQLGenerator.GetRQLParser: TRQL2SQL;
begin
if fRQL2SQL = nil then
begin
fRQL2SQL := TRQL2SQL.Create;
end;
Result := fRQL2SQL;
end;
function TMVCSQLGenerator.GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string;
const Step: Integer = 1): string;
begin
Result := '';
end;
function TMVCSQLGenerator.GetTableNameForSQL(const TableName: string): string;
begin
Result := fCompiler.GetTableNameForSQL(TableName);
end;
function TMVCSQLGenerator.HasNativeUUID: Boolean;
begin
Result := False;
end;
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, 1000);
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 17:52:06 +01:00
if not lRQLSortingAndLimitPart.IsEmpty then
begin
2021-11-18 17:52:06 +01:00
Result := Result + ';' + lRQLSortingAndLimitPart;
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);
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;
function TMVCSQLGenerator.TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string;
const Delimiter: string): string;
var
lPair: TPair<TRTTIField, TFieldInfo>;
begin
for lPair in Map do
begin
// if not lPair.Value.FieldName.IsEmpty then
if lPair.Value.Readable then
begin
Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + Delimiter;
end;
end;
Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
if not PKFieldName.IsEmpty then
begin
if not Result.IsEmpty then
begin
Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result
end
else
begin
Result := GetFieldNameForSQL(PKFieldName)
end;
end;
end;
{ TMVCConnectionsRepository.TConnHolder }
destructor TMVCConnectionsRepository.TConnHolder.Destroy;
begin
if OwnsConnection then
begin
2019-05-09 20:53:52 +02:00
if Connection.Connected then
Connection.Connected := false;
FreeAndNil(Connection);
end;
inherited;
end;
constructor MVCTableFieldAttribute.Create(const aFieldName: string;
const aFieldOptions: TMVCActiveRecordFieldOptions;
const aSequenceName: string; const aDataTypeName: string);
2019-02-15 12:21:11 +01:00
begin
inherited Create;
FieldName := aFieldName;
FieldOptions := aFieldOptions;
SequenceName := aSequenceName;
DataTypeName := aDataTypeName;
2019-02-15 12:21:11 +01:00
end;
{ EMVCActiveRecordNotFound }
procedure EMVCActiveRecordNotFound.AfterConstruction;
begin
inherited;
fHttpErrorCode := http_status.NotFound;
end;
2022-06-19 18:57:47 +02:00
class function TMVCActiveRecord.ExecQuery(
const SQL: string;
const Values: array of Variant;
const ValueTypes: array of TFieldType;
const Connection: TFDConnection;
const Unidirectional: Boolean): TDataSet;
var
lQry: TFDQuery;
begin
lQry := TFDQuery.Create(nil);
try
2022-06-19 18:57:47 +02:00
lQry.FetchOptions.Unidirectional := Unidirectional; // True;
lQry.UpdateOptions.ReadOnly := 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;
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
2022-06-19 18:57:47 +02:00
const ValueTypes: array of TFieldType; const Unidirectional: Boolean): TDataSet;
begin
2022-06-19 18:57:47 +02:00
Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional);
end;
{ TFieldsMap }
constructor TFieldsMap.Create;
begin
inherited Create([doOwnsValues]);
fWritableFieldsCount := -1;
fReadableFieldsCount := -1;
end;
procedure TFieldsMap.EndUpdates;
var
lPair: TPair<TRTTIField, TFieldInfo>;
begin
fWritableFieldsCount := 0;
fReadableFieldsCount := 0;
for lPair in Self do
begin
lPair.Value.EndUpdates;
// if not(foTransient in lPair.Value.FieldOptions) then
if lPair.Value.Writeable then
begin
Inc(fWritableFieldsCount);
end;
if lPair.Value.Readable then
begin
Inc(fReadableFieldsCount);
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;
2022-06-19 18:57:47 +02:00
raise EMVCActiveRecord.CreateFmt('FieldName [%s] not found in table', [FieldName]);
end;
{ TFieldInfo }
procedure TFieldInfo.EndUpdates;
begin
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;
end;
{ TMVCUnitOfWork<T> }
procedure TMVCUnitOfWork<T>.Apply(const ItemApplyAction: TMVCItemApplyAction<T>);
var
i: Integer;
lHandled: Boolean;
begin
for i := 0 to fListToInsert.Count - 1 do
begin
lHandled := false;
DoItemApplyAction(fListToInsert[i], eaCreate, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToInsert[i].Insert;
end;
end;
for i := 0 to fListToUpdate.Count - 1 do
begin
lHandled := false;
DoItemApplyAction(fListToUpdate[i], eaUpdate, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToUpdate[i].Update(True);
end;
end;
for i := 0 to fListToDelete.Count - 1 do
begin
lHandled := false;
DoItemApplyAction(fListToDelete[i], eaDelete, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToDelete[i].Delete(True);
end;
end;
end;
constructor TMVCUnitOfWork<T>.Create;
begin
inherited;
fListToDelete := TObjectList<T>.Create(false);
fListToUpdate := TObjectList<T>.Create(false);
fListToInsert := TObjectList<T>.Create(false);
end;
destructor TMVCUnitOfWork<T>.Destroy;
begin
fListToDelete.Free;
fListToUpdate.Free;
fListToInsert.Free;
inherited;
end;
procedure TMVCUnitOfWork<T>.DoItemApplyAction(const Obj: TMVCActiveRecord;
const EntityAction: TMVCEntityAction;
const ItemApplyAction: TMVCItemApplyAction<T>;
var Handled: Boolean);
begin
if Assigned(ItemApplyAction) then
begin
ItemApplyAction(Obj, EntityAction, Handled);
end;
end;
class function TMVCUnitOfWork<T>.KeyExistsInt(const NewList: TObjectList<T>;
const KeyValue: Integer; out Index: Integer): Boolean;
var
i: Integer;
begin
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
if (not NewList[i].PKIsNull) and (NewList[i].GetPK.AsInt64 = KeyValue) then
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
begin
if NewList[i].GetPK.AsString = KeyValue then
begin
Index := i;
Exit(True);
end;
end;
end;
procedure TMVCUnitOfWork<T>.RegisterDelete(const Value: T);
begin
fListToDelete.Add(Value);
end;
procedure TMVCUnitOfWork<T>.RegisterDelete(const Enumerable: TEnumerable<T>);
begin
fListToDelete.AddRange(Enumerable);
end;
procedure TMVCUnitOfWork<T>.RegisterInsert(const Value: T);
begin
fListToInsert.Add(Value);
end;
procedure TMVCUnitOfWork<T>.RegisterUpdate(const Value: T);
var
lCurrPKValue: Integer;
lFoundAtIndex: Integer;
begin
fListToUpdate.Add(Value);
lCurrPKValue := Value.GetPK.AsInteger;
if KeyExistsInt(fListToDelete, lCurrPKValue, lFoundAtIndex) then
begin
fListToDelete.Delete(lFoundAtIndex);
end;
end;
procedure TMVCUnitOfWork<T>.UnregisterDelete(const Value: T);
begin
fListToDelete.Remove(Value);
end;
procedure TMVCUnitOfWork<T>.UnregisterInsert(const Value: T);
begin
fListToInsert.Remove(Value);
end;
procedure TMVCUnitOfWork<T>.UnregisterUpdate(const Value: T);
begin
fListToUpdate.Remove(Value);
end;
2021-11-17 15:36:20 +01:00
constructor MVCTableAttribute.Create(aName, aRQLFilter: String);
begin
inherited Create;
Name := aName;
RQLFilter := aRQLFilter;
end;
{ 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;
end;
procedure TPartitionInfo.InitializeFilterStrings(
2021-11-18 17:52:06 +01:00
const RQLCompiler: TRQLCompiler);
var
lFieldCount, I: Integer;
lRQL2SQL: TRQL2SQL;
begin
2021-11-18 17:52:06 +01:00
fRQLFilter := '';
lFieldCount := FieldNames.Count;
if lFieldCount > 0 then
begin
for I := 0 to lFieldCount - 1 do
begin
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;
end;
2021-11-18 17:52:06 +01:00
fRQLFilter := fRQLFilter.Remove(fRQLFilter.Length - 1,1);
if lFieldCount > 1 then
begin
2021-11-18 17:52:06 +01:00
fRQLFilter := 'and(' + fRQLFilter + ')';
end;
end;
lRQL2SQL := TRQL2SQL.Create;
2021-11-18 17:52:06 +01:00
try
lRQL2SQL.Execute(fRQLFilter, fSQLFilter, RQLCompiler, False, True)
2021-11-18 17:52:06 +01:00
finally
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;
end;
initialization
gLock := TObject.Create;
gCtx := TRttiContext.Create;
gCtx.FindType('');
finalization
gCtx.Free;
gLock.Free;
end.