Unit Interpreter;

{ Copyright (C) 2006-2014 by Shleps
  This library is a part of ChaosWarehouse project.

  !!! This is the latest developing version of Interpreter-Level2.
  +getting external commands via File queue/TCP/UDP


  It is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License v2

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  Usage example:
// creation

applicable commands are
}

{$mode objfpc}{$H+}
Interface

Uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ShellCtrls, ComCtrls, MaskEdit, Spin,
  {$IFDEF LINUX}CThreads,{$ENDIF} Types, blcksock, synsock;

Type



  { TInterpreterForm }

  TInterpreterForm = Class(TForm)
    DisplayConfigBitBtn: TBitBtn;
    ConfigMemo: TMemo;
    CurrentCommandEdit: TEdit;
    Label1: TLabel;
    DescrLabel: TLabel;
    LineCounterEdit: TEdit;
    LogMemo: TMemo;
    OpenDialog: TOpenDialog;
    Panel5: TPanel;
    LoadCmdsButton: TSpeedButton;
     Panel6: TPanel;
    SaveCmdsButton: TSpeedButton;
    LogLevelEdit: TSpinEdit;
    SaveDialog: TSaveDialog;
    Splitter2: TSplitter;
    SubmitButton: TButton;
    commandList: TListBox;
    CommandEdit: TEdit;
    EraseButton: TSpeedButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    CmdListBox: TListBox;
    ModulesList: TListBox;
    PageControl1: TPageControl;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    RunButton: TSpeedButton;
    Splitter1: TSplitter;
    StepButton: TSpeedButton;
    InterpreterSheet: TTabSheet;
    ConfigSheet: TTabSheet;
    LogSheet: TTabSheet;
    StopButton: TSpeedButton;
    procedure commandListClick(Sender: TObject);
    procedure DisplayConfigBitBtnClick(Sender: TObject);
    procedure CmdListBoxClick(Sender: TObject);
    Procedure EraseButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    Procedure LoadCmdsButtonClick(Sender: TObject);
    Procedure ModulesListClick(Sender: TObject);
    Procedure ProcessCommand(Data:PtrInt);
    Procedure RunButtonClick(Sender: TObject);
    Procedure LogLevelEditChange(Sender: TObject);
    procedure SaveCmdsButtonClick(Sender: TObject);
    Procedure StepButtonClick(Sender: TObject);
    Procedure StopButtonClick(Sender: TObject);
    procedure SubmitButtonClick(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
  End;

  TTCPEchoDaemon = class(TThread)
  private
    Sock:TTCPBlockSocket;
  public
    Constructor Create;
    Destructor Destroy; override;
    procedure Execute; override;
  end;

  TTCPEchoThrd = class(TThread)
  private
    Sock:TTCPBlockSocket;
    CSock: TSocket;
    Buf:TStringList;
  public
    Constructor Create (hsock:tSocket);
    procedure Execute; override;
    procedure EnqueueCommands;
  end;


Var
  InterpreterForm: TInterpreterForm;
  DoOneStep:Boolean;
  DoMultipleSteps:Boolean;
  AutoEraseExecutedCommand:Boolean;
  Index:Longint;
  ICommands:TStringList;
  TCPEchoDaemon:TTCPEchoDaemon;
  TCPEchoThrd:TTCPEchoThrd;

Function GetNextToken(S:String;Var ParsedS:String;Delimiter:String):String; //error fixed on 20100215
Function GetValByName(S,Name:String):String;
Function OSPath(Path:String):String;
Procedure LogMessage(Level:Longint;Msg:String);
Procedure QueueCommand(Command:String);
Procedure QueueMultipleCommands(Commands:TStringList);

Implementation
Uses unit1,Config,CADEngine;

Procedure LogMessage(Level:Longint;Msg:String);
Begin
  If Level>InterpreterForm.LogLevelEdit.Value Then Exit;
   InterpreterForm.LogMemo.Lines.Add(Msg);
   If InterpreterForm.LogMemo.Lines.Count>20 Then
     InterpreterForm.LogMemo.Lines.Delete(0);
End;

Function GetNextToken(S:String;Var ParsedS:String;Delimiter:String):String; //error fixed on 20100215
Var P:Longint;
Begin P:=Pos(Delimiter,S);
      If P=0 Then Begin ParsedS:='';Result:=S;Exit;End;
      ParsedS:=Copy(S,P+Length(Delimiter),Length(S)-P-Length(Delimiter)+1);
      Result:=Copy(S,0,P-1);
End;

Function GetValByName(S, Name:String):String;
Var P,PP,I,L:Longint;SS:String;
    Found:Boolean;
Begin
  P:=Pos(Name+'=',S);//неправильно - должна искать только вне кавычек
  If P=0 Then Begin Result:=''; Exit; End;
  L:=Length(Name);
  I:=P+Length(Name)+1;
  If I>Length(S) Then Begin Result:='';Exit;End; //последний параметр - пустой
  If S[I]='"' Then Begin
    //берем кусок до следующих кавычек, включая пробелы
    Found:=False;
    For I:=P+Length(Name)+2 To Length(S) Do Begin
      If S[I]='"' Then Begin Found:=True;Break;End;
    End;
    If Found Then Result:=Copy(S,P+Length(Name)+2,I-(P+Length(Name)+2)) Else {ошибка - нет закрывающих кавычек};
  End Else Begin
    //берем кусок до следующего пробела
    Found:=False;
    For I:=P+Length(Name)+1 To Length(S) Do Begin
      If S[I]=' ' Then Begin Found:=True;Break;End;
    End;
    If Found Then Result:=Copy(S,P+Length(Name)+1,I-(P+Length(Name)+2)+1)
    Else Result:=Copy(S,P+Length(Name)+1,I-(P+Length(Name)))
  End;
End;

Function OSPath(Path:String):String;
Var I,P:Longint;Buf:String;
Begin
  Buf:=Path;
{$IFDEF LINUX}
        For I:=1 To Length(Buf) Do
          If (Buf[I]='|') Or (Buf[I]='\') Then Buf[I]:='/';
        Repeat
          P:=Pos('//',Buf);
          If P>0 Then Delete(Buf,P,1);
        Until P=0;
{$ELSE}
        For I:=1 To Length(Buf) Do
          If (Buf[I]='|') Or (Buf[I]='/') Then Buf[I]:='\';
        Repeat
          P:=Pos('\\',Buf);
          If P>0 Then Begin
            Delete(Buf,P,1);
          end;
        Until P=0;

{$ENDIF}
  Result:=Buf;
End;

Procedure QueueCommand(Command:String);
Begin
  InterpreterForm.CommandList.Items.Add(Command);
  If Index=0 Then InterpreterForm.CommandList.ItemIndex:=0;
  Application.QueueAsyncCall(@InterpreterForm.ProcessCommand,0);
End;
Procedure QueueMultipleCommands(Commands:TStringList);
Var I:Longint;
Begin
  If Commands.Count>0 Then
    For I:=0 To Commands.Count-1 Do
      InterpreterForm.CommandList.Items.Add(Commands[I]);
  InterpreterForm.LineCounterEdit.Text:='0/'+IntToStr(InterpreterForm.CommandList.Count);
  Application.QueueAsyncCall(@InterpreterForm.ProcessCommand,0);
End;

Procedure InitModule; // This procedure should build list of all modules of application and their commands
// add proper amount of unit.InitModule to the end of the preocedure
Begin
  InterpreterForm.ModulesList.Items.Add('Interpreter');
  InterpreterForm.ModulesList.ItemIndex:=0;
  ICommands:=TStringList.Create;
  ICommands.Add('Interpreter::QueueCommand:<command>');
  ICommands.Add('Interpreter::Loop:<command>');
  ICommands.Add('Interpreter::ListenTCP:');
  Config.InitModule;
  CADEngine.InitModule;
  Unit1.InitModule;

End;

Procedure TInterpreterForm.ModulesListClick(Sender: TObject);
// Switching between lists of commands by modules. You need to enumarate all modules here manually.
Begin
  If ModulesList.Items[ModulesList.ItemIndex]='Interpreter'
  Then CmdListBox.Items.Assign(Interpreter.ICommands);
  If ModulesList.Items[ModulesList.ItemIndex]='Config'
  Then CmdListBox.Items.Assign(Config.ICommands);
  If ModulesList.Items[ModulesList.ItemIndex]='CADEngine'
  Then CmdListBox.Items.Assign(CADEngine.ICommands);
  If ModulesList.Items[ModulesList.ItemIndex]='Main'
  Then CmdListBox.Items.Assign(Unit1.ICommands);
end;


Function ExecCommand(Command:String):String;
// this procedure starts parsing of command, process interpreter internal command and routes
// external commands to the proper module. Modules in "If" must be enumerated manually.
var B,PB,Module,Obj,Cmd,Attr:String;
Begin
  Module:=GetNextToken(Command,PB,':');
  LogMessage(4,'running '+Command);
  If LowerCase(Module)='main' Then Result:=Unit1.ExecCommand(PB);
  If LowerCase(Module)='config' Then Result:=Config.ExecCommand(PB);
  If Result<>'' Then LogMessage(4,'('+Command+')='+Result);
  If LowerCase(Module)='interpreter' Then Begin
    B:=PB;
    Obj:=GetNextToken(B,PB,':');
    B:=PB;
    Cmd:=GetNextToken(B,PB,':');
    Attr:=PB;
    If LowerCase(Cmd)='initmodules' Then InitModule;
    If LowerCase(Cmd)='queuecommand' Then queueCommand(Attr);
    If LowerCase(Cmd)='listentcp' Then
      If Config.ConfigFile.Values['tcpport']<>'' Then TCPEChoDaemon:=TTCPEChoDaemon.Create;
    If LowerCase(Cmd)='loop' Then Begin
      queueCommand(Attr);
      queueCommand('Interpreter::Loop:'+Attr);
    End;
  End;
End;

Procedure TInterpreterForm.ProcessCommand(Data:PtrInt);
Begin
  If DoOneStep Then Begin
    If CommandList.Items.Count>Index Then Begin
      CurrentCommandEdit.Text:=CommandList.Items[Index];
      ExecCommand(CurrentCommandEdit.Text);
    End;
    If AutoEraseExecutedCommand Then CommandList.Items.Delete(Index)
    Else Inc(Index);
    DoOneStep:=False;
  End;
  If DoMultipleSteps Then Begin
    If CommandList.Items.Count>Index Then Begin
      CurrentCommandEdit.Text:=CommandList.Items[Index];
      ExecCommand(CurrentCommandEdit.Text);
      If EraseButton.Down Then CommandList.Items.Delete(Index)
      Else Inc(Index);
    End;
  End;
  If CommandList.Count>0 Then CommandList.ItemIndex:=Index-1;
  LineCounterEdit.Text:=IntToStr(Index)+'/'+IntToStr(CommandList.Count);
  If Index>=CommandList.Count Then CommandList.ItemIndex:=-1;
  Application.ProcessMessages;
  If RunButton.Down Then Begin
    If CommandList.Items.Count>Index Then Begin
      Application.QueueAsyncCall(@ProcessCommand,0);
    end;
  End;

End;

Procedure TInterpreterForm.EraseButtonClick(Sender: TObject);
Begin
  AutoEraseExecutedCommand:=EraseButton.Down;
end;

procedure TInterpreterForm.CmdListBoxClick(Sender: TObject);
begin
  CommandEdit.Text:=CmdListBox.Items[CmdListBox.ItemIndex];
end;

procedure TInterpreterForm.DisplayConfigBitBtnClick(Sender: TObject);
begin
  ConfigMemo.Lines.Assign(ConfigFile);
end;

procedure TInterpreterForm.CommandListClick(Sender: TObject);
begin
  If CommandList.ItemIndex<0 Then Index:=0 Else
  Index:=CommandList.ItemIndex;
  LineCounterEdit.Text:=IntToStr(Index)+'/'+IntToStr(CommandList.Count);
end;

procedure TInterpreterForm.FormCreate(Sender: TObject);
begin
  Application.QueueAsyncCall(@ProcessCommand,0);
end;

Procedure TInterpreterForm.LoadCmdsButtonClick(Sender: TObject);
Var Cmds:TStringList;
Begin
  If OpenDialog.Execute Then Begin
    Cmds:=TStringList.Create;
    Cmds.LoadFromFile(OpenDialog.FileName);
    QueueMultipleCommands(Cmds);
  End;
end;

Procedure TInterpreterForm.RunButtonClick(Sender: TObject);
Begin
  DoMultipleSteps:=True;
  Application.QueueAsyncCall(@ProcessCommand,0);
end;

Procedure TInterpreterForm.LogLevelEditChange(Sender: TObject);
Begin
  Case LogLevelEdit.Value of
  0: DescrLabel.Caption:='exceptions';
  1: DescrLabel.Caption:='exceptions and errors';
  2: DescrLabel.Caption:='exceptions, errors and logical bugs';
  3: DescrLabel.Caption:='exceptions, errors, logical bugs, debug messages';
  4: DescrLabel.Caption:='exceptions, errors, logical bugs, debug messages, routine';
  End;
end;

procedure TInterpreterForm.SaveCmdsButtonClick(Sender: TObject);
begin
  If SaveDialog.Execute Then CommandList.Items.SaveToFile(SaveDialog.FileName);
end;

Procedure TInterpreterForm.StepButtonClick(Sender: TObject);
Begin
  DoOneStep:=True;
  DoMultipleSteps:=False;
  RunButton.Down:=False;
  StopButton.Down:=True;
  Application.QueueAsyncCall(@ProcessCommand,0);
end;

Procedure TInterpreterForm.StopButtonClick(Sender: TObject);
Begin
  DoMultipleSteps:=False;
end;

procedure TInterpreterForm.SubmitButtonClick(Sender: TObject);
begin
  If CommandEdit.Text='' Then Exit;
  queueCommand(CommandEdit.Text);
  CommandEdit.Text:='';
end;




Constructor TTCPEchoDaemon.Create;
begin
  inherited create(false);
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate:=true;
end;

Destructor TTCPEchoDaemon.Destroy;
begin
  Sock.free;
end;

procedure TTCPEchoDaemon.Execute;
var
  ClientSock:TSocket;
begin
  with sock do
    begin
      CreateSocket;
      setLinger(true,1000);
      bind('0.0.0.0',Config.ConfigFile.Values['TCPPort']);
      listen;
      repeat
        if terminated then break;
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
end;

{ TEchoThrd }

Constructor TTCPEchoThrd.Create(Hsock:TSocket);
begin
  inherited create(false);
  Csock := Hsock;
  FreeOnTerminate:=true;
  Buf:=TStringList.Create;
end;

procedure TTCPEchoThrd.EnqueueCommands;
Var I:Longint;
Begin
If Buf.Count>0 Then
  QueueMultipleCommands(Buf);
End;

procedure TTCPEchoThrd.Execute;
var
  s,s1,IP,ID,Date,tcY,tcM,tcD,tcH,tcMN,filepath: string;
  posd,idn,module,I,ErrCode:Longint;
  RecievedCmd:String;
begin
  Sock:=TTCPBlockSocket.create;
  try
    Sock.socket:=CSock;
    Sock.GetSins;
    S:='';S1:='';
    With Sock Do Begin
      Sock.ConvertLineEnd:=True;
      IP:=GetRemoteSinIP;
      Date:=(DateTimeToStr(Now));
      Repeat
        If Terminated Then Break;
        S1:=RecvPacket(4000);
        If S1<>'' Then S:=S+S1;
        If LastError<>0 Then Break;
      Until False;
      Repeat
        Posd:=Pos(#10,S);
        If PosD>0 Then Begin
          Buf.Add(Copy(S,1,PosD-1));
          S:=Copy(S,PosD+1,Length(S)-PosD);
        End;
      Until PosD=0;
      Synchronize(@EnqueueCommands);
      Buf.SaveTofile('/tmp/'+IP+'-');
    End;
    Buf.Free;
  finally
    Sock.Free;
  end;
end;


Initialization
  {$I interpreter.lrs}
  Index:=0;
  AutoEraseExecutedCommand:=True;
  DoMultipleSteps:=True;
  DoOneStep:=False;
End.

