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

unit ServerTest;

interface

uses
  SyncObjs;

var
  GlobalDataLock : TCriticalSection;

function TestServer : boolean;

implementation

uses
  Classes, SysUtils, Utilities,
  Globals, ClientCommunicatorUnit, DatabaseObjects;

type

  // this class is used to simulate a number of clients
  // accessing the server simultaneously
  TTestClientThread = class(TThread)
  private
    FClientCommunicator : TClientCommunicator;
    FDatabaseObjectCollection1 : TDatabaseObjectCollection;
    FDatabaseObjectCollection2 : TDatabaseObjectCollection;
    FDatabaseObjectCollection3 : TDatabaseObjectCollection;
    FDatabaseObjectCollection4 : TDatabaseObjectCollection;
    FDatabaseObjectCollection5 : TDatabaseObjectCollection;

    FGlobalConfigurationCount : integer;
    FWorkstationConfigurationCount : integer;
    FNoteCount : integer;
    FCompanyCount : integer;
    FAccountCount : integer;
    FEntryCount : integer;
    FCashbookCount : integer;
    FCashbookEntryCount : integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute; override;
  end;

var
  ErrorSignalled : boolean;
  FullSaveCount : integer;
  LoadCount : integer;
  UpdateCount : integer;

procedure SignalError;
begin
  GlobalDataLock.Acquire;
  try
    ErrorSignalled := true;
  finally
    GlobalDataLock.Release;
  end;
end;

procedure IncrementFullSaveCount;
begin
  GlobalDataLock.Acquire;
  try
    Inc(FullSaveCount);
  finally
    GlobalDataLock.Release;
  end;
end;

function GetFullSaveCount : integer;
begin
  GlobalDataLock.Acquire;
  try
    Result := FullSaveCount;
  finally
    GlobalDataLock.Release;
  end;
end;

procedure IncrementLoadCount;
begin
  GlobalDataLock.Acquire;
  try
    Inc(LoadCount);
  finally
    GlobalDataLock.Release;
  end;
end;

function GetLoadCount : integer;
begin
  GlobalDataLock.Acquire;
  try
    Result := LoadCount;
  finally
    GlobalDataLock.Release;
  end;
end;

procedure IncrementUpdateCount;
begin
  GlobalDataLock.Acquire;
  try
    Inc(UpdateCount);
  finally
    GlobalDataLock.Release;
  end;
end;

function GetUpdateCount : integer;
begin
  GlobalDataLock.Acquire;
  try
    Result := UpdateCount;
  finally
    GlobalDataLock.Release;
  end;
end;

constructor TTestClientThread.Create;
begin
  // create thread suspended
  inherited Create(true);
  // create other objects used during test
  FClientCommunicator := TClientCommunicator.Create(ServerIPAddress,ServerPortNumber);
  FDatabaseObjectCollection1 := TDatabaseObjectCollection.Create;
  FDatabaseObjectCollection1.Owned := true;
  FDatabaseObjectCollection2 := TDatabaseObjectCollection.Create;
  FDatabaseObjectCollection2.Owned := true;
  FDatabaseObjectCollection3 := TDatabaseObjectCollection.Create;
  FDatabaseObjectCollection3.Owned := true;
  FDatabaseObjectCollection4 := TDatabaseObjectCollection.Create;
  FDatabaseObjectCollection4.Owned := true;
  FDatabaseObjectCollection5 := TDatabaseObjectCollection.Create;
  FDatabaseObjectCollection5.Owned := true;
end;

destructor TTestClientThread.Destroy;
begin
  // cleanup
  FDatabaseObjectCollection1.Free;
  FDatabaseObjectCollection2.Free;
  FDatabaseObjectCollection3.Free;
  FDatabaseObjectCollection4.Free;
  FDatabaseObjectCollection5.Free;
  FClientCommunicator.Free;
end;

const
  ThreadCount = 5;

procedure TTestClientThread.Execute;
var
  SelectionString : string;

  procedure TestFullSaveToDatabase;
  var
    i : integer;
    WorkstationConfiguration : TWorkstationConfiguration;
  const
    LongString = 'jasl asjkf asdjklf asdfjk asdfjklas dfjk;lsad ajsdf;j asdl;j salkdfj ;lkasdjf asjdflkja sdfjasdlk;fjl;asdjf asdjflk;sajdfkl;ajs dflkas jdflkasjdflk;jaskldf;j as;kldfj as;djf lkas;jdf lk;asj dfas;jd f;jaslkdf jasljk;df ';
  begin
    try
      for i := 0 to 10 do
      begin
        WorkstationConfiguration := TWorkstationConfiguration.Create;
        WorkstationConfiguration.Id := FClientCommunicator.GenerateId(1);
        WorkstationConfiguration.ReportLayouts.SetString(LongString);
        FClientCommunicator.FullSaveDatabaseObject(TWorkstationConfiguration,WorkstationConfiguration,true,true);
        FDatabaseObjectCollection1.Add(WorkstationConfiguration);
      end;

      for i := 0 to FDatabaseObjectCollection1.Count - 1 do
      begin
        WorkstationConfiguration := TWorkstationConfiguration(FClientCommunicator.LoadDatabaseObject(TWorkstationConfiguration,FDatabaseObjectCollection1[i].Id));
        if WorkstationConfiguration.ReportLayouts.AsString <> LongString then
        begin
          MessageLog.Log('Strings do not match in TestFullSaveToDatabase');
          SignalError;
        end;
        WorkstationConfiguration.Free;
      end;

      for i := 0 to FDatabaseObjectCollection1.Count - 1 do
      begin
        FClientCommunicator.DeleteDatabaseObject(TWorkstationConfiguration,FDatabaseObjectCollection1[i].Id);
        SelectionString := 'WHERE ' + DelimitSQLFieldName('ObjectId') + ' = ' + IntToStr(FDatabaseObjectCollection1[i].Id);
        FClientCommunicator.DeleteSomeDatabaseObjects(TNote,SelectionString);
      end;

      FDatabaseObjectCollection1.Clear;
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in TestFullSaveToDatabase');
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;
  end;

  procedure TestLoad
    (DatabaseObjectClass : TDatabaseObjectClass;
     var Count : integer);
  var
    EndRecNo : integer;
    i : integer;
    DatabaseObject1 : TDatabaseObject;
    DatabaseObject2 : TDatabaseObject;
  begin
    Count := 0;
    // test LoadAllDatabaseObjects
    try
      FClientCommunicator.LoadAllDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in LoadAllDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;
    // test LoadSomeDatabaseObjects
    try
      FClientCommunicator.LoadSomeDatabaseObjects(FDatabaseObjectCollection2,DatabaseObjectClass,'');
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in LoadSomeDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;
    // test LoadDatabaseObjectsFromRemoteDataset
    try
      EndRecNo := FClientCommunicator.OpenRemoteDataset(DatabaseObjectClass,'');
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in OpenRemoteDataset for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
        EndRecNo := 0;
      end;
    end;
    try
      FClientCommunicator.LoadDatabaseObjectsFromRemoteDataset(FDatabaseObjectCollection3,1,EndRecNo);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in LoadDatabaseObjectsFromRemoteDataset for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;
    try
      FClientCommunicator.CloseRemoteDataset;
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in CloseRemoteDataset for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;
    // test LoadDatabaseObject
    try
      Count := FDatabaseObjectCollection1.Count;
      if Count > 20 then
        Count := 20;
      for i := 0 to Count - 1 do
      begin
        DatabaseObject1 := FDatabaseObjectCollection1[i];
        DatabaseObject2 := FClientCommunicator.LoadDatabaseObject(DatabaseObjectClass,DatabaseObject1.Id);
        if DatabaseObject2 <> nil then
          FDatabaseObjectCollection4.Add(DatabaseObject2);
        SelectionString := 'WHERE ' + DelimitSQLFieldName('Id') + ' = ' + IntToStr(DatabaseObject1.Id);
        DatabaseObject2 := FClientCommunicator.LoadDatabaseObject(DatabaseObjectClass,SelectionString);
        if DatabaseObject2 <> nil then
          FDatabaseObjectCollection5.Add(DatabaseObject2);
      end;
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in LoadDatabaseObject for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    if (FDatabaseObjectCollection1.Count <> FDatabaseObjectCollection2.Count)
      or (FDatabaseObjectCollection2.Count <> FDatabaseObjectCollection3.Count)
      or (Count <> FDatabaseObjectCollection4.Count)
      or (Count <> FDatabaseObjectCollection5.Count) then
    begin
      MessageLog.Log('Count mismatch for ' + DatabaseObjectClass.ClassName);
      SignalError;
    end;

    Count := FDatabaseObjectCollection1.Count;

    FDatabaseObjectCollection1.Clear;
    FDatabaseObjectCollection2.Clear;
    FDatabaseObjectCollection3.Clear;
    FDatabaseObjectCollection4.Clear;
    FDatabaseObjectCollection5.Clear;
  end;

  procedure TestUpdate
    (DatabaseObjectClass : TDatabaseObjectClass);
  var
    i : integer;
  begin
    try
      FClientCommunicator.LoadAllDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in TestUpdate-LoadAllDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // clear the object ids and generate new ids before
    // saving to database
    try
      for i := 0 to FDatabaseObjectCollection1.Count - 1 do
      begin
        FDatabaseObjectCollection1[i].Id := FClientCommunicator.GenerateId(1);
        FClientCommunicator.SaveDatabaseObject(DatabaseObjectClass,FDatabaseObjectCollection1[i]);
      end;
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in SaveDatabaseObject for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // then delete the ones that were just created
    try
      FClientCommunicator.DeleteDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in DeleteDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // save them again as a collection
    try
      FClientCommunicator.SaveDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in SaveDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // then delete them again individually
    try
      for i := 0 to FDatabaseObjectCollection1.Count - 1 do
        FClientCommunicator.DeleteDatabaseObject(DatabaseObjectClass,FDatabaseObjectCollection1[i].Id);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in DeleteDatabaseObject for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // save them again as a collection
    try
      FClientCommunicator.SaveDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in SaveDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    // then delete them using selection string
    try
      for i := 0 to FDatabaseObjectCollection1.Count - 1 do
      begin
        SelectionString := 'WHERE ' + DelimitSQLFieldName('Id') + ' = ' + IntToStr(FDatabaseObjectCollection1[i].Id);
        FClientCommunicator.DeleteSomeDatabaseObjects(DatabaseObjectClass,SelectionString);
      end;
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in DeleteSomeDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    FDatabaseObjectCollection1.Clear;
  end;

  procedure TestFinalCount
    (DatabaseObjectClass : TDatabaseObjectClass;
     Count : integer);
  begin
    try
      FClientCommunicator.LoadAllDatabaseObjects(FDatabaseObjectCollection1,DatabaseObjectClass);
    except
      on E:Exception do
      begin
        MessageLog.Log('Exception in TestFinalCount-LoadAllDatabaseObjects for ' + DatabaseObjectClass.ClassName);
        MessageLog.Log(E.Message);
        SignalError;
      end;
    end;

    if (FDatabaseObjectCollection1.Count <> Count) then
    begin
      MessageLog.Log('Count mismatch for ' + DatabaseObjectClass.ClassName + ' in TestFinalCount');
      SignalError;
    end;

    FDatabaseObjectCollection1.Clear;
  end;

begin
  if not FClientCommunicator.CheckProgramVersion then
    SignalError;

{  SelectionString := 'WHERE ' + DelimitSQLFieldName('AccountId') + ' = 1052';
  try
    FClientCommunicator.LoadSomeDatabaseObjects(FDatabaseObjectCollection1,TEntry,SelectionString);
  except
    MessageLog.Log('Exception in first LoadSomeDatabaseObjects for 1052');
    SignalError;
  end;
  try
    FClientCommunicator.LoadSomeDatabaseObjects(FDatabaseObjectCollection2,TEntry,SelectionString);
  except
    MessageLog.Log('Exception in second LoadSomeDatabaseObjects for 1052');
    SignalError;
  end;
  if FDatabaseObjectCollection1.Count <> FDatabaseObjectCollection2.Count then
  begin
    MessageLog.Log('Count mismatch for 1052');
    SignalError;
  end;
  FDatabaseObjectCollection1.Clear;
  FDatabaseObjectCollection2.Clear;

  TestFullSaveToDatabase;

  IncrementFullSaveCount;

  // wait until all threads have completed full save testing
  while GetFullSaveCount < ThreadCount do
    Sleep(10); }

  TestLoad(TGlobalConfiguration,FGlobalConfigurationCount);
  Sleep(100);
  TestLoad(TWorkstationConfiguration,FWorkstationConfigurationCount);
  Sleep(100);
  TestLoad(TNote,FNoteCount);
  Sleep(100);
  TestLoad(TCompany,FCompanyCount);
  Sleep(100);
  TestLoad(TAccount,FAccountCount);
  Sleep(100);
  TestLoad(TEntry,FEntryCount);
  Sleep(100);
  TestLoad(TCashbook,FCashbookCount);
  Sleep(100);
  TestLoad(TCashbookEntry,FCashbookEntryCount);
  Sleep(100);

  IncrementLoadCount;

  // wait until all threads have completed load testing
  while GetLoadCount < ThreadCount do
    Sleep(10);

  TestUpdate(TGlobalConfiguration);
  Sleep(100);
  TestUpdate(TWorkstationConfiguration);
  Sleep(100);
  TestUpdate(TNote);
  Sleep(100);
  TestUpdate(TCompany);
  Sleep(100);
  TestUpdate(TAccount);
  Sleep(100);
  TestUpdate(TEntry);
  Sleep(100);
  TestUpdate(TCashbook);
  Sleep(100);
  TestUpdate(TCashbookEntry);

  IncrementUpdateCount;

  // wait until all threads have completed update testing
  while GetUpdateCount < ThreadCount do
    Sleep(10);

  TestFinalCount(TGlobalConfiguration,FGlobalConfigurationCount);
  Sleep(100);
  TestFinalCount(TWorkstationConfiguration,FWorkstationConfigurationCount);
  Sleep(100);
  TestFinalCount(TNote,FNoteCount);
  Sleep(100);
  TestFinalCount(TCompany,FCompanyCount);
  Sleep(100);
  TestFinalCount(TAccount,FAccountCount);
  Sleep(100);
  TestFinalCount(TEntry,FEntryCount);
  Sleep(100);
  TestFinalCount(TCashbook,FCashbookCount);
  Sleep(100);
  TestFinalCount(TCashbookEntry,FCashbookEntryCount);
end;

function TestServer : boolean;
var
  TestClientThreads : array[1..ThreadCount] of TTestClientThread;
  i : integer;
  SaveMessagingPollTime : integer;
begin
  // increase messaging poll time to sixty minutes
  // so it does not interfere with test clients
  SaveMessagingPollTime := MessagingPollTime;
  MessagingPollTime := 3600000;
  // clear error flag
  ErrorSignalled := false;
  // create lock object to be used by client threads
  GlobalDataLock := TCriticalSection.Create;
  // create threads
  for i := 1 to ThreadCount do
    TestClientThreads[i] := TTestClientThread.Create;
  // run the threads
  for i := 1 to ThreadCount do
  begin
    Sleep(1000);
    TestClientThreads[i].Resume;
  end;
  // wait for all threads to finish
  for i := 1 to ThreadCount do
    TestClientThreads[i].WaitFor;
  // destroy threads
  for i := 1 to ThreadCount do
    TestClientThreads[i].Free;
  // return true if no error
  Result := not ErrorSignalled;
  // restore messaging poll time
  MessagingPollTime := SaveMessagingPollTime;
  // destroy lock object
  GlobalDataLock.Free;
  GlobalDataLock := nil;
end;

end.