delphimvcframework/sources/MVCFramework.ActiveRecord.pas

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 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.SysUtils,
  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,
  MVCFramework,
  MVCFramework.Commons,
  MVCFramework.RQL.Parser,
  MVCFramework.Cache,
  MVCFramework.Serializer.Intf,
  MVCFramework.Serializer.Commons, System.SyncObjs, System.TypInfo;

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

  TSQLQueryWithName = record
    Name: String;
    SQLText: String;
    BackEnd: String; //TMVCActiveRecordBackEnd
  end;

  TRQLQueryWithName = record
    Name: String;
    RQLText: String;
  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;

  MVCNamedSQLQueryAttribute = class(MVCActiveRecordCustomAttribute)
  public
    Name: string;
    SQLQuery: String;
    Backend: String; //TMVCActiveRecordBackEnd
    constructor Create(aName: string; aSQLSelect: String); overload;
    constructor Create(aName: string; aSQLSelect: String; aBackEnd: String); overload;
  end;

  MVCNamedRQLQueryAttribute = class(MVCActiveRecordCustomAttribute)
  public
    Name: string;
    RQLQuery: String;
    constructor Create(aName: string; aRQL: 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;

  TMVCTableMap = class
  protected
    fPartitionInfoInternal: TPartitionInfo;
    fEntityAllowedActions: TMVCEntityActions;
    fTableName: string;
    fPartitionClause: String;
    fRTTIType: TRttiInstanceType;
    fObjAttributes: TArray<TCustomAttribute>;
    fDefaultRQLFilter: string;
    fMap: TFieldsMap;
    fPrimaryKey: TRTTIField;
    fMapping: TMVCFieldsMapping;
    fPropsAttributes: TArray<TCustomAttribute>;
    fProps: TArray<TRTTIField>;
    fPrimaryKeyFieldName: string;
    fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
    fPrimaryKeySequenceName: string;
    fPrimaryKeyFieldType: TFieldType;
    fNamedSQLQueries: TArray<TSQLQueryWithName>;
    fNamedRQLQueries: TArray<TRQLQueryWithName>;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TMVCActiveRecord = class
  private
    fChildren: TObjectList<TObject>;
    fConn: TFDConnection;
    fSQLGenerator: TMVCSQLGenerator;
    fRQL2SQL: TRQL2SQL;
    fCustomTableName: String;
    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);
    function GetTableName: string;
  protected
    fBackendDriver: string;
    fTableMap: TMVCTableMap;
    function GetPartitionInfo: TPartitionInfo;
    function GetConnection: TFDConnection;
    procedure InitTableInfo;
    class function ExecQuery(
      const SQL: string;
      const Values: array of Variant;
      const Unidirectional: Boolean;
      const DirectExecute: Boolean): TDataSet; overload;
    class function ExecQuery(
      const SQL: string;
      const Values: array of Variant;
      const Connection: TFDConnection;
      const Unidirectional: Boolean;
      const DirectExecute: Boolean)
      : TDataSet; overload;
    class function ExecQuery(
      const SQL: string;
      const Values: array of Variant;
      const ValueTypes: array of TFieldType;
      const Unidirectional: Boolean;
      const DirectExecute: Boolean)
      : TDataSet; overload;
    class function ExecQuery(
      const SQL: string;
      const Values: array of Variant;
      const ValueTypes: array of TFieldType;
      const Connection: TFDConnection;
      const Unidirectional: Boolean;
      const DirectExecute: Boolean): TDataSet; overload;
    procedure FillPrimaryKey(const SequenceName: string);
    function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): Int64;
      overload;
    class function GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string; const aFieldType: TFieldType;
      const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord; overload;


    // load events
    /// <summary>
    /// Called everywhere before persist object into database
    /// </summary>
    procedure OnValidation(const EntityAction: TMVCEntityAction); virtual;

    /// <summary>
    /// Called just after load the object state from database
    /// </summary>
    procedure OnAfterLoad; virtual;

    /// <summary>
    /// Called before load the object state from database
    /// </summary>
    procedure OnBeforeLoad; virtual;

    /// <summary>
    /// Called before insert the object state to database
    /// </summary>
    procedure OnBeforeInsert; virtual;

    /// <summary>
    /// Called after insert the object state to database
    /// </summary>
    procedure OnAfterInsert; virtual;

    /// <summary>
    /// Called before update the object state to database
    /// </summary>
    procedure OnBeforeUpdate; virtual;

    /// <summary>
    /// Called after update the object state to database
    /// </summary>
    procedure OnAfterUpdate; virtual;

    /// <summary>
    /// Called before delete object from database
    /// </summary>
    procedure OnBeforeDelete; virtual;

    /// <summary>
    /// Called after delete object from database
    /// </summary>
    procedure OnAfterDelete; virtual;

    /// <summary>
    /// Called before insert or update the object to the database
    /// </summary>
    procedure OnBeforeInsertOrUpdate; virtual;

    /// <summary>
    /// Called before execute sql
    /// </summary>
    procedure OnBeforeExecuteSQL(var SQL: string); virtual;

    /// <summary>
    /// Called after insert or update the object to the database
    /// </summary>
    procedure OnAfterInsertOrUpdate; virtual;

    procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
    procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
      var Handled: Boolean); virtual;

    function GenerateSelectSQL: string;

    function SQLGenerator: TMVCSQLGenerator;
    function InternalCount(const RQL: string): Int64;
    function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer)
      : TMVCActiveRecordList; overload;
    function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer;
      const OutList: TMVCActiveRecordList): UInt32; overload;
  public
    constructor Create(aLazyLoadConnection: Boolean); overload;
    { cannot be virtual! }
    constructor Create; overload; virtual;
    destructor Destroy; override;
    procedure EnsureConnection;
    procedure Assign(ActiveRecord: TMVCActiveRecord); virtual;
    procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
    function GetBackEnd: string;
    /// <summary>
    /// Executes an Insert (pk is null) or an Update (pk is not null)
    /// </summary>
    procedure Store;
    /// <summary>
    ///   Reload the current instance from database if the primary key is not empty.
    /// </summary>
    procedure Refresh; virtual;
    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;
    function LoadByPK(const id: TGuid): Boolean; overload; virtual;
    function LoadByPK(const id: string; const aFieldType: TFieldType): Boolean; overload; virtual;
    procedure Update(const RaiseExceptionIfNotFound: Boolean = True);
    procedure Delete(const RaiseExceptionIfNotFound: Boolean = True);
    function TableInfo: string;
    procedure LoadByDataset(const aDataSet: TDataSet;
      const aOptions: TMVCActiveRecordLoadOptions = []);
    procedure SetPK(const aValue: TValue);
    procedure SetPropertyValue(const aProp: TRttiProperty; const aValue: TValue);
    function GetPK: TValue;
    function TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
    function PKIsNullable(out PKValue: TValue): Boolean;
    function PKIsNull: Boolean;
    procedure AddChildren(const ChildObject: TObject);
    procedure RemoveChildren(const ChildObject: TObject);
    function GetPrimaryKeyFieldType: TFieldType;

    function FindSQLQueryByName(const QueryName: String; out NamedSQLQuery: TSQLQueryWithName): Boolean;
    function FindRQLQueryByName(const QueryName: String; out NamedRQLQuery: TRQLQueryWithName): Boolean;

    property Attributes[const AttrName: string]: TValue
      read GetAttributes
      write SetAttributes;

    [MVCDoNotSerialize]
    property TableName: string
      read GetTableName
      write SetTableName;

    [MVCDoNotSerialize]
    property PrimaryKeyIsAutogenerated: Boolean
      read GetPrimaryKeyIsAutogenerated
      write SetPrimaryKeyIsAutogenerated;

    class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
    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);

  TMergeModeItem = (mmInsert, mmUpdate, mmDelete);
  TMergeMode = set of TMergeModeItem;

  IMVCMultiExecutor<T: TMVCActiveRecord> = interface
    ['{C815246B-19CA-4F6C-AA67-8E491F809340}']
    procedure Apply(const ItemApplyAction: TMVCItemApplyAction<T> = nil);
  end;

  TMVCActiveRecordHelper = class helper for TMVCActiveRecord
    { GetByPK }
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: Int64;
      const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
      const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
      const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string; const aFieldType: TFieldType;
      const RaiseExceptionIfNotFound: Boolean): T; overload;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: Int64;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: TGuid;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;

    { Select }
    /// <summary>
    ///   Returns a TObjectList<TMVCActiveRecord> from a SQL using variant params
    /// </summary>
    class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
      const Params: array of Variant;
      const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
    /// <summary>
    ///   Returns a TObjectList<TMVCActiveRecord> from a SQL using typed params
    /// </summary>
    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;
    /// <summary>
    ///   Fills a TObjectList<TMVCActiveRecord> from a SQL using typed params.
    ///   Returns number of the records in the list (not only the selected records, but the current .Count of the list)
    /// </summary>
    class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
      const OutList: TObjectList<T>): UInt32; overload;

    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 Select(const aClass: TMVCActiveRecordClass; const SQL: string;
      const Params: array of Variant;
      const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32; overload;

    { SelectOne }
    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;


    { SelectRQL }
    function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
      : TMVCActiveRecordList; overload;
    class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
      const MaxRecordCount: Integer)
      : TObjectList<T>; overload;
    class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
      const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32; overload;
    class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
      const MaxRecordCount: Integer)
      : TMVCActiveRecordList; overload;
    class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
      const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32; overload;

    { Misc }
    class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
    class function DeleteRQL<T: TMVCActiveRecord>(const RQL: string = ''): Int64; overload;
    class function Count<T: TMVCActiveRecord>(const RQL: string = ''): Int64; overload;

    { Where }
    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 Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant;
      const ParamTypes: array of TFieldType;
      const OutList: TObjectList<T>): UInt32; 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 Where(
      const aClass: TMVCActiveRecordClass;
      const SQLWhere: string;
      const Params: array of Variant;
      const Connection: TFDConnection;
      const OutList: TMVCActiveRecordList): UInt32; overload;

    { GetXXXByWhere }
    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;

    { Merge }
    class function Merge<T: TMVCActiveRecord>(CurrentList,
      NewList: TObjectList<T>; const MergeMode: TMergeMode = [mmInsert, mmUpdate, mmDelete]): IMVCMultiExecutor<T>;

    { Misc }
    class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
      overload;
    class function All(const aQualifiedClassName: String): TObjectList<TMVCActiveRecord>;
      overload;
    class function DeleteAll(const aClass: TMVCActiveRecordClass): Int64; overload;
    class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): Int64; overload;
    function Count(const RQL: string = ''): Int64; overload;
    class function Count(const aClass: TMVCActiveRecordClass; const RQL: string = '')
      : int64; overload;

    { SelectDataSet }
    class function SelectDataSet(const SQL: string; const Params: array of Variant;
      const Unidirectional: Boolean = False;
      const DirectExecute: Boolean = False): TDataSet; overload;
    class function SelectDataSet(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType;
      const Unidirectional: Boolean = False;
      const DirectExecute: Boolean = False): TDataSet; overload;

    { NamedQuery}
    class function SelectByNamedQuery<T: TMVCActiveRecord, constructor>(
      const QueryName: String;
      const Params: array of Variant;
      const ParamTypes: array of TFieldType;
      const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>;
    class function SelectRQLByNamedQuery<T: constructor, TMVCActiveRecord>(
      const QueryName: String;
      const Params: array of const;
      const MaxRecordCount: Integer): TObjectList<T>;
    class function DeleteRQLByNamedQuery<T: TMVCActiveRecord, constructor>(
      const QueryName: String;
      const Params: array of const): Int64;
    class function CountRQLByNamedQuery<T: TMVCActiveRecord, constructor>(
      const QueryName: string;
      const Params: array of const): Int64;

    { RTTI }
    class function CreateMVCActiveRecord<T: TMVCActiveRecord>(AQualifiedClassName: string; const AParams: TArray<TValue> = nil): 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;

  IMVCActiveRecordTableMap = interface
    ['{517A863F-8BAD-4F66-A520-205149228360}']
    procedure AddTableMap(const AR: TMVCActiveRecord; const TableMap: TMVCTableMap);
    function GetTableMap(const TypeInfo: TMVCActiveRecord): TMVCTableMap;
    function TryGetValue(const AR: TMVCActiveRecord; out TableMap: TMVCTableMap): Boolean;
    procedure ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
    procedure FlushCache;
  end;

  IMVCActiveRecordConnections = interface
    ['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
    procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false); overload;
    procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
    procedure AddDefaultConnection(const aConnectionDefName: String); overload;
    procedure AddConnection(const aName, 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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
    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); overload;
    procedure AddConnection(const aName, aConnectionDefName: String); overload;
    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 GetCurrentConnectionName(const RaiseExceptionIfNotAvailable: Boolean = False): String;
    function GetByName(const aName: string): TFDConnection;
    function GetCurrentBackend: string;
    procedure SetDefault;
  end;


  TMVCTableMapRepository = class(TInterfacedObject, IMVCActiveRecordTableMap)
  private
    fMREW: TMultiReadExclusiveWriteSynchronizer;
    fTableMapDict: TObjectDictionary<String, TMVCTableMap>;
    function GetCacheKey(const AR: TMVCActiveRecord): String; inline;
  protected
    procedure AddTableMap(const AR: TMVCActiveRecord; const TableMap: TMVCTableMap);
    function GetTableMap(const TypeInfo: TMVCActiveRecord): TMVCTableMap;
    function TryGetValue(const AR: TMVCActiveRecord; out TableMap: TMVCTableMap): Boolean;
    procedure ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
    procedure FlushCache;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  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 PartitionSQL, FilteringSQL: String): String;
    function GetRQLParser: TRQL2SQL;
    function GetCompiler: TRQLCompiler;
    function GetCompilerClass: TRQLCompilerClass; virtual; abstract;
    function GetMapping: TMVCFieldsMapping;
    function TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string; const Delimiter: string): string;
  public
    constructor Create(Mapping: TMVCFieldsMapping; const DefaultRQLFilter: string;
      const PartitionInfo: TPartitionInfo); virtual;
    destructor Destroy; override;
    // capabilities
    function HasSequences: Boolean; virtual;
    function HasReturning: Boolean; virtual;
    function HasNativeUUID: Boolean; virtual;
    // end-capabilities

    // abstract SQL generator methods
    function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
      const UseArtificialLimit: Boolean = True; const UseFilterOnly: Boolean = false;
      const MaxRecordCount: Int32 = TMVCConstants.MAX_RECORD_COUNT): string;
    function CreateSelectSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
    function CreateInsertSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;

    // virtual methods with default implementation
    function CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
    function CreateDeleteSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
    function CreateDeleteAllSQL(const TableName: string): string; virtual;
    function CreateSelectCount(const TableName: string): string; virtual;
    function CreateUpdateSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual;
    function GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string; const Step: Integer = 1)
      : string; virtual;

    // Overwritten by descendant if the SQL syntaxt requires more than the simple table name
    // or if the table name contains spaces.
    function GetTableNameForSQL(const TableName: string): string; virtual;
    // Overwritten by descendant if the SQL syntaxt requires more than the simple field name
    // or if the field name contains spaces.
    function GetFieldNameForSQL(const FieldName: string): string; virtual;
    function GetParamNameForSQL(const FieldName: string): string; virtual;
    // 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;

  TMVCActiveRecordBackEnd = record
  public
  const
    Unknown = 'unknown';
    Oracle = 'oracle';
    MSSql = 'mssql';
    MSAccess  = 'msaccess';
    MySQL ='mysql';
    DB2 = 'db2';
    SQLAnywhere = 'sqlanywhere';
    Advantage = 'advantage';
    Interbase = 'interbase';
    FirebirdSQL = 'firebird';
    SQLite = 'sqlite';
    PostgreSQL = 'postgresql';
    NexusDB = 'nexusdb';
    DataSnap = 'dataSnap';
    Informix = 'informix';
    Teradata = 'teradata';
    MongoDB = 'mongodb';
    Other = 'other';
  end;

function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
function ActiveRecordTableMapRegistry: IMVCActiveRecordTableMap;
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
function GetBackEndByConnection(aConnection: TFDConnection): string;

implementation

uses
  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;
  gConnectionsLock: TObject;
  gTableMap: IMVCActiveRecordTableMap;
  gTableMapLock: TObject;

function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
  case Ord(aConnection.RDBMSKind) of
    0:
      Exit(TMVCActiveRecordBackEnd.Unknown);
    1:
      Exit(TMVCActiveRecordBackEnd.Oracle);
    2:
      Exit(TMVCActiveRecordBackEnd.MSSql);
    3:
      Exit(TMVCActiveRecordBackEnd.MSAccess);
    4:
      Exit(TMVCActiveRecordBackEnd.MySQL);
    5:
      Exit(TMVCActiveRecordBackEnd.DB2);
    6:
      Exit(TMVCActiveRecordBackEnd.SQLAnywhere);
    7:
      Exit(TMVCActiveRecordBackEnd.Advantage);
    8:
      Exit(TMVCActiveRecordBackEnd.Interbase);
    9:
      Exit(TMVCActiveRecordBackEnd.FirebirdSQL);
    10:
      Exit(TMVCActiveRecordBackEnd.SQLite);
    11:
      Exit(TMVCActiveRecordBackEnd.PostgreSQL);
    12:
      Exit(TMVCActiveRecordBackEnd.NexusDB);
    13:
      Exit(TMVCActiveRecordBackEnd.DataSnap);
    14:
      Exit(TMVCActiveRecordBackEnd.Informix);
    15:
      Exit(TMVCActiveRecordBackEnd.Teradata);
    16:
      Exit(TMVCActiveRecordBackEnd.MongoDB);
    17:
      Exit(TMVCActiveRecordBackEnd.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 ActiveRecordTableMapRegistry: IMVCActiveRecordTableMap;
begin
  if gTableMap = nil then // double check here
  begin
    TMonitor.Enter(gTableMapLock);
    try
      if gTableMap = nil then
      begin
        gTableMap := TMVCTableMapRepository.Create;
      end;
    finally
      TMonitor.Exit(gTableMapLock);
    end;
  end;
  Result := gTableMap;
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.AddConnection(const aName,
  aConnectionDefName: String);
var
  lConn: TFDConnection;
begin
  lConn := TFDConnection.Create(nil);
  try
    lConn.ConnectionDefName := aConnectionDefName;
    AddConnection(aName, lConn, True);
  except
    on E: Exception do
    begin
      lConn.Free;
      raise;
    end;
  end;
end;

procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnectionDefName: String);
begin
  AddConnection('default', aConnectionDefName);
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.GetCurrentConnectionName(
  const RaiseExceptionIfNotAvailable: Boolean): String;
var
  lName: string;
begin
{$IF not Defined(TokyoOrBetter)}
  Result := '';
{$ENDIF}
  fMREW.BeginRead;
  try
    if fCurrentConnectionsByThread.TryGetValue(TThread.CurrentThread.ThreadID, lName) then
    begin
      Result := lName;
    end
    else
    begin
      if RaiseExceptionIfNotAvailable then
        raise EMVCActiveRecord.Create('No current connection for thread')
      else
        Result := '';
    end;
  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;
   fCurrentConnectionsByThread.Remove(TThread.CurrentThread.ThreadID);
  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;
  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
  { TODO -oDanieleT -cGeneral : Why not a TFDCommand? }
  lQry := TFDQuery.Create(nil);
  try
    lQry.Connection := GetConnection;
    lSQL := SQL;
    OnBeforeExecuteSQL(lSQL);
    lQry.SQL.Text := lSQL;

    lHandled := false;
    // lQry.Prepare;
    MapObjectToParams(lQry.Params, lHandled);
    if not lHandled then
    begin
      { partitioning }
      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 fTableMap.fMap do
      begin
        lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
        if lPar <> nil then
        begin
          lValue := lPair.Key.GetValue(Self);
          lPar.DataTypeName := fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
          MapTValueToParam(lValue, lPar);
        end
      end;

      // Check if it's the primary key
      lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(fTableMap.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(fTableMap.fPrimaryKey.GetValue(Self), lPar);
      end;
    end;

    if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fTableMap.fPrimaryKeyOptions) and
      fTableMap.fPrimaryKeySequenceName.IsEmpty then
    begin
      lValue := fTableMap.fPrimaryKey.GetValue(Self);
      lQry.Open;

      if (lValue.Kind = tkRecord) then
      begin
        MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fTableMap.fPrimaryKey, Self);
      end
      else
      begin
        lValue := lQry.FieldByName(fTableMap.fPrimaryKeyFieldName).AsInteger;
        fTableMap.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; const Unidirectional: Boolean;
  const DirectExecute: Boolean): TDataSet;
begin
  Result := ExecQuery(SQL, Values, [], Connection, Unidirectional, DirectExecute);
end;

procedure TMVCActiveRecord.FillPrimaryKey(const SequenceName: string);
var
  lDS: TDataSet;
  lSQL: string;
begin
  if not SequenceName.IsEmpty then
  begin
    lSQL := SQLGenerator.GetSequenceValueSQL(fTableMap.fPrimaryKeyFieldName, SequenceName);
    if lSQL.IsEmpty then
    begin
      Exit;
    end;
    lDS := ExecQuery(lSQL, [], True, False);
    try
      MapDataSetFieldToRTTIField(lDS.Fields[0], fTableMap.fPrimaryKey, Self);
    finally
      lDS.Free;
    end;
  end;
end;

function TMVCActiveRecord.FindRQLQueryByName(const QueryName: String;
  out NamedRQLQuery: TRQLQueryWithName): Boolean;
var
  I: Integer;
begin
  for I := Low(fTableMap.fNamedRQLQueries) to High(fTableMap.fNamedRQLQueries) do
  begin
    if SameText(QueryName, fTableMap.fNamedRQLQueries[I].Name) then
    begin
      NamedRQLQuery := fTableMap.fNamedRQLQueries[I];
      Exit(True);
    end;
  end;
  Result := False;
end;

function TMVCActiveRecord.FindSQLQueryByName(const QueryName: String;
  out NamedSQLQuery: TSQLQueryWithName): Boolean;
var
  I: Integer;
  lBackEnd: String;
begin
  for I := Low(fTableMap.fNamedSQLQueries) to High(fTableMap.fNamedSQLQueries) do
  begin
    if SameText(QueryName, fTableMap.fNamedSQLQueries[I].Name) then
    begin
      lBackEnd := fTableMap.fNamedSQLQueries[I].BackEnd;
      if lBackEnd.IsEmpty or (lBackEnd = GetBackEnd) then
      begin
        NamedSQLQuery := fTableMap.fNamedSQLQueries[I];
        Exit(True);
      end;
    end;
  end;
  Result := False;
end;

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

procedure TMVCActiveRecord.InitTableInfo;
var
  lAttribute: TCustomAttribute;
  lRTTIField: TRTTIField;
  lFieldInfo: TFieldInfo;
  lPrimaryFieldTypeAsStr: string;
  lTableMap: TMVCTableMap;
  lPKCount: Integer;
  lNamedSQLQueryCount: Integer;
  lNamedRQLQueryCount: Integer;
begin
  if ActiveRecordTableMapRegistry.TryGetValue(Self, fTableMap) then
  begin
    Exit;
  end;
  TMonitor.Enter(gTableMapLock);
  try
    if ActiveRecordTableMapRegistry.TryGetValue(Self, fTableMap) then //double check here
    begin
      Exit;
    end;
    lTableMap := TMVCTableMap.Create;
    SetLength(lTableMap.fMapping, 0);
    lTableMap.fPartitionInfoInternal := nil;
    lTableMap.fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate,
      TMVCEntityAction.eaDelete];
    lTableMap.fTableName := '';
    lTableMap.fPartitionClause := '';
    lTableMap.fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
    lTableMap.fObjAttributes := lTableMap.fRTTIType.GetAttributes;
    lPKCount := 0;
    lNamedSQLQueryCount := Length(lTableMap.fNamedSQLQueries);
    lNamedRQLQueryCount := Length(lTableMap.fNamedRQLQueries);
    for lAttribute in lTableMap.fObjAttributes do
    begin
      if lAttribute is MVCTableAttribute then
      begin
        lTableMap.fTableName := MVCTableAttribute(lAttribute).Name;
        lTableMap.fDefaultRQLFilter := MVCTableAttribute(lAttribute).RQLFilter;
        Continue;
      end;
      if lAttribute is MVCEntityActionsAttribute then
      begin
        lTableMap.fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
        Continue;
      end;
      if lAttribute is MVCPartitionAttribute then
      begin
        lTableMap.fPartitionClause := MVCPartitionAttribute(lAttribute).PartitionClause;
        Continue;
      end;
      if lAttribute is MVCNamedSQLQueryAttribute then
      begin
        Inc(lNamedSQLQueryCount);
        SetLength(lTableMap.fNamedSQLQueries, lNamedSQLQueryCount);
        lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].Name := MVCNamedSQLQueryAttribute(lAttribute).Name;
        lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].SQLText := MVCNamedSQLQueryAttribute(lAttribute).SQLQuery;
        lTableMap.fNamedSQLQueries[lNamedSQLQueryCount - 1].BackEnd := MVCNamedSQLQueryAttribute(lAttribute).Backend;
        Continue;
      end;
      if lAttribute is MVCNamedRQLQueryAttribute then
      begin
        Inc(lNamedRQLQueryCount);
        SetLength(lTableMap.fNamedRQLQueries, lNamedRQLQueryCount);
        lTableMap.fNamedRQLQueries[lNamedRQLQueryCount - 1].Name := MVCNamedRQLQueryAttribute(lAttribute).Name;
        lTableMap.fNamedRQLQueries[lNamedRQLQueryCount - 1].RQLText := MVCNamedRQLQueryAttribute(lAttribute).RQLQuery;
        Continue;
      end;
    end;

    if lTableMap.fTableName = '' then
    begin
      if [eaCreate, eaUpdate, eaDelete] * lTableMap.fEntityAllowedActions <> [] then
      begin
        raise Exception.Create('Cannot find TableNameAttribute on class ' + ClassName + ' - [HINT] Is this class decorated with MVCTable and its fields with MVCTableField?');
      end;
    end;

    lTableMap.fProps := lTableMap.fRTTIType.GetFields;
    for lRTTIField in lTableMap.fProps do
    begin
      lTableMap.fPropsAttributes := lRTTIField.GetAttributes;
      if Length(lTableMap.fPropsAttributes) = 0 then
        Continue;
      for lAttribute in lTableMap.fPropsAttributes do
      begin
        if lAttribute is MVCTableFieldAttribute then
        begin
          if foPrimaryKey in MVCTableFieldAttribute(lAttribute).FieldOptions then
          begin
            lTableMap.fPrimaryKey := lRTTIField;
            lPrimaryFieldTypeAsStr := lTableMap.fPrimaryKey.FieldType.ToString.ToLowerInvariant;
            if lPrimaryFieldTypeAsStr.EndsWith('int64') then
            begin
              lTableMap.fPrimaryKeyFieldType := ftLargeInt;
            end
            else if lPrimaryFieldTypeAsStr.EndsWith('integer')
              or lPrimaryFieldTypeAsStr.EndsWith('int16')
              or lPrimaryFieldTypeAsStr.EndsWith('int32') then
            begin
              lTableMap.fPrimaryKeyFieldType := ftInteger;
            end
            else if lPrimaryFieldTypeAsStr.EndsWith('string') then
            begin
              lTableMap.fPrimaryKeyFieldType := ftString;
            end
            else if lPrimaryFieldTypeAsStr.EndsWith('guid') then
            begin
              lTableMap.fPrimaryKeyFieldType := ftGuid;
            end
            else
            begin
              raise EMVCActiveRecord.Create
                ('Allowed primary key types are: (Nullable)Integer, (Nullable)Int16, (Nullable)Int32, (Nullable)Int64, (Nullable)String, GUID - found: ' +
                lPrimaryFieldTypeAsStr);
            end;
            lTableMap.fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
            lTableMap.fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
            lTableMap.fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
            Inc(lPKCount);
            Continue;
          end;

          lFieldInfo := TFieldInfo.Create;
          lTableMap.fMap.Add(lRTTIField, lFieldInfo);
          lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
          lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
          lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;
        end;
      end;
    end;
    lTableMap.fMap.EndUpdates;
    if (lPKCount + lTableMap.fMap.WritableFieldsCount + lTableMap.fMap.ReadableFieldsCount) = 0 then
      raise EMVCActiveRecord.Create(
        'No fields nor PKs defined in class ' + ClassName + '. [HINT] Use MVCTableField in private fields');
    lTableMap.fPartitionInfoInternal := nil;

    ActiveRecordTableMapRegistry.AddTableMap(Self, lTableMap);
    fTableMap := lTableMap;
  finally
    TMonitor.Exit(gTableMapLock);
  end;
end;

procedure TMVCActiveRecord.Insert;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaCreate);
  OnValidation(TMVCEntityAction.eaCreate);
  OnBeforeInsert;
  OnBeforeInsertOrUpdate;
  if fTableMap.fMap.WritableFieldsCount = 0 then
  begin
    raise EMVCActiveRecord.CreateFmt
      ('Cannot insert an entity if no fields are writable. Class [%s] mapped on table [%s]',
      [ClassName, TableName]);
  end;
  if (foAutoGenerated in fTableMap.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 fTableMap.fPrimaryKeySequenceName.IsEmpty then
        begin
          raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' + GetBackEnd +
            ' requires it');
        end;
        if foReadOnly in fTableMap.fPrimaryKeyOptions then
        begin
          raise EMVCActiveRecord.Create('Cannot define a read-only primary key when a sequence is used for the class ' +
            ClassName);
        end;
        FillPrimaryKey(fTableMap.fPrimaryKeySequenceName);
      end;
    end;
  end;

  SQL := SQLGenerator.CreateInsertSQL(TableName, fTableMap.fMap,
    fTableMap.fPrimaryKeyFieldName, fTableMap.fPrimaryKeyOptions);
  ExecNonQuery(SQL, True);
  OnAfterInsert;
  OnAfterInsertOrUpdate;
end;

function TMVCActiveRecord.InternalCount(const RQL: string): int64;
var
  lSQL: string;
begin
  lSQL := Self.SQLGenerator.CreateSelectCount(TableName);
  lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false, True);
  Result := GetScalar(lSQL, []);
end;

function TMVCActiveRecord.InternalSelectRQL(const RQL: string;
  const MaxRecordCount: Integer; const OutList: TMVCActiveRecordList): UInt32;
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, [], nil, OutList);
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;
  if not aLazyLoadConnection then
  begin
    GetConnection;
  end;
  InitTableInfo;
end;

function TMVCActiveRecord.GenerateSelectSQL: string;
begin
  Result := SQLGenerator.CreateSelectSQL(TableName, fTableMap.fMap,
    fTableMap.fPrimaryKeyFieldName, fTableMap.fPrimaryKeyOptions);
end;

function TMVCActiveRecord.GetAttributes(const AttrName: string): TValue;
var
  lProperty: TRttiProperty;
begin
  if not TRttiUtils.ExistsProperty(Self, AttrName, lProperty) then
  begin
    raise EMVCActiveRecord.CreateFmt('Attribute [%s] not found', [AttrName]);
  end;
  Result := lProperty.GetValue(Self);
end;

function TMVCActiveRecord.GetBackEnd: string;
begin
  if fBackendDriver.IsEmpty then
  begin
    fBackendDriver := GetBackEndByConnection(GetConnection);
  end;
  Result := fBackendDriver;
end;

class function TMVCActiveRecord.GetByPK(aActiveRecord: TMVCActiveRecord; const aValue: string;
  const aFieldType: TFieldType; const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
var
  lFound: Boolean;
begin
  Result := aActiveRecord;
  try
    if Result.SQLGenerator.HasNativeUUID then
    begin
      lFound := Result.LoadByPK(aValue, aFieldType)
    end
    else
    begin
      lFound := Result.LoadByPK(aValue);
    end;
    if not lFound then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecordNotFound.Create('No data found')
      else
        FreeAndNil(Result);
    end;
  except
    FreeAndNil(Result);
    raise;
  end;
end;

class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
  const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
  Result := GetByPK(aClass.Create, aValue, ftString, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
  const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
  Result := GetByPK(aClass.Create, aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: TGuid;
  const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
  Result := GetByPK(aClass.Create, aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
  const RaiseExceptionIfNotFound: Boolean = True): T;
begin
  Result := GetByPK<T>(aValue.ToString, ftInteger, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string; const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := GetByPK<T>(aValue, ftString, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: TGuid; const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := GetByPK<T>(aValue.ToString, ftGuid, RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string; const aFieldType: TFieldType;
  const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := T(GetByPK(T.Create, aValue, aFieldType, RaiseExceptionIfNotFound));
end;

class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
var
  lList: TObjectList<T>;
begin
  lList := Where<T>(SQLWhere, Params, ParamTypes);
  try
    if lList.Count = 0 then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecordNotFound.Create('Got 0 rows when at least 1 was expected');
      Exit(nil);
    end;
    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;
  lPropFromField: TRttiProperty;
  lParentType: TRttiType;
  lTmp: String;
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(fTableMap.fMapping) = 0 then
  begin
    if not fTableMap.fPrimaryKeyFieldName.IsEmpty then
    begin
      lParentType := fTableMap.fPrimaryKey.Parent;
      SetLength(fTableMap.fMapping, fTableMap.fMap.Count + 1);
      fTableMap.fMapping[0].InstanceFieldName := fTableMap.fPrimaryKey.Name.Substring(1).ToLower;
      fTableMap.fMapping[0].DatabaseFieldName := fTableMap.fPrimaryKeyFieldName;
      lPropFromField := lParentType.GetProperty(fTableMap.fPrimaryKey.Name.Substring(1));
      if Assigned(lPropFromField) then
      begin
        lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
        if not SameText(lTmp, fTableMap.fMapping[0].InstanceFieldName) then
        begin
          fTableMap.fMapping[0].Alias := lTmp;
        end;
      end;
      I := 1;
    end
    else
    begin
      SetLength(fTableMap.fMapping, fTableMap.fMap.Count);
      I := 0;
    end;

    for lPair in fTableMap.fMap do
    begin
      lParentType := lPair.Key.Parent;
      fTableMap.fMapping[I].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
      fTableMap.fMapping[I].DatabaseFieldName := lPair.Value.FieldName;

      lPropFromField := lParentType.GetProperty(lPair.Key.Name.Substring(1));
      if Assigned(lPropFromField) then
      begin
        lTmp := TMVCSerializerHelper.GetKeyName(lPropFromField, lParentType);
        if not SameText(lTmp, fTableMap.fMapping[I].InstanceFieldName) then
        begin
          fTableMap.fMapping[I].Alias := lTmp;
        end;
      end;
      Inc(I);
    end;
  end;
  Result := fTableMap.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;

class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string;
  const MaxRecordCount: Integer; const OutList: TObjectList<T>): UInt32;
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, [], [], OutList);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.SelectRQLByNamedQuery<T>(
  const QueryName: string;
  const Params: array of const;
  const MaxRecordCount: Integer): TObjectList<T>;
var
  lT: T;
  lRQLQuery: TRQLQueryWithName;
begin
  lT := T.Create;
  try
    if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
    begin
      raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
    end;
    Result := SelectRQL<T>(Format(lRQLQuery.RQLText, Params), MaxRecordCount);
  finally
    lT.Free;
  end;
end;

class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
  const Params: array of Variant; const ParamTypes: array of TFieldType;
  const OutList: TObjectList<T>): UInt32;
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, [], OutList);
    end
    else
    begin
      if lFilter.IsEmpty then
      begin
        Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes, [], OutList);
      end
      else
      begin
        Result := Select<T>(lAR.GenerateSelectSQL + lFilter + ' AND ' + SQLWhere, Params, ParamTypes, [], OutList);
      end;
    end;
  finally
    lAR.Free;
  end;
end;

function TMVCActiveRecord.GetPartitionInfo: TPartitionInfo;
var
  lRQLCompilerClass: TRQLCompilerClass;
begin
  if fTableMap.fPartitionInfoInternal = nil then
  begin
    lRQLCompilerClass := TRQLCompilerRegistry.Instance.GetCompiler(GetBackEnd);
    fTableMap.fPartitionInfoInternal := TPartitionInfo.BuildPartitionClause(fTableMap.fPartitionClause, lRQLCompilerClass);
  end;
  Result := fTableMap.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 := fTableMap.fPrimaryKeyFieldType;
end;

function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean;
begin
  Result := foAutoGenerated in fTableMap.fPrimaryKeyOptions;
end;

class function TMVCActiveRecord.GetScalar(const SQL: string; const Params: array of Variant): Variant;
begin
  Result := CurrentConnection.ExecSQLScalar(SQL, Params);
end;

function TMVCActiveRecord.GetTableName: string;
begin
  if fCustomTableName.IsEmpty then
    Result := fTableMap.fTableName
  else
    Result := fCustomTableName;
end;

function TMVCActiveRecord.CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean): Boolean;
begin
  Result := aEntityAction in fTableMap.fEntityAllowedActions;
  if (not Result) and aRaiseException then
    raise EMVCActiveRecord.CreateFmt
      ('Action [%s] not allowed on entity [%s]. [HINT] If this isn''t the expected behavior, add the entity action in MVCEntityActions attribute.',
      [GetEnumName(TypeInfo(TMVCEntityAction), Ord(aEntityAction)), ClassName]) at ReturnAddress;
end;

class function TMVCActiveRecordHelper.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 TMVCActiveRecordHelper.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 TMVCActiveRecordHelper.CountRQLByNamedQuery<T>(
      const QueryName: string;
      const Params: array of const): Int64;
var
  lRQLQuery: TRQLQueryWithName;
  lT: T;
begin
  lT := T.Create;
  try
    if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
    begin
      raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
    end;
    Result := Count<T>(Format(lRQLQuery.RQLText, Params));
  finally
    lT.Free;
  end;
end;

class function TMVCActiveRecordHelper.CreateMVCActiveRecord<T>(
  AQualifiedClassName: string; const AParams: TArray<TValue>): T;
var
  lTmp: TObject;
begin
  lTmp := TRttiUtils.CreateObject(AQualifiedClassName, AParams);
  try
    Result := lTmp as T;
  except
    on E: EInvalidCast do
    begin
      lTmp.Free;
      raise EMVCActiveRecord.Create(AQualifiedClassName + ' is not a TMVCActiveRecord descendant');
    end;
  end;
end;

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

class function TMVCActiveRecordHelper.DeleteRQLByNamedQuery<T>(
      const QueryName: String;
      const Params: array of const): Int64;
var
  lRQLQuery: TRQLQueryWithName;
  lT: T;
begin
  lT := T.Create;
  try
    if not lT.FindRQLQueryByName(QueryName, lRQLQuery) then
    begin
      raise EMVCActiveRecord.CreateFmt('NamedRQLQuery not found: %s', [QueryName]);
    end;
    Result := DeleteRQL<T>(Format(lRQLQuery.RQLText, Params));
  finally
    lT.Free;
  end;
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(fTableMap.fPrimaryKey) then
    raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
  SQL := SQLGenerator.CreateDeleteSQL(TableName, fTableMap.fMap,
    fTableMap.fPrimaryKeyFieldName, fTableMap.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, fTableMap.fPrimaryKeyFieldName]);
  end;
  OnAfterDelete;
end;

class function TMVCActiveRecordHelper.DeleteAll(const aClass: TMVCActiveRecordClass): int64;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableMap.fTableName) +
      lAR.SQLGenerator.GetDefaultSQLFilter(True));
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create(True);
  try
    Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableMap.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;
var
  lNullableType: TNullableType;
begin
  Assert(aValue.Kind = tkRecord);
  Result := True;
  lNullableType := GetNullableType(aValue.TypeInfo);
  case lNullableType of
    ntInvalidNullableType:
      begin
        Exit(False);
      end;
    ntNullableString:
      begin
        if not aValue.AsType<NullableString>().HasValue then
        begin
          aParam.DataType := ftString;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableString>().Value;
        end;
      end;
    ntNullableCurrency:
      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;
        end;
      end;
    ntNullableBoolean:
      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);
        end;
      end;
    ntNullableTDate:
      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);
        end;
      end;
    ntNullableTTime:
      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);
        end;
      end;
    ntNullableTDateTime:
      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);
        end;
      end;
    ntNullableSingle:
      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;
        end;
      end;
    ntNullableDouble:
      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;
        end;
      end;
    ntNullableExtended:
      begin
        if not aValue.AsType<NullableExtended>().HasValue then
        begin
          aParam.DataType := TFieldType.ftExtended;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableExtended>().Value;
        end;
      end;
    ntNullableInt16:
      begin
        if not aValue.AsType<NullableInt16>().HasValue then
        begin
          aParam.DataType := ftInteger;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableInt16>().Value;
        end;
      end;
    ntNullableUInt16:
      begin
        if not aValue.AsType<NullableUInt16>().HasValue then
        begin
          aParam.DataType := ftInteger;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableUInt16>().Value;
        end;
      end;
    ntNullableInt32:
      begin
        if not aValue.AsType<NullableInt32>().HasValue then
        begin
          aParam.DataType := ftInteger;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableInt32>().Value;
        end;
      end;
    ntNullableUInt32:
      begin
        if not aValue.AsType<NullableUInt32>().HasValue then
        begin
          aParam.DataType := ftInteger;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableUInt32>().Value;
        end;
      end;
    ntNullableInt64:
      begin
        if not aValue.AsType<NullableInt64>().HasValue then
        begin
          aParam.DataType := ftLargeInt;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableInt64>().Value;
        end;
      end;
    ntNullableUInt64:
      begin
        if not aValue.AsType<NullableUInt64>().HasValue then
        begin
          aParam.DataType := ftLargeInt;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := aValue.AsType<NullableUInt64>().Value;
        end;
      end;
    ntNullableTGUID:
      begin
        if not aValue.AsType<NullableTGUID>().HasValue then
        begin
          aParam.DataType := TFieldType.ftGuid;
          aParam.Clear;
          Exit(True);
        end
        else
        begin
          aValue := TValue.From<TGuid>(aValue.AsType<NullableTGUID>().Value);
        end;
      end;
  end; // case

  // the nullable value contains a value, so let's call
  // the "non nullable" version of this procedure
  MapTValueToParam(aValue, aParam);
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 (lName.StartsWith('Nullable', True) and (aValue.TypeInfo.Kind = tkRecord)) then
  begin
    if MapNullableTValueToParam(aValue, aParam) then
    begin
      Exit;
    end;
  end;

  case aValue.TypeInfo.Kind of
    tkUString:
      begin
        case aParam.DataType of
          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 := aValue.AsOrdinal;
        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.TypeInfo = TypeInfo(TGuid) then
        begin
          if SQLGenerator.HasNativeUUID then
          begin
            aParam.AsGuid := aValue.AsType<TGuid>
          end
          else
          begin
            aParam.AsString := GUIDToString(aValue.AsType<TGuid>);
          end;
        end
        else if aValue.TypeInfo = TypeInfo(NullableTGUID) then
        begin
          if aValue.AsType<NullableTGUID>.HasValue then
            aParam.AsGuid := aValue.AsType<NullableTGUID>.Value
          else
            aParam.Clear();
        end
        else
        begin
          raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
            [Ord(aValue.TypeInfo.Kind), aParam.Name]);
        end;
      end;
  else
    raise Exception.CreateFmt('Unsupported TypeKind (%d) for param %s', [Ord(aValue.TypeInfo.Kind), aParam.Name]);
  end;
end;

procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions);
var
  lItem: TPair<TRTTIField, TFieldInfo>;
  lField: TField;
  lHandled: Boolean;
begin
  CheckAction(TMVCEntityAction.eaRetrieve);
  OnBeforeLoad;

  lHandled := false;
  MapDatasetToObject(aDataSet, aOptions, lHandled);
  if not lHandled then
  begin
    for lItem in fTableMap.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 fTableMap.fPrimaryKeyFieldName.IsEmpty then
    begin
      MapDataSetFieldToRTTIField(aDataSet.FieldByName(fTableMap.fPrimaryKeyFieldName), fTableMap.fPrimaryKey, Self);
    end;
  end;
  OnAfterLoad;
end;

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

function TMVCActiveRecord.LoadByPK(const id: string): Boolean;
begin
  Result := LoadByPK(id, ftString);
end;

function TMVCActiveRecord.LoadByPK(const id: int64): Boolean;
begin
  Result := LoadByPK(id.ToString, ftInteger);
end;

function TMVCActiveRecord.LoadByPK(const id: TGuid): Boolean;
begin
  Result := LoadByPK(id.ToString, ftGuid);
end;

procedure TMVCActiveRecord.OnAfterDelete;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnAfterInsert;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnAfterInsertOrUpdate;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnAfterLoad;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnAfterUpdate;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeDelete;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL: string);
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeInsert;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeInsertOrUpdate;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeLoad;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnBeforeUpdate;
begin
  // do nothing
end;

procedure TMVCActiveRecord.OnValidation(const EntityAction: TMVCEntityAction);
begin
  // do nothing
end;

procedure TMVCActiveRecord.Refresh;
begin
  if not GetPK.IsEmpty then
  begin
    case GetPrimaryKeyFieldType of
      ftLargeInt: begin
        LoadByPK(GetPK.AsInt64);
      end;
      ftInteger: begin
        LoadByPK(GetPK.AsInteger);
      end;
      ftString: begin
        LoadByPK(GetPK.AsString);
      end;
      ftGuid: begin
        LoadByPK(GetPK.AsType<TGUID>);
      end;
      else
        raise EMVCActiveRecord.Create('Unknown primary key type');
    end;
  end;
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 TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
  const Params: array of Variant): TMVCActiveRecordList;
begin
  Result := Select(aClass, SQL, Params, nil);
end;

class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
  const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
begin
  Result := TMVCActiveRecordList.Create;
  try
    Select(aClass, SQL, Params, Connection, Result);
  except
    Result.Free;
    raise;
  end;
end;

class function TMVCActiveRecordHelper.SelectDataSet(const SQL: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
begin
  Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes, Unidirectional, DirectExecute);
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 TMVCActiveRecordHelper.SelectDataSet(const SQL: string; const Params: array of Variant;
  const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
begin
  Result := TMVCActiveRecord.ExecQuery(SQL, Params, Unidirectional, DirectExecute);
end;

function TMVCActiveRecordHelper.SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
begin
  Result := InternalSelectRQL(RQL, MaxRecordCount);
end;

class function TMVCActiveRecordHelper.SelectRQL(const aClass: TMVCActiveRecordClass;
  const RQL: string; const MaxRecordCount: Integer;
  const OutList: TMVCActiveRecordList): UInt32;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create(True);
  try
    Result := lAR.InternalSelectRQL(RQL, MaxRecordCount, OutList);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions; const OutList: TObjectList<T>): UInt32;
var
  lDataSet: TDataSet;
  lAR: TMVCActiveRecord;
begin
  lDataSet := ExecQuery(SQL, Params, ParamTypes, True, False);
  try
    while not lDataSet.Eof do
    begin
      lAR := T.Create;
      OutList.Add(lAR);
      lAR.LoadByDataset(lDataSet, Options);
      lDataSet.Next;
    end;
    Result := OutList.Count;
  finally
    lDataSet.Free;
  end;
end;

class function TMVCActiveRecordHelper.SelectByNamedQuery<T>(
  const QueryName: String; const Params: array of Variant;
  const ParamTypes: array of TFieldType;
  const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
var
  lT: T;
  lSQLQuery: TSQLQueryWithName;
begin
  lT := T.Create;
  try
    if not lT.FindSQLQueryByName(QueryName, lSQLQuery) then
    begin
      raise EMVCActiveRecord.CreateFmt('NamedSQLQuery not found: %s', [QueryName]);
    end;
    Result := Select<T>(lSQLQuery.SQLText, Params, ParamTypes, Options);
  finally
    lT.Free;
  end;
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
    Select<T>(SQL, Params, ParamTypes, Options, Result);
  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>;
begin
  Result := TObjectList<T>.Create(True);
  try
    Where<T>(SQLWhere, Params, ParamTypes, Result);
  except
    Result.Free;
    raise;
  end;
end;

class function TMVCActiveRecordHelper.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 fTableMap.fPrimaryKeyFieldName.IsEmpty then
  begin
    raise Exception.Create('No primary key defined');
  end;

  if fTableMap.fPrimaryKey.GetValue(Self).Kind = tkRecord then
  begin
    lPKValue := fTableMap.fPrimaryKey.GetValue(Self);
    if lPKValue.IsType<NullableInt32> { and aValue.IsType<NullableInt32>() } then
    begin
      if aValue.IsType<Int32> then
      begin
        lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
      end
      else
      begin
        raise EMVCActiveRecord.Create('Invalid type for primary key');
      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;
    fTableMap.fPrimaryKey.SetValue(Self, lPKValue);
  end
  else
  begin
    fTableMap.fPrimaryKey.SetValue(Self, aValue)
  end;
end;

procedure TMVCActiveRecord.SetPrimaryKeyIsAutogenerated(const Value: Boolean);
begin
  if Value then
  begin
    Include(fTableMap.fPrimaryKeyOptions, foAutoGenerated);
  end
  else
  begin
    Exclude(fTableMap.fPrimaryKeyOptions, foAutoGenerated);
  end;
end;

procedure TMVCActiveRecord.SetTableName(const Value: string);
begin
  if Value = fTableMap.fTableName then
  begin
    fCustomTableName := '';
  end
  else
  begin
    fCustomTableName := Value;
  end;
end;

function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
var
  lSQLGeneratorClass: TMVCSQLGeneratorClass;
begin
  if not Assigned(fSQLGenerator) then
  begin
    GetConnection.Connected := True;
    lSQLGeneratorClass := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd);
    fSQLGenerator := lSQLGeneratorClass.Create(GetMapping, fTableMap.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: ' + TableName;
  for KeyValue in fTableMap.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 fTableMap.fPrimaryKeyFieldName.IsEmpty then
    raise Exception.Create('No primary key defined');
  Value := fTableMap.fPrimaryKey.GetValue(Self);
  if Value.Kind = tkRecord then
  begin
    if Value.IsType<NullableInt32>() then
    begin
      Result := Value.AsType<NullableInt32>().TryHasValue(Value);
    end
    else if Value.IsType<NullableInt64>() then
    begin
      Result := Value.AsType<NullableInt64>().TryHasValue(Value)
    end
    else if Value.IsType<NullableUInt32>() then
    begin
      Result := Value.AsType<NullableUInt32>().TryHasValue(Value)
    end
    else if Value.IsType<NullableUInt64>() then
    begin
      Result := Value.AsType<NullableUInt64>().TryHasValue(Value)
    end
    else if Value.IsType<NullableInt16>() then
    begin
      Result := Value.AsType<NullableInt16>().TryHasValue(Value)
    end
    else if Value.IsType<NullableUInt16>() then
    begin
      Result := Value.AsType<NullableUInt16>().TryHasValue(Value)
    end
    else if Value.IsType<NullableString>() then
    begin
      Result := Value.AsType<NullableString>().TryHasValue(Value)
    end
    else if Value.IsType<NullableTGUID>() then
    begin
      Result := Value.AsType<NullableTGUID>().TryHasValue(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 fTableMap.fMap.WritableFieldsCount = 0 then
  begin
    raise EMVCActiveRecord.CreateFmt
      ('Cannot update an entity if no fields are writeable. Class [%s] mapped on table [%s]', [ClassName, TableName]);
  end;
  SQL := SQLGenerator.CreateUpdateSQL(TableName, fTableMap.fMap,
    fTableMap.fPrimaryKeyFieldName, fTableMap.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, fTableMap.fPrimaryKeyFieldName]);
  end;
  OnAfterUpdate;
  OnAfterInsertOrUpdate;
end;

class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass;
  const SQLWhere: string; const Params: array of Variant;
  const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection, OutList);
  finally
    lAR.Free;
  end;
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 TMVCActiveRecordHelper.All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := Select(aClass,
      lAR.GenerateSelectSQL + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
  finally
    lAR.Free;
  end;
end;

procedure TMVCActiveRecord.Assign(ActiveRecord: TMVCActiveRecord);
begin
  //do nothing
end;

class function TMVCActiveRecordHelper.All(const aQualifiedClassName: String): TObjectList<TMVCActiveRecord>;
var
  lAR: TMVCActiveRecord;
begin
  lAR := TMVCActiveRecord.CreateMVCActiveRecord<TMVCActiveRecord>(aQualifiedClassName, []);
  try
    Result := Select(TMVCActiveRecordClass(lAR.ClassType),
      lAR.GenerateSelectSQL + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
  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 + lAR.SQLGenerator.GetDefaultSQLFilter(True), []);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
  const Params: array of Variant): TMVCActiveRecordList;
begin
  Result := Where(aClass, SQLWhere, Params, nil);
end;

class function TMVCActiveRecordHelper.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
  const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
begin
  Result := TMVCActiveRecordList.Create;
  try
    Where(aClass, SQLWhere, Params, Connection, Result);
  except
    Result.Free;
    raise;
  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>; const MergeMode: TMergeMode): IMVCMultiExecutor<T>;
var
  I: Integer;
  lFoundAtIndex: Integer;
  lCurrPKValue: Integer;
  lPKValue: TValue;
  lUnitOfWork: IMVCUnitOfWork<T>;
  lPKType: TFieldType;
  lNeedsToBeUpdated: Boolean;
begin
  lUnitOfWork := TMVCUnitOfWork<T>.Create;
  if mmDelete in MergeMode then
  begin
    lUnitOfWork.RegisterDelete(CurrentList);
  end;
  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
        if mmInsert in MergeMode then
        begin
          lUnitOfWork.RegisterInsert(NewList[I]);
        end;
        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 for merge');
      end;

      if lNeedsToBeUpdated then
      begin
        if mmUpdate in MergeMode then
        begin
          lUnitOfWork.RegisterUpdate(NewList[I])
        end;
      end
      else
      begin
        if mmInsert in MergeMode then
        begin
          lUnitOfWork.RegisterInsert(NewList[I]);
        end;
      end;
    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
  else
  begin
    raise EMVCActiveRecord.Create('Cannot perform an update without an entity primary key');
  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.HasNativeUUID: Boolean;
begin
  Result := false;
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;
end;

function TMVCSQLGenerator.MergeSQLFilter(const PartitionSQL, FilteringSQL: String): String;
begin
  Result := '';
  if PartitionSQL + FilteringSQL = '' then
  begin
    Exit;
  end;
  //if PartitionSQL.IsEmpty and (not FilteringSQL.IsEmpty) then
  if not FilteringSQL.IsEmpty then
  begin
    Exit(FilteringSQL); //ignore partitioning while reading if filtering is present
  end;
  if FilteringSQL.IsEmpty and (not PartitionSQL.IsEmpty) then
  begin
    Exit(PartitionSQL);
  end;
//  Result := '((' + PartitionSQL + ') and (' + FilteringSQL + '))';
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;
  FHTTPStatusCode := http_status.NotFound;
end;

class function TMVCActiveRecord.ExecQuery(
  const SQL: string;
  const Values: array of Variant;
  const ValueTypes: array of TFieldType;
  const Connection: TFDConnection;
  const Unidirectional: Boolean;
  const DirectExecute: Boolean): TDataSet;
var
  lQry: TFDQuery;
begin
  lQry := TFDQuery.Create(nil);
  try
    lQry.FetchOptions.Unidirectional := Unidirectional;
    lQry.UpdateOptions.ReadOnly := True;
    lQry.ResourceOptions.DirectExecute := DirectExecute;  //2023-07-12

    if Unidirectional then
    begin
      lQry.FetchOptions.CursorKind := ckForwardOnly;
    end;
    if Connection = nil then
    begin
      lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
    end
    else
    begin
      lQry.Connection := Connection;
    end;
    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; const Unidirectional: Boolean; const DirectExecute: Boolean): TDataSet;
begin
  Result := ExecQuery(SQL, Values, ValueTypes, nil, Unidirectional, DirectExecute);
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 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 [%s] not found in table', [FieldName]);
end;

{ TFieldInfo }

procedure TFieldInfo.EndUpdates;
begin
  if FieldName.IsEmpty then
  begin
    Writeable := false;
    Readable := false;
  end
  else
  begin
    Writeable := ((FieldOptions * [foReadOnly, foAutoGenerated]) = []);
    Readable := (FieldOptions * [foWriteOnly]) = [];
  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 Create;
  fListToDelete := TObjectList<T>.Create(false);
  fListToUpdate := TObjectList<T>.Create(false);
  fListToInsert := TObjectList<T>.Create(false);
end;

destructor TMVCUnitOfWork<T>.Destroy;
begin
  fListToDelete.Free;
  fListToUpdate.Free;
  fListToInsert.Free;
  inherited;
end;

procedure TMVCUnitOfWork<T>.DoItemApplyAction(const Obj: TMVCActiveRecord; const EntityAction: TMVCEntityAction;
  const ItemApplyAction: TMVCItemApplyAction<T>; var Handled: Boolean);
begin
  if Assigned(ItemApplyAction) then
  begin
    ItemApplyAction(Obj, EntityAction, Handled);
  end;
end;

class function TMVCUnitOfWork<T>.KeyExistsInt(const NewList: TObjectList<T>; const KeyValue: Integer;
  out Index: Integer): Boolean;
var
  I: Integer;
begin
  Result := false;
  for I := 0 to NewList.Count - 1 do
  begin
    if NewList[I].GetPK.AsInteger = KeyValue then
    begin
      Index := I;
      Exit(True);
    end;
  end;
end;

class function TMVCUnitOfWork<T>.KeyExistsInt64(const NewList: TObjectList<T>; const KeyValue: int64;
  out Index: Integer): Boolean;
var
  I: Integer;
begin
  Result := false;
  for I := 0 to NewList.Count - 1 do
  begin
    if (not NewList[I].PKIsNull) and (NewList[I].GetPK.AsInt64 = KeyValue) then
    begin
      Index := I;
      Exit(True);
    end;
  end;
end;

class function TMVCUnitOfWork<T>.KeyExistsString(const NewList: TObjectList<T>; const KeyValue: String;
  out Index: Integer): Boolean;
var
  I: Integer;
begin
  Result := false;
  for I := 0 to NewList.Count - 1 do
  begin
    if NewList[I].GetPK.AsString = KeyValue then
    begin
      Index := I;
      Exit(True);
    end;
  end;
end;

procedure TMVCUnitOfWork<T>.RegisterDelete(const Value: T);
begin
  fListToDelete.Add(Value);
end;

procedure TMVCUnitOfWork<T>.RegisterDelete(const Enumerable: TEnumerable<T>);
begin
  fListToDelete.AddRange(Enumerable);
end;

procedure TMVCUnitOfWork<T>.RegisterInsert(const Value: T);
begin
  fListToInsert.Add(Value);
end;

procedure TMVCUnitOfWork<T>.RegisterUpdate(const Value: T);
var
  lCurrPKValue: Integer;
  lFoundAtIndex: Integer;
begin
  fListToUpdate.Add(Value);
  lCurrPKValue := Value.GetPK.AsInteger;
  if KeyExistsInt(fListToDelete, lCurrPKValue, lFoundAtIndex) then
  begin
    fListToDelete.Delete(lFoundAtIndex);
  end;
end;

procedure TMVCUnitOfWork<T>.UnregisterDelete(const Value: T);
begin
  fListToDelete.Remove(Value);
end;

procedure TMVCUnitOfWork<T>.UnregisterInsert(const Value: T);
begin
  fListToInsert.Remove(Value);
end;

procedure TMVCUnitOfWork<T>.UnregisterUpdate(const Value: T);
begin
  fListToUpdate.Remove(Value);
end;

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;
  lRQL2SQL: TRQL2SQL;
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;
  lRQL2SQL := TRQL2SQL.Create;
  try
    lRQL2SQL.Execute(fRQLFilter, fSQLFilter, RQLCompiler, false, True)
  finally
    lRQL2SQL.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] Partioning 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;

{ TMVCTableMapRepository }

procedure TMVCTableMapRepository.AddTableMap(const AR: TMVCActiveRecord; const TableMap: TMVCTableMap);
begin
  fMREW.BeginWrite;
  try
    fTableMapDict.Add(GetCacheKey(AR), TableMap);
  finally
    fMREW.EndWrite;
  end;
end;

constructor TMVCTableMapRepository.Create;
begin
  inherited;
  fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
  fTableMapDict := TObjectDictionary<String, TMVCTableMap>.Create([doOwnsValues]);
end;

destructor TMVCTableMapRepository.Destroy;
begin
  fTableMapDict.Free;
  fMREW.Free;
  inherited;
end;

procedure TMVCTableMapRepository.ExecWithExclusiveLock(Proc: TProc<IMVCActiveRecordTableMap>);
begin
  fMREW.BeginWrite;
  try
    Proc(Self);
  finally
    fMREW.EndWrite;
  end;
end;

procedure TMVCTableMapRepository.FlushCache;
begin
  ExecWithExclusiveLock(
    procedure(Map: IMVCActiveRecordTableMap)
    begin
      TMVCTableMapRepository(Map).fTableMapDict.Clear;
    end);
end;

function TMVCTableMapRepository.GetCacheKey(const AR: TMVCActiveRecord): String;
begin
  Result := AR.QualifiedClassName;
end;

function TMVCTableMapRepository.GetTableMap(
  const TypeInfo: TMVCActiveRecord): TMVCTableMap;
begin
{$IF not Defined(TokyoOrBetter)}
  Result := nil;
{$ENDIF}
  fMREW.BeginRead;
  try
    if not fTableMapDict.TryGetValue(TypeInfo.QualifiedClassName, Result) then
    begin
      Result := nil;
    end;
  finally
    fMREW.EndRead;
  end;
end;

function TMVCTableMapRepository.TryGetValue(const AR: TMVCActiveRecord;
  out TableMap: TMVCTableMap): Boolean;
begin
{$IF not Defined(TokyoOrBetter)}
  Result := nil;
{$ENDIF}
  fMREW.BeginRead;
  try
    Result := fTableMapDict.TryGetValue(GetCacheKey(AR), TableMap);
  finally
    fMREW.EndRead;
  end;
end;

{ TMVCTableMap }

constructor TMVCTableMap.Create;
begin
  inherited;
  fMap := TFieldsMap.Create;
end;

destructor TMVCTableMap.Destroy;
begin
  fMap.Free;
  inherited;
end;

class function TMVCActiveRecordHelper.Select(const aClass: TMVCActiveRecordClass;
  const SQL: string; const Params: array of Variant;
  const Connection: TFDConnection; const OutList: TMVCActiveRecordList): UInt32;
var
  lDataSet: TDataSet;
  lAR: TMVCActiveRecord;
begin
  lDataSet := ExecQuery(SQL, Params, Connection, True, False);
  try
    while not lDataSet.Eof do
    begin
      lAR := aClass.Create;
      OutList.Add(lAR);
      lAR.LoadByDataset(lDataSet);
      lDataSet.Next;
    end;
    Result := OutList.Count;
  finally
    lDataSet.Free;
  end;
end;

{ MVCNamedSQLQueryAttribute }

constructor MVCNamedSQLQueryAttribute.Create(aName, aSQLSelect: String);
begin
  Create(aName, aSQLSelect, '');
end;

constructor MVCNamedSQLQueryAttribute.Create(aName, aSQLSelect,
  aBackEnd: String);
begin
  inherited Create;
  Name := aName;
  SQLQuery := aSQLSelect;
  BackEnd := aBackEnd;
end;

{ MVCNamedRQLQueryAttribute }

constructor MVCNamedRQLQueryAttribute.Create(aName, aRQL: String);
begin
  inherited Create;
  Name := aName;
  RQLQuery := aRQL;
end;

initialization

gConnectionsLock := TObject.Create;
gTableMapLock := TObject.Create;
gCtx := TRttiContext.Create;
gCtx.FindType('');

finalization

gCtx.Free;
gConnectionsLock.Free;
gTableMapLock.Free;

end.