////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit containts Asyncronous standard console input and output.         //
// To be used in robust multi-threaded console applications.                  //
// ************************************************************************** //
// Usage example:                                                             //
//  // Recognize @Exit=n command, print message on unrecognized commands      //
//  program demo_ascio;                                                       //
//  const Terminated : Boolean = False;                                       //
//   procedure DoSpec(const args:LongString);                                 //
//   begin                                                                    //
//    StdOut.Put:='Could not recognize: '+args;                               //
//   end;                                                                     //
//   procedure DoExit(const cmnd,args:LongString);                            //
//   begin                                                                    //
//    Terminated:=True;                                                       //
//    System.ExitCode:=StrToIntDef(args,0);                                   //
//    StdOut.Put:=Format('%s=%d',[cmnd,System.ExitCode]);                     //
//   end;                                                                     //
//  begin                                                                     //
//   StdIn.SpecHandler:=DoSpec;                                               //
//   StdIn.AddCommand('@Exit',DoExit);                                        //
//   while not Terminated do begin                                            //
//    if StdIn.Count>0 then StdIn.Process(StdIn.Get);                         //
//   end;                                                                     //
//  end;                                                                      //
// ************************************************************************** //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20051017 - Creation, testing                                               //
// 20051225 - Fully modified, add Count, Space                                //
// 20051226 - Process, AddCommand, ClearCommands, SpecHandler, TimeOut        //
// 20080119 - DefaultStdInTimeOut, DefaultStdOutTimeOut                       //
// 20230504 - Modified for FPC (A.K.)                                         //
// 20250129 - Use TAtomicCounter                                              //
// 20260115 - TStdIOThread.Put(…) uses PosEol/ForEachStringLine               //
//  myCmndList.UseLocale:=False for fast ANSI sort/search                     //
//  TStdIOWrapper.Process uses TrimRight(cmnd) to allow spaces before =       //
////////////////////////////////////////////////////////////////////////////////

unit _crw_ascio; // Asynchronous Standard Console Input and Output

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_str;

const
 StdIoErrorCount    : TAtomicCounter = nil;      // I/O errors counter
 StdIoCmndPrefChars : TCharSet       = ['@'];    // Commands prefix chars
 DefaultStdInCapacity                = 65535;    // Lines in StdIn  queue
 DefaultStdOutCapacity               = 65535;    // Lines in StdOut queue
 DefaultStdInTimeOut                 = 1;        // StdIn.TimeOut, ms
 DefaultStdOutTimeOut                = 0;        // StdOut.TimeOut, ms
 StdInUseFOT        : Boolean        = True;     // StdIn  Use FreeOnTerminate
 StdOutUseFOT       : Boolean        = False;    // StdOut Use FreeOnTerminate
 StdInBuffSize      : SizeInt        = 1024*32;  // StdIn  Buffer Size, bytes
 StdOutBuffSize     : SizeInt        = 1024*32;  // StdOut Buffer Size, bytes
 SetTextBufMinimal                   = 128;      // Minimal size for SetTextBuf
 SetTextBufMaximal                   = 65355;    // Maximal size for SetTextBuf
 StdIoSleepQuantum  : Cardinal       = {$IFDEF WINDOWS} 1 {$ELSE} 4 {$ENDIF};

type
 TStdIoSpecialHandler = procedure (const args:LongString);
 TStdIoCommandHandler = procedure (const cmnd,args:LongString);

 /////////////////////////////////////////////////////////////////////////
 // Asynchronous Input/Output communication thread. For internal use only.
 /////////////////////////////////////////////////////////////////////////
type
 TStdIOThread = class(TThread)
 private
  myLatch    : TSysCriticalSection;
  myQueue    : TStringList;
  myCapacity : Integer;
  myTimeOut  : Cardinal;
  myQuantum  : Cardinal;
  myBuffer   : LongString;
  function    Count:Integer;
  function    Get(var Line:LongString):Boolean;
  function    Put(const Line:LongString):Boolean;
  procedure   ResetBuffer(var F:Text; NeedFlush:Boolean);
  function    WaitForTimeout:Boolean;
  procedure   Clear;
 public
  constructor Create(aCapacity:Integer);
  destructor  Destroy; override;
 end;

 ///////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Input communication thread. For internal use only.
 ///////////////////////////////////////////////////////////////////////////
type
 TStdInThread = class(TStdIOThread)
 public
  constructor Create;
  procedure   Execute; override;
 end;

 ////////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Output communication thread. For internal use only.
 ////////////////////////////////////////////////////////////////////////////
type
 TStdOutThread = class(TStdIOThread)
 public
  constructor Create;
  procedure   Execute; override;
 end;

 ////////////////////////////////////////////////////////////////////////////
 // Asynchronous Standard Input/Output thread wrapper. For internal use only.
 ////////////////////////////////////////////////////////////////////////////
type
 TStdIOWrapper = class(TMasterObject)
 private
  myThread   : TStdIOThread;
  myUseFOT   : Boolean;
  myCmndList : TStringList;
  mySpecHand : TStdIoSpecialHandler;
  function    GetLine:LongString;
  procedure   SetPut(const Line:LongString);
  function    GetCapacity:Integer;
  procedure   SetCapacity(const aCapacity:Integer);
  function    GetPriority:TThreadPriority;
  procedure   SetPriority(const aPriority:TThreadPriority);
  function    GetCount:Integer;
  function    GetSpace:Integer;
  function    GetTimeOut:Cardinal;
  procedure   SetTimeOut(aTimeOut:Cardinal);
  procedure   SetSpecHandler(aSpecHandler:TStdIoSpecialHandler);
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   Clear;
  procedure   ClearCommands;
  function    Process(const data:LongString):Boolean;
  function    AddCommand(const cmnd:LongString; proc:TStdIoCommandHandler):Boolean;
  function    TryGet(var Line:LongString):Boolean;
  function    TryPut(const Line:LongString):Boolean;
  property    Get         : LongString      read  GetLine;
  property    Put         : LongString      write SetPut;
  property    Capacity    : Integer         read  GetCapacity write SetCapacity;
  property    Priority    : TThreadPriority read  GetPriority write SetPriority;
  property    Count       : Integer         read  GetCount;
  property    Space       : Integer         read  GetSpace;
  property    TimeOut     : Cardinal        read  GetTimeOut  write SetTimeOut;
  property    SpecHandler : TStdIoSpecialHandler              write SetSpecHandler;
 end;

 ///////////////////////////////////////////////////////////////
 // Asynchronous Standard Input communication thread wrapper.
 // Readln queue strings from stdin file.
 // Usage like:
 //  if StdIn.TryGet(Line) then Process(Line);
 // or
 //  if StdIn.Count>0 then Process(StdIn.Get);
 // You also may use StdIn.TryPut(Line) and StdIn.Put
 // to simulate input (which normally coming from System.Input).
 ///////////////////////////////////////////////////////////////
type
 TStdIn = class(TStdIOWrapper)
 public
  constructor Create;
 end;

 //////////////////////////////////////////////////////////////////
 // Asynchronous Standard Output communication thread wrapper.
 // Write queue strings into stdout file, then flush stdout buffers
 // to be sure that data really transferred to stdout file.
 // Usage like:
 //  if StdOut.TryPut(Line) then Success;
 // or
 //  if StdOut.Space>0 then StdOut.Put:=Line;
 // You also may use StdOut.TryGet(Line) and StdOut.Get
 // to free output queue (which normally coming to System.Output).
 //////////////////////////////////////////////////////////////////
type
 TStdOut = class(TStdIOWrapper)
 public
  constructor Create;
 end;

function StdIn:TStdIn;

function StdOut:TStdOut;

procedure StdOutEcho(const Msg:LongString);

 // Test, just for debug.
procedure test_crw_ascio;

implementation

procedure InitIoCounters;
begin
 LockedInit(StdIoErrorCount);
end;

procedure FreeIoCounters;
begin
 LockedFree(StdIoErrorCount);
end;

 //////////////////////////////
 // TStdIOThread implementation
 //////////////////////////////

constructor TStdIOThread.Create(aCapacity:Integer);
begin
 inherited Create(True);
 InitCriticalSection(myLatch);
 myQueue:=TStringList.Create;
 myCapacity:=aCapacity; myBuffer:='';
 myQuantum:=Max(1,Min(10,StdIoSleepQuantum));
 {$IFDEF FPC} Start; {$ELSE} Resume; {$ENDIF}
end;

destructor TStdIOThread.Destroy;
begin
 if not Terminated and not Suspended then begin
  Terminate;
  if myTimeOut>0 then
  if WaitForTimeout then Suspended:=True;
  if not Suspended then WaitFor;
 end;
 Kill(myQueue); myBuffer:='';
 DoneCriticalSection(myLatch);
 inherited Destroy;
end;

function TStdIOThread.WaitForTimeout:Boolean;
var t:QWord;
begin
 Result:=False;
 if IsWindows then begin
  {$IFDEF WINDOWS}
  if WaitForSingleObject(Handle,myTimeOut)<>WAIT_OBJECT_0 then Result:=True;
  {$ENDIF}
 end else begin
  t:=GetTickCount64;
  while (GetTickCount64-t<=myTimeOut) and not Finished do Sleep(myQuantum);
  Result:=not Finished;
 end;
end;

function TStdIOThread.Count:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  EnterCriticalSection(myLatch);
  try
   if Assigned(myQueue) then Result:=myQueue.Count;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Count');
  end;
 end;
end;

function TStdIOThread.Get(var Line:LongString):Boolean;
begin
 Line:='';
 Result:=False;
 if Assigned(Self) then
 try
  EnterCriticalSection(myLatch);
  try
   if Assigned(myQueue) then
   if myQueue.Count>0 then begin
    Line:=myQueue[0];
    myQueue.Delete(0);
    Result:=True;
   end;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Get');
  end;
 end;
end;

function IterPutLine(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=Assigned(Custom);
 if Result then TStringList(Custom).Add(Line);
end;

function TStdIOThread.Put(const Line:LongString):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 try
  EnterCriticalSection(myLatch);
  try
   if Assigned(myQueue) then
   if myQueue.Count<myCapacity then begin
    if (PosEol(Line)<=0)
    then myQueue.Add(Line)
    else ForEachStringLine(Line,IterPutLine,myQueue);
    Result:=True;
   end;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Put');
  end;
 end;
end;

procedure TStdIOThread.Clear;
begin
 if Assigned(Self) then
 try
  EnterCriticalSection(myLatch);
  try
   if Assigned(myQueue) then myQueue.Clear;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Clear');
  end;
 end;
end;

procedure TStdIOThread.ResetBuffer(var F:Text; NeedFlush:Boolean);
var Buf:Pointer; Len:SizeInt;
begin
 if Assigned(Self) then
 try
  Len:=Length(myBuffer);
  Buf:=Pointer(myBuffer);
  if (Len>SetTextBufMinimal) then begin
   if NeedFlush then Flush(F);
   SetTextBuf(F,Buf^,Len);
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'ResetBuffer');
  end;
 end;
end;

 //////////////////////////////
 // TStdInThread implementation
 //////////////////////////////

constructor TStdInThread.Create;
begin
 inherited Create(DefaultStdInCapacity);
 myTimeOut:=DefaultStdInTimeOut;
 myBuffer:=StringOfChar(#0,Max(0,Min(SetTextBufMaximal,StdInBuffSize)));
end;

procedure TStdInThread.Execute;
var
 DataS : LongString;
begin
 ResetBuffer(System.Input,False);
 while not Terminated do
 try
  DataS:='';
  if System.IOResult<>0 then LockedInc(StdIoErrorCount) else
  while not System.Eof(System.Input) and not Terminated do begin
   System.Readln(System.Input,DataS);
   if (System.IOResult<>0) or not Put(DataS) then begin
    LockedInc(StdIoErrorCount);
    Break;
   end;
  end;
  DataS:='';
  Sleep(myQuantum);
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Execute');
   Sleep(myQuantum);
  end;
 end;
end;

 ///////////////////////////////
 // TStdOutThread implementation
 ///////////////////////////////

constructor TStdOutThread.Create;
begin
 inherited Create(DefaultStdOutCapacity);
 myTimeOut:=DefaultStdOutTimeOut;
 myBuffer:=StringOfChar(#0,Max(0,Min(SetTextBufMaximal,StdOutBuffSize)));
end;

procedure TStdOutThread.Execute;
var
 nLine : Integer;
 DataS : LongString;
begin
 ResetBuffer(System.Output,True);
 while not Terminated do
 try
  nLine:=0;
  DataS:='';
  if System.IOResult<>0 then LockedInc(StdIoErrorCount) else
  while Get(DataS) and not Terminated do begin
   System.Writeln(System.Output,DataS);
   if System.IOResult<>0 then begin
    LockedInc(StdIoErrorCount);
    Break;
   end;
   Inc(nLine);
  end;
  if nLine>0 then begin
   System.Flush(System.Output);
   if System.IOResult<>0 then LockedInc(StdIoErrorCount);
  end; 
  DataS:='';
  Sleep(myQuantum);
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   BugReport(E,Self,'Execute');
   Sleep(myQuantum);
  end;
 end;
end;

 ///////////////////////////////
 // TStdIOWrapper implementation
 ///////////////////////////////

constructor TStdIoWrapper.Create;
begin
 inherited Create;
 myCmndList:=TStringList.Create;
 myCmndList.Duplicates:=dupIgnore;
 myCmndList.UseLocale:=False;
 myCmndList.Sorted:=True;
end;

destructor TStdIOWrapper.Destroy;
begin
 if myUseFOT then myThread:=nil; // FreeOnTerminate - kill object later
 Kill(TObject(myThread));
 Kill(TObject(myCmndList));
 inherited Destroy;
end;

procedure TStdIOWrapper.Clear;
begin
 if Assigned(Self) then myThread.Clear;
end;

procedure TStdIOWrapper.ClearCommands;
begin
 if Assigned(Self) then
 if Assigned(myCmndList) then myCmndList.Clear;
end;

function TStdIOWrapper.Process(const data:LongString):Boolean;
var i,p:Integer; cmnd,args:LongString; proc:Pointer;
begin
 Result:=False;
 if Assigned(Self) then
 try
  if Length(data)>0 then
  if Assigned(myCmndList) then
  if data[1] in StdIoCmndPrefChars then begin
   p:=pos('=',data);
   if p>0 then begin
    cmnd:=Copy(data,1,p-1);
    args:=Copy(data,p+1,Length(data)-p);
   end else begin
    cmnd:=data;
    args:='';
   end;
   // Handle tail spaces: @cmnd = args
   if (cmnd<>'') and (StrLastChar(cmnd)<=' ')
   then cmnd:=TrimRight(cmnd); // Drop tail spaces
   i:=myCmndList.IndexOf(cmnd);
   if i>=0 then begin
    proc:=myCmndList.Objects[i];
    if Assigned(proc) then begin
     TStdIoCommandHandler(proc)(cmnd,args);
     Result:=True;
    end;
   end;
  end;
  if not Result then
  if Assigned(mySpecHand) then begin
   mySpecHand(data);
   Result:=True;
  end;
 except
  on E:Exception do begin
   LockedInc(StdIoErrorCount);
   StdOut.Put:=E.Message;
  end;
 end;
end;

function TStdIOWrapper.AddCommand(const cmnd:LongString; proc:TStdIoCommandHandler):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 if Length(cmnd)>0 then
 if Assigned(myCmndList) then
 if cmnd[1] in StdIoCmndPrefChars then
 if myCmndList.IndexOf(Trim(cmnd))<0 then
 Result:=myCmndList.AddObject(Trim(cmnd),@proc)>=0;
end;

function TStdIOWrapper.TryGet(var Line:LongString):Boolean;
begin
 if Assigned(Self)
 then Result:=myThread.Get(Line)
 else Result:=False;
end;

function TStdIOWrapper.TryPut(const Line:LongString):Boolean;
begin
 if Assigned(Self)
 then Result:=myThread.Put(Line)
 else Result:=False;
end;

procedure TStdIOWrapper.SetPut(const Line:LongString);
begin
 if Assigned(Self) then
 if not myThread.Put(Line) then LockedInc(StdIoErrorCount);
end;

function TStdIOWrapper.GetLine:LongString;
begin
 Result:='';
 if Assigned(Self)
 then myThread.Get(Result)
 else Result:='';
end;

function TStdIOWrapper.GetCapacity:Integer;
begin
 if Assigned(Self)
 then Result:=myThread.myCapacity
 else Result:=0;
end;

procedure TStdIOWrapper.SetCapacity(const aCapacity:Integer);
begin
 if Assigned(Self)
 then myThread.myCapacity:=Max(1,aCapacity);
end;

function TStdIOWrapper.GetPriority:TThreadPriority;
begin
 if Assigned(Self)
 then Result:=myThread.Priority
 else Result:=tpNormal;
end;

procedure TStdIOWrapper.SetPriority(const aPriority:TThreadPriority);
begin
 if Assigned(Self)
 then myThread.Priority:=aPriority;
end;

function TStdIOWrapper.GetCount:Integer;
begin
 if Assigned(Self)
 then Result:=myThread.Count
 else Result:=0;
end;

function TStdIOWrapper.GetSpace:Integer;
begin
 if Assigned(Self)
 then Result:=Capacity-Count
 else Result:=0;
end;

function TStdIOWrapper.GetTimeOut:Cardinal;
begin
 if Assigned(Self) and Assigned(myThread)
 then Result:=myThread.myTimeOut
 else Result:=0;
end;

procedure TStdIOWrapper.SetTimeOut(aTimeOut:Cardinal);
begin
 if Assigned(Self) and Assigned(myThread)
 then myThread.myTimeOut:=aTimeOut;
end;

procedure TStdIOWrapper.SetSpecHandler(aSpecHandler:TStdIoSpecialHandler);
begin
 if Assigned(Self) then mySpecHand:=aSpecHandler;
end;

 ////////////////////////
 // TStdIn implementation
 ////////////////////////

constructor TStdIn.Create;
begin
 inherited Create;
 myThread:=TStdInThread.Create;
 myThread.FreeOnTerminate:=StdInUseFOT;
 myUseFOT:=myThread.FreeOnTerminate;
end;

 /////////////////////////
 // TStdOut implementation
 /////////////////////////

constructor TStdOut.Create;
begin
 inherited Create;
 myThread:=TStdOutThread.Create;
 myThread.FreeOnTerminate:=StdOutUseFOT;
 myUseFOT:=myThread.FreeOnTerminate;
end;

 ////////////////////////
 // StdIn implementation
 ////////////////////////

const
 TheStdIn : TStdIn = nil;

function StdIn:TStdIn;
begin
 if not Assigned(TheStdIn) then begin
  TheStdIn:=TStdIn.Create;
  TheStdIn.Master:=@TheStdIn;
 end;
 Result:=TheStdIn;
end;

 ////////////////////////
 // StdOut implementation
 ////////////////////////

const
 TheStdOut : TStdOut = nil;

function StdOut:TStdOut;
begin
 if not Assigned(TheStdOut) then begin
  TheStdOut:=TStdOut.Create;
  TheStdOut.Master:=@TheStdOut;
 end;
 Result:=TheStdOut;
end;

procedure StdOutEcho(const Msg:LongString);
begin
 StdOut.Put:=TrimRight(Msg);
end;

 ////////////////////////
 // Test example for demo
 ////////////////////////

procedure DoSpec(const args:LongString);
begin
 StdOut.Put:='Could not recognize: '+args;
end;
procedure DoHelp(const cmnd,args:LongString);
begin
 if (cmnd='') and (args='') then Exit;
 StdOut.Put:='@help   - This help screen.';
 StdOut.Put:='@exit n - Exit with code n.';
end;
const TestTerminated : Boolean = False;
procedure DoExit(const cmnd,args:LongString);
begin
 TestTerminated:=True;
 System.ExitCode:=StrToIntDef(args,0);
 StdOut.Put:=Format('%s=%d',[cmnd,System.ExitCode]);
end;
procedure test_crw_ascio;
begin
 StdOut.Put:='Exec test_crw_ascio:';
 StdIn.SpecHandler:=DoSpec;
 StdIn.AddCommand('@Help',DoHelp);
 StdIn.AddCommand('@Exit',DoExit);
 while not TestTerminated do begin
  if StdIn.Count>0 then StdIn.Process(StdIn.Get);
  Sleep(StdIoSleepQuantum);
 end;
 StdOut.Put:='Done test_crw_ascio.';
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_ascio;
begin
 InitIoCounters;
end;

procedure Free_crw_ascio;
begin
 TheStdIn.Free;
 TheStdOut.Free;
 FreeIoCounters;
end;

initialization

 Init_crw_ascio;
 
finalization

 Free_crw_ascio;

end.

//////////////
// END OF FILE
//////////////

