unit Aurelius.Drivers.SQLite;

{$I Aurelius.inc}

interface

uses
  Classes, DB, Variants, Generics.Collections, SysUtils,
  Aurelius.Sql.SQLite,
  Aurelius.Schema.SQLite,
  Aurelius.Comp.Drivers,
  Aurelius.Drivers.SQLite.Classes,
  Aurelius.Drivers.Base,
  Aurelius.Drivers.Interfaces;

type
  TSQLiteNativeResultSetAdapter = class(TInterfacedObject, IDBResultSet, IDBResultSet2)
  private
    FStatement: TSQLiteStatement;
  public
    constructor Create(AStatement: TSQLiteStatement);
    destructor Destroy; override;
    function Next: boolean;
    function GetFieldValue(FieldIndex: Integer): Variant; overload;
    function GetFieldValue(FieldName: string): Variant; overload;
    function GetFieldIndex(const FieldName: string): Integer;
  end;

  TSQLiteNativeStatementAdapter = class(TInterfacedObject, IDBStatement)
  private
    FDB: TSQLiteDatabase;
    FSQL: string;
    FParams: TObjectList<TDBParam>;
    function PrepareStatement: TSQLiteStatement;
  public
    constructor Create(ADB: TSQLiteDatabase);
    destructor Destroy; override;
    procedure SetSQLCommand(SQLCommand: string);
    procedure SetParams(Params: TEnumerable<TDBParam>);
    function Execute: Integer;
    function ExecuteQuery: IDBResultSet;
  end;

  TSQLiteNativeConnectionAdapter = class(TInterfacedObject, IDBConnection)
  strict private
    FDatabase: TSQLiteDatabase;
    FFileName: string;
    procedure Execute(const SQL: string);
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    procedure EnableForeignKeys;
    procedure DisableForeignKeys;
    procedure Connect;
    procedure Disconnect;
    function IsConnected: Boolean;
    function CreateStatement: IDBStatement;
    function BeginTransaction: IDBTransaction;
    function SqlDialect: string;
  end;

  TSQLiteConnection = class(TSQLiteNativeConnectionAdapter)
  public
    constructor Create(const AConnectionString: string); reintroduce; overload;
    constructor Create(Params: IDriverParams); overload;
  end;


  TSQLiteNativeTransactionAdapter = class(TInterfacedObject, IDBTransaction)
  private
    FDatabase: TSQLiteDatabase;
  public
    constructor Create(ADatabase: TSQLiteDatabase);
    procedure Commit;
    procedure Rollback;
  end;

  EFieldNotFound = class(Exception)
  public
    constructor Create(const FieldName: string);
  end;

implementation

uses
  Aurelius.Drivers.Exceptions,
  Aurelius.Global.Utils;

{ EFieldNotFound }

constructor EFieldNotFound.Create(const FieldName: string);
begin
  inherited CreateFmt('Field "%s" not found', [FieldName]);
end;

{ TSQLiteNativeStatementAdapter }

constructor TSQLiteNativeStatementAdapter.Create(ADB: TSQLiteDatabase);
begin
  FDB := ADB;
  FParams := TObjectList<TDBParam>.Create(true);
end;

destructor TSQLiteNativeStatementAdapter.Destroy;
begin
  FParams.Free;
  inherited;
end;

function TSQLiteNativeStatementAdapter.Execute: Integer;
var
  Statement: TSqliteStatement;
begin
  Statement := PrepareStatement;
  try
    Statement.Execute;
    Result := FDB.RowsAffected;
  finally
    Statement.Free;
  end;
end;

function TSQLiteNativeStatementAdapter.ExecuteQuery: IDBResultSet;
var
  Statement: TSqliteStatement;
begin
  Statement := PrepareStatement;
  Result := TSQLiteNativeResultSetAdapter.Create(Statement);
end;

function TSQLiteNativeStatementAdapter.PrepareStatement: TSQLiteStatement;
var
  Statement: TSQLiteStatement;
  Param: TDBParam;
  ParamIdx: integer;
  I: Integer;
begin
  Statement := FDB.Prepare(FSQL);
  try
    I := 0;
    for Param in FParams do
    begin
      Inc(I);
      if VarIsNull(Param.ParamValue) then
        Continue;

      if Param.ParamName <> '' then
        ParamIdx := Statement.BindParameterIndex(':' + Param.ParamName)
      else
        ParamIdx := I;
      case Param.ParamType of
        ftInteger, ftShortint, ftSmallint, ftLargeint:
          Statement.BindInt64(ParamIdx, Param.ParamValue);
        ftFloat, ftCurrency, ftExtended:
          Statement.BindDouble(ParamIdx, Param.ParamValue);
        ftString, ftWideString, ftFixedChar, ftMemo, ftWideMemo:
          Statement.BindText(ParamIdx, Param.ParamValue);
        ftBlob:
          Statement.BindBlob(ParamIdx, TUtils.VariantToBytes(Param.ParamValue));
      else
        Statement.BindText(ParamIdx, Param.ParamValue);
      end;
    end;
    Result := Statement;
  except
    Statement.Free;
    raise;
  end;
end;

procedure TSQLiteNativeStatementAdapter.SetParams(Params: TEnumerable<TDBParam>);
var
  P: TDBParam;
begin
  FParams.Clear;
  for P in Params do
    FParams.Add(TDBParam.Create(P.ParamName, P.ParamType, P.ParamValue));
end;

procedure TSQLiteNativeStatementAdapter.SetSQLCommand(SQLCommand: string);
begin
  FSQL := SQLCommand;
end;

{ TSQLiteNativeConnectionAdapter }

function TSQLiteNativeConnectionAdapter.BeginTransaction: IDBTransaction;
begin
  if not IsConnected then
    Connect;

  if not FDatabase.InTransaction then
  begin
    FDatabase.BeginTransaction;
    Result := TSQLiteNativeTransactionAdapter.Create(FDatabase);
  end else
    Result := TSQLiteNativeTransactionAdapter.Create(nil);
end;

procedure TSQLiteNativeConnectionAdapter.Connect;
begin
  if not IsConnected then
    FDatabase := TSQLiteDatabase.Create(FFileName);
end;

constructor TSQLiteNativeConnectionAdapter.Create(AFileName: string);
begin
  FFilename := AFileName;
end;

function TSQLiteNativeConnectionAdapter.CreateStatement: IDBStatement;
begin
  if not IsConnected then
    Connect;
  Result := TSQLiteNativeStatementAdapter.Create(FDatabase);
end;

destructor TSQLiteNativeConnectionAdapter.Destroy;
begin
  Disconnect;
  inherited;
end;

procedure TSQLiteNativeConnectionAdapter.DisableForeignKeys;
begin
  Execute('PRAGMA foreign_keys = off');
end;

procedure TSQLiteNativeConnectionAdapter.Disconnect;
begin
  if FDatabase <> nil then
  begin
    FDatabase.Free;
    FDatabase := nil;
  end;
end;

procedure TSQLiteNativeConnectionAdapter.EnableForeignKeys;
begin
  Execute('PRAGMA foreign_keys = on');
end;

procedure TSQLiteNativeConnectionAdapter.Execute(const SQL: string);
var
  Statement: IDBStatement;
begin
  Statement := CreateStatement;
  Statement.SetSQLCommand(SQL);
  Statement.Execute;
end;

function TSQLiteNativeConnectionAdapter.IsConnected: Boolean;
begin
  Result := FDatabase <> nil;
end;

function TSQLiteNativeConnectionAdapter.SqlDialect: string;
begin
  Result := 'SQLite';
end;

{ TSQLiteNativeTransactionAdapter }

procedure TSQLiteNativeTransactionAdapter.Commit;
begin
  if (FDatabase = nil) then
    Exit;

  FDatabase.Commit;
end;

constructor TSQLiteNativeTransactionAdapter.Create(ADatabase: TSQLiteDatabase);
begin
  FDatabase := ADatabase;
end;

procedure TSQLiteNativeTransactionAdapter.Rollback;
begin
  if (FDatabase = nil) then
    Exit;

  FDatabase.Rollback;
end;

{ TSQLiteNativeResultSetAdapter }

constructor TSQLiteNativeResultSetAdapter.Create(AStatement: TSQLiteStatement);
begin
  FStatement := AStatement;
end;

destructor TSQLiteNativeResultSetAdapter.Destroy;
begin
  FStatement.Free;
  inherited;
end;

function TSQLiteNativeResultSetAdapter.GetFieldValue(FieldIndex: Integer): Variant;
begin
  case FStatement.ColumnType(FieldIndex) of
    TSQLiteFieldType.stInteger:
      Result := FStatement.ColumnInt64(FieldIndex);
    TSQLiteFieldType.stFloat:
      Result := FStatement.ColumnDouble(FieldIndex);
    TSQLiteFieldType.stText:
      Result := FStatement.ColumnText(FieldIndex);
    TSQLiteFieldType.stBlob:
      Result := FStatement.ColumnBlob(FieldIndex);
    TSQLiteFieldType.stNull:
      Result := Variants.Null;
  else
    //sftUnknown:
    // ERROR!
  end;
end;

function TSQLiteNativeResultSetAdapter.GetFieldIndex(
  const FieldName: string): Integer;
begin
  Result := FStatement.ColumnIndex(FieldName);
  if Result = -1 then
    raise EFieldNotFound.Create(FieldName);
end;

function TSQLiteNativeResultSetAdapter.GetFieldValue(FieldName: string): Variant;
begin
  Result := GetFieldValue(GetFieldIndex(FieldName));
end;

function TSQLiteNativeResultSetAdapter.Next: boolean;
begin
  Result := FStatement.Next;
end;

procedure RegisterDriverAdapter;
var
  Driver: IAureliusDriver;
begin
  Driver := TAureliusDriver.Create('SQLite');
  Driver.ParamDefs.Add('Database', True).EditorType := TEditorType.ptFilename;
  Driver.ParamDefs.AddBoolean('EnableForeignKeys');

  Driver.DriverFactory :=
    function(Args: TDriverFactoryArgs): IDBConnection
    begin
      Result := TSQLiteConnection.Create(Args.Params);
    end;

  TAureliusDriverRegister.Instance.RegisterDriver(Driver);
  TAureliusDriverRegister.Instance.RegisterDriverUnits('SQLite', 'Aurelius.Drivers.SQLite');
end;

{ TSQLiteConnection }

constructor TSQLiteConnection.Create(Params: IDriverParams);
var
  Database: string;
  EnableForeignKeysParam: Boolean;
begin
  // Retrieve parameters
  Database := Params.GetAsString('Database');
  EnableForeignKeysParam := Params.GetAsBoolean('EnableForeignKeys');

  // Validate parameters
  if Database = '' then
    raise EInvalidDriverParam.Create('SQLite', 'Param "Database" not specified');

  inherited Create(Database);
  if EnableForeignKeysParam then
    Self.EnableForeignKeys
  else
    Self.DisableForeignKeys;
end;

constructor TSQLiteConnection.Create(const AConnectionString: string);
begin
  Create(IDriverParams(TDriverParams.Create(AConnectionString)));
end;

initialization
  RegisterDriverAdapter;
end.
