{ This DISQLite3 demo allows to experiment with read and write locks using two
  threads. The TReaderThread locks the database through a SELECT operation,
  while the TWriterThread tries an INSERT at the same time.

  The TWriterThread sets up a busy timeout to wait for the TReaderThread to
  finish and unlock the database so the TWriterThread can proceed writing
  the data. You can follow this as you watch the output each thread prints
  to the console.

  In the original setup, the TWriterThread waits just long enough for the
  TReaderThread to finish. However, you can change the settings in the const
  section at the very beginning of this unit to experiment with different
  scenarios. For example, if you increase the READ_LIMIT constant, TReaderThread
  might take too long for TWriterThread to succeed.  Alternatively, you can cut
  down the WRITE_BUSY_TIMEOUT to achieve the same result. Just play with the
  different values to understand how locking works with DISQLite3.

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de

  Copyright (c) 2006-2021 Ralf Junker, Yunqa <delphi@yunqa.de>

------------------------------------------------------------------------------ }

program DISQLite3_Busy_Timeout;

{$APPTYPE CONSOLE}
{$I DICompilers.inc}
{$I DISQLite3.inc}

uses
  {$IFDEF FastMM}{$IFDEF COMPILER_6_UP}FastMM4, {$ENDIF}{$ENDIF}
  DISystemCompat, Windows, SysUtils, Classes, DISQLite3Api;

{$R ..\Yunqa.res}

const
  { Modify these constants to experiment with different scenarios. }

  READ_LIMIT = 20; // Default: 20 -- each read takes about 100 ms

  WRITE_BUSY_TIMEOUT = 3000; // Default: 3000 -- busy timeout in milliseconds.

  WRITE_TRANSACTION_TYPE = 'DEFERRED'; // Default: DEFERRED
  // WRITE_TRANSACTION_TYPE = 'IMMEDIATE';
  // WRITE_TRANSACTION_TYPE = 'EXCLUSIVE';

  {.$DEFINE InsertInTransaction}// Default: Undefined.

  INSERT_COUNT = 25; // Default: 25 -- numer of records inserted.

type
  //------------------------------------------------------------------------------
  // TTestClass class - performs the tests.
  //------------------------------------------------------------------------------

  TTestClass = class
  private
    FCriticalSection: TRTLCriticalSection;
    FThreadCounter: Cardinal;
    FDatabaseName: string;
  public
    constructor Create(const ADatabaseName: string);
    destructor Destroy; override;
    { TThread.OnTerminate does not work in console applications, so we have to
      implement our own thread tracking mechanism. }
    procedure IncThreadCounter;
    procedure DecThreadCounter;
    procedure Execute;
    { Waits till all threads have finished. }
    procedure Wait;

    property DatabaseName: string read FDatabaseName;
  end;

  //------------------------------------------------------------------------------

  TDISQLite3Thread = class(TThread)
  private
    FDb: sqlite3_ptr;
    FTestClass: TTestClass;
    FVerbose: Boolean;
  protected
    procedure WriteMsg(const AMsg: string; const AArgs: array of const);
  public
    constructor Create(const ATestClass: TTestClass; const AVerbose: Boolean = False);
    destructor Destroy; override;
    property DB: sqlite3_ptr read FDb;
    property TestClass: TTestClass read FTestClass;
  end;

  //------------------------------------------------------------------------------

  TReaderThread = class(TDISQLite3Thread)
  public
    procedure Execute; override;
  end;

  //------------------------------------------------------------------------------

  TWriterThread = class(TDISQLite3Thread)
  public
    procedure Execute; override;
  end;

  //------------------------------------------------------------------------------

function MakeMethod(const AData, ACode: Pointer): TMethod;
begin
  with Result do begin Data := AData; Code := ACode; end;
end;

//------------------------------------------------------------------------------
// TDISQLite3Thread
//------------------------------------------------------------------------------

constructor TDISQLite3Thread.Create(const ATestClass: TTestClass; const AVerbose: Boolean = False);
begin
  ATestClass.IncThreadCounter;
  sqlite3_check(sqlite3_open(PUtf8Char(sqlite3_encode_utf8(ATestClass.DatabaseName)), @FDb), FDb);
  sqlite3_exec_fast(FDb, 'PRAGMA synchronous=off'); // Be faster and less safe - this is just a demo ;-)
  FTestClass := ATestClass;
  FVerbose := AVerbose;
  FreeOnTerminate := True;
  inherited Create(False);
end;

//------------------------------------------------------------------------------

destructor TDISQLite3Thread.Destroy;
begin
  sqlite3_check(sqlite3_close(FDb), FDb);
  inherited;
end;

//------------------------------------------------------------------------------

procedure TDISQLite3Thread.WriteMsg(const AMsg: string; const AArgs: array of const);
begin
  if FVerbose then
    WriteLn(Format(AMsg, AArgs));
end;

//------------------------------------------------------------------------------
// TReaderThread
//------------------------------------------------------------------------------

procedure TReaderThread.Execute;
var
  SQL: Utf8String;
  Stmt: sqlite3_stmt_ptr;
begin
  try
    ReturnValue := SQLITE_OK;
    try
      { Run a query which takes about 3 seconds to complete. The database
        will be locked as long as the query executes. }
      SQL := 'SELECT t FROM Test LIMIT ' + Utf8String(IntToStr(READ_LIMIT)) + ';';
      sqlite3_check(sqlite3_prepare_v2(DB, PUtf8Char(SQL), Length(SQL), @Stmt, nil), DB);
      try
        while not Terminated and (sqlite3_check(sqlite3_step(Stmt), DB) = SQLITE_ROW) do
          begin
            WriteLn('Read ', sqlite3_column_int(Stmt, 0));
            Sleep(100); // Make sure this query takes some time!
          end;
      finally
        sqlite3_finalize(Stmt);
      end;
    except
      on e: ESQLite3 do
        begin
          { If the DISQLite3 database engine raised this error,
            return the specific error code? }
          ReturnValue := e.ErrorCode;
        end
    else
      begin
        { For all other exceptions, return just a general error value. }
        ReturnValue := SQLITE_ERROR;
      end;
    end;
  finally
    TestClass.DecThreadCounter;
  end;
end;

//------------------------------------------------------------------------------
// TWriterThread
//------------------------------------------------------------------------------

procedure TWriterThread.Execute;
var
  e, i: Integer;
  Stmt: sqlite3_stmt_ptr;
begin
  try
    ReturnValue := SQLITE_OK;
    try
      { Set a busy timeout of 3000 ms, equivalent to 3 seconds. If subsequent
        commands are executed while the database is locked by another thread
        (like TReaderThread in this example), DISQLite3 will keep on retrying
        the command for 3 seconds before giving up and returning SQLITE_LOCKED. }
      sqlite3_busy_timeout(FDb, WRITE_BUSY_TIMEOUT);

      {$IFDEF InsertInTransaction}
      WriteMsg('  BEGINNING %s TRANSACTION ...', [WRITE_TRANSACTION_TYPE]);
      sqlite3_exec_fast(DB, 'BEGIN ' + WRITE_TRANSACTION_TYPE + ';');
      WriteMsg('  BEGINNING %s TRANSACTION ... Done', [WRITE_TRANSACTION_TYPE]);
      try
        {$ENDIF InsertInTransaction}
        { Create a new table ... }
        sqlite3_exec_fast(FDb, 'CREATE TABLE IF NOT EXISTS Test (t INTEGER);');

        e := sqlite3_prepare_v2(DB, 'INSERT INTO test VALUES (?);', -1, @Stmt, nil);
        try
          if e = SQLITE_OK then
            begin
              i := 0;
              repeat
                WriteMsg('  Inserting %d ...', [i]);
                sqlite3_check(sqlite3_bind_int(Stmt, 1, i), DB);
                sqlite3_check(sqlite3_step(Stmt), DB);
                WriteMsg('  Inserting %d ... Done', [i]);
                sqlite3_check(sqlite3_reset(Stmt), DB);
                Inc(i);
              until Terminated or (i >= INSERT_COUNT);
            end;
        finally
          sqlite3_finalize(Stmt);
        end;
        {$IFDEF InsertInTransaction}
      finally
        WriteMsg('  COMMITTING TRANSACTION ...', []);
        sqlite3_exec_fast(DB, 'COMMIT TRANSACTION');
        WriteMsg('  COMMITTING TRANSACTION ... Done', []);
      end;
      {$ENDIF InsertInTransaction}
    except
      on e: ESQLite3 do
        begin
          { If the DISQLite3 database engine raised this error,
            return the specific error code? }
          ReturnValue := e.ErrorCode;
          if ReturnValue = SQLITE_BUSY then
            WriteLn('  INSERT timed out!')
          else
            WriteLn(e.Message);
        end
    else
      begin
        { For all other exceptions, return just a general error value. }
        ReturnValue := SQLITE_ERROR;
      end;
    end;
  finally
    TestClass.DecThreadCounter;
  end;
end;

//------------------------------------------------------------------------------
// TTestClass class
//------------------------------------------------------------------------------

constructor TTestClass.Create(const ADatabaseName: string);
begin
  inherited Create;
  FDatabaseName := ADatabaseName;
  { Create critical section and event object to monitor multiple threads. }
  InitializeCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

destructor TTestClass.Destroy;
begin
  DeleteCriticalSection(FCriticalSection);
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTestClass.DecThreadCounter;
begin
  EnterCriticalSection(FCriticalSection);
  if FThreadCounter > 0 then
    Dec(FThreadCounter);
  LeaveCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

procedure TTestClass.Execute;
var
  DB: sqlite3_ptr;
  i, v: Integer;
  SQL: AnsiString;
  Stmt: sqlite3_stmt_ptr;
begin
  { Always start over with an empty database. }
  SysUtils.DeleteFile(FDatabaseName);
  { ... and insert some data. We use the thread here just for convenience. }
  TWriterThread.Create(Self);
  Wait;

  { Here starts the test: We create two threads: }

  { Thread 1: Initializes a prolonged reading, which locks the database. The
    thread will free itself automatically when terminated.}
  TReaderThread.Create(Self);
  { Wait a bit to simulate a writing when tread one is already in the middle of
    the reading. }
  Sleep(300);
  { Thread 2: Tries to write to the database while it is locked because thread 1
    is reading from it. The thread will free itself automatically when
    terminated. }
  TWriterThread.Create(Self, True);
  Wait;

  { Check if all values were correctly inserted into the database. }
  sqlite3_check(sqlite3_open(PUtf8Char(sqlite3_encode_utf8(DatabaseName)), @DB), DB);
  try
    i := 0;
    SQL := 'SELECT t FROM Test ORDER BY 1;';
    sqlite3_check(sqlite3_prepare_v2(DB, PAnsiChar(SQL), Length(SQL), @Stmt, nil), DB);
    try
      while sqlite3_check(sqlite3_step(Stmt), DB) = SQLITE_ROW do
        begin
          v := sqlite3_column_int(Stmt, 0);
          if v <> i div 2 then
            begin
              WriteLn('ERROR');
              Break;
            end;
          Inc(i);
        end;
    finally
      sqlite3_finalize(Stmt);
    end;
  finally
    sqlite3_check(sqlite3_close(DB), DB);
  end;

  if i <> 2 * INSERT_COUNT then
    WriteLn('ERROR: ', i, ' records found, ', 2 * INSERT_COUNT, ' expexted');
end;

//------------------------------------------------------------------------------

procedure TTestClass.IncThreadCounter;
begin
  EnterCriticalSection(FCriticalSection);
  Inc(FThreadCounter);
  LeaveCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

procedure TTestClass.Wait;
begin
  while FThreadCounter > 0 do
    Sleep(10);
end;

//------------------------------------------------------------------------------

var
  t: TTestClass;

begin
  { Disable all FPU and SSE exceptions. }
  Set8087CW($133F); {$IFDEF CPUX64}SetMXCSR($1F80); {$ENDIF CPUX64}

  try
    { Initialize the DISQLite3 library prior to using any other DISQLite3
      functionality. See also sqlite3_shutdown() below.}
    sqlite3_initialize;
    try

      t := TTestClass.Create('test.db3');
      try
        t.Execute;

        WriteLn;
        WriteLn('Done - Press ENTER to Exit');
        ReadLn;
      finally
        t.Free;
      end;

    finally
      { Deallocate any resources that were allocated by
        sqlite3_initialize() above. }
      sqlite3_shutdown;
    end;

  except
    on e: Exception do
      WriteLn(e.Message);
  end;

end.

