{*******************************************************}
{                                                       }
{  Responsive Software     http://www.responsive.co.nz  }
{                                                       }
{  Copyright (c) 2003-2006 Responsive Software Limited  }
{                                                       }
{*******************************************************}

unit DatabaseManager;

interface

uses
  DatabaseObjects, BusinessObjects, IBDatabase;

// generic database object handling routines

// load all objects of a given type into a collection
procedure LoadAllDatabaseObjects
  (var DatabaseObjectCollection : TDatabaseObjectCollection;
   DatabaseObjectClass : TDatabaseObjectClass);

// load some objects of a given type into a collection
procedure LoadSomeDatabaseObjects
  (var DatabaseObjectCollection : TDatabaseObjectCollection;
   DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);

// count the number of database objects of a given type
function CountDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string) : integer;

// retrieve an object of a given type using the
// given criteria
function LoadDatabaseObject
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string) : TDatabaseObject; overload;

// get a database object based on the id
function LoadDatabaseObject
  (DatabaseObjectClass : TDatabaseObjectClass;
   Id : int64) : TDatabaseObject; overload;

// delete some objects from the database
procedure DeleteSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);

// delete some objects from the database
// and then save the objects in the collection
procedure DeleteAndSaveSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string;
   DatabaseObjectCollection : TDatabaseObjectCollection;
   NotifyWorkstations : boolean);

// update some objects in the database
procedure UpdateSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   UpdateString : string;
   SelectionString : string);

// perform general database restructuring on startup
procedure RestructureDatabase;

// use these when making updates to the database
procedure AcquireDatabaseCriticalUpdate;
procedure ReleaseDatabaseCriticalUpdate;

// generate a unique id from the database
function GenerateId
  (Increment : integer) : int64;

// load/save global configuration
procedure LoadGlobalConfiguration;
procedure SaveGlobalConfiguration;

// load/save workstation configuration
procedure LoadWorkstationConfiguration;
procedure SaveWorkstationConfiguration;  

implementation

uses
  IBTable, IBQuery, 
  DB, DBTables, Dialogs, Controls, SysUtils, Classes,
  Globals, GeneralUtilities, Utilities, CommunicationsManager;

// this procedure loads all objects of the given type into the
// collection and if the collection does not exist it creates it
procedure LoadAllDatabaseObjects
  (var DatabaseObjectCollection : TDatabaseObjectCollection;
   DatabaseObjectClass : TDatabaseObjectClass);
begin
  if DatabaseObjectCollection = nil then
  begin
    DatabaseObjectCollection := TDatabaseObjectCollection.Create;
    DatabaseObjectCollection.Owned := true;
  end else
    DatabaseObjectCollection.Clear;
  DatabaseObjectCollection.LoadAllObjects(DatabaseObjectClass);
end;

// this procedure loads some objects of the given type into the
// collection and if the collection does not exist it creates it
// the criteria used is given in the SelectionString
procedure LoadSomeDatabaseObjects
  (var DatabaseObjectCollection : TDatabaseObjectCollection;
   DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);
begin
  if DatabaseObjectCollection = nil then
  begin
    DatabaseObjectCollection := TDatabaseObjectCollection.Create;
    DatabaseObjectCollection.Owned := true;
  end else
    DatabaseObjectCollection.Clear;
  DatabaseObjectCollection.LoadSomeObjects(DatabaseObjectClass,SelectionString);
end;

function CountDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string) : integer;
var
  Query : TDataset;
  WherePos : integer;
  OrderByPos : integer;
begin
  // if client mode then get result from server
  if ClientMode then
  begin
    Result := ClientCommunicator.CountDatabaseObjects(DatabaseObjectClass,SelectionString);
    Exit;
  end;

  // look for WHERE clause
  WherePos := Pos('WHERE',SelectionString);
  OrderByPos := Pos('ORDER BY',SelectionString);
  if WherePos = 0 then
    SelectionString := ''
  else if OrderByPos <> 0 then
    SelectionString := Copy(SelectionString,WherePos,OrderByPos-WherePos)
  else
    SelectionString := Copy(SelectionString,WherePos,Length(SelectionString));

  SelectionString := 'SELECT COUNT(*) FROM "' + DatabaseObjectClass.TableName + '" ' + SelectionString;
  // create and open query object
  if Firebird then
    Query := DatabaseObjectClass.OpenIBQuery(SelectionString)
  else
    Query := DatabaseObjectClass.OpenQuery(SelectionString);

  try
    if not Query.EOF then
      Result := TIntegerField(Query.Fields[0]).Value
    else
      Result := 0;
  finally
    Query.Active := false;
    if Firebird then
    begin
      if TIBQuery(Query).Transaction.InTransaction then
        TIBQuery(Query).Transaction.Commit;
      TIBQuery(Query).Transaction.Free;
    end;
    Query.Free;
  end;
end;

// this procedure returns a single object using the
// criteria given in the SelectionString
function LoadDatabaseObject
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string) : TDatabaseObject;
var
  Query : TDataset;
begin
  // if client mode then get object from server
  if ClientMode then
  begin
    Result := ClientCommunicator.LoadDatabaseObject(DatabaseObjectClass,SelectionString);
    Exit;
  end;

  Result := nil;
  // create and open query object
  if Firebird then
    Query := DatabaseObjectClass.OpenIBQuery(SelectionString)
  else
    Query := DatabaseObjectClass.OpenQuery(SelectionString);

  try
    if not Query.EOF then
    begin
      Result := DatabaseObjectClass.Create;
      Result.LoadFromTable(Query);
    end;
  finally
    Query.Active := false;
    if Firebird then
    begin
      if TIBQuery(Query).Transaction.InTransaction then
        TIBQuery(Query).Transaction.Commit;
      TIBQuery(Query).Transaction.Free;
    end;
    Query.Free;
  end;
end;

// get a database object based on the id
function LoadDatabaseObject
  (DatabaseObjectClass : TDatabaseObjectClass;
   Id : int64) : TDatabaseObject; overload;
var
  SelectionString : string;
begin
  // if client mode then get object from server
  if ClientMode then
  begin
    Result := ClientCommunicator.LoadDatabaseObject(DatabaseObjectClass,Id);
    Exit;
  end;

  SelectionString := 'WHERE ' + DelimitSQLFieldName('Id') + ' = ' + IntToStr(Id);
  Result := LoadDatabaseObject(DatabaseObjectClass,SelectionString);
end; 

// this procedure deletes some objects of the given type from
// the database using the criteria given in the SelectionString
procedure DeleteSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);
var
  Query : TQuery;
  IBQuery : TIBQuery;
  Transaction : TIBTransaction;
  SQLStr : string;
begin
  if ClientMode then
  begin
    if not ClientCommunicator.DeleteSomeDatabaseObjects(DatabaseObjectClass,SelectionString) then
      raise Exception.Create('Server confirmation not received when deleting objects from database');
    Exit;
  end;

  SQLStr := 'DELETE FROM "';
  SQLStr := SQLStr + DatabaseObjectClass.TableName;
  SQLStr := SQLStr + '" ';
  SQLStr := SQLStr + SelectionString;

  if Firebird then
  begin
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    IBQuery := TIBQuery.Create(nil);
    IBQuery.Database := TVFirebirdDatabase;
    IBQuery.Transaction := Transaction;
    IBQuery.SQL.Clear;
    IBQuery.SQL.Add(SQLStr);
    IBQuery.ExecSQL;
    IBQuery.Free;
    if Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end else begin
    Query := TQuery.Create(nil);
    Query.DatabaseName := BDEDatabaseName;
    Query.SessionName := TVSessionName;
    Query.SQL.Clear;
    Query.SQL.Add(SQLStr);
    Query.ExecSQL;
    Query.Free;
  end;
end;

// this procedure deletes some objects of the given type from
// the database using the criteria given in the SelectionString
// and then saves the objects in the collection
procedure DeleteAndSaveSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string;
   DatabaseObjectCollection : TDatabaseObjectCollection;
   NotifyWorkstations : boolean);
begin
  if ClientMode then
  begin
    if not ClientCommunicator.DeleteAndSaveSomeDatabaseObjects(DatabaseObjectClass,SelectionString,DatabaseObjectCollection) then
      raise Exception.Create('Server confirmation not received when deleting and saving objects in database');
    Exit;
  end;

  DeleteSomeDatabaseObjects(DatabaseObjectClass,SelectionString);
  DatabaseObjectCollection.SaveToDatabase(DatabaseObjectClass,NotifyWorkstations);
end;

// this procedure updates some objects of the given type in
// the database using the criteria given in the SelectionString
// and the update information given in UpdateString
procedure UpdateSomeDatabaseObjects
  (DatabaseObjectClass : TDatabaseObjectClass;
   UpdateString : string;
   SelectionString : string);
var
  Query : TQuery;
  IBQuery : TIBQuery;
  Transaction : TIBTransaction;
  SQLStr : string;
begin
  if ClientMode then
  begin
    if not ClientCommunicator.UpdateSomeDatabaseObjects(DatabaseObjectClass,UpdateString,SelectionString) then
      raise Exception.Create('Server confirmation not received when updating objects in database');
    Exit;
  end;

  SQLStr := 'UPDATE "';
  SQLStr := SQLStr + DatabaseObjectClass.TableName;
  SQLStr := SQLStr + '" SET ';
  SQLStr := SQLStr + UpdateString;
  SQLStr := SQLStr + ' ';
  SQLStr := SQLStr + SelectionString;

  if Firebird then
  begin
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    IBQuery := TIBQuery.Create(nil);
    IBQuery.Database := TVFirebirdDatabase;
    IBQuery.Transaction := Transaction;
    IBQuery.SQL.Clear;
    IBQuery.SQL.Add(SQLStr);
    IBQuery.ExecSQL;
    IBQuery.Free;
    if Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end else begin
    Query := TQuery.Create(nil);
    Query.DatabaseName := BDEDatabaseName;
    Query.SessionName := TVSessionName;
    Query.SQL.Clear;
    Query.SQL.Add(SQLStr);
    Query.ExecSQL;
    Query.Free;
  end;
end;

// this procedure is called after the application has initialized but
// before any forms are created in order to perform any required changes
// to the database structure
procedure RestructureDatabase;
begin
  // ensure that the id generator table exists
  // as this will be used to indicate critical updates are being made to the
  // database
  TIdGenerator.CreateTable;
  if not ServerMode then
    AcquireDatabaseCriticalUpdate;
  try
    // create tables for all objects if they do not already exist
    CreateTables;
    // make modifications to existing structures
    UpdateTables;
  finally
    if not ServerMode then
      ReleaseDatabaseCriticalUpdate;
  end;
end;

var
  CriticalUpdateTable : TTable;
  CriticalUpdateCounter : integer;

procedure AcquireDatabaseCriticalUpdate;
begin
  // this should never be called in server mode as this has
  // its own locking mechanism in the server logic
  if ServerMode then
    Exit;

  if ClientMode then
  begin
    if not ClientCommunicator.AcquireDatabaseCriticalUpdate then
      raise Exception.Create('Server confirmation not received when attempting to lock database');
    Exit;
  end;
  // check for consistency
  if ((CriticalUpdateCounter = 0) and (CriticalUpdateTable <> nil))
    or ((CriticalUpdateCounter > 0) and (CriticalUpdateTable = nil))
    or (CriticalUpdateCounter < 0) then
    raise Exception.Create('Acquire critical update inconsistency');
  // use id generator table locked in exclusive mode to ensure that only
  // one instance of the application is performing updates to the database
  // during a critical update
  if CriticalUpdateCounter = 0 then
    CriticalUpdateTable := TIdGenerator.OpenTable(true);
  // increment the counter
  Inc(CriticalUpdateCounter);
end;

procedure ReleaseDatabaseCriticalUpdate;
begin
  // this should never be called in server mode as this has
  // its own locking mechanism in the server logic
  if ServerMode then
    Exit;

  if ClientMode then
  begin
    if not ClientCommunicator.ReleaseDatabaseCriticalUpdate then
      raise Exception.Create('Server confirmation not received when attempting to unlock database');
    Exit;
  end;
  // check for consistency
  if ((CriticalUpdateCounter > 0) and (CriticalUpdateTable = nil))
    or (CriticalUpdateCounter = 0) then
    raise Exception.Create('Release critical update inconsistency');
  // decrement the counter
  Dec(CriticalUpdateCounter);
  // close table when it reaches zero
  if CriticalUpdateCounter = 0 then
  begin
    CriticalUpdateTable.Active := false;
    CriticalUpdateTable.Free;
    CriticalUpdateTable := nil;
  end;
end;

// generate a new id from the database
// this function will add a record to the table if it does
// not already exist
// it will increment the next id number by the increment amount
// this allows for them to be generated in batches when necessary
function GenerateId
  (Increment : integer) : int64;
var
  IdGenerator : TIdGenerator;
  Table : TDataset;
begin
  // if client mode then get id from the server
  if ClientMode then
  begin
    Result := ClientCommunicator.GenerateId(Increment);
    Exit;
  end;

  if Firebird then
    Table := TIdGenerator.OpenIBTable
  else
    // open table in exclusive mode
    Table := TIdGenerator.OpenTable(true);

  try
    IdGenerator := TIdGenerator.Create;
    try
      if Table.RecordCount = 0 then
      begin
        // set initial id values
        IdGenerator.Id := InitialId;
        IdGenerator.NextId := InitialId + 1;
      end else
        IdGenerator.LoadFromTable(Table);

      Result := IdGenerator.GenerateId(Increment);
      if Table.RecordCount = 0 then
        Table.Insert
      else
        Table.Edit;
      IdGenerator.SaveToTable(Table);
      Table.Post;
    finally
      // clean up
      IdGenerator.Free;
    end;
  finally
    Table.Active := false;
    if Firebird then
    begin
      if TIBTable(Table).Transaction.InTransaction then
        TIBTable(Table).Transaction.Commit;
      TIBTable(Table).Transaction.Free;
    end;
    Table.Free;
  end;
end;

// load global configuration
// create new one and save to database if it does not already exist
// note that there is only one record in this table
procedure LoadGlobalConfiguration;
var
  Table : TDataset;
begin
  // if client mode then get global configuration from the server
  if ClientMode then
  begin
    GlobalConfiguration.Free;
    GlobalConfiguration := ClientCommunicator.LoadGlobalConfiguration;
    Exit;
  end;

  if Firebird then
    Table := TGlobalConfiguration.OpenIBTable
  else
    // open table in exclusive mode
    Table := TGlobalConfiguration.OpenTable(true);

  try
    if GlobalConfiguration = nil then
      GlobalConfiguration := TGlobalConfiguration.Create;
    if Table.RecordCount = 0 then
    begin
      // if no record in table then create one now
      // with default settings
      GlobalConfiguration.Id := GenerateId(1);
      GlobalConfiguration.SetDefaults;
      Table.Insert;
      GlobalConfiguration.SaveToTable(Table);
      Table.Post;
    end else
      GlobalConfiguration.LoadFromTable(Table);
  finally
    Table.Active := false;
    if Firebird then
    begin
      if TIBTable(Table).Transaction.InTransaction then
        TIBTable(Table).Transaction.Commit;
      TIBTable(Table).Transaction.Free;
    end;
    Table.Free;
  end;
end;

procedure SaveGlobalConfiguration;
var
  Table : TDataset;
begin
  if GlobalConfiguration = nil then
    Exit;

  // if client mode then save via server
  if ClientMode then
  begin
    if not ClientCommunicator.SaveGlobalConfiguration(GlobalConfiguration) then
      raise Exception.Create('Server confirmation not received when saving global configuration');
    UpdateGlobalConfigurationOnLoggedOnWorkstations;
    Exit;
  end;

  if Firebird then
    Table := TGlobalConfiguration.OpenIBTable
  else
    // open table in exclusive mode
    Table := TGlobalConfiguration.OpenTable(true);
  Table.Edit;
  if GlobalConfiguration.Id = 0 then
    GlobalConfiguration.Id := GenerateId(1);
  GlobalConfiguration.SaveToTable(Table);
  Table.Post;
  Table.Active := false;
  if Firebird then
  begin
    if TIBTable(Table).Transaction.InTransaction then
      TIBTable(Table).Transaction.Commit;
    TIBTable(Table).Transaction.Free;
  end;
  Table.Free;

  UpdateGlobalConfigurationOnLoggedOnWorkstations;
end;

// load workstation configuration for this workstation
// if not found then create one and save to table
procedure LoadWorkstationConfiguration;
var
  SelectionString : string;
begin
  AcquireDatabaseCriticalUpdate;
  try
    WorkstationConfiguration.Free;
    // in client mode use user name as identifier for configuration
    if ClientMode then
      SelectionString := 'WHERE ' + DelimitSQLFieldName('ComputerName') + ' = ' + DelimitSQLStringValue(ClientUserName)
    // otherswise use computer name
    else
      SelectionString := 'WHERE ' + DelimitSQLFieldName('ComputerName') + ' = ' + DelimitSQLStringValue(ComputerName);
    WorkstationConfiguration := TWorkstationConfiguration(LoadDatabaseObject(TWorkstationConfiguration,SelectionString));
    // if there isn't one then create one
    if WorkstationConfiguration = nil then
    begin
      WorkstationConfiguration := TWorkstationConfiguration.Create;
      WorkstationConfiguration.SetDefaults;
      WorkstationConfiguration.SaveToDatabase(false);
    end else begin
      // check ip address is correct and if not then make it correct and
      // save to database
      if (not ClientMode) and (Globals.IPAddresses.IndexOf(WorkstationConfiguration.IPAddress) = -1)  then
      begin
        WorkstationConfiguration.IPAddress := ChooseIPAddress;
        SaveWorkstationConfiguration;
      end;
    end;
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
end;

procedure SaveWorkstationConfiguration;
begin
  if WorkstationConfiguration = nil then
    Exit;
  AcquireDatabaseCriticalUpdate;
  try
    WorkstationConfiguration.FullSaveToDatabase(true);
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
end;

end.