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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// DIM demo test server.                                                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20190220 - Last Win32 version by A.K.                                      //
// 20230524 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

program dim_demotest_server;

{$IFDEF WINDOWS}{$APPTYPE CONSOLE}{$ENDIF WINDOWS}

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$R *.res}

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes,
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_str, _crw_fio, _crw_rtc,
 _crw_dim, _crw_dimq, _crw_dimc, _crw_dims;

var                                         // DIM uses services:
 DnsVersion   : TDicInfoService = nil;      // To receive DNS version.
 DisInfo1     : TDisInfoService = nil;      // I:Call counter; I:GetTickCount; D:Current time
 DisInfo2     : TDisInfoService = nil;      // X:System time as file time; C:Date and time string
 DisCmnd1     : TDisCmndService = nil;      // Command 1
 DisCmnd2     : TDisCmndService = nil;      // Command 2
 Terminated   : Boolean = false;            // Terminator for main loop

 //
 // Thread safe printing: Print(s,1) => StdOut, Print(s,2) => StdErr
 //
function Print(const Msg:LongString; n:Integer=1):DWORD;
var h:THandle;
begin
 Result:=0;
 if n=1 then h:=GetStdHandle(STD_OUTPUT_HANDLE) else
 if n=2 then h:=GetStdHandle(STD_ERROR_HANDLE)  else h:=INVALID_HANDLE_VALUE;
 if (h>0) and (Msg<>'') then Result:=FileWrite(h,PChar(Msg)^,Length(Msg));
end;

function PrintLn(const Msg:LongString; n:Integer=1):DWORD;
const Delimeter=EOL;
begin
 Result:=Print(Msg+Delimeter,n);
end;

 //
 // Callback to receive DNS version
 //
procedure OnDnsVersionGot(Service:TDicInfoService);
begin
 if (Service<>nil) then
 try
  if (Service.MessageLeng=sizeof(Integer)) and (Service.Buffer.GetAsInteger = -1) then begin
   PrintLn('DNS server is dead. Please restart DNS.EXE.',2);
   Exit;
  end;
  if (Service.MessageLeng=sizeof(Integer))
  then PrintLn(Format('Got DNS version: %d, server:%s',[Service.Buffer.GetAsInteger,Service.ServerName]))
  else PrintLn(Format('Invalid data size: %d, server:%s',[Service.MessageLeng,Service.ServerName]),2);
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on server exit
 //
procedure on_server_exit(var code:Integer); cdecl;
var name:array[byte] of char;
begin
 try
  if dis_get_client(name)=0 then name:='?';
  PrintLn(Format('Server "%s" (code %d) exited.',[name,code]));
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on client exit
 //
procedure on_client_exit(var code:Integer); cdecl;
var name:array[byte] of char;
begin
 try
  if dis_get_client(name)=0 then name:='?';
  PrintLn(Format('Client "%s" (code %d) disconnected.',[name,code]));
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on server update
 //
procedure OnInfoSend(Service:TDisInfoService; var Buffer:Pointer; var Size:Integer; First:Integer);
begin
 if (Service<>nil) then // Use Service.Buffer.GetAsType(Offset) to access data in Buffer.
 try
  PrintLn(Format('Serving: service %s, client "%s"',[Service.ServiceName,Service.ClientName]));
  if Service=DisInfo1 then begin
   PrintLn(Format('Provide data: %d, %d, %g',[DisInfo1.Buffer.GetAsInteger,
              DisInfo1.Buffer.GetAsInteger(4),DisInfo1.Buffer.GetAsDouble(8)]));
  end else
  if Service=DisInfo2 then begin
   PrintLn(Format('Provide data: %d, %s',[Service.Buffer.GetAsInt64,DisInfo2.Buffer.GetAsString(8)]));
  end else
  PrintLn(Format('Unknown service identifier %s requested.',[Service.ServiceName]));
  if first>0 then begin
   PrintLn(Format('Client "%s" connected to service %s.',[Service.ClientName,Service.ServiceName]));
   dis_set_client_exit_handler(dis_get_conn_id,Integer(Service));
   if (Service.ClientServices<>'')
   then PrintLn('Client services: '+StringReplace(Trim(Service.ClientServices),#10,' ',[rfReplaceAll]));
  end;
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on client command - handle it
 //
procedure OnCmndGot(Service:TDisCmndService);
begin
 if (Service<>nil) then
 try
  PrintLn(Format('Got command: %s, server: %s',[Service.Buffer.GetAsString,Service.ClientName]));
  if SameText(Service.Buffer.GetAsString,'RESET') then DisInfo1.Buffer.SetAsInteger(0); // CallCount=0
  if SameText(Service.Buffer.GetAsString,'EXIT') then Terminated:=true;
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on Client Error
 //
procedure on_client_error(severity:Integer; error_code:Integer; error_message:PChar); cdecl;
begin
 try
  PrintLn(Format('%s - %s (%d) - %s',[FormatDateTime('yyyy.mm.dd-hh:nn:ss',Now),
                                      dim_severity_name(severity),error_code,error_message]));
  if (dic_get_error_services<>nil) and (strlen(dic_get_error_services)>0)
  then PrintLn('Error services: '+dic_get_error_services);
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on Server Error
 //
procedure on_server_error(severity:Integer; error_code:Integer; error_message:PChar); cdecl;
begin
 try
  PrintLn(Format('%s - %s (%d) - %s',[FormatDateTime('yyyy.mm.dd-hh:nn:ss',Now),
                                      dim_severity_name(severity),error_code,error_message]));
  if (dis_get_error_services<>nil) and (strlen(dis_get_error_services)>0)
  then PrintLn('Error services: '+dis_get_error_services);
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
end;

 //
 // Callback on DIM Exception
 //
procedure TheBugReport(E:Exception; O:TObject; Note:LongString);
var Msg:LongString;
begin
 if (E=nil) then Exit;
 Msg:='Exception '+E.ClassName+': «'+E.Message+'».';
 if (O<>nil) then Msg:=Msg+' Note: «'+O.ClassName+'».';
 PrintLn(FormatDateTime('yyyy.mm.dd-hh:nn:ss',Now)+' - '+Msg);
end;

procedure Main;
var FileTime:Int64;
begin
 try
  CmdArgs.ListOptVal:='-dns';
  if CmdArgs.HasOptionValue('-dns')
  then SetEnv('DIM_DNS_NODE',CmdArgs.GetOptionValue('-dns'));
  //
  // 1. Initialize DIM, set DNS node & exit handlers.
  //
  dim_init;
  dis_disable_padding;
  dic_disable_padding;
  SetDimBugReport(TheBugReport);
  dic_add_error_handler(on_client_error);
  dis_add_error_handler(on_server_error);
  if GetDimDnsNode='' then SetDimDnsNode('localhost');
  if GetDimDnsNode='' then raise EDimFail.Create('Fail set DNS.');
  PrintLn('DIM_DNS_NODE='+GetDimDnsNode);
  dis_add_client_exit_handler(on_client_exit);
  dis_add_exit_handler(on_server_exit);
  //
  // 2. Subscribe DNS server version to call it only once.
  //
  DnsVersion:=TDicInfoService.Create('DIS_DNS/VERSION_NUMBER',DimServiceTypeSize('I'),ONCE_ONLY,10);
  DnsVersion.Filler.SetAsInteger(-1,0,true); // Data to send in case of timeout
  DnsVersion.OnInfoGot:=OnDnsVersionGot;     // Handler on data received
  //
  // 3. Publish information services.
  //
  DisInfo1:=TDisInfoService.Create('DEMO/INFO1','I:2;D',DimServiceTypeSize('I:2;D'));
  DisInfo2:=TDisInfoService.Create('DEMO/INFO2','X:1;C',DimServiceTypeSize('X:1;C',256));
  DisInfo1.OnInfoSend:=OnInfoSend; // Handler on serve to provide data
  DisInfo2.OnInfoSend:=OnInfoSend; // Handler on serve to provide data
  DisInfo1.Buffer.Auto:=false;     // Not automatic updates on SetData
  DisInfo2.Buffer.Auto:=false;     // Not automatic updates on SetData
  //
  // 4.Publish command services.
  //
  DisCmnd1:=TDisCmndService.Create('DEMO/COMMAND1','C',DimServiceTypeSize('C',256));
  DisCmnd2:=TDisCmndService.Create('DEMO/COMMAND2','C',DimServiceTypeSize('C',256));
  DisCmnd1.OnCmndGot:=OnCmndGot; // Handler on command received
  DisCmnd2.OnCmndGot:=OnCmndGot; // Handler on command received
  //
  // 5. Start to serve published services.
  //
  if not DimClients.StartServing
  then raise EDicFail.Create('DIM Could not start clients!');
  if not DimServer.StartServing('DEMO_TASK')
  then EDisFail.Create('DIM Could not start serving!');
  //
  // 6. Main server loop:
  //    Update published information services each second
  //
  PrintLn('Start serving...');
  while not Terminated do begin
   // Set data of services. Use offset to put data.
   DisInfo1.Buffer.SetAsInteger(DisInfo1.Buffer.GetAsInteger+1);
   DisInfo1.Buffer.SetAsInteger(GetTickCount,4); // Offset 4
   DisInfo1.Buffer.SetAsDouble(Now,8); // Offset 8
   FileTime:=FileTimeNow;
   DisInfo2.Buffer.SetAsInt64(Int64(FileTime));
   DisInfo2.Buffer.SetAsString(DateTimeToStr(Now),8); // Offset 8
   // Then update all services
   DimServer.UpdateServices;
   Sleep(1000);
  end;
  //
  // 7. Stop DIM.
  //
  PrintLn('Stop DIM...');
  DimServer.StopServing;
  DimServer.FreeServices;
  DimClients.StopServing;
  DimClients.FreeServices;
 except
  on E:Exception do PrintLn(E.Message,2);
 end;
 PrintLn('Goodbye.');
 Sleep(2000);
end;

begin
 Main;
end.

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

