delphimvcframework/sources/MVCFramework.ActiveRecord.pas

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2019 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;

interface

uses
  System.Generics.Defaults,
  System.Generics.Collections,
  System.RTTI,

  FireDAC.DApt,

  Data.DB,
  MVCFramework.Commons,
  MVCFramework.RQL.Parser,

  MVCFramework,
  MVCFramework.Serializer.Intf,
  FireDAC.Comp.Client,
  FireDAC.Stan.Param,
  System.SysUtils;

type
  EMVCActiveRecord = class(EMVCException)
  public
    constructor Create(const AMsg: string); reintroduce; { do not override!! }
  end;

  TMVCActiveRecordClass = class of TMVCActiveRecord;
  TMVCActiveRecordFieldOption = (foAutoGenerated);
  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;

  MVCActiveRecordCustomAttribute = class(TCustomAttribute)

  end;

  MVCTableAttribute = class(MVCActiveRecordCustomAttribute)
  public
    Name: string;
    constructor Create(aName: string);
  end;

  MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
  public
    FieldName: string;
    constructor Create(aFieldName: string);
  end;

  MVCPrimaryKeyAttribute = class(MVCActiveRecordCustomAttribute)
  public
    FieldName: string;
    FieldOptions: TMVCActiveRecordFieldOptions;
    constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions); overload;
    constructor Create(const aFieldName: string); overload;
  end;

  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
    fConn: TFDConnection;
    fSQLGenerator: TMVCSQLGenerator;
    fPrimaryKeyFieldName: string;
    fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
    fEntityAllowedActions: TMVCEntityActions;
    fRQL2SQL: TRQL2SQL;
    procedure MapColumnToTValue(const aFieldName: string; const aField: TField; const aRTTIField: TRttiField);
    procedure MapTValueToParam(const aValue: TValue; const aParam: TFDParam);
  protected
    fRTTIType: TRttiType;
    fProps: TArray<TRttiField>;
    fObjAttributes: TArray<TCustomAttribute>;
    fPropsAttributes: TArray<TCustomAttribute>;
    fTableName: string;
    fMap: TDictionary<TRttiField, string>;
    fPrimaryKey: TRttiField;
    fBackendDriver: string;
    fMapping: TMVCFieldsMapping;
    function GetBackEnd: string;
    function SelfConnection: 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 ExecNonQuery(const SQL: string; const Values: array of Variant): int64; overload;
    // class function ExecNonQuery(const SQL: string; const Values: array of Variant; const Connection: TFDConnection): int64; overload;

    function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64; overload;
    // load events
    /// <summary>
    /// Called everywhere before persist object into database
    /// </summary>
    procedure OnValidation; 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 after insert or update the object to the database
    /// </summary>
    procedure OnAfterInsertOrUpdate; virtual;

    function GenerateSelectSQL: string;

    function SQLGenerator: TMVCSQLGenerator;
  public
    constructor Create(aLazyLoadConnection: Boolean); overload;
    { cannot be virtual! }
    constructor Create; overload; virtual;
    destructor Destroy; override;
    function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
    procedure Insert;
    function GetMapping: TMVCFieldsMapping;
    function LoadByPK(id: int64): Boolean; virtual;
    procedure Update;
    procedure Delete;
    function TableInfo: string;
    procedure LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions = []);
    procedure SetPK(const aValue: TValue);
    function GetPK: TValue;
    class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64): T; overload;
    class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord; overload;
    class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
    class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
      const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; 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 SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string; const MaxRecordCount: Integer)
      : TMVCActiveRecordList; overload;
    class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string; const MaxRecordCount: Integer)
      : TObjectList<T>; overload;
    function SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList; overload;
    class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string; const Params: array of Variant)
      : TObjectList<T>; overload;
    class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T;
    class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
      const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T;
    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<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
    class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>; overload;
    class function SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet;
    class function CurrentConnection: TFDConnection;
  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 RemoveConnection(const aName: string);
    procedure SetCurrent(const aName: string);
    function GetCurrent: TFDConnection;
    function GetCurrentBackend: string;
  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 RemoveConnection(const aName: string);
    procedure SetCurrent(const aName: string);
    function GetCurrent: TFDConnection;
    function GetByName(const aName: string): TFDConnection;
    function GetCurrentBackend: string;
  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: TDictionary<TRttiField, string>; const PKFieldName: string;
      const Delimiter: string): string;
  public
    constructor Create(Mapping: TMVCFieldsMapping); virtual;
    destructor Destroy; override;
    function CreateSelectSQLByRQL(const RQL: string; const Mapping: TMVCFieldsMapping): string; virtual; abstract;
    function CreateSelectSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
      const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateSelectByPKSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
      const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string;
      virtual; abstract;
    function CreateInsertSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
      const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateUpdateSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
      const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
    function CreateDeleteSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
      const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string;
      virtual; abstract;
  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,
  FireDAC.Stan.Option,
  Data.FmtBcd;

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

function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
  case 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;

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

  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;

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
  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
  fMREW.BeginRead;
  try
    if fCurrentConnectionsByThread.TryGetValue(TThread.Current.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.Current.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.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.Current.ThreadID, lName);
  finally
    fMREW.EndWrite;
  end;
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);
begin
  inherited Create;
  FieldName := aFieldName;
end;

{ TableAttribute }

constructor MVCTableAttribute.Create(aName: string);
begin
  inherited Create;
  name := aName;
end;

{ TActiveRecord }

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

function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
var
  lQry: TFDQuery;
  lPar: TFDParam;
  lPair: TPair<TRttiField, string>;
  lValue: TValue;
begin
  lQry := TFDQuery.Create(nil);
  try
    lQry.Connection := fConn;
    lQry.SQL.Text := SQL;
    // lQry.Prepare;
    for lPair in fMap do
    begin
      lPar := lQry.FindParam(lPair.value);
      if lPar <> nil then
      begin
        lValue := lPair.Key.GetValue(Self);
        MapTValueToParam(lValue, lPar);
      end
    end;

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

    if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fPrimaryKeyOptions) then
    begin
      lQry.Open;
      fPrimaryKey.SetValue(Self, lQry.FieldByName(fPrimaryKeyFieldName).AsInteger);
      OnAfterLoad;
    end
    else
    begin
      lQry.ExecSQL(SQL);
    end;

    Result := lQry.RowsAffected;
  finally
    lQry.Free;
  end;
end;

// class function TMVCActiveRecord.ExecNonQuery(const SQL: string;
// const Values: array of Variant; const Connection: TFDConnection): int64;
// var
// lQry: TFDQuery;
// begin
// lQry := TFDQuery.Create(nil);
// try
// lQry.FetchOptions.Unidirectional := True;
// if Connection = nil then
// begin
// lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
// end
// else
// begin
// lQry.Connection := Connection;
// end;
// lQry.SQL.Text := SQL;
// lQry.Prepare;
// lQry.ExecSQL(SQL, Values);
// Result := lQry.RowsAffected;
// except
// lQry.Free;
// raise;
// end;
// end;
//
// class function TMVCActiveRecord.ExecNonQuery(const SQL: string;
// const Values: array of Variant): int64;
// begin
// Result := ExecNonQuery(SQL, Values, nil);
// end;

class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
  const Connection: TFDConnection): TDataSet;
var
  lQry: TFDQuery;
begin
  lQry := TFDQuery.Create(nil);
  try
    lQry.FetchOptions.Unidirectional := True;
    if Connection = nil then
    begin
      lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
    end
    else
    begin
      lQry.Connection := Connection;
    end;
    lQry.SQL.Text := SQL;
    // lQry.Prepare;
    lQry.Open(SQL, Values);
    Result := lQry;
  except
    lQry.Free;
    raise;
  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;
begin
  fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate,
    TMVCEntityAction.eaDelete];
  fTableName := '';
  fRTTIType := gCtx.GetType(Self.ClassInfo);
  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;
      Break;
    end;
  end;

  if fTableName = '' then
    raise Exception.Create('Cannot find TableNameAttribute');

  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
        fMap.Add(lRTTIField, { fTableName + '.' + } MVCTableFieldAttribute(lAttribute).FieldName);
      end
      else if lAttribute is MVCPrimaryKeyAttribute then
      begin
        fPrimaryKey := lRTTIField;
        fPrimaryKeyFieldName := MVCPrimaryKeyAttribute(lAttribute).FieldName;
        fPrimaryKeyOptions := MVCPrimaryKeyAttribute(lAttribute).FieldOptions;
      end;
    end;
  end;
end;

procedure TMVCActiveRecord.Insert;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaCreate);
  OnValidation;
  OnBeforeInsert;
  OnBeforeInsertOrUpdate;
  SQL := SQLGenerator.CreateInsertSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
  ExecNonQuery(SQL, True);
  OnAfterInsert;
  OnAfterInsertOrUpdate;
end;

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

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

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

class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord;
begin
  Result := aClass.Create;
  Result.LoadByPK(aValue);
end;

class function TMVCActiveRecord.GetByPK<T>(const aValue: int64): T;
var
  lActiveRecord: TMVCActiveRecord;
begin
  Result := T.Create;
  lActiveRecord := TMVCActiveRecord(Result);
  lActiveRecord.LoadByPK(aValue);
end;

class function TMVCActiveRecord.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
  const RaiseExceptionIfNotFound: Boolean): T;
var
  lList: TObjectList<T>;
begin
  lList := Where<T>(SQLWhere, Params);
  try
    if lList.Count = 0 then
    begin
      if RaiseExceptionIfNotFound then
        raise EMVCActiveRecord.Create('Got 0 rows');
      Exit(nil);
    end;
    lList.OwnsObjects := false;
    Result := lList.First;
  finally
    lList.Free;
  end;
end;

function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
var
  lPair: TPair<TRttiField, string>;
  i: Integer;
begin
  if Length(fMapping) = 0 then
  begin
    if not fPrimaryKeyFieldName.IsEmpty then
      SetLength(fMapping, fMap.Count + 1)
    else
      SetLength(fMapping, fMap.Count);

    i := 0;
    for lPair in fMap do
    begin
      fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
      fMapping[i].DatabaseFieldName := lPair.value;
      inc(i);
    end;

    if not fPrimaryKeyFieldName.IsEmpty then
    begin
      fMapping[i].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
      fMapping[i].DatabaseFieldName := fPrimaryKeyFieldName;
    end;
  end;
  Result := fMapping;
end;

class function TMVCActiveRecord.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 EMVCActiveRecord.Create('Got 0 rows when exactly 1 was expected');
  end;
end;

function TMVCActiveRecord.GetPK: TValue;
begin
  if fPrimaryKeyFieldName.IsEmpty then
    raise Exception.Create('No primary key defined');
  Result := fPrimaryKey.GetValue(Self);
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 not allowed on "%s"', [ClassName]);
end;

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

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

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

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

procedure TMVCActiveRecord.MapColumnToTValue(const aFieldName: string; const aField: TField;
  const aRTTIField: TRttiField);
var
  lInternalStream: TStream;
  lSStream: TStringStream;
begin
  case aField.DataType of
    ftString, ftWideString:
      begin
        aRTTIField.SetValue(Self, aField.AsString);
      end;
    ftLargeint, ftAutoInc:
      begin
        aRTTIField.SetValue(Self, aField.AsLargeInt);
      end;
    ftInteger, ftSmallint, ftShortint:
      begin
        aRTTIField.SetValue(Self, aField.AsInteger);
      end;
    ftLongWord, ftWord:
      begin
        aRTTIField.SetValue(Self, aField.AsLongWord);
      end;
    ftFMTBcd:
      begin
        aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD));
      end;
    ftDate:
      begin
        aRTTIField.SetValue(Self, Trunc(aField.AsDateTime));
      end;
    ftDateTime:
      begin
        aRTTIField.SetValue(Self, aField.AsDateTime);
      end;
    ftTimeStamp:
      begin
        aRTTIField.SetValue(Self, aField.AsDateTime);
      end;
    ftBoolean:
      begin
        aRTTIField.SetValue(Self, aField.AsBoolean);
      end;
    ftMemo, ftWideMemo:
      begin
        if aRTTIField.FieldType.TypeKind in [tkString, tkUString, tkWideString] then
        begin
          // In case you want to map a "TEXT" blob into a Delphi String
          lSStream := TStringStream.Create('', TEncoding.Unicode);
          try
            TBlobField(aField).SaveToStream(lSStream);
            aRTTIField.SetValue(Self, lSStream.DataString);
          finally
            lSStream.Free;
          end;
        end
        else
        begin
          // In case you want to map a bynary blob into a Delphi Stream
          lInternalStream := aRTTIField.GetValue(Self).AsObject as TStream;
          if lInternalStream = nil then
          begin
            raise EMVCActiveRecord.CreateFmt('Property target for %s field is nil', [aFieldName]);
          end;
          lInternalStream.Position := 0;
          TBlobField(aField).SaveToStream(lInternalStream);
          lInternalStream.Position := 0;
        end;
      end;
    ftBCD:
      begin
        aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD));
      end;
    ftBlob:
      begin
        lInternalStream := aRTTIField.GetValue(Self).AsObject as TStream;
        if lInternalStream = nil then
        begin
          raise EMVCActiveRecord.CreateFmt('Property target for %s field is nil', [aFieldName]);
        end;
        lInternalStream.Position := 0;
        TBlobField(aField).SaveToStream(lInternalStream);
        lInternalStream.Position := 0;
      end;
  else
    raise EMVCActiveRecord.CreateFmt('Unsupported FieldType (%d) for field %s', [Ord(aField.DataType), aFieldName]);
  end;

end;

procedure TMVCActiveRecord.MapTValueToParam(const aValue: TValue; const aParam: TFDParam);
var
  lStream: TStream;
begin
  case aValue.TypeInfo.Kind of
    // tkUnknown:
    // 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;
    tkString, tkUString:
      begin
        aParam.AsString := aValue.AsString;
      end;
    tkWideString:
      begin
        aParam.AsWideString := aValue.AsString;
      end;
    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 aValue.TypeInfo.Name = 'TDate' then
        begin
          aParam.AsDate := Trunc(aValue.AsExtended);
        end
        else if aValue.TypeInfo.Name = 'TDateTime' then
        begin
          aParam.AsDateTime := aValue.AsExtended;
        end
        else if aValue.TypeInfo.Name = 'Currency' then
        begin
          aParam.AsCurrency := aValue.AsCurrency;
        end
        else
        begin
          aParam.AsFloat := aValue.AsExtended;
        end;
      end;
    tkClass:
      begin
        if not aValue.IsInstanceOf(TStream) then
          raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s',
            [aParam.Name, aValue.AsObject.ClassName]);
        lStream := aValue.AsType<TStream>(false);
        if Assigned(lStream) then
        begin
          lStream.Position := 0;
          aParam.LoadFromStream(lStream, ftBlob);
        end
        else
        begin
          aParam.Clear;
        end;
      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 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, string>;
  lField: TField;
begin
  CheckAction(TMVCEntityAction.eaRetrieve);
  OnBeforeLoad;
  for lItem in fMap do
  begin
    lField := aDataSet.FindField(lItem.value);
    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]);
    end;
    MapColumnToTValue(lItem.value, lField, lItem.Key);
  end;
  if not fPrimaryKeyFieldName.IsEmpty then
  begin
    MapColumnToTValue(fPrimaryKeyFieldName, aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey);
  end;
  OnAfterLoad;
end;

function TMVCActiveRecord.LoadByPK(id: int64): Boolean;
var
  SQL: string;
  lDataSet: TDataSet;
begin
  CheckAction(TMVCEntityAction.eaRetrieve);
  SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions, id);
  lDataSet := ExecQuery(SQL, [id], fConn);
  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.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;
begin
  // do nothing
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;
      // lDataSet.First;
      // TFile.WriteAllText('output.json', lDataSet.AsJSONArray);
    finally
      lDataSet.Free;
    end;
  except
    Result.Free;
    raise;
  end;

end;

class function TMVCActiveRecord.Select<T>(const SQL: string; const Params: array of Variant;
  const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
var
  lDataSet: TDataSet;
  lAR: TMVCActiveRecord;
begin
  Result := TObjectList<T>.Create(True);
  try
    lDataSet := ExecQuery(SQL, Params);
    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 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;
var
  lSQL: string;
begin
  lSQL := SQLGenerator.CreateSelectSQLByRQL(RQL, GetMapping);
  LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
  Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, []);
end;

class function TMVCActiveRecord.SelectRQL<T>(const RQL: string; const MaxRecordCount: Integer): TObjectList<T>;
var
  lAR: TMVCActiveRecord;
  lSQL: string;
begin
  lAR := T.Create;
  try
    lSQL := lAR.SQLGenerator.CreateSelectSQLByRQL(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 TMVCActiveRecord.SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
  const MaxRecordCount: Integer): TMVCActiveRecordList;
var
  lAR: TMVCActiveRecord;
begin
  lAR := aClass.Create(True);
  try
    Result := lAR.SelectRQL(RQL, MaxRecordCount);
  finally
    lAR.Free;
  end;
end;

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

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

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

procedure TMVCActiveRecord.Update;
var
  SQL: string;
begin
  CheckAction(TMVCEntityAction.eaUpdate);
  OnValidation;
  OnBeforeUpdate;
  OnBeforeInsertOrUpdate;
  { TODO -oDanieleT -cSQLGenerators : Add a parameter to update to allow to update only selected fields }
  SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
  ExecNonQuery(SQL, false);
  OnAfterUpdate;
  OnAfterInsertOrUpdate;
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 TMVCActiveRecord.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 TMVCActiveRecord.Where<T>(const SQLWhere: string; const Params: array of Variant): 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);
    end
    else
    begin
      Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params);
    end;
  finally
    lAR.Free;
  end;
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;
end;

function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
begin
  Result := fMapping;
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.GetRQLParser: TRQL2SQL;
begin
  if fRQL2SQL = nil then
  begin
    fRQL2SQL := TRQL2SQL.Create(20);
  end;
  Result := fRQL2SQL;
end;

function TMVCSQLGenerator.TableFieldsDelimited(const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
  const Delimiter: string): string;
var
  lPair: TPair<TRttiField, string>;
begin
  for lPair in Map do
  begin
    Result := Result + lPair.value + Delimiter;
  end;
  Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
  if not PKFieldName.IsEmpty then
  begin
    Result := PKFieldName + ',' + Result;
  end;
end;

{ TMVCConnectionsRepository.TConnHolder }

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

initialization

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

finalization

gCtx.Free;
gLock.Free;

end.