{
   Double Commander
   -------------------------------------------------------------------------
   Detect string parser.

   Copyright (C) 2008  Dmitry Kolomiets (B4rr4cuda@rambler.ru)
   Based on TMathControl by Vimil Saju
  
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   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 General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

unit uDetectStr;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes,
  uMasks, uFile;

type
  TMathtype=(mtnil,mtoperator,mtlbracket,mtrbracket,mtoperand);

type
  TMathOperatortype=(monone, // NULL
                     moequ,  // =
                     moneq,  // != replaced with #
                     moles,  // <
                     momor,  // >
                     moand,  // &
                     moor,   // |
                     monot   // NOT
                    );

type
  pmathchar = ^Tmathchar;
  TMathChar = record
    case mathtype: Tmathtype of
      mtoperand:(data:shortstring);
      mtoperator:(op:TMathOperatortype);
  end;

type

   { TParserControl }

   TParserControl = class
   public
    function TestFileResult(const aFile: TFile): boolean; overload;
    function TestFileResult(const aFileName: String): boolean; overload;
   private
    input,output,stack:array of tmathchar;
    fmathstring:string;
    fforce:boolean;
    function getresult(const aFile: TFile):boolean;
    function calculate(aFile: TFile; operand1,operand2,Aoperator:Tmathchar):string;
    function getoperator(c:String):TMathOperatortype;
    function getoperand(mid:integer;var len:integer):string;
    procedure processstring;
    procedure convertinfixtopostfix;
    function isdigit(c:String):boolean;
    function isoperator(c:String):boolean;
    function getprecedence(mop:TMathOperatortype):integer;
    function BooleanToStr(x:boolean):string;
    function StrToBoolean(s:string):boolean;
   public
     destructor Destroy; override;
   published
    property DetectStr:string read fmathstring write fmathstring;
    property IsForce:boolean read fforce write fforce;
   end;

implementation

uses
  uDebug, uFileProperty, uFileSystemFileSource;
  
function TParserControl.calculate(aFile: TFile; operand1,operand2,Aoperator:Tmathchar):string;
var
  ASize: Int64;
  tmp, data1: String;
begin
  Result:= 'false';
  data1:= UpperCase(operand1.data);

  //Not
  if (operand1.data = 'NOT') and ((operand2.data = 'true') or (operand2.data = 'false')) then
  begin
    Result:= BooleanToStr(not StrToBoolean(operand2.data));
  end;

  // & |
  if ((operand1.data = 'true') or (operand1.data = 'false')) and
     ((operand2.data = 'true') or (operand2.data = 'false')) then
  begin
    case Aoperator.op of
      moand: Result:= BooleanToStr((StrToBoolean(operand1.data)) and (StrToBoolean(operand2.data)));
      moor: Result:= BooleanToStr((StrToBoolean(operand1.data)) or (StrToBoolean(operand2.data)));
    end;
  end;

   //EXT= EXT!=
   if (data1 = 'EXT') then
   begin
     tmp:= aFile.Extension;
     tmp:= UpperCase(tmp);
     tmp:= '"' + tmp + '"';
     case Aoperator.op of
      moequ: Result:= BooleanToStr(MatchesMask(tmp, operand2.data));
      moneq: Result:= BooleanToStr(not MatchesMask(tmp, operand2.data));
     end;
   end;

   //SIZE > < = !=
   if (data1 = 'SIZE') and (fpSize in aFile.SupportedProperties) then
   begin
     if TryStrToInt64(operand2.data, ASize) then
     begin
       case Aoperator.op of
         moequ: Result:= BooleanToStr(aFile.Size = ASize);
         moneq: Result:= BooleanToStr(aFile.Size <> ASize);
         moles: Result:= BooleanToStr(aFile.Size < ASize);
         momor: Result:= BooleanToStr(aFile.Size > ASize);
       end;
     end;
   end;
end;

function TParserControl.TestFileResult(const aFile: TFile):boolean;
begin
  Result:= getresult(aFile);
end;

function TParserControl.TestFileResult(const aFileName: String): boolean;
var
  aFile: TFile;
begin
  aFile:= TFileSystemFileSource.CreateFileFromFile(aFileName);
  try
    DCDebug('aFile.Extension = ' + aFile.Extension);
    Result:= getresult(aFile);
  finally
    aFile.Free;
  end;
end;

function TParserControl.getresult(const aFile: TFile):boolean;
var
  i: integer;
  tmp1, tmp2, tmp3: tmathchar;
begin
  if fmathstring = '' then
  begin
    Result:= True;
    Exit;
  end;
  convertinfixtopostfix;
  SetLength(stack, 0);
  for i:= 0 to Length(output) - 1 do
  begin
    if output[i].mathtype = mtoperand then
    begin
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1]:= output[i];
    end
    else if output[i].mathtype = mtoperator then
    begin
      if Length(stack) > 1 then
      begin
        tmp1:= stack[length(stack) - 1];
        tmp2:= stack[length(stack) - 2];
        setlength(stack, length(stack) - 2);
        tmp3.mathtype:= mtoperand;
        tmp3.data:= calculate(aFile, tmp2, tmp1, output[i]);
        setlength(stack,length(stack) + 1);
        stack[length(stack) - 1]:= tmp3;
      end;
    end;
  end;
  Result:= (Length(stack) > 0) and strToBoolean(stack[0].data);
  SetLength(stack, 0);
  SetLength(input, 0);
  SetLength(output, 0);
end;

 function TParserControl.getoperator(c:String):TMathOperatortype;
 begin
 result:=monone;
      if c='<' then
   result:=moles
 else if c='>' then
   result:=momor
 else if c='&' then
   result:=moand
 else if c='=' then
   result:=moequ
 else if c='#' then
   result:=moneq
 else if c='|' then
   result:=moor
else if c='!' then
   result:=monot;
 end;

 function TParserControl.getoperand(mid:integer;var len:integer):string;
 var
 i,j:integer;
 begin
 Result := '';
 j:=1;
 for i:=mid to length(fmathstring)-1 do
   begin
    if isdigit(fmathstring[i]) then
     begin
      if j<=20 then
       Result:=Result+fmathstring[i];
      j:=j+1;
     end
    else
     break;
   end;
 len:=length(Result);
 end;

procedure TParserControl.processstring;
 var
 i:integer;
 numlen:integer;
 begin
 //---------------------
 while pos('!=',fmathstring)>0 do
   begin
     i:=pos('!=',fmathstring);
     delete(fmathstring,i,2);
     insert('#',fmathstring,i);
   end;
 //---------------------
 fmathstring:= StringReplace(fmathstring, 'FORCE', BooleanToStr(fforce),
                             [rfReplaceAll, rfIgnoreCase]);
 //---------------------
 fmathstring:= StringReplace(fmathstring, 'MULTIMEDIA', 'true',
                             [rfReplaceAll, rfIgnoreCase]);
 //---------------------
 numlen:=1;
 while numlen < length(fmathstring) do
 if (fmathstring[numlen]='!') and (fmathstring[numlen+1]<>'=') then
   begin
     i:=numlen;
     delete(fmathstring,i,1);
     insert('NOT!',fmathstring,i);
     inc(numlen,4);
   end else inc(numlen);
 //---------------------

 i:=0;
 numlen:=0;
 setlength(output,0);
 setlength(input,0);
 setlength(stack,0);

 fmathstring:='('+fmathstring+')';
 setlength(input,length(fmathstring));
 while i<=length(fmathstring)-1 do
   begin
    if fmathstring[i+1]='(' then
     begin
      input[i].mathtype:=mtlbracket;
      i:=i+1;
     end
    else if fmathstring[i+1]=')' then
     begin
      input[i].mathtype:=mtrbracket;
      i:=i+1;
     end
    else if isoperator(fmathstring[i+1]) then
     begin
      input[i].mathtype:=mtoperator;
      input[i].op:=getoperator(fmathstring[i+1]);
      i:=i+1;
     end
    else if isdigit(fmathstring[i+1]) then
     begin
      input[i].mathtype:=mtoperand;
      input[i].data:=getoperand(i+1,numlen);
      i:=i+numlen;
     end else {if fmathstring[i+1]=' ' then} inc(i);
   end;
 end;


 function TParserControl.isoperator(c:String):boolean;
 begin
 result:=false;
 if (c='=')
 or (c='#')
 or (c='!')
 or (c='&')
 or (c='<')
 or (c='>')
 or (c='|') then
   result:=true;
 end;

function TParserControl.isdigit(c:String):boolean;
 begin
 result:=false;
 if pos(c,'=#!&<>|() ')<=0 then
   result:=true;
 end;

 function TParserControl.getprecedence(mop:TMathOperatortype):integer;
 begin
 result:=-1;
 case mop of
   moor:result:=1;
   moand:result:=1;
   moequ:result:=2;
   moneq:result:=2;
   moles:result:=2;
   momor:result:=2;
   monot:result:=2;
 end;
 end;

function TParserControl.BooleanToStr(x: boolean): string;
 begin
   if x then
     Result:='true'
   else
     Result:='false';
 end;

function TParserControl.StrToBoolean(s: string): boolean;
 begin
  if s='true' then Result:=true else
   Result:=false;
 end;

destructor TParserControl.Destroy;
begin
  inherited Destroy;
end;

 procedure TParserControl.convertinfixtopostfix;
 var
 i,j,prec:integer;
 begin
 processstring;
 for i:=0 to length(input)-1 do
   begin
    if input[i].mathtype=mtoperand then
     begin
      setlength(output,length(output)+1);
      output[length(output)-1]:=input[i];
     end
    else if input[i].mathtype=mtlbracket then
     begin
      setlength(stack,length(stack)+1);
      stack[length(stack)-1]:=input[i];
     end
    else if input[i].mathtype=mtoperator then
     begin
      prec:=getprecedence(input[i].op);
      j:=length(stack)-1;
      if j>=0 then
       begin
        while (j>=0) and (getprecedence(stack[j].op)>=prec) do
         begin
          setlength(output,length(output)+1);
          output[length(output)-1]:=stack[j];
          setlength(stack,length(stack)-1);
          j:=j-1;
         end;
        setlength(stack,length(stack)+1);
        stack[length(stack)-1]:=input[i];
       end;
     end
    else if input[i].mathtype=mtrbracket then
     begin
      j:=length(stack)-1;
      if j>=0 then
       begin
        while (j>=0) and (stack[j].mathtype<>mtlbracket) do
         begin
          setlength(output,length(output)+1);
          output[length(output)-1]:=stack[j];
          setlength(stack,length(stack)-1);
          j:=j-1;
         end;
        if j>=0 then
         setlength(stack,length(stack)-1);
       end;
     end;
   end;
 end;

 end.

