unit baseconnection;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, extTypes,commandcol, Contnrs, cgiDM;
type
   { TBaseConnection }
  TBaseConnection=class;


  TBaseConnection=class(TThread)
    private
    fOwner:TComponent;
    fLogger: TLogger;
    fConnectionID: string;
    fTimeout: integer;
    fProcessor: TNIDBDM;

    Commands: TStrings;
    DoneCommands: TList;
    fCreated,
    fCommandReceived,
    fCommandCompleted: TDateTime;
    nCommandComplete: integer;
    nCommandReceived: integer;
    nCommandReady: integer;
    nErrors: integer;
    fCheckConnect: boolean;
    procedure CleanDone;
    public
    Host: string;
    port: integer;
    DataBase: string;
    User: string;
    UserID: integer;
    LastAccess: TDateTime;
    procedure Log(ALevel:TLogLevel;sender: TObject; msg: string);
    procedure LogError(Sender: TObject; e: Exception; Command: string);

    property Created: TDateTime read fCreated;
    property LastReceive: TDateTime read fCommandReceived;
    property LastComplete: TDateTime read fCommandCompleted;
    property CountReceived: integer read nCommandReceived;
    property CountCompleted: integer read nCommandComplete;
    property CountReady: integer read nCommandReady;
    property CountErrors: integer read nErrors;
    property Owner: TComponent read fOwner;
    property ConnectionID: string read fConnectionID;
    property Processor: TNIDBDM read fProcessor;
    procedure Init;
    constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
    destructor Destroy; override;
    // CommandID,Param,ACommand,Fields,iParam.Data
    function AddCommand(ACode: DWORD; iParam: QWORD; ACommandClass,ACommandName: string; Arguments: TStrings; intArgs: TParamArray; CmdData: TStream; out ID: string; out retCode:DWORD; out Errors: TStrings): boolean;
    function RunCommand(ACommand: TCommand): boolean;
    function FindCommand(IDCommand: string): TCommand;
    procedure Idle;
    procedure SetIdle;
    procedure Execute; override;
    function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
    class function newID: string;
    function calchash(data: TStream): string;
  end;

implementation
uses
  ConnectionsDmUnit;
{ TBaseConnection }
function TBaseConnection.calchash(data: TStream): string;
begin
  result := (Owner as TConnectionsDM).CalcHash(data);
end;

procedure TBaseConnection.Init;
begin
  Processor.connection.RemoteHost:=Host;
  Processor.connection.RemotePort:=Port;
  Processor.connection.Database:=DataBase;
  Processor.OpenConnection;
end;


constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
  aLogger: TLogger);
begin
  inherited Create(true);
  fConnectionID:=newID;
  fTimeout:=ATimeOut;
  fOwner := AOwner;
  flogger := ALogger;
  fProcessor:=TNIDBDM.Create(nil);
  fProcessor.Name := 'NIDB_'+fConnectionID;
  fProcessor.logger:=aLogger;
  Commands:=TStringList.Create;
  DoneCommands:=TList.Create;
  fCreated := now();
  fCommandReceived := 0;
  fCommandCompleted := 0;
  nCommandComplete:=0;
  nCommandReceived:=0;
  nCommandReady:=0;
  nErrors:=0;


end;

destructor TBaseConnection.Destroy;
begin
  log(mtExtra,self,'Destroy');
  Processor.Free;
  Commands.Free;
  DoneCommands.Free;
  inherited;
end;

function TBaseConnection.AddCommand(ACode: DWORD; iParam: QWORD; ACommandClass,
  ACommandName: string; Arguments: TStrings; intArgs: TParamArray;
  CmdData: TStream; out ID: string; out retCode: DWORD; out Errors: TStrings
  ): boolean;
var
  cc: TCommandClass;
  cmd: TCommand;
begin
  Errors := nil;
  ID := '';
  retCode := 0;
  log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName);
  fCommandReceived:=Now();
  cc := TCommandCollection.Find(ACommandClass,ACommandName);
  if assigned(cc) then
    begin
      cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
      cmd.AccessTime:=NOW();
      try
      result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);

      except on e: Exception do
        begin
          LogError(self,e,format('ParseCommand(%s,%s)',[ACommandClass, ACommandName]));
          result := false;
        end;
      end;
      if result then
          begin
          Commands.AddObject(ACommandName,cmd);
          ID := cmd.CommandID;
          retCode := Commands.Count;
        end
      else
        begin
          ID := 'неверные параметры запроса';
          retCode := ErrorArguments;
          inc(nErrors);
          cmd.Error:=true;
          cmd.Done;
          DoneCommands.Add(cmd);
        end;
      inc(nCommandReceived);



    end
  else
    begin
    inc(nErrors);
    result := false;
    ID := format('Неизвестная команда %s(%s)',[ACommandClass, ACommandName]);
    log(mtWarning,self,ID);
    retCode := ErrorCommand;
    end;
end;

function TBaseConnection.RunCommand(ACommand: TCommand): boolean;
begin
  log(mtDebug,self,format('Запуск на исполнение %s_%s %s',[ACommand.CommandName,ACommand.CommandSubClass, ACommand.CommandID]));
  try
  ACommand.doRun();
  log(mtDebug,Self,'Завершена '+ACommand.CommandID);

  except on e: Exception do
    begin
      LogError(self,e,format('Command %s',[ACommand.CommandID]));
    end;
  end;
  fCommandCompleted:=Now();
  inc(nCommandReady);
end;

function TBaseConnection.FindCommand(IDCommand: string): TCommand;
var
  i: integer;
begin
  for i := 0 to Commands.Count-1  do
    if (Commands.Objects[i] as TCommand).CommandID=IDCommand then
      begin
        result := Commands.Objects[i] as TCommand;
        result.AccessTime:=now();
        exit;
      end;
  for i := DoneCommands.Count-1 downto 0 do
    if TCommand(DoneCommands[i]).CommandID=IDCommand then
    begin
      result := TCommand(DoneCommands[i]);
      result.AccessTime:=now();
      exit;
    end;
  result := nil;
end;

procedure TBaseConnection.Idle;
var
  d: TDateTime;
begin
  fCheckConnect:=false;
  d := Created;
  if LastAccess>d then d := LastAccess;
  if (now()-d)*24*60>fTimeout then
    begin
      log(mtInfo,self,'TIMEOUT');
      terminate;
    end
  else
    fProcessor.ExecuteSQL('SELECT 1');
end;

procedure TBaseConnection.SetIdle;
begin
  fCheckConnect:=true;
end;

procedure TBaseConnection.CleanDone;
var
  i: integer;
  cmd: TCommand;
begin
  for i := DoneCommands.Count-1 downto 0 do
    begin
      cmd := TCommand(DoneCommands[i]);
      if cmd.isDone or (now()-cmd.AccessTime > cmd.TimeOut) then
        begin
          cmd.free;
          DoneCommands.Delete(i);
          Dec(nCommandReady);

        end;
    end;
end;

procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
begin
  if assigned(fLogger) then
    flogger(ALevel,sender,msg);
end;

procedure TBaseConnection.LogError(Sender: TObject; e: Exception;
  Command: string);
begin
  log(mtError,Sender,format('%s вызвала ошибку %s(%s)  ',[Command, e.classname,e.message]));
end;

procedure TBaseConnection.Execute;
var
  cmd: TCommand;
begin
  log(mtExtra,self,'started');
  while not terminated do
    begin
      while Commands.Count>0 do
        begin
          cmd := Commands.Objects[0] as TCommand;
          try
            RunCommand(cmd);
          finally
            Commands.Delete(0);
            DoneCommands.Add(cmd);
          end;
        end;
      CleanDone;
      if fCheckConnect then Idle;
      sleep(200);
    end;
  log(mtExtra,self,'finished');
end;

function TBaseConnection.ProcessOptionValues(ReportName, ParamName: string;
  ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out
  OptionValues: TStrings): boolean;
var
  c: TCommand;
  tmp: TStrings;
  cc: TCommandClass;
begin
  cc := TCommandCollection.Find('report',Reportname);
  if assigned(cc) then
    try
      with cc.Create('', self.Processor,ReportName,fLogger,User,UserID) do
      try
        ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
        if assigned(tmp) then FreeAndNil(tmp);
        result := ProcessOptionValues(ParamName,answer,RetValue,OptionValues);
      finally
        free
      end;

    except on e: Exception do
      begin
        LogError(self,e,format('ProcessOptionValues(report=%s,param=%s)',[ReportName,ParamName]));
        result := false;
        Answer := e.Message;
      end;
    end
  else
    begin
      result := false;
      answer := 'Отчет не найден '+ReportName;
    end;
end;

class function TBaseConnection.newID: string;
var
  g: TGUID;
  i: integer;
begin
  createguid(g);
  result := inttohex(g.D1,8)+inttohex(g.D2,4)+inttohex(g.D3,4);
  for i := 0  to 7 do
    result := result + inttohex(g.D4[i],2);
end;



end.