unit managedb;
{$mode objfpc}{$h+}

interface

uses
  sqldb, Variants, FBLDatabase, FBLTransaction ,FBLDsql, FBLExcept, ibase_h;

type
  TArray = array of variant;
  IDB = Interface
    function initDB          : boolean;
    function getErrorCode    : integer;
    function getErrorMessage : string;
    function getDatabaseName : string;
    function executeQuery    : boolean;
    procedure setQuery(thequery: string);
    procedure setData(value: variant);
    function getResult       : TArray;
  end;

  TDB = class
    private
      db : IDB;
    public
      constructor Create(db_type: string);
      function initDB          : boolean;
      function getErrorCode    : integer;
      function getErrorMessage : string;
      function getDatabaseName : string;
      function executeQuery    : boolean;
      procedure setQuery(thequery: string);
      procedure setData(value: variant);
      function getResult       : TArray;
      destructor Destroy; override;
  end;

  TDBSQlite = class(TInterfacedObject, IDB)
    private
      DATABASE_FILE : string;
    public
      constructor Create;
      function initDB : boolean;
      function getErrorCode    : integer;
      function getErrorMessage : string;
      function getDatabaseName : string;
      function executeQuery    : boolean;
      procedure setQuery(thequery: string);
      procedure setData(value: variant);
      function getResult       : TArray;
      destructor Destroy; override;
  end;

  TDBFirebird = class(TInterfacedObject, IDB)
    private
      DATABASE_FILE : string;
      query        : string;
      dataValue    : array of variant;
      resultValue  : array of variant;
      MyDB         : TFBLDatabase;
      errorCode    : integer;
      errorMessage : string;
      procedure createTables;
      procedure createKeys;
      procedure createSequences;
      procedure createTriggers;
      procedure createData;
    public
      constructor Create;
      function initDB          : boolean;
      function getErrorCode    : integer;
      function getErrorMessage : string;
      function getDatabaseName : string;
      function executeQuery    : boolean;
      procedure setQuery(thequery: string);
      procedure setData(value: variant);
      function getResult       : TArray;
      destructor Destroy; override;
  end;

implementation

constructor TDB.Create(db_type: string);
begin
  inherited Create;

  if (db_type = 'sqlite') then
    db := TDBSQlite.Create
  else if (db_type = 'firebird') then
    db := TDBFirebird.Create
end;

destructor TDB.Destroy;
begin
  inherited Destroy;
end;

function TDB.initDB: boolean;
begin
  initDB := db.initDB;
end;

function TDB.getErrorCode : integer;
begin
  getErrorCode := db.getErrorCode;
end;

function TDB.getErrorMessage : string;
begin
  getErrorMessage := db.getErrorMessage;
end;

function TDB.getDatabaseName : string;
begin
  getDatabaseName := db.getDatabaseName;
end;

function TDB.executeQuery : boolean;
begin
  executeQuery := db.executeQuery;
end;

procedure TDB.setQuery(thequery : string);
begin
  db.setQuery(thequery);
end;

procedure TDB.setData(value : variant);
begin
  db.setData(value)
end;

function TDB.getResult : TArray;
begin
  getResult := db.getResult;
end;

{TODO: implementare db per SQLite}
constructor TDBSQlite.Create;
begin
  inherited Create;

  DATABASE_FILE := 'mail.db'
end;

destructor TDBSQlite.Destroy;
begin
  inherited Destroy;
end;

function TDBSQlite.initDB : boolean;
begin
  initDB := False;
end;

function TDBSQlite.getErrorCode : integer;
begin
  getErrorCode := 0;
end;

function TDBSQlite.getErrorMessage : string;
begin
  getErrorMessage := 'Not implemented';
end;

function TDBSQlite.getDatabaseName : string;
begin
  getDatabaseName := DATABASE_FILE;
end;

function TDBSQlite.executeQuery : boolean;
begin
  executeQuery := False;
end;

procedure TDBSQlite.setQuery(thequery : string);
begin
end;

procedure TDBSQlite.setData(value : variant);
begin
end;

function TDBSQlite.getResult : TArray;
begin
  getResult := nil;
end;

{TODO: cambiare libreria per Firebird}
constructor TDBFirebird.Create;
begin
  inherited Create;

  DATABASE_FILE := 'mail.fdb';

  MyDB := TFBLDatabase.Create(nil);
  MyDb.DBFile := DATABASE_FILE;
  MyDb.User := 'sysdba';
  MyDb.Password := 'masterkey';
  MyDb.Protocol := ptLocal;
end;

destructor TDBFirebird.Destroy;
begin
  MyDB.free;
  inherited Destroy;
end;

function TDBFirebird.getDatabaseName : string;
begin
  getDatabaseName := DATABASE_FILE;
end;

function TDBFirebird.initDB: boolean;
begin
  try
    MyDB.CreateDatabase(DATABASE_FILE,
                        'sysdba',
                        'masterkey',
                        3,
                        4096,
                        'UTF8');
    createTables;
    createSequences;
    createTriggers;
    //createKeys; {Note: non funziona}
    createData;
    initDB := True;
  except
    on E: EFBLError do
      begin
        errorCode := E.ISC_ErrorCode;
        errorMessage := E.Message;
        initDB := False;
      end;
  end;
end;

function TDBFirebird.getErrorMessage: string;
begin
  getErrorMessage := errorMessage;
end;

function TDBFirebird.getErrorCode: integer;
begin
  getErrorCode := errorCode;
end;

procedure TDBFirebird.createTables;
var
  trans  : TFBLTransaction;
  sqlstr : TFBLDsql;
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect; // Open the connection with the database
  trans.StartTransaction;

  sqlstr.sql.text := 'CREATE TABLE identities(' +
                     'identity_id integer not null, ' +
                     'identity_desc varchar(30), ' +
                     'is_default char(1), ' +
                     'name varchar(30), ' +
                     'surname varchar(30), ' +
                     'organization varchar(30), ' +
                     'email varchar(50), ' +
                     'constraint pk_identity primary key(identity_id))';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TABLE accounts(' +
                     'account_id integer not null, ' +
                     'name varchar(30), ' +
                     'protocol varchar(10), ' +
                     'host varchar(30), ' +
                     'port integer, ' +
                     'userid varchar(30), ' +
                     'account_pwd varchar(255), ' +
                     'constraint pk_accounts primary key(account_id))';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TABLE folders( ' +
                     'folder_id integer not null, ' +
                     'name varchar(50), ' +
                     'parent varchar(50), ' +
                     'constraint pk_folders primary key(folder_id))';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TABLE emails( ' +
                     'email_id integer not null, ' +
                     'folder_id integer, ' +
                     'constraint pk_emails primary key(email_id))';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TABLE headers( ' +
                     'email_id integer, ' +
                     'header_name varchar(50), ' +
                     'header_value varchar(10000))';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TABLE bodies( ' +
                     'email_id integer, ' +
                     'body blob sub_type text)';
  sqlstr.ExecSQL;

  trans.Commit;

  MyDB.Disconnect;
  sqlstr.free;
  trans.free;
end;

procedure TDBFirebird.createData;
var
  i       : integer;
  trans   : TFBLTransaction;
  sqlstr  : TFBLDsql;
  folders : array[1..4] of string = ('Inbox', 'Outbox', 'Sentbox', 'Draftbox');
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect; // Open the connection with the database
  trans.StartTransaction;

  for i := 1 to 4 do
  begin
    sqlstr.sql.text := 'INSERT INTO folders (name, parent) VALUES(?, ?)';
    sqlstr.prepare;
    sqlstr.ParamAsString(0, folders[i]);
    sqlstr.ParamAsString(1, folders[i]);
    sqlstr.ExecSQl;
  end;

  trans.Commit;

  MyDB.Disconnect;
  sqlstr.free;
  trans.free;
end;

procedure TDBFirebird.createKeys;
var
  trans  : TFBLTransaction;
  sqlstr : TFBLDsql;
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect;
  trans.StartTransaction;

  sqlstr.sql.text := 'ALTER TABLE emails ' +
                     'ADD CONSTRAINT fk_emails_1 ' +
             'FOREIGN KEY (folder_id) ' +
             'REFERENCES folders(folder_id) ' +
             'ON DELETE CASCADE';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'ALTER TABLE bodies ' +
                     'ADD CONSTRAINT fk_bodies_1 ' +
             'FOREIGN KEY (email_id) ' +
             'REFERENCES emails(email_id) ' +
             'ON DELETE CASCADE';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'ALTER TABLE headers ' +
                     'ADD CONSTRAINT fk_headers_1 ' +
             'FOREIGN KEY (email_id) ' +
             'REFERENCES emails(email_id) ' +
             'ON DELETE CASCADE';
  sqlstr.ExecSQL;

  trans.Commit;
  MyDB.Disconnect;

  sqlstr.free;
  trans.free;
end;

procedure TDBFirebird.createSequences;
var
  trans  : TFBLTransaction;
  sqlstr : TFBLDsql;
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect;
  trans.StartTransaction;

  sqlstr.sql.text := 'CREATE GENERATOR accounts_seq';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE GENERATOR folders_seq';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE GENERATOR emails_seq';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE GENERATOR identity_seq';
  sqlstr.ExecSQL;

  trans.Commit;
  MyDB.Disconnect;

  sqlstr.free;
  trans.free;
end;

procedure TDBFirebird.createTriggers;
var
  trans  : TFBLTransaction;
  sqlstr : TFBLDsql;
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect;
  trans.StartTransaction;

  sqlstr.sql.text := 'CREATE TRIGGER gen_seq_accounts ' +
                     'FOR accounts ' +
                     'BEFORE INSERT ' +
                     'POSITION 0 ' +
                     'AS ' +
                     'BEGIN ' +
                     'new.account_id = GEN_ID(accounts_seq, 1); ' +
                     'END';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TRIGGER gen_seq_emails ' +
                     'FOR emails ' +
                     'BEFORE INSERT ' +
                     'POSITION 0 ' +
                     'AS ' +
                     'BEGIN ' +
                     'new.email_id = GEN_ID(emails_seq, 1); ' +
                     'END';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TRIGGER gen_seq_folders ' +
                     'FOR folders ' +
                     'BEFORE INSERT ' +
                     'POSITION 0 ' +
                     'AS ' +
                     'BEGIN ' +
                     'new.folder_id = GEN_ID(folders_seq, 1); ' +
                     'END';
  sqlstr.ExecSQL;

  sqlstr.sql.text := 'CREATE TRIGGER gen_seq_identities ' +
                     'FOR identities ' +
                     'BEFORE INSERT ' +
                     'POSITION 0 ' +
                     'AS ' +
                     'BEGIN ' +
                     'new.identity_id = GEN_ID(identity_seq, 1); ' +
                     'END';
  sqlstr.ExecSQL;

  trans.Commit;
  MyDB.Disconnect;

  sqlstr.free;
  trans.free;
end;

procedure TDBFirebird.setQuery(thequery: string);
begin
  query := thequery;
end;

procedure TDBFirebird.setData(value: variant);
var
  lengthArray : integer;
begin
  {TODO: trovare una maniera migliore per implemetare i dati passati alla query}
  lengthArray := Length(dataValue);
  SetLength(dataValue, lengthArray + 1);
  dataValue[lengthArray] := value;
end;

function TDBFirebird.executeQuery: boolean;
var
  trans       : TFBLTransaction;
  sqlstr      : TFBLDsql;
  i, j        : integer;
  lengthArray : integer;
  returnValue : boolean;
  curDataType : Integer;
begin
  trans := TFBLTransaction.Create(nil);
  sqlstr := TFBLDsql.Create(nil);

  trans.database := MyDB;
  sqlstr.transaction := trans;

  MyDB.Connect; // Open the connection with the database
  try
    trans.StartTransaction;

    // Set the query and prepare the statement
    sqlstr.sql.text := query;
    sqlstr.Prepare;

    // Check lenght of the array
    if Length(dataValue) > 0 then
    //writeln('Elements in data: ', Length(dataValue));
    begin
      for i := 0 to Length(dataValue) -1 do
      begin
        writeln('Value ', i, ' is: ', dataValue[i]);
        curDataType := VarType(dataValue[i]) and VarTypeMask;
        case curDataType of
          varInteger : sqlstr.ParamAsLong(i, dataValue[i]);
          varInt64   : sqlstr.ParamAsInt64(i, dataValue[i]);
          varString  : sqlstr.ParamAsString(i, dataValue[i]);
        end;
      end;
    end;

    // Execute the query
    sqlstr.ExecSQL;

    if sqlstr.FetchCount <> 0 then
    begin
      for i := 0 to sqlstr.FetchCount - 1 do
      begin
        for j := 0 to sqlstr.FieldCount - 1 do
        begin
          lengthArray := Length(resultValue);
          SetLength(resultValue, lengthArray + 1);
          if sqlstr.FieldType(i) = SQL_LONG then
          begin
           resultValue[lengthArray] := sqlstr.FieldAsLong(i);
          end;
        end;
      end;
    end;

    trans.Commit;

    returnValue := True;
  except
    on E: EFBLError do
    begin
      errorCode := E.ISC_ErrorCode;
      errorMessage := E.Message;
      returnValue := False;
    end;
  end;

  MyDB.Disconnect;
  sqlstr.free;
  trans.free;

  executeQuery := returnValue;
end;

function TDBFirebird.getResult : TArray;
var
  i   : integer;
  res : TArray;
begin
  SetLength(res, Length(resultValue));

  for i := 0 to Length(resultValue) -1 do
  begin
    res[i] := resultValue[i];
  end;

  getResult := res;
end;

end.