{
    This file is part of logfilter.

    Copyright (C) 2015 Andreas Schneider

    logfilter 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 3 of the License, or
    (at your option) any later version.

    logfilter 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 logfilter.  If not, see <http://www.gnu.org/licenses/>.
}
unit UApp;

{$mode objfpc}{$H+}

{.$define debugmatches}

interface

uses
  Classes, SysUtils, CustApp, RegExpr, Math,
  UFilter, UWriter, Crt;

type

  { TLogFilterApplication }

  TLogFilterApplication = class(TCustomApplication)
  protected
    FLineFilters: TLineFilters;
    FCurrentLineFilter: TLineFilter;
    FCommandMatcher: TRegExpr;
    FCommandFileName: String;
    FLogFileName: String;
    FWriter: TWriterList;
    FSeparator: String;
    FFirstMatch: Boolean;
    procedure DoRun; override;
    procedure ProcessCommand(ACommand, AParams: String);
    procedure WriteContent(AContent: String; AFilters: TFilterList;
      AGroupRanges: TGroupRanges);
    procedure FilterLine(ALine: String);
    //Logfile handling
    procedure DumpFile(AFileName: String);
    procedure PollFile(AFileName: String);
    //Key Handling
    function CheckQuit: Boolean;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

implementation

{Some trickery to have clean command line option checks}
{$MACRO ON}
{$define OPT_COMMANDFILE:='c', 'commandfile'}
{$define OPT_SIMPLE:='s', 'simple'}
{$define OPT_LOGFILE:='f', 'logfile'}

{ TLogFilterApplication }

procedure TLogFilterApplication.DoRun;
var
  commandFile: TextFile;
  line: String;
  fg, bg: Byte;
begin
  if HasOption('h', 'help') or (not HasOption(OPT_COMMANDFILE) and not
    HasOption(OPT_SIMPLE)) then
  begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  if HasOption(OPT_COMMANDFILE) then
  begin
    FCommandFileName := GetOptionValue(OPT_COMMANDFILE);

    if not FileExists(FCommandFileName) then
    begin
      Writeln('Commandfile not found: ', FCommandFileName);
      ExitCode := 1;
      Terminate;
      Exit;
    end;

    AssignFile(commandFile, FCommandFileName);
    Reset(commandFile);

    // Parse command file first
    while not EOF(commandFile) do
    begin
      Readln(commandFile, line);
      if FCommandMatcher.Exec(line) then
        ProcessCommand(FCommandMatcher.Match[1], FCommandMatcher.Match[3]);
    end;

    CloseFile(commandFile);
  end; //commandfile processing

  if HasOption(OPT_SIMPLE) then
  begin
    FCurrentLineFilter := TLineFilter.Create(GetOptionValue(OPT_SIMPLE));
    FLineFilters.Add(FCurrentLineFilter);

    if HasOption('fg') then
      fg := StrToIntDef(GetOptionValue('fg'), $FF)
    else
      fg := LightBlue;

    if HasOption('bg') then
      bg := StrToIntDef(GetOptionValue('bg'), $FF)
    else
      bg := $FF;

    FCurrentLineFilter.Filters.Add(THighlightFilter.Create('.*', fg, bg, 0));
  end; //Simple Mode

  //If "only highlight" option is set, we append a "match all" filter so even
  //normally non-matching lines are shown.
  if HasOption('highlightonly') or HasOption('all') then
    FLineFilters.Add(TLineFilter.Create('.*'));

  if HasOption(OPT_LOGFILE) then
    FLogFileName := GetOptionValue(OPT_LOGFILE);

  if not FileExists(FLogFileName) then
  begin
    Writeln('Logfile not found: ', FLogFileName);
    ExitCode := 1;
    Terminate;
    Exit;
  end;

  FWriter.Add(TConsoleWriter.Create);

  if HasOption('html') then
    FWriter.Add(THTMLWriter.Create(GetOptionValue('html')));

  // Whatever happens next, we haven't had a match yet.
  FFirstMatch := True;

  if HasOption('p', 'poll') then
    PollFile(FLogFileName)
  else
    DumpFile(FLogFileName);

  // One run is enough.
  Terminate;
end;

procedure TLogFilterApplication.ProcessCommand(ACommand, AParams: String);
var
  highlightFilter: THighlightFilter;
begin
  case LowerCase(ACommand) of
    'filter':
      begin
        FCurrentLineFilter := TLineFilter.Create(AParams);
        FLineFilters.Add(FCurrentLineFilter);
      end;
    'highlight':
      begin
        highlightFilter := THighlightFilter.Create(AParams);
        FCurrentLineFilter.Filters.Add(highlightFilter);
      end;
    'file':
      begin
        FLogFileName := AParams;
      end;
    'followup':
      begin
        FCurrentLineFilter.SetFollowUp(AParams);
      end;
    'separator':
      begin
        FSeparator := StringReplace(AParams, '\n', sLineBreak, [rfReplaceAll]);
      end;
  end;
end;

procedure TLogFilterApplication.WriteContent(AContent: String;
  AFilters: TFilterList; AGroupRanges: TGroupRanges);
var
  i: Integer;
  matchPos, offset: Integer;
  highlights: THighlights;
  highlight: THighlight;
  group: Byte;
  writer: TWriter;
begin

  highlights := THighlights.Create;

  offset := 0;

  for i := 0 to AFilters.Count - 1 do
  begin
    if AFilters[i].Expression.Exec(AContent) then
    begin
      repeat
        // We need these values anyway.
        matchPos := AFilters[i].Expression.MatchPos[0];
        offset := AFilters[i].Expression.MatchLen[0];

        group := AFilters[i].Group;
        if group = $FF then
        begin
          highlight.Start := matchPos;
          highlight.Length := offset;
        end else if group < Length(AGroupRanges) then
        begin
          if (matchPos + offset < AGroupRanges[group].StartIdx) or
            (matchPos > AGroupRanges[group].EndIdx) then
            continue; //Pointless; nothing we can do here

          highlight.Start := Max(AGroupRanges[group].StartIdx, matchPos);
          highlight.Length := Min(AGroupRanges[group].EndIdx - highlight.Start,
            highlight.Start + offset - matchPos);

          {$ifdef debugmatches}
          writeln('  Highlight: ', highlight.Start, ', ', highlight.Length);
          writeln('    MatchPos: ', matchPos, ', StartIdx: ', AGroupRanges[group].StartIdx);
          writeln('    Offset: ', offset, ', EndIdx: ', AGroupRanges[group].EndIdx);
          {$endif}
        end else
        begin
          continue;
        end;

        highlight.FGColor := AFilters[i].FGColor;
        highlight.BGColor := AFilters[i].BGColor;
        highlights.Add(highlight);
      until not AFilters[i].Expression.ExecNext;
    end;
  end;

  highlights.Sort(@CompareHighlights);

  // Sanitize highlights
  for i := 0 to highlights.Count - 2 do
  begin
    if (highlights[i].Start + highlights[i].Length) > highlights[i+1].Start then
    begin
      highlight := highlights[i];
      highlight.Length := highlights[i+1].Start - highlights[i].Start;
      highlights[i] := highlight;
    end;
  end;

  for writer in FWriter do
    writer.WriteContent(AContent, highlights);

  highlights.Free;
end;

procedure TLogFilterApplication.FilterLine(ALine: String);
var
  lineFilter: TLineFilter;
  groupRanges: TGroupRanges;
begin
  if (FCurrentLineFilter <> nil)
    and (FCurrentLineFilter.FollowUpMatch(ALine, groupRanges)) then
  begin
    WriteContent(ALine, FCurrentLineFilter.Filters, groupRanges);
    Exit;
  end else
    FCurrentLineFilter := nil; //We assume, nothing matched.

  for lineFilter in FLineFilters do
  begin
    if lineFilter.Matches(ALine, groupRanges) then
    begin
      if (FSeparator <> '') and (not FFirstMatch) then
        WriteLn(FSeparator);
      FCurrentLineFilter := lineFilter; //Remember the last matching filter
      WriteContent(ALine, lineFilter.Filters, groupRanges);

      //Now it's definitely no longer a first match ...
      FFirstMatch := False;

      Break;
    end;
  end;
end;

procedure TLogFilterApplication.DumpFile(AFileName: String);
var
  logFile: TextFile;
  line: String;
begin
  AssignFile(logFile, AFileName);
  Reset(logFile);

  // Filter log
  while (not Terminated) and (not EOF(logFile)) do
  begin
    Readln(logFile, line);
    FilterLine(line);

    if CheckQuit then
      Terminate;
  end;

  CloseFile(logFile);
end;

procedure TLogFilterApplication.PollFile(AFileName: String);
const
  BUFSIZE = 8192;
var
  f: File of char;
  b: array[0..BUFSIZE-1] of Char;
  lastSize, currentSize: Int64;
  bufPos, bufMax, read, checkStart: Word;
  breakPos, breakLen: Word;
  pos: Int64;
  s: String;
  i: Integer;
begin
  AssignFile(f, AFileName);
  Reset(f);
  bufPos := 0;
  bufMax := 0;
  lastSize := 0;
  while not Terminated do
  begin
    currentSize := FileSize(f);
    if currentSize > lastSize then
    begin
      pos := FilePos(f);
      breakPos := 0;
      while (pos < currentSize) or (breakPos > 0) do
      begin
        breakPos := 0;
        breakLen := 0;

        BlockRead(f, b[bufMax], Min(BUFSIZE-bufMax, currentSize-pos), read);
        Inc(pos, read);
        Inc(bufMax, read);

        if bufMax = 0 then
          Continue;

        if bufPos > 0 then
          checkStart := bufPos - 1 //we could miss a #13 in a #13#10
        else
          checkStart := bufPos;

        for i := checkStart to bufMax - 1 do
        begin
          if b[i] = #10 then
          begin
            breakPos := i + 1;
            breakLen := 1;
          end
          else if (b[i] = #13) and (i < bufMax) and (b[i+1] = #10) then
          begin
            breakPos := i + 2;
            breakLen := 2;
          end
          else if b[i] = #13 then
          begin
            breakPos := i + 1;
            breakLen := 1;
          end;

          if breakPos > 0 then
            break;
        end;

        if breakPos > 0 then
        begin
          SetLength(s, breakPos - breakLen); //We don't want the actual line break
          Move(b[0], s[1], breakPos - breakLen);
          FilterLine(s);
          Move(b[breakPos], b[0], bufMax - breakPos);
          bufPos := 0;
          Dec(bufMax, breakPos);
        end else
        begin
          bufPos := bufMax;
          if bufPos = BUFSIZE then // Nothing we can do here; we need to dump
          begin
            SetLength(s, BUFSIZE);
            Move(b[0], s[1], BUFSIZE);
            FilterLine(s);
            bufPos := 0;
            bufMax := 0;
          end;
        end;
      end;

      lastSize := currentSize;
    end;

    Sleep(100);

    if CheckQuit then
      Terminate;
  end;
end;

// This is necessary since we use CRT, which captures all keys.
// Therefore Ctrl+C will by default no longer send SIGINT.
function TLogFilterApplication.CheckQuit: Boolean;
begin
  Result := False;
  if KeyPressed then
    if ReadKey = ^C then
      Result := True;
end;

constructor TLogFilterApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FLineFilters := TLineFilters.Create;
  FCommandMatcher := TRegExpr.Create('^(\w+)( (.*)|)$'); // 1 = command, 3 = OPTIONAL params
  FWriter := TWriterList.Create;
end;

destructor TLogFilterApplication.Destroy;
begin
  FLineFilters.Free;
  FCommandMatcher.Free;
  FWriter.Free;
  inherited Destroy;
end;

procedure TLogFilterApplication.WriteHelp;
begin
  Writeln('Usage: ', ExtractFileName(ExeName), ' [options]');
  Writeln;
  Writeln('Options:');
  Writeln('  -c --commandfile=<filename>');
  Writeln('    specifies the filename with filter commands');
  Writeln('  -s --simple=<pattern>');
  Writeln('    Applies a simple filter and highlights the (full) match.');
  Writeln('  -f --logfile=<filename>');
  Writeln('    specifies the logfile to be parsed');
  Writeln('  -p --poll');
  Writeln('    keep the log file open and wait for data');
  Writeln('  --html=<filename>');
  Writeln('    outputs filtered results in a formatted HTML file');
  Writeln('  --fg=<color> --bg=<color>');
  Writeln('    Sets the highlight color for the simple matcher (-s)');
  Writeln('  --highlightonly --all');
  Writeln('    Either option will also print non matching lines.');
  Writeln('  -h --help');
  Writeln('    show this help screen');
end;

end.