delphimvcframework/sources/MVCFramework.ActiveRecord.pas

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// ***************************************************************************

unit MVCFramework.ActiveRecord;

{$I dmvcframework.inc}

interface

uses
  System.Generics.Defaults,
  System.Generics.Collections,
  System.RTTI,
  FireDAC.DApt,
  Data.DB,
  FireDAC.Comp.Client,
  FireDAC.Stan.Def,
  FireDAC.Stan.Pool,
  FireDAC.Stan.Async,
  FireDAC.Stan.Param,
  System.SysUtils,
  MVCFramework,
  MVCFramework.Commons,
  MVCFramework.RQL.Parser,
  MVCFramework.Serializer.Intf,
  MVCFramework.Serializer.Commons;

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;
  TMVCActiveRecordFieldOption = (foPrimaryKey, { it's the primary key of the mapped table }
    foAutoGenerated, { not written, read - similar to readonly }
    foTransient, { not written, not read }
    foReadOnly, { not written, read }
    foWriteOnly); { written, not read }
  TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
  TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete);
  TMVCEntityActions = set of TMVCEntityAction;
  TMVCActiveRecordLoadOption = (loIgnoreNotExistentFields);
  TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption;

  IMVCEntityProcessor = interface
    ['{E7CD11E6-9FF9-46D2-B7B0-DA5B38EAA14E}']
    procedure GetEntities(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
      var Handled: Boolean);
    procedure GetEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
      const id: Integer; var Handled: Boolean);
    procedure CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
      var Handled: Boolean);
    procedure UpdateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
      const id: Integer; var Handled: Boolean);
    procedure DeleteEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
      const id: Integer; var Handled: Boolean);
  end;

  TFieldInfo = class
  public
    // TableName: string;
    FieldName: string;
    FieldOptions: TMVCActiveRecordFieldOptions;
    DataTypeName: string;
    Writeable, Readable: Boolean;
    procedure EndUpdates;
  end;

  TFieldsMap = class(TObjectDictionary<TRTTIField, TFieldInfo>)
  private
    fWritableFieldsCount: Integer;
    fReadableFieldsCount: Integer;
  public
    constructor Create;
    procedure EndUpdates;
    property WritableFieldsCount: Integer read fWritableFieldsCount;
    property ReadableFieldsCount: Integer read fWritableFieldsCount;
    function GetInfoByFieldName(const FieldName: string): TFieldInfo;
  end;

  MVCActiveRecordCustomAttribute = class(TCustomAttribute)

  end;

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

  TMVCActiveRecord = class;

  TMVCSQLGenerator = class;

  TMVCActiveRecordList = class(TObjectList<TMVCActiveRecord>)
  public
    constructor Create; virtual;
  end;

  TMVCActiveRecord = class
  private
    fChildren: TObjectList<TObject>;
    fConn: TFDConnection;
    fSQLGenerator: TMVCSQLGenerator;
    fPrimaryKeyFieldName: string;
    fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
    fPrimaryKeySequenceName: string;
    fPrimaryKeyFieldType: TFieldType;
    fEntityAllowedActions: TMVCEntityActions;
    fRQL2SQL: TRQL2SQL;
    procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam);
    function MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
    function GetPrimaryKeyIsAutogenerated: Boolean;
    procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
    function GetPrimaryKeyFieldType: TFieldType;
    procedure SetTableName(const Value: string);
    function GetAttributes(const AttrName: string): TValue;
    procedure SetAttributes(const AttrName: string; const Value: TValue);
  protected
    fRTTIType: TRttiInstanceType;
    fProps: TArray<TRTTIField>;
    fObjAttributes: TArray<TCustomAttribute>;
    fPropsAttributes: TArray<TCustomAttribute>;
    fTableName: string;
    fMap: TFieldsMap;
    // fMapNonTransientFields: TFieldsMap;
    // fMapFieldDataTypes: TDictionary<string, string>;
    fPrimaryKey: TRTTIField;
    fBackendDriver: string;
    fMapping: TMVCFieldsMapping;
    function GetBackEnd: string;
    function GetConnection: TFDConnection;
    procedure InitTableInfo;
    class function ExecQuery(const SQL: string; const Values: array of Variant): TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant; const Connection: TFDConnection)
      : TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant; const ValueTypes: array of TFieldType)
      : TDataSet; overload;
    class function ExecQuery(const SQL: string; const Values: array of Variant; const ValueTypes: array of TFieldType;
      const Connection: TFDConnection): TDataSet; overload;
    procedure FillPrimaryKey(const SequenceName: string);
    function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64; overload;
    // load events
    /// <summary>
    /// Called everywhere before persist object into database
    /// </summary>
    procedure OnValidation(const EntityAction: TMVCEntityAction); virtual;

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

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

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

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

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

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

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

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

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

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

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

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

    function GenerateSelectSQL: string;

    function SQLGenerator: TMVCSQLGenerator;

    function InternalCount(const RQL: string): int64;
    function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
  public
    constructor Create(aLazyLoadConnection: Boolean); overload;
    { cannot be virtual! }
    constructor Create; overload; virtual;
    destructor Destroy; override;
    procedure EnsureConnection;
    procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
    /// <summary>
    /// Executes an Insert (pk is null) or an Update (pk is not null)
    /// </summary>
    procedure Store;
    function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
    procedure Insert;
    function GetMapping: TMVCFieldsMapping;
    function LoadByPK(const id: int64): Boolean; overload; virtual;
    function LoadByPK(const id: string): Boolean; overload; virtual;
    procedure Update;
    procedure Delete;
    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;
    procedure AddChildren(const ChildObject: TObject);
    procedure RemoveChildren(const ChildObject: TObject);
    // dynamic access
    property Attributes[const AttrName: string]: TValue read GetAttributes write SetAttributes;
    [MVCDoNotSerialize]
    property TableName: string read fTableName write SetTableName;
    [MVCDoNotSerialize]
    property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated write SetPrimaryKeyIsAutogenerated;
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
      const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
      const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
    class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
    class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant)
      : TMVCActiveRecordList; overload;
    class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant;
      const Connection: TFDConnection): TMVCActiveRecordList; overload;
    class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string; const MaxRecordCount: Integer)
      : TMVCActiveRecordList; overload;
    class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
    function SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList; overload;
    class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant)
      : TMVCActiveRecordList; overload;
    class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant;
      const Connection: TFDConnection): TMVCActiveRecordList; overload;
    class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>; overload;
    class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload;
    function Count(const RQL: string = ''): int64; overload;
    class function Count(const aClass: TMVCActiveRecordClass; const RQL: string = ''): int64; overload;
    class function SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet; overload;
    class function SelectDataSet(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType): TDataSet; overload;
    class function CurrentConnection: TFDConnection;
  end;

  TMVCActiveRecordHelper = class helper for TMVCActiveRecord
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
    class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
    class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions = [];
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string; const MaxRecordCount: Integer)
      : TObjectList<T>; overload;
    class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(const RQL: string;
      const RaiseExceptionIfNotFound: Boolean): T; overload;
    class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
    class function Count<T: TMVCActiveRecord>(const RQL: string = ''): int64; overload;
    class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string; const Params: array of Variant)
      : TObjectList<T>; overload;
    class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string; const Params: array of Variant;
      const ParamTypes: array of TFieldType): TObjectList<T>; overload;
    class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const ParamTypes: array of TFieldType;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T; overload;
    class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const ParamTypes: array of TFieldType;
      const RaiseExceptionIfNotFound: Boolean = True): T; overload;
  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;
  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;
  end;

  IMVCActiveRecordConnections = interface
    ['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
    procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false);
    procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false);
    procedure RemoveConnection(const aName: string);
    procedure RemoveDefaultConnection;
    procedure SetCurrent(const aName: string);
    function GetCurrent: TFDConnection;
    function GetCurrentBackend: string;
    procedure SetDefault;
  end;

  TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections)
  private type
    TConnHolder = class
    public
      Connection: TFDConnection;
      OwnsConnection: Boolean;
      destructor Destroy; override;
    end;

  var
    fMREW: TMultiReadExclusiveWriteSynchronizer;
    fConnectionsDict: TDictionary<string, TConnHolder>;
    fCurrentConnectionsByThread: TDictionary<TThreadID, string>;
    function GetKeyName(const aName: string): string;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false);
    procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false);
    procedure RemoveConnection(const aName: string);
    procedure RemoveDefaultConnection;
    procedure SetCurrent(const aName: string);
    function GetCurrent: TFDConnection;
    function GetByName(const aName: string): TFDConnection;
    function GetCurrentBackend: string;
    procedure SetDefault;
  end;

  TMVCSQLGenerator = class abstract
  private
    fMapping: TMVCFieldsMapping;
    fCompiler: TRQLCompiler;
    fRQL2SQL: TRQL2SQL;
  protected
    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); virtual;
    destructor Destroy; override;
    // capabilities
    function HasSequences: Boolean; virtual;
    function HasReturning: Boolean; virtual;
    // end-capabilities
    function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
      const UseArtificialLimit: Boolean = True; const UseFilterOnly: Boolean = false): string; virtual; abstract;
    function CreateSelectSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateInsertSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateUpdateSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateDeleteSQL(const TableName: string; const Map: TFieldsMap; const PKFieldName: string;
      const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateDeleteAllSQL(const TableName: string): string; virtual; abstract;
    function CreateSelectCount(const TableName: string): string; virtual; abstract;
    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;
  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;

function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;

function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;

function GetBackEndByConnection(aConnection: TFDConnection): string;

implementation

uses
  System.TypInfo,
  System.IOUtils,
  System.Classes,
  MVCFramework.DataSet.Utils,
  MVCFramework.Logger,
  MVCFramework.Nullables,
  MVCFramework.RTTI.Utils,
  FireDAC.Stan.Option,
  Data.FmtBcd, System.Variants;

var
  gCtx: TRttiContext;
  gEntitiesRegistry: IMVCEntitiesRegistry;
  gConnections: IMVCActiveRecordConnections;
  gLock: TObject;

function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
  case Ord(aConnection.RDBMSKind) of
    0:
      Exit('unknown');
    1:
      Exit('oracle');
    2:
      Exit('mssql');
    3:
      Exit('msaccess');
    4:
      Exit('mysql');
    5:
      Exit('db2');
    6:
      Exit('sqlanywhere');
    7:
      Exit('advantage');
    8:
      Exit('interbase');
    9:
      Exit('firebird');
    10:
      Exit('sqlite');
    11:
      Exit('postgresql');
    12:
      Exit('nexusdb');
    13:
      Exit('dataSnap');
    14:
      Exit('informix');
    15:
      Exit('teradata');
    16:
      Exit('mongodb');
    17:
      Exit('other');
  else
    raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
  end;
end;

function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
begin
  if gConnections = nil then // double check here
  begin
    TMonitor.Enter(gLock);
    try
      if gConnections = nil then
      begin
        gConnections := TMVCConnectionsRepository.Create;
      end;
    finally
      TMonitor.Exit(gLock);
    end;
  end;
  Result := gConnections;
end;

function IntToNullableInt(const Value: Integer): NullableInt32;
begin
  Result.SetValue(Value);
end;

{ TConnectionsRepository }

procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection;
  const aOwns: Boolean = false);
var
  lName: string;
  lConnKeyName: string;
  lConnHolder: TConnHolder;
begin
  lName := aName.ToLower;
  lConnKeyName := GetKeyName(lName);

  { If the transaction is not started, initialize TxIsolation as ReadCommitted }
  if aConnection.Transaction = nil then
  begin
    { needed for Delphi 10.4 Sydney+ }
    aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
  end;

  fMREW.BeginWrite;
  try
    lConnHolder := TConnHolder.Create;
    lConnHolder.Connection := aConnection;
    lConnHolder.OwnsConnection := aOwns;
    fConnectionsDict.Add(lConnKeyName, lConnHolder);
    // raise exception on duplicates
    if (lName = 'default') and (not fCurrentConnectionsByThread.ContainsKey(TThread.CurrentThread.ThreadID)) then
    begin
      fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
    end;
  finally
    fMREW.EndWrite;
  end;
end;

procedure TMVCConnectionsRepository.AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean);
begin
  AddConnection('default', aConnection, aOwns);
end;

constructor TMVCConnectionsRepository.Create;
begin
  inherited;
  fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
  fConnectionsDict := TDictionary<string, TConnHolder>.Create;
  fCurrentConnectionsByThread := TDictionary<TThreadID, string>.Create;
end;

destructor TMVCConnectionsRepository.Destroy;
begin
  fConnectionsDict.Free;
  fCurrentConnectionsByThread.Free;
  fMREW.Free;
  inherited;
end;

function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection;
var
  lKeyName: string;
  lConnHolder: TConnHolder;
begin
{$IF not Defined(TokyoOrBetter)}
  Result := nil;
{$ENDIF}
  lKeyName := GetKeyName(aName.ToLower);
  fMREW.BeginRead;
  try
    if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
      raise Exception.CreateFmt('Unknown connection %s', [aName]);
    Result := lConnHolder.Connection;
  finally
    fMREW.EndRead;
  end;
end;

function TMVCConnectionsRepository.GetCurrent: 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
      raise EMVCActiveRecord.Create('No current connection for thread');
    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);
var
  lName: string;
  lKeyName: string;
  lConnHolder: TConnHolder;
begin
  lName := aName.ToLower;
  lKeyName := GetKeyName(lName);

  fMREW.BeginWrite;
  try
    if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
      raise Exception.CreateFmt('Unknown connection %s', [aName]);
    fConnectionsDict.Remove(lKeyName);
    try
      FreeAndNil(lConnHolder);
    except
      on E: Exception do
      begin
        LogE('ActiveRecord: ' + E.ClassName + ' > ' + E.Message);
        raise;
      end;
    end;
  finally
    fMREW.EndWrite;
  end;
end;

procedure TMVCConnectionsRepository.RemoveDefaultConnection;
begin
  RemoveConnection('default');
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
  inherited Create;
  name := aName;
end;

{ TActiveRecord }

destructor TMVCActiveRecord.Destroy;
begin
  fChildren.Free;
  fMap.Free;
  fSQLGenerator.Free;
  fRQL2SQL.Free;
  fConn := nil; // do not free it!!
  inherited;
end;

procedure TMVCActiveRecord.EnsureConnection;
begin
  GetConnection;
end;

function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
var
  lQry: TFDQuery;
  lPar: TFDParam;
  lPair: TPair<TRTTIField, TFieldInfo>;
  lValue: TValue;
  lSQL: string;
  lHandled: Boolean;
begin
  lQry := TFDQuery.Create(nil);
  try
    lQry.Connection := GetConnection;
    lSQL := SQL;
    OnBeforeExecuteSQL(lSQL);
    lQry.SQL.Text := lSQL;

    lHandled := false;
    // lQry.Prepare;
    MapObjectToParams(lQry.Params, lHandled);
    if not lHandled then
    begin
      for lPair in fMap do
      begin
        lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
        if lPar <> nil then
        begin
          lValue := lPair.Key.GetValue(Self);
          lPar.DataTypeName := fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
          // if fMapFieldDataTypes.TryGetValue(lPar.Name, lDataType) then
          // begin
          // lPar.DataTypeName := lDataType;
          // end;
          MapTValueToParam(lValue, lPar);
        end
      end;

      // check if it's the primary key
      lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(fPrimaryKeyFieldName));
      if lPar <> nil then
      begin
        if lPar.DataType = ftUnknown then
        begin
          { TODO -oDanieleT -cGeneral : Let's find a smarter way to do this if the engine cannot recognize parameter's datatype }
          lPar.DataType := GetPrimaryKeyFieldType;
        end;
        MapTValueToParam(fPrimaryKey.GetValue(Self), lPar);
      end;
    end;

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

      if (lValue.Kind = tkRecord) then
      begin
        MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fPrimaryKey, Self);
      end
      else
      begin
        lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger;
        fPrimaryKey.SetValue(Self, lValue);
      end;
    end
    else
    begin
      lQry.ExecSQL(lSQL);
    end;
    Result := lQry.RowsAffected;
  finally
    lQry.Free;
  end;
end;

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

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

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

procedure TMVCActiveRecord.InitTableInfo;
var
  lAttribute: TCustomAttribute;
  lRTTIField: TRTTIField;
  lFieldInfo: TFieldInfo;
  lPrimaryFieldTypeAsStr: string;
begin
  fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate,
    TMVCEntityAction.eaDelete];
  fTableName := '';
  fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
  fObjAttributes := fRTTIType.GetAttributes;
  for lAttribute in fObjAttributes do
  begin
    if lAttribute is MVCTableAttribute then
    begin
      fTableName := MVCTableAttribute(lAttribute).Name;
      continue;
    end;
    if lAttribute is MVCEntityActionsAttribute then
    begin
      fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
    end;
  end;

  if fTableName = '' then
  begin
    if [eaCreate, eaUpdate, eaDelete] * fEntityAllowedActions <> [] then
    begin
      raise Exception.Create('Cannot find TableNameAttribute');
    end;
  end;

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

        lFieldInfo := TFieldInfo.Create;
        // lFieldInfo.TableName := fTableName;
        lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
        lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
        lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;

        fMap.Add(lRTTIField, lFieldInfo);

        // if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then
        // begin
        // lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
        // fMapNonTransientFields.Add(lRTTIField, lFieldInfo);
        // end;
        //
        // if not MVCTableFieldAttribute(lAttribute).DataTypeName.IsEmpty then
        // begin
        // fMapFieldDataTypes.Add(MVCTableFieldAttribute(lAttribute).FieldName.ToUpper,
        // MVCTableFieldAttribute(lAttribute).DataTypeName);
        // end;

      end;
    end;
  end;
  fMap.EndUpdates;
end;

procedure TMVCActiveRecord.Insert;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaCreate);
  OnValidation(TMVCEntityAction.eaCreate);
  OnBeforeInsert;
  OnBeforeInsertOrUpdate;
  if fMap.WritableFieldsCount = 0 then
  begin
    raise EMVCActiveRecord.CreateFmt
      ('Cannot insert an entity if all fields are not writable or transient. Class [%s] mapped on table [%s]',
      [ClassName, fTableName]);
  end;
  if (foAutoGenerated in fPrimaryKeyOptions) then
  begin
    if not SQLGenerator.HasReturning then
    begin
      if not SQLGenerator.HasSequences then
      begin
        raise EMVCActiveRecord.Create
          ('Cannot use AutoGenerated primary keys if the engine doesn''t support returning clause nor sequences');
      end
      else
      begin
        if fPrimaryKeySequenceName.IsEmpty then
        begin
          raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' + GetBackEnd +
            ' requires it');
        end;
        FillPrimaryKey(fPrimaryKeySequenceName);
      end;
    end;
  end;

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

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

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

constructor TMVCActiveRecord.Create(aLazyLoadConnection: Boolean);
begin
  inherited Create;
  fConn := nil;
  SetLength(fMapping, 0);
  { TODO -oDanieleT -cGeneral : Consider lazyconnection }
  if not aLazyLoadConnection then
  begin
    GetConnection;
  end;
  fMap := TFieldsMap.Create;
  // fMapNonTransientFields := TFieldsMap.Create;
  // fMapFieldDataTypes := TDictionary<string, string>.Create;
  InitTableInfo;
end;

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

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

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

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

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

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

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

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

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

class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
var
  lList: TObjectList<T>;
begin
  lList := Where<T>(SQLWhere, Params, ParamTypes);
  try
    if lList.Count = 0 then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecordNotFound.Create('Got 0 rows when at least 1 was expected');
      Exit(nil);
    end;
    Result := lList.Extract(lList.First);
  finally
    lList.Free;
  end;
end;

class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := GetFirstByWhere<T>(SQLWhere, Params, [], RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := GetFirstByWhere<T>(SQLWhere, Params, ParamTypes, false);
  if Result = nil then
  begin
    if RaiseExceptionIfNotFound then
      raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
  end;
end;

function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
var
  lPair: TPair<TRTTIField, TFieldInfo>;
  i: Integer;
begin
  { TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
  if Length(fMapping) = 0 then
  begin
    if not fPrimaryKeyFieldName.IsEmpty then
    begin
      SetLength(fMapping, fMap.Count + 1);
      fMapping[0].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
      fMapping[0].DatabaseFieldName := fPrimaryKeyFieldName;
      i := 1;
    end
    else
    begin
      SetLength(fMapping, fMap.Count);
      i := 0;
    end;

    for lPair in fMap do
    begin
      fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
      fMapping[i].DatabaseFieldName := lPair.Value.FieldName;
      Inc(i);
    end;
  end;
  Result := fMapping;
end;

class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := GetFirstByWhere<T>(SQLWhere, Params, false);
  if Result = nil then
  begin
    if RaiseExceptionIfNotFound then
      raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
  end;
end;

class function TMVCActiveRecordHelper.SelectOneByRQL<T>(const RQL: string; const RaiseExceptionIfNotFound: Boolean): T;
var
  lAR: TMVCActiveRecord;
  lSQL: string;
begin
  lAR := T.Create;
  try
    lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim;
    if lSQL.StartsWith('where', True) then
      lSQL := lSQL.Remove(0, 5).Trim;
    Result := GetFirstByWhere<T>(lSQL, [], RaiseExceptionIfNotFound);
    if Result = nil then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
    end;
  finally
    lAR.Free;
  end;
end;

function TMVCActiveRecord.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.GetPrimaryKeyFieldType: TFieldType;
begin
  Result := fPrimaryKeyFieldType;
end;

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

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

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

class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    // Up to 10.1 Berlin, here the compiler try to call the Count<T> introduced by the class helper
    // Instead of the Count() which exists in "TMVCActiveRecord"
    Result := lAR.InternalCount(RQL);
  finally
    lAR.Free;
  end;
end;

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

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

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

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

constructor TMVCActiveRecord.Create;
begin
  Create(True);
end;

procedure TMVCActiveRecord.Delete;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaDelete);
  OnValidation(TMVCEntityAction.eaDelete);
  OnBeforeDelete;
  if not Assigned(fPrimaryKey) then
    raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
  SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
  ExecNonQuery(SQL, false);
  OnAfterDelete;
end;

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

class function TMVCActiveRecord.DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create(True);
  try
    Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableName) +
      lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, false));
  finally
    lAR.Free;
  end;
end;

procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
  var Handled: Boolean);
begin
  // do nothing
end;

procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams; var Handled: Boolean);
begin
  // do nothing
end;

function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
begin
  Assert(aValue.Kind = tkRecord);
  Result := false;
  if aValue.IsType(TypeInfo(NullableString)) then
  begin
    if not aValue.AsType<NullableString>().HasValue then
    begin
      aParam.DataType := ftString;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableString>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableInt32)) then
  begin
    if not aValue.AsType<NullableInt32>().HasValue then
    begin
      aParam.DataType := ftInteger;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableInt32>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableTDate)) then
  begin
    if not aValue.AsType<NullableTDate>().HasValue then
    begin
      aParam.DataType := ftDate;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := TValue.From<TDate>(aValue.AsType<NullableTDate>().Value);
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableTTime)) then
  begin
    if not aValue.AsType<NullableTTime>().HasValue then
    begin
      aParam.DataType := ftTime;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := TValue.From<TTime>(aValue.AsType<NullableTTime>().Value);
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableTDateTime)) then
  begin
    if not aValue.AsType<NullableTDateTime>().HasValue then
    begin
      aParam.DataType := ftDateTime;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := TValue.From<TDateTime>(aValue.AsType<NullableTDateTime>().Value);
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableUInt32)) then
  begin
    if not aValue.AsType<NullableUInt32>().HasValue then
    begin
      aParam.DataType := ftInteger;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableUInt32>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableInt64)) then
  begin
    if not aValue.AsType<NullableInt64>().HasValue then
    begin
      aParam.DataType := ftLargeInt;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableInt64>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableInt16)) then
  begin
    if not aValue.AsType<NullableInt16>().HasValue then
    begin
      aParam.DataType := ftInteger;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableInt16>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableUInt64)) then
  begin
    if not aValue.AsType<NullableUInt64>().HasValue then
    begin
      aParam.DataType := ftLargeInt;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableUInt64>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableUInt16)) then
  begin
    if not aValue.AsType<NullableUInt16>().HasValue then
    begin
      aParam.DataType := ftInteger;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableUInt16>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableBoolean)) then
  begin
    if not aValue.AsType<NullableBoolean>().HasValue then
    begin
      aParam.DataType := ftBoolean;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := TValue.From<Boolean>(aValue.AsType<NullableBoolean>().Value);
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableSingle)) then
  begin
    if not aValue.AsType<NullableSingle>().HasValue then
    begin
      aParam.DataType := TFieldType.ftSingle;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableSingle>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableDouble)) then
  begin
    if not aValue.AsType<NullableDouble>().HasValue then
    begin
      aParam.DataType := TFieldType.ftFloat;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableDouble>().Value;
      Result := True;
    end;
  end
  else if aValue.IsType(TypeInfo(NullableCurrency)) then
  begin
    if not aValue.AsType<NullableCurrency>().HasValue then
    begin
      aParam.DataType := TFieldType.ftCurrency;
      aParam.Clear;
      Exit(True);
    end
    else
    begin
      aValue := aValue.AsType<NullableCurrency>().Value;
      Result := True;
    end;
  end;
  if Result then
  begin
    MapTValueToParam(aValue, aParam);
  end;
end;

procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
var
  lStream: TStream;
  lName: string;
begin
{$IFDEF NEXTGEN}
  lName := aValue.TypeInfo.NameFld.ToString;
{$ELSE}
  lName := string(aValue.TypeInfo.Name);
{$ENDIF}
  if (aValue.TypeInfo.Kind = tkRecord) then
  begin
    if MapNullableTValueToParam(aValue, aParam) then
    begin
      Exit;
    end;
  end;

  case aValue.TypeInfo.Kind of
    tkString, tkUString:
      begin
        case aParam.DataType of
          ftUnknown, ftString, ftWideString:
            begin
              aParam.AsString := aValue.AsString;
            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, tkUString) [%s]', [lName]);
          end;
        end;
      end;
{$IF Defined(SeattleOrBetter)}
    tkWideString:
      begin
        aParam.AsWideString := aValue.AsString;
      end;
{$ENDIF}
    tkInt64:
      begin
        aParam.AsLargeInt := aValue.AsInt64;
      end;
    tkInteger:
      begin
        aParam.AsInteger := aValue.AsInteger;
      end;
    tkEnumeration:
      begin
        if aValue.TypeInfo = TypeInfo(System.Boolean) then
        begin
          aParam.AsBoolean := aValue.AsBoolean;
        end
        else
        begin
          aParam.AsInteger := Ord(aValue.AsInteger);
        end;
      end;
    tkFloat:
      begin
        if lName = 'TDate' then
        begin
          aParam.AsDate := Trunc(aValue.AsExtended);
        end
        else if lName = 'TDateTime' then
        begin
          aParam.AsDateTime := aValue.AsExtended;
        end
        else if lName = 'TTime' then
        begin
          aParam.AsTime := aValue.AsExtended;
        end
        else if lName = 'Currency' then
        begin
          aParam.AsCurrency := aValue.AsCurrency;
        end
        else
        begin
          aParam.AsFloat := aValue.AsExtended;
        end;
      end;
    tkClass:
      begin
        if (aValue.AsObject <> nil) and (not aValue.IsInstanceOf(TStream)) then
          raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s',
            [aParam.Name, aValue.AsObject.ClassName]);
{$IF Defined(SeattleOrBetter)}
        lStream := aValue.AsType<TStream>();
{$ELSE}
        lStream := aValue.AsType<TStream>();
{$ENDIF}
        if Assigned(lStream) then
        begin
          lStream.Position := 0;
          aParam.LoadFromStream(lStream, ftBlob);
        end
        else
        begin
          aParam.DataType := TFieldType.ftBlob;
          aParam.Clear;
        end;
      end;
    tkRecord:
      begin
        if aValue.IsType(TypeInfo(TGUID)) then
        begin
          aParam.AsGuid := aValue.AsType<TGUID>;
        end
        else
        begin
          raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
            [Ord(aValue.TypeInfo.Kind), aParam.Name]);
        end;
      end;
  else
    raise Exception.CreateFmt('Unsupported TypeKind (%d) for param %s', [Ord(aValue.TypeInfo.Kind), aParam.Name]);
  end;

  // case aParam.DataType of
  // ftUnknown:
  // begin
  // { aParam.DataType could be pkUndefined for some RDBMS (es. MySQL), so we rely on Variant }
  // if (aValue.TypeInfo.Kind = tkClass) then
  // begin
  // if not aValue.IsInstanceOf(TStream) then
  // raise EMVCActiveRecord.CreateFmt('Unsupported type for param %s', [aParam.Name]);
  // lStream := aValue.AsType<TStream>(false);
  // if Assigned(lStream) then
  // begin
  // lStream.Position := 0;
  // aParam.LoadFromStream(lStream, ftBlob);
  // end
  // else
  // begin
  // aParam.Clear;
  // end;
  //
  // end
  // else
  // begin
  // aParam.value := aValue.AsVariant;
  // end;
  // end;
  // ftString:
  // begin
  // aParam.AsString := aValue.AsString;
  // end;
  // ftWideString:
  // begin
  // aParam.AsWideString := aValue.AsString;
  // end;
  // ftLargeint:
  // begin
  // aParam.AsLargeInt := aValue.AsInt64;
  // end;
  // ftSmallint:
  // begin
  // aParam.AsSmallInt := aValue.AsInteger;
  // end;
  // ftInteger:
  // begin
  // aParam.AsInteger := aValue.AsInteger;
  // end;
  // ftLongWord:
  // begin
  // aParam.AsLongWord := aValue.AsInteger;
  // end;
  // ftWord:
  // begin
  // aParam.AsWord := aValue.AsInteger;
  // end;
  // ftDate:
  // begin
  // aParam.AsDate := Trunc(aValue.AsExtended);
  // end;
  // ftDateTime:
  // begin
  // aParam.AsDateTime := aValue.AsExtended;
  // end;
  // ftBoolean:
  // begin
  // aParam.AsBoolean := aValue.AsBoolean;
  // end;
  // ftMemo:
  // begin
  // aParam.AsMemo := AnsiString(aValue.AsString);
  // end;
  // ftWideMemo:
  // begin
  // aParam.AsWideMemo := aValue.AsString;
  // end;
  // ftBCD:
  // begin
  // aParam.AsBCD := aValue.AsCurrency;
  // end;
  // ftBlob:
  // begin
  // lStream := aValue.AsType<TStream>(false);
  // if Assigned(lStream) then
  // begin
  // lStream.Position := 0;
  // aParam.LoadFromStream(lStream, ftBlob);
  // end
  // else
  // begin
  // aParam.Clear;
  // end;
  // end;
  // else
  // raise Exception.CreateFmt('Unsupported FieldType (%d) for param %s', [Ord(aParam.DataType), aParam.Name]);
  // end;
end;

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

  lHandled := false;
  MapDatasetToObject(aDataSet, aOptions, lHandled);
  if not lHandled then
  begin
    for lItem in fMap do
    begin
      if not lItem.Value.Readable then
      begin
        continue;
      end;
      lField := aDataSet.FindField(lItem.Value.FieldName);
      if lField = nil then
      begin
        if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then
          continue
        else
          raise EMVCActiveRecord.CreateFmt
            ('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields',
            [lItem.Value.FieldName]);
      end;
      MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
    end;
    if not fPrimaryKeyFieldName.IsEmpty then
    begin
      MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey, Self);
    end;
  end;
  OnAfterLoad;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

procedure TMVCActiveRecord.RemoveChildren(const ChildObject: TObject);
begin
  if fChildren <> nil then
  begin
    fChildren.Extract(ChildObject);
  end;
end;

procedure TMVCActiveRecord.InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
begin
  FreeAndNil(fConn);
  if ReacquireAfterInvalidate then
  begin
    EnsureConnection;
  end;
end;

class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
  const Params: array of Variant): TMVCActiveRecordList;
begin
  Result := Select(aClass, SQL, Params, nil);
end;

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

end;

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

class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
  const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
begin
  Result := Select<T>(SQL, Params, [], Options);
end;

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

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

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

class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
  const RaiseExceptionIfNotFound: Boolean): T;
begin
  Result := SelectOne<T>(SQL, Params, [], [], RaiseExceptionIfNotFound);
end;

class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType; const Options: TMVCActiveRecordLoadOptions;
  const RaiseExceptionIfNotFound: Boolean): T;
var
  lDataSet: TDataSet;
  lAR: TMVCActiveRecord;
  lHandled: Boolean;
  lList: TObjectList<T>;
begin
  Result := nil;
  lList := Select<T>(SQL, Params, ParamTypes, Options);
  try
    if (lList.Count = 0) then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected')
      else
        Exit(nil);
    end;
    if lList.Count > 1 then
    begin
      raise EMVCActiveRecordNotFound.CreateFmt('Got %d rows when exactly 1 was expected', [lList.Count]);
    end;
    Result := lList.Extract(lList.First);
  finally
    lList.Free;
  end;
end;

class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string; const MaxRecordCount: Integer): TObjectList<T>;
var
  lAR: TMVCActiveRecord;
  lSQL: string;
begin
  lAR := T.Create;
  try
    lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim;
    // LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
    if lSQL.StartsWith('where', True) then
      lSQL := lSQL.Remove(0, 5).Trim;
    Result := Where<T>(lSQL, []);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant;
  const ParamTypes: array of TFieldType): TObjectList<T>;
var
  lAR: TMVCActiveRecord;
begin
  lAR := T.Create;
  try
    if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
    begin
      Result := Select<T>(lAR.GenerateSelectSQL + SQLWhere, Params, ParamTypes);
    end
    else
    begin
      Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes);
    end;
  finally
    lAR.Free;
  end;
end;

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

procedure TMVCActiveRecord.SetAttributes(const AttrName: string; const Value: TValue);
var
  lProperty: TRttiProperty;
begin
  if not TRttiUtils.ExistsProperty(Self, AttrName, lProperty) then
  begin
    raise EMVCActiveRecord.CreateFmt('Attribute [%s] not found', [AttrName]);
  end;
  SetPropertyValue(lProperty, Value);
end;

procedure TMVCActiveRecord.SetPropertyValue(const aProp: TRttiProperty; const aValue: TValue);
var
  lCurrValue: TValue;
  lNullableString: NullableString;
  lNullableUInt32: NullableUInt32;
  lNullableUInt64: NullableUInt64;
  lNullableInt64: NullableInt64;
  lNullableBoolean: NullableBoolean;
  lNullableTDateTime: NullableTDateTime;
  lNullableTDate: NullableTDate;
  lNullableTTime: NullableTTime;
begin
  if aProp.GetValue(Self).Kind = tkRecord then
  begin
    lCurrValue := aProp.GetValue(Self);
    if lCurrValue.IsType<NullableInt32> then
    begin
      if aValue.IsType<NullableInt32>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lCurrValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
      end
    end
    else if lCurrValue.IsType<NullableInt64> then
    begin
      if aValue.IsType<NullableInt64>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableInt64 := aValue.AsInt64;
        lCurrValue := TValue.From<NullableInt64>(lNullableInt64);
      end;
    end
    else if lCurrValue.IsType<NullableString> then
    begin
      if aValue.IsType<NullableString>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableString := aValue.AsString;
        lCurrValue := TValue.From<NullableString>(lNullableString);
      end;
    end
    else if lCurrValue.IsType<NullableUInt32> then
    begin
      if aValue.IsType<NullableUInt32>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableUInt32 := aValue.AsInteger;
        lCurrValue.From<NullableUInt32>(lNullableUInt32);
      end;
    end
    else if lCurrValue.IsType<NullableUInt64> then
    begin
      if aValue.IsType<NullableUInt64>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableUInt64 := aValue.AsUInt64;
        lCurrValue.From<NullableUInt64>(lNullableUInt64);
      end;
    end
    else if lCurrValue.IsType<NullableBoolean> then
    begin
      if aValue.IsType<NullableBoolean>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableBoolean := aValue.AsBoolean;
        lCurrValue.From<NullableBoolean>(lNullableBoolean);
      end;
    end
    else if lCurrValue.IsType<NullableTDateTime> then
    begin
      if aValue.IsType<NullableTDateTime>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableTDateTime := TDateTime(aValue.AsExtended);
        lCurrValue.From<NullableTDateTime>(lNullableTDateTime);
      end;
    end
    else if lCurrValue.IsType<NullableTDate> then
    begin
      if aValue.IsType<NullableTDate>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableTDate := TDate(aValue.AsExtended);
        lCurrValue.From<NullableTDate>(lNullableTDate);
      end;
    end
    else if lCurrValue.IsType<NullableTTime> then
    begin
      if aValue.IsType<NullableTTime>() then
      begin
        lCurrValue := aValue;
      end
      else
      begin
        lNullableTTime := TTime(aValue.AsExtended);
        lCurrValue.From<NullableTTime>(lNullableTTime);
      end;
    end
    else
    begin
      raise EMVCActiveRecord.Create('Invalid data type for dynamic property access');
    end;
    aProp.SetValue(Self, lCurrValue);
  end
  else
  begin
    aProp.SetValue(Self, aValue)
  end;
end;

procedure TMVCActiveRecord.SetPK(const aValue: TValue);
var
  lPKValue: TValue;
begin
  if fPrimaryKeyFieldName.IsEmpty then
  begin
    raise Exception.Create('No primary key defined');
  end;

  if fPrimaryKey.GetValue(Self).Kind = tkRecord then
  begin
    lPKValue := fPrimaryKey.GetValue(Self);
    if lPKValue.IsType<NullableInt32> and aValue.IsType<NullableInt32>() then
    begin
      if aValue.IsType<UInt32> then
      begin
        lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
      end;
    end
    else if lPKValue.IsType<NullableInt64> and aValue.IsType<NullableInt64>() then
    begin
      if aValue.AsType<NullableInt64>().HasValue then
      begin
        lPKValue := aValue;
      end
      else
      begin
        lPKValue.AsType<NullableInt64>().Clear;
      end;
    end
    else if lPKValue.IsType<NullableString> and aValue.IsType<NullableString>() then
    begin
      if aValue.AsType<NullableString>().HasValue then
      begin
        lPKValue := aValue;
      end
      else
      begin
        lPKValue.AsType<NullableString>().Clear;
      end;
    end
    else if lPKValue.IsType<NullableUInt32> and aValue.IsType<NullableUInt32>() then
    begin
      if aValue.AsType<NullableUInt32>().HasValue then
      begin
        lPKValue := aValue;
      end
      else
      begin
        lPKValue.AsType<NullableUInt32>().Clear;
      end;
    end
    else if lPKValue.IsType<NullableUInt64> and aValue.IsType<NullableUInt64>() then
    begin
      if aValue.AsType<NullableUInt64>().HasValue then
      begin
        lPKValue := aValue;
      end
      else
      begin
        lPKValue.AsType<NullableUInt64>().Clear;
      end;
    end
    else
    begin
      raise EMVCActiveRecord.Create
        ('Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)');
    end;
    fPrimaryKey.SetValue(Self, lPKValue);
  end
  else
  begin
    fPrimaryKey.SetValue(Self, aValue)
  end;
end;

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

procedure TMVCActiveRecord.SetTableName(const Value: string);
begin
  fTableName := Value;
end;

function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
begin
  if not Assigned(fSQLGenerator) then
  begin
    GetConnection.Connected := True;
    fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd).Create(GetMapping);
  end;
  Result := fSQLGenerator;
end;

procedure TMVCActiveRecord.Store;
var
  lValue: TValue;
  lRes: Boolean;
  lIsNullableType: Boolean;
begin
  lRes := TryGetPKValue(lValue, lIsNullableType);
  if not lIsNullableType then
  begin
    raise EMVCActiveRecord.Create('Store can be used only with nullable PKs [HINT] Use NullableInt64 as PK');
  end;
  if lRes then
  begin
    Update;
  end
  else
  begin
    Insert;
  end;
end;

function TMVCActiveRecord.TableInfo: string;
var
  keyvalue: TPair<TRTTIField, TFieldInfo>;
begin
  Result := 'Table Name: ' + fTableName;
  for keyvalue in fMap do
    Result := Result + sLineBreak + #9 + keyvalue.Key.Name + ' = ' + keyvalue.Value.FieldName;
end;

function TMVCActiveRecord.TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
begin
  IsNullableType := false;
  if fPrimaryKeyFieldName.IsEmpty then
    raise Exception.Create('No primary key defined');
  Value := fPrimaryKey.GetValue(Self);
  if Value.Kind = tkRecord then
  begin
    if Value.IsType<NullableInt32>() then
    begin
      Result := Value.AsType<NullableInt32>().HasValue;
      if Result then
        Value := Value.AsType<NullableInt32>().Value;
    end
    else if Value.IsType<NullableInt64>() then
    begin
      Result := Value.AsType<NullableInt64>().HasValue;
      if Result then
        Value := Value.AsType<NullableInt64>().Value;
    end
    else if Value.IsType<NullableUInt32>() then
    begin
      Result := Value.AsType<NullableUInt32>().HasValue;
      if Result then
        Value := Value.AsType<NullableUInt32>().Value;
    end
    else if Value.IsType<NullableUInt64>() then
    begin
      Result := Value.AsType<NullableUInt64>().HasValue;
      if Result then
        Value := Value.AsType<NullableUInt64>().Value;
    end
    else if Value.IsType<NullableInt16>() then
    begin
      Result := Value.AsType<NullableInt16>().HasValue;
      if Result then
        Value := Value.AsType<NullableInt16>().Value;
    end
    else if Value.IsType<NullableUInt16>() then
    begin
      Result := Value.AsType<NullableUInt16>().HasValue;
      if Result then
        Value := Value.AsType<NullableUInt16>().Value;
    end
    else if Value.IsType<NullableString>() then
    begin
      Result := Value.AsType<NullableString>().HasValue;
      if Result then
        Value := Value.AsType<NullableString>().Value;
    end
    else
      raise EMVCActiveRecord.Create
        ('Invalid primary key type [HINT: Use Int64, String, NullableInt64 or NullableString, so that Store method is available too.]');
    IsNullableType := True;
  end
  else
  begin
    Result := not Value.IsEmpty;
  end;
end;

procedure TMVCActiveRecord.Update;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaUpdate);
  OnValidation(TMVCEntityAction.eaUpdate);
  OnBeforeUpdate;
  OnBeforeInsertOrUpdate;
  if fMap.WritableFieldsCount = 0 then
  begin
    raise EMVCActiveRecord.CreateFmt
      ('Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]', [ClassName, fTableName]);
  end;
  SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
  ExecNonQuery(SQL, false);
  OnAfterUpdate;
  OnAfterInsertOrUpdate;
end;

procedure TMVCActiveRecord.AddChildren(const ChildObject: TObject);
begin
  if fChildren = nil then
  begin
    fChildren := TObjectList<TObject>.Create(True);
  end;
  if not(fChildren.Contains(ChildObject)) and (not(ChildObject = Self)) then
  begin
    fChildren.Add(ChildObject);
  end;
end;

class function TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := Select(aClass, lAR.GenerateSelectSQL, []);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.All<T>: TObjectList<T>;
var
  lAR: TMVCActiveRecord;
begin
  lAR := T.Create;
  try
    Result := Select<T>(lAR.GenerateSelectSQL, []);
  finally
    lAR.Free;
  end;
end;

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

class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
  const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create;
  try
    Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
  finally
    lAR.Free;
  end;
end;

class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant): TObjectList<T>;
begin
  Result := Where<T>(SQLWhere, Params, []);
end;
{ PrimaryKeyAttribute }

// constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string);
// begin
// Create(aFieldName, []);
// end;
//
// constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions);
// begin
// inherited Create;
// FieldName := aFieldName;
// FieldOptions := aFieldOptions;
// 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;

{ 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);
begin
  inherited Create;
  fMapping := Mapping;
  GetCompiler;
end;

function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
begin
  Result := fMapping;
end;

function TMVCSQLGenerator.GetParamNameForSQL(const FieldName: string): string;
begin
  Result := fCompiler.GetParamNameForSQL(FieldName);
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.GetFieldNameForSQL(const FieldName: string): string;
begin
  Result := fCompiler.GetFieldNameForSQL(FieldName);
end;

function TMVCSQLGenerator.GetRQLParser: TRQL2SQL;
begin
  if fRQL2SQL = nil then
  begin
    fRQL2SQL := TRQL2SQL.Create; // (20);
  end;
  Result := fRQL2SQL;
end;

function TMVCSQLGenerator.GetSequenceValueSQL(const PKFieldName: string; const SequenceName: string;
  const Step: Integer = 1): string;
begin
  Result := '';
end;

function TMVCSQLGenerator.GetTableNameForSQL(const TableName: string): string;
begin
  Result := fCompiler.GetTableNameForSQL(TableName);
end;

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

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

function TMVCSQLGenerator.TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string;
  const Delimiter: string): string;
var
  lPair: TPair<TRTTIField, TFieldInfo>;
begin
  for lPair in Map do
  begin
    // if not lPair.Value.FieldName.IsEmpty then
    if lPair.Value.Readable then
    begin
      Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + Delimiter;
    end;
  end;
  Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
  if not PKFieldName.IsEmpty then
  begin
    if not Result.IsEmpty then
    begin
      Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result
    end
    else
    begin
      Result := GetFieldNameForSQL(PKFieldName)
    end;
  end;
end;

{ TMVCConnectionsRepository.TConnHolder }

destructor TMVCConnectionsRepository.TConnHolder.Destroy;
begin
  if OwnsConnection then
  begin
    if Connection.Connected then
      Connection.Connected := false;
    FreeAndNil(Connection);
  end;
  inherited;
end;

constructor MVCTableFieldAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
  const aSequenceName: string; const aDataTypeName: string);
begin
  inherited Create;
  FieldName := aFieldName;
  FieldOptions := aFieldOptions;
  SequenceName := aSequenceName;
  DataTypeName := aDataTypeName;
end;

{ EMVCActiveRecordNotFound }

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

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

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

{ TFieldsMap }

constructor TFieldsMap.Create;
begin
  inherited Create([doOwnsValues]);
  fWritableFieldsCount := -1;
  fReadableFieldsCount := -1;
end;

procedure TFieldsMap.EndUpdates;
var
  lPair: TPair<TRTTIField, TFieldInfo>;
begin
  fWritableFieldsCount := 0;
  fReadableFieldsCount := 0;
  for lPair in Self do
  begin
    lPair.Value.EndUpdates;
    // if not(foTransient in lPair.Value.FieldOptions) then
    if lPair.Value.Writeable then
    begin
      Inc(fWritableFieldsCount);
    end;
    if lPair.Value.Readable then
    begin
      Inc(fReadableFieldsCount);
    end;
  end;
end;

function TFieldsMap.GetInfoByFieldName(const FieldName: string): TFieldInfo;
var
  lPair: TPair<TRTTIField, TFieldInfo>;
begin
  for lPair in Self do
  begin
    if SameText(FieldName, lPair.Value.FieldName) then
    begin
      Result := Items[lPair.Key];
      Exit;
    end;
  end;
  raise EMVCActiveRecord.CreateFmt('FieldName not found in table [%s]', [FieldName]);
end;

{ TFieldInfo }

procedure TFieldInfo.EndUpdates;
begin
  if FieldName.IsEmpty then
  begin
    Writeable := false;
    Readable := false;
  end
  else
  begin
    // Writeable := (not (foReadOnly in FieldOptions)) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
    Writeable := ((FieldOptions * [foReadOnly, foTransient, foAutoGenerated]) = []);
    // Readable := (not (foWriteOnly in FieldOptions)) and (not(foTransient in FieldOptions));
    Readable := (FieldOptions * [foWriteOnly, foTransient]) = [];
  end;
end;

initialization

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

finalization

gCtx.Free;
gLock.Free;

end.