unit Aurelius.Commands.AbstractSqlPerformer;

{$I Aurelius.inc}

interface

uses
  Generics.Collections, DB,
  Aurelius.Commands.Listeners,
  Aurelius.Drivers.Interfaces,
  Aurelius.Mapping.Explorer,
  Aurelius.Sql.Interfaces;

type
  TAbstractSQLPerformer = class abstract
  strict private
    FClazz: TClass;
    FSQLGenerator: ISQLGenerator;
    FExplorer: TMappingExplorer;
  strict protected
    {$IFDEF AUTOREFCOUNT} [Weak] {$ENDIF}
    FEntityManager: TObject;
    FConnection: IDBConnection;
    FExecutionListeners: TList<ICommandExecutionListener>;
    function BuildStatement(SQL: string; Params: TList<TDBParam>): IDBStatement;
    function ConvertFieldValue(const Value: Variant; ClassFieldType: TFieldType): Variant;
  protected
    function ExecuteQuery(const SQL: string; Params: TList<TDBParam>): IDBResultSet;
    function Execute(const SQL: string; Params: TList<TDBParam>): Integer;
  public
    constructor Create; overload; virtual;
    destructor Destroy; override;
    procedure AddExecutionListener(Listener: ICommandExecutionListener);
    procedure AddExecutionListeners(Listeners: TEnumerable<ICommandExecutionListener>);
    procedure SetConnection(Conn: IDBConnection);
    procedure SetSQLGenerator(ASQLGenerator: ISQLGenerator);
    procedure SetClass(Clazz: TClass); virtual;
    procedure SetEntityManager(EntityManager: TObject);
    procedure SetExplorer(AExplorer: TMappingExplorer);
  public
    function ReadFieldValue(ResultSet: IDBResultSet; const FieldName: string; ClassFieldType: TFieldType): Variant; overload;
    function ReadFieldValue(ResultSet: IDBResultSet; const FieldIndex: Integer; ClassFieldType: TFieldType): Variant; overload;
    property Clazz: TClass read FClazz;
    property EntityManager: TObject read FEntityManager;
    property Explorer: TMappingExplorer read FExplorer;
    property SQLGenerator: ISQLGenerator read FSQLGenerator;
  end;

implementation

uses
  SysUtils, Variants,
  Aurelius.Engine.ObjectManager,
  Aurelius.Events.Manager,
  Aurelius.Global.Utils,
  Aurelius.Global.Config,
  Aurelius.Sql.Exceptions;

type
  TInternalObjectManager = class(TObjectManager)
  end;

{ TAbstractSQLPerformer }

procedure TAbstractSQLPerformer.AddExecutionListener(
  Listener: ICommandExecutionListener);
begin
  FExecutionListeners.Add(Listener);
end;

procedure TAbstractSQLPerformer.AddExecutionListeners(
  Listeners: TEnumerable<ICommandExecutionListener>);
begin
  FExecutionListeners.AddRange(Listeners);
end;

function TAbstractSQLPerformer.ConvertFieldValue(const Value: Variant;
  ClassFieldType: TFieldType): Variant;
var
  E: TFieldTypeEquivalence;
begin
  Result := Value;
  if Result <> Variants.Null then
  begin
    // Workaround for drivers that return GUID values as array of bytes
    // (For now, only SQL-Direct is known to do that
    if (ClassFieldType = ftGuid) and VarIsArray(Result) then
      Result := GuidToString(TUtils.VariantToGuid(Result));

    // Replace equivalent field type
    if not (ClassFieldType in FSQLGenerator.GetSupportedFieldTypes) then
    begin
      for E in FSQLGenerator.GetEquivalentFieldTypes do
        if E.NotSupportedType = ClassFieldType then
          Exit(FSQLGenerator.ConvertValue(Result, E.EquivalentType, E.NotSupportedType));

      raise EUnsupportedFieldType.Create(FSQLGenerator, ClassFieldType);
    end;
  end;
end;

constructor TAbstractSQLPerformer.Create;
begin
  FExecutionListeners := TList<ICommandExecutionListener>.Create;
end;

destructor TAbstractSQLPerformer.Destroy;
begin
  FExecutionListeners.Free;
  inherited;
end;

function TAbstractSQLPerformer.Execute(const SQL: string; Params: TList<TDBParam>): Integer;
var
  Statement: IDBStatement;
begin
  Statement := BuildStatement(SQL, Params);
  if not TGlobalConfigs.GetInstance.SimuleStatements then
    Result := Statement.Execute
  else
    Result := 0;
end;

function TAbstractSQLPerformer.ExecuteQuery(const SQL: string; Params: TList<TDBParam>): IDBResultSet;
var
  Statement: IDBStatement;
begin
  Statement := BuildStatement(SQL, Params);
  if not TGlobalConfigs.GetInstance.SimuleStatements then
    Result := Statement.ExecuteQuery
  else
    Result := nil;
end;

function TAbstractSQLPerformer.ReadFieldValue(ResultSet: IDBResultSet;
  const FieldIndex: Integer; ClassFieldType: TFieldType): Variant;
begin
  Result := ResultSet.GetFieldValue(FieldIndex);
  Result := ConvertFieldValue(Result, ClassFieldType);
end;

function TAbstractSQLPerformer.BuildStatement(SQL: string; Params: TList<TDBParam>): IDBStatement;
var
  Statement: IDBStatement;
  Listener: ICommandExecutionListener;
  P: TDBParam;
  E: TFieldTypeEquivalence;
  Found: Boolean;
  Events: TManagerEvents;
  Args: TSQLExecutingArgs;
  SQLListener: TSQLExecutingProc;
begin
  FSQLGenerator.ProcessCommand(SQL);

  for Listener in FExecutionListeners do
    Listener.ExecutingCommand(SQL, Params);

  Statement := FConnection.CreateStatement;
  Statement.SetSQLCommand(SQL);

  if Params <> nil then
  begin
    for P in Params do
    begin
      if not (P.ParamType in FSQLGenerator.GetSupportedFieldTypes) then
      begin
        Found := False;
        for E in FSQLGenerator.GetEquivalentFieldTypes do
          if E.NotSupportedType = P.ParamType then
          begin
            Found := True;
            P.ParamType := E.EquivalentType;
            if P.ParamValue <> Variants.Null then
              P.ParamValue := FSQLGenerator.ConvertValue(
                P.ParamValue, E.NotSupportedType, E.EquivalentType);
            Break;
          end;
        if not Found then
          raise EUnsupportedFieldType.Create(FSQLGenerator, P.ParamType);
      end;

      // Convert blob value to memo if needed
      if (P.ParamType in [ftMemo, ftWideMemo]) and (VarIsArray(P.ParamValue)) then
        P.ParamValue := TEncoding.Unicode.GetString(TUtils.VariantToBytes(P.ParamValue));
    end;

    Statement.SetParams(Params);
  end;

  // Notify SQL Executing event
  Events := TInternalObjectManager(FEntityManager).Events;
  if Events.OnSQLExecuting.HasListeners then
  begin
    Args := TSQLExecutingArgs.Create(FEntityManager, SQL, Params);
    try
      for SQLListener in Events.OnSQLExecuting.Listeners do
        SQLListener(Args);
    finally
      Args.Free;
    end;
  end;

  Result := Statement;
end;

function TAbstractSQLPerformer.ReadFieldValue(ResultSet: IDBResultSet;
  const FieldName: string; ClassFieldType: TFieldType): Variant;
begin
  Result := ResultSet.GetFieldValue(FieldName);
  Result := ConvertFieldValue(Result, ClassFieldType);
end;

procedure TAbstractSQLPerformer.SetExplorer(AExplorer: TMappingExplorer);
begin
  FExplorer := AExplorer;
end;

procedure TAbstractSQLPerformer.SetClass(Clazz: TClass);
begin
  FClazz := Clazz;
end;

procedure TAbstractSQLPerformer.SetConnection(Conn: IDBConnection);
begin
  FConnection := Conn;
end;

procedure TAbstractSQLPerformer.SetEntityManager(EntityManager: TObject);
begin
  FEntityManager := EntityManager;
end;

procedure TAbstractSQLPerformer.SetSQLGenerator(ASQLGenerator: ISQLGenerator);
begin
  FSQLGenerator := ASQLGenerator;
end;

end.
