delphimvcframework/sources/MVCFramework.ActiveRecord.pas

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2021 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,
  MVCFramework.Cache,
  MVCFramework.Serializer.Intf,
  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;

  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)
  public
    Name: string;
    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;
    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
  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;
    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;
    fDefaultRQLFilter: string;
    fMap: TFieldsMap;
    fPrimaryKey: TRTTIField;
    fBackendDriver: string;
    fMapping: TMVCFieldsMapping;
    fPartitionInfoInternal: TPartitionInfo;
    fPartitionClause: String;
    function GetPartitionInfo: TPartitionInfo;
    function GetBackEnd: string;
    function GetConnection: TFDConnection;
    procedure InitTableInfo;
    class function ExecQuery(const SQL: string; const Values: array of Variant): TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant;
      const Connection: TFDConnection)
      : TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant;
      const ValueTypes: array of TFieldType)
      : TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant;
      const ValueTypes: array of TFieldType;
      const Connection: TFDConnection): TDataSet; overload;
    procedure FillPrimaryKey(const SequenceName: string);
    function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
      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;

    function InternalCount(const RQL: string): int64;
    function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
      : TMVCActiveRecordList;
  public
    constructor Create(aLazyLoadConnection: Boolean); overload;
    { cannot be virtual! }
    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;
    function GetMapping: TMVCFieldsMapping;
    function LoadByPK(const id: int64): Boolean; overload; virtual;
    function LoadByPK(const id: string): 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 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)
      : TDataSet; overload;
    class function SelectDataSet(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType): 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;

  TMVCActiveRecordHelper = class helper for TMVCActiveRecord
    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 Select<T: TMVCActiveRecord, constructor>(const SQL: string;
      const Params: array of Variant;
      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)
      : TObjectList<T>; overload;
    class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    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;
    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>;
  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;

  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
    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;
    fDefaultSQLFilter: String;
    fDefaultRQLFilter: String;
    fCompiler: TRQLCompiler;
    fRQL2SQL: TRQL2SQL;
  protected
    fPartitionInfo: TPartitionInfo;
    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;
    // 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;
    //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;

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
  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;

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);
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)}
  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)}
  Result := nil;
{$ENDIF}
  fMREW.BeginRead;
  try
    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
  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);
begin
  RemoveConnection('default', RaiseExceptionIfNotAvailable);
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]);
    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
  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
  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}
      for I := 0 to GetPartitionInfo.FieldNames.Count - 1 do
      begin
        lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(GetPartitionInfo.FieldNames[I]));
        if lPar <> nil then
        begin
          if GetPartitionInfo.FieldTypes[I] = ftInteger then
            lValue := StrToInt(GetPartitionInfo.FieldValues[I])
          else
            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
        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;
  const Connection: TFDConnection): TDataSet;
begin
  Result := ExecQuery(SQL, Values, [], Connection);
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;
    lDS := ExecQuery(lSQL, []);
    try
      MapDataSetFieldToRTTIField(lDS.Fields[0], fPrimaryKey, Self);
    finally
      lDS.Free;
    end;
  end;
end;

class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant)
  : TDataSet;
begin
  Result := ExecQuery(SQL, Values, nil);
end;

procedure TMVCActiveRecord.InitTableInfo;
var
  lAttribute: TCustomAttribute;
  lRTTIField: TRTTIField;
  lFieldInfo: TFieldInfo;
  lPrimaryFieldTypeAsStr: string;
begin
  fPartitionInfoInternal := nil;
  fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve,
    TMVCEntityAction.eaUpdate,
    TMVCEntityAction.eaDelete];
  fTableName := '';
  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;
      fDefaultRQLFilter := MVCTableAttribute(lAttribute).RQLFilter;
      Continue;
    end;
    if lAttribute is MVCEntityActionsAttribute then
    begin
      fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
    end;
    if lAttribute is MVCPartitionAttribute then
    begin
      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
          begin
            raise EMVCActiveRecord.Create
              ('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String - 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');
  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;
        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;
var
  lSQL: string;
begin
  lSQL := Self.SQLGenerator.CreateSelectCount(fTableName);
  lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false, True);
  Result := GetScalar(lSQL, []);
end;

function TMVCActiveRecord.InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
  : TMVCActiveRecordList;
var
  lSQL: string;
begin
  lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, True, false, MaxRecordCount);
  LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
  Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, []);
end;

constructor TMVCActiveRecord.Create(aLazyLoadConnection: Boolean);
begin
  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(const aClass: TMVCActiveRecordClass; const aValue: string;
  const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
  Result := aClass.Create;
  if not Result.LoadByPK(aValue) then
  begin
    Result.Free;
    if RaiseExceptionIfNotFound then
    begin
      raise EMVCActiveRecordNotFound.Create('Data not found');
    end
    else
    begin
      Result := nil;
    end;
  end;
end;

class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
  const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
  Result := aClass.Create;
  if not Result.LoadByPK(aValue) then
  begin
    Result.Free;
    if RaiseExceptionIfNotFound then
    begin
      raise EMVCActiveRecordNotFound.Create('Data not found');
    end
    else
    begin
      Result := nil;
    end;
  end;
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
  const RaiseExceptionIfNotFound: Boolean = True): T;
var
  lActiveRecord: TMVCActiveRecord;
  lLoaded: Boolean;
begin
  Result := T.Create;
  lActiveRecord := TMVCActiveRecord(Result);

  try
    lLoaded := lActiveRecord.LoadByPK(aValue);
  except
    FreeAndNil(Result);
    raise;
  end;

  if not lLoaded then
  begin
    FreeAndNil(Result);
    if RaiseExceptionIfNotFound then
    begin
      raise EMVCActiveRecordNotFound.Create('Data not found');
    end;
  end;
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string;
  const RaiseExceptionIfNotFound: Boolean): T;
var
  lActiveRecord: TMVCActiveRecord;
begin
  Result := T.Create;
  lActiveRecord := TMVCActiveRecord(Result);
  if not lActiveRecord.LoadByPK(aValue) then
  begin
    Result.Free;
    if RaiseExceptionIfNotFound then
    begin
      raise EMVCActiveRecordNotFound.Create('Data not found');
    end
    else
    begin
      Result := nil;
    end;
  end;
end;

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;
    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;

function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
var
  lPair: TPair<TRTTIField, TFieldInfo>;
  i: Integer;
begin
  { TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
  { TODO -oDanieleT -cGeneral : Add NameAs in the TFieldInfo because the user needs to use the property name he see }
  if Length(fMapping) = 0 then
  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;

    for lPair in fMap do
    begin
      fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
      fMapping[i].DatabaseFieldName := lPair.Value.FieldName;
      Inc(i);
    end;
  end;
  Result := fMapping;
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;
    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;

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;
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;
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"
    Result := lAR.InternalCount(RQL);
  finally
    lAR.Free;
  end;
end;

function TMVCActiveRecord.Count(const RQL: string = ''): int64;
begin
  Result := InternalCount(RQL);
end;

class function TMVCActiveRecordHelper.Count<T>(const RQL: string = ''): int64;
begin
  Result := TMVCActiveRecord.Count(TMVCActiveRecordClass(T), RQL);
end;

class function TMVCActiveRecord.CurrentConnection: TFDConnection;
begin
  Result := ActiveRecordConnectionsRegistry.GetCurrent;
end;

function TMVCActiveRecord.GetConnection: TFDConnection;
begin
  if fConn = nil then
  begin
    fConn := ActiveRecordConnectionsRegistry.GetCurrent;
  end;
  Result := fConn;
end;

constructor TMVCActiveRecord.Create;
begin
  Create(True);
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
    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;
  end;
  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
{$IFDEF NEXTGEN}
  lName := aValue.TypeInfo.NameFld.ToString;
{$ELSE}
  lName := string(aValue.TypeInfo.Name);
{$ENDIF}
  if (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
          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;
          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
          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;
          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;
{$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;
{$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
        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
          aParam.AsGuid := aValue.AsType<TGUID>;
        end
        else
        begin
          raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
            [Ord(aValue.TypeInfo.Kind), aParam.Name]);
        end;
      end;
  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;
      MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
    end;
    if not fPrimaryKeyFieldName.IsEmpty then
    begin
      MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey, Self);
    end;
  end;
  OnAfterLoad;
end;

function TMVCActiveRecord.LoadByPK(const id: string): Boolean;
var
  SQL: string;
  lDataSet: TDataSet;
begin
  CheckAction(TMVCEntityAction.eaRetrieve);
  SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName,
    fPrimaryKeyOptions);
  lDataSet := ExecQuery(SQL, [id], GetConnection);
  try
    Result := not lDataSet.Eof;
    if Result then
    begin
      LoadByDataset(lDataSet);
    end;
  finally
    lDataSet.Free;
  end;
end;

function TMVCActiveRecord.LoadByPK(const id: int64): Boolean;
var
  SQL: string;
  lDataSet: TDataSet;
begin
  CheckAction(TMVCEntityAction.eaRetrieve);
  SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName,
    fPrimaryKeyOptions);
  lDataSet := ExecQuery(SQL, [id], GetConnection);
  try
    Result := not lDataSet.Eof;
    if Result then
    begin
      LoadByDataset(lDataSet);
    end;
  finally
    lDataSet.Free;
  end;
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;
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
    lDataSet := ExecQuery(SQL, Params, Connection);
    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;

end;

class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType): TDataSet;
begin
  Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes);
end;

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;

class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant)
  : TDataSet;
begin
  Result := TMVCActiveRecord.ExecQuery(SQL, Params);
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
    lDataSet := ExecQuery(SQL, Params, ParamTypes);
    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;
    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);
  try
    Result := lAR.InternalSelectRQL(RQL, MaxRecordCount);
  finally
    lAR.Free;
  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)
      .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
      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;
begin
  Result := Where(aClass, SQLWhere, Params, nil);
end;

class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
  const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
  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;
  fDefaultRQLFilter := DefaultRQLFilter;
  fPartitionInfo := PartitionInfo;
  GetCompiler;
  if not fDefaultRQLFilter.IsEmpty then
  begin
    GetRQLParser.Execute(fDefaultRQLFilter,fDefaultSQLFilter, GetCompiler, False, True);
    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;

function TMVCSQLGenerator.GetDefaultSQLFilter(const IncludeWhereClause: Boolean; const IncludeAndClauseBeforeFilter: Boolean): String;
begin
  Result := MergeSQLFilter(fPartitionInfo.SQLFilter, fDefaultSQLFilter);
  if not Result.IsEmpty then
  begin
    if IncludeWhereClause then
    begin
      Result := ' WHERE ' + Result;
    end
    else
    begin
      if IncludeAndClauseBeforeFilter then
        Result := ' and ' + Result;
    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.HasReturning: Boolean;
begin
  Result := True;
end;

function TMVCSQLGenerator.HasSequences: Boolean;
begin
  Result := True;
end;

function TMVCSQLGenerator.MergeDefaultRQLFilter(const RQL: String): String;
var
  lRQLFilterPart, lRQLSortingAndLimitPart: String;
  lSemicolonPos: Integer;
begin
  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
  begin
    Result := 'and(';
    if not fDefaultRQLFilter.IsEmpty then
    begin
      Result := Result + fDefaultRQLFilter;
    end;
    if not fPartitionInfo.RQLFilter.IsEmpty then
    begin
      Result := Result + ',' + fPartitionInfo.RQLFilter;
    end;
    if not lRQLFilterPart.IsEmpty then
    begin
      Result := Result + ',' + lRQLFilterPart;
    end;
    Result := Result + ')';
  end
  else
  begin
    Exit(RQL);
  end;

  if not lRQLSortingAndLimitPart.IsEmpty then
  begin
    Result := Result + ';' + lRQLSortingAndLimitPart;
  end;


//
//    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 + '))';
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
    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);
begin
  inherited Create;
  FieldName := aFieldName;
  FieldOptions := aFieldOptions;
  SequenceName := aSequenceName;
  DataTypeName := aDataTypeName;
end;

{ EMVCActiveRecordNotFound }

procedure EMVCActiveRecordNotFound.AfterConstruction;
begin
  inherited;
  fHttpErrorCode := http_status.NotFound;
end;

class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
  const ValueTypes: array of TFieldType; const Connection: TFDConnection): TDataSet;
var
  lQry: TFDQuery;
begin
  lQry := TFDQuery.Create(nil);
  try
    lQry.FetchOptions.Unidirectional := false; // True;
    if Connection = nil then
    begin
      lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
    end
    else
    begin
      lQry.Connection := Connection;
    end;
    lQry.SQL.Text := SQL;
    // lQry.Prepare;
    if Length(ValueTypes) = 0 then
    begin
      lQry.Open(SQL, Values);
    end
    else
    begin
      lQry.Open(SQL, Values, ValueTypes);
    end;
    Result := lQry;
  except
    lQry.Free;
    raise;
  end;
end;

class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
  const ValueTypes: array of TFieldType): TDataSet;
begin
  Result := ExecQuery(SQL, Values, ValueTypes, nil);
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;
  raise EMVCActiveRecord.CreateFmt('FieldName not found in table [%s]', [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;

// function TMVCUnitOfWork<T>.GetListToDelete: TList<T>;
// begin
// Result := fListToDelete;
// end;
//
// function TMVCUnitOfWork<T>.GetListToInsert: TList<T>;
// begin
// Result := fListToInsert;
// end;
//
// function TMVCUnitOfWork<T>.GetListToUpdate: TList<T>;
// begin
// Result := fListToUpdate;
// 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;

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;
  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(
  const RQLCompiler: TRQLCompiler);
var
  lFieldCount, I: Integer;
begin
  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;
    fRQLFilter := fRQLFilter.Remove(fRQLFilter.Length - 1,1);
    if lFieldCount > 1 then
    begin
      fRQLFilter := 'and(' + fRQLFilter + ')';
    end;
  end;
  var rql := TRQL2SQL.Create;
  try
    rql.Execute(fRQLFilter, fSQLFilter, RQLCompiler, False, True)
  finally
    rql.Free;
  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.