source: trunk/linetime.lpr

program linetime;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this }
  ,DateUtils, IOStream;

type

  { TMyApplication }

  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  private
    UseEscapeChars: Boolean;
    TestMode: Boolean;
    TestLineDelay: TDateTime;
    TestString: string;
    FirstLine: Boolean;
    TextOnLine: Boolean;
    StartTime: TDateTime;
    NewLine: Boolean;
    NewLineEnding: string;
    ShowTime: Boolean;
    LastLineTime: TDateTime;
    LogFile: TFileStream;
    LogEnabled: Boolean;
    TermString: string;
    TermStringIndex: Integer;
    procedure TermCheckString(Buffer: string);
    function FindLineEnding(Buffer: string; var FoundLineEnding: string): Integer;
    procedure WriteRaw(Text: string);
    procedure WriteLog(Text: string);
    procedure PrintOutput(Output: string);
    procedure ShowTimePrefix;
    procedure ProcessBuffer(Buffer: string);
  public
    FormatCSV: Boolean;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TMyApplication }

procedure TMyApplication.DoRun;
var
  ErrorMsg: String;
  Buffer: string;
  InputStream: TStream;
  Count: Integer;
  LogDir: string;
  FileName: string;
begin
  // Quick check parameters
  ErrorMsg := CheckOptions('hclt:e', 'help csv log termstr escape');
  if ErrorMsg <> '' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // Parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  if HasOption('t', 'termstr') then begin
    TermString := GetOptionValue('t', 'termstr');
  end else TermString := '';

  FormatCSV := HasOption('c', 'csv');
  UseEscapeChars := HasOption('e', 'escape');
  LogEnabled := HasOption('l', 'log');
  if LogEnabled then begin
    LogDir := GetUserDir + DirectorySeparator + '.linetime' + DirectorySeparator + 'logs';
    ForceDirectories(LogDir);
    FileName := LogDir + DirectorySeparator + FormatDateTime('yyyymmddhhnnss', Now) + '.log';
    LogFile := TFileStream.Create(FileName, fmCreate);
  end;

  NewLine := True;
  ShowTime := True;
  FirstLine := True;
  StartTime := Now;
  LastLineTime := 0;
  TermStringIndex := 1;
  TextOnLine := False;
  try
    if TestMode then begin
      InputStream := TMemoryStream.Create;
      InputStream.Write(TestString[1], Length(TestString));
      InputStream.Position := 0;
    end else
      InputStream := TIOStream.Create(iosInput);
    repeat
      SetLength(Buffer, 1000);
      Count := InputStream.Read(Buffer[1], Length(Buffer));
      SetLength(Buffer, Count);
      ProcessBuffer(Buffer);
    until (Count = 0) or Terminated;
    NewLineEnding := LineEnding;
    PrintOutput('');
  finally
    InputStream.Free;
  end;
  WriteRaw(LineEnding);
  WriteLog(LineEnding);

  Terminate;
end;

procedure TMyApplication.TermCheckString(Buffer: string);
var
  I: Integer;
begin
  // Search for termination string
  if TermString <> '' then
  for I := 1 to Length(Buffer) do begin
    if TermStringIndex > Length(TermString) then begin
      Terminate;
      Break;
    end;
    if Buffer[I] = TermString[TermStringIndex] then
      Inc(TermStringIndex)
      else TermStringIndex := 1;
  end;
end;

function TMyApplication.FindLineEnding(Buffer: string; var FoundLineEnding: string): Integer;
const
  LineEnding1 = #13#10;
  LineEnding2 = #10;
  LineEnding3 = #13;
var
  P: Integer;
begin
  Result := 0;
  FoundLineEnding := '';

  P := Pos(LineEnding1, Buffer);
  if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin
    Result := P;
    FoundLineEnding := LineEnding1;
  end;
  P := Pos(LineEnding2, Buffer);
  if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin
    Result := P;
    FoundLineEnding := LineEnding2;
  end;
  P := Pos(LineEnding3, Buffer);
  if (P > 0) and (((Result > 0) and (P < Result)) or (Result = 0)) then begin
    Result := P;
    FoundLineEnding := LineEnding3;
  end;
end;

procedure TMyApplication.WriteRaw(Text: string);
begin
  Write(Text);
end;

procedure TMyApplication.WriteLog(Text: string);
begin
  if LogEnabled then begin
    if Length(Text) > 0 then
      LogFile.Write(Text[1], Length(Text));
  end;
end;

procedure TMyApplication.PrintOutput(Output: string);
begin
  TermCheckString(Output);
  if NewLine then begin
    if not FirstLine then begin
      // If previous line was empty then print time prefix before move to next line
      if (not TextOnLine) then ShowTimePrefix;
      if FormatCSV then begin
        WriteRaw('"' + LineEnding);
      end else begin
        WriteRaw(NewLineEnding);
      end;
      TextOnLine := False;
    end;
    WriteLog(LineEnding);
    NewLine := False;
    FirstLine := False;
  end;
  if Length(Output) > 0 then TextOnLine := True;
  if TextOnLine and ShowTime then begin
    ShowTimePrefix;
    ShowTime := False;
  end;
  WriteRaw(Output);
  WriteLog(Output);
end;

procedure TMyApplication.ShowTimePrefix;
var
  LineTime: TDateTime;
  TimeStr: string;
begin
  LineTime := Now - StartTime;
  TimeStr := FloatToStrF(LineTime / OneSecond, ffFixed, 10, 2);
  if FormatCSV then begin
    WriteRaw(TimeStr + ',' +
      FloatToStrF((LineTime - LastLineTime) / OneSecond, ffFixed, 10, 2) + ',"');
  end else begin
    if UseEscapeChars then
      WriteRaw(#$1b'[0;32m' + TimeStr + #$1b'[0m ')
      else WriteRaw(TimeStr + ' ');
  end;
  WriteLog(TimeStr + ' ');
  LastLineTime := LineTime;
  Sleep(Trunc(TestLineDelay / OneMillisecond));
end;

procedure TMyApplication.ProcessBuffer(Buffer: string);
var
  P: Integer;
  I: Integer;
  Part: string;
  FoundLineEnding: string;
begin
  NewLineEnding := LineEnding;
  repeat
    FoundLineEnding := '';
    P := FindLineEnding(Buffer, FoundLineEnding);
    if P > 0 then begin
      Part := Copy(Buffer, 1, P - 1);
      if FormatCSV then
        Part := StringReplace(Part, '"', '""', [rfReplaceAll]);
      PrintOutput(Part);
      NewLineEnding := FoundLineEnding;
      Delete(Buffer, 1, P - 1 + Length(FoundLineEnding));
      NewLine := True;
      ShowTime := True;
    end;

  until P = 0;
  PrintOutput(Buffer);
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
  TestLineDelay := 0;
  TestMode := False;
  //TestMode := True;
  if TestMode then begin
    TestLineDelay := 10 * OneMillisecond;
    //TestString := 'Line 1'#13#10'Line 2'#13'Line 3'#10'Line 4 abcd abcd xyz'#13#10#13#10'Line 9'#13#13#10'Line 10';
    TestString := 'sas'#13#13#10'Line 10';
  end;
end;

destructor TMyApplication.Destroy;
begin
  FreeAndNil(LogFile);
  inherited Destroy;
end;

procedure TMyApplication.WriteHelp;
begin
  WriteLn('Usage: ', ExeName, ' <parameters>');
  WriteLn(' -h --help        Show this help');
  WriteLn(' -c --csv         Print lines in CSV format');
  WriteLn(' -l --log         Log output to log files in ~/.linetime/logs');
  WriteLn(' -t --termstr <string> Termination string');
  WriteLn(' -e --escape      Use escape characters for color change');
end;

var
  Application: TMyApplication;
begin
  Application := TMyApplication.Create(nil);
  Application.Run;
  Application.Free;
end.