/// unit obsahujuci procedury a triedu pre tvorbu logu
unit log;

interface

uses
  constants, filereader, StdCtrls;

type
  PLogItem = ^TLogItem;
  /// record popisujuci jeden zaznam v logu
  TLogItem = record
    s: xString;
    path: xString;
    p,l,c,eid: Integer;
    s1,s2,s3: xString;
  end;

  /// trieda obsahujuca zaznamy o chybach vo vykonavani roznych algoritmov (log)
  TLog = class
  private
    a: array of PLogItem;
    allocated, count: Integer;
    lasterr: Integer;
    oldestnewindex: Integer;
    errorscount,warningscount: Integer;
    procedure addinternal(StringFilePath: xString; p, l, c, id: Integer; s1, s2,
      s3: xString);
  public
    constructor create;
    destructor Destroy; override;
    procedure clearandreset;
    function clone: TLog;
    procedure addLog(log: TLog);
    procedure add(path: xString; pos: Integer; id: Integer; s1: xString = ''; s2: xString = ''; s3: xString = '');
    procedure addSFR2(TSFR: TSimpleReader; delta: Integer; id: Integer; s1: xString = ''; s2: xString = ''; s3: xString = '');
    function fillListBox(ListBox: TListBox): boolean;
    function updateListBox(ListBox: TListBox): boolean;
    function toString: xString;
    function getLastError: Integer;
    function getLastIndex: Integer;
    function getString(i: Integer): xString;
    function getNumOfErrors: Integer;
    function getNumOfWarnings: Integer;
  end;

implementation

uses
  SysUtils, langres,simple;

{ TLog }

/// konstructor vytvarajuci objekt typu TLog
constructor TLog.create;
begin
  inherited;
  SetLength(a,8);
  count := 0;
  allocated := 8;
  lasterr := 0;
  oldestnewindex := 0;
  errorscount := 0;
  warningscount := 0;
end;

/// procedura na vymazanie vsetkych riadkov z logu
procedure TLog.clearandreset;
var i: Integer;
begin
  for i := 0 to Pred(count) do begin
    dispose(a[i]);
  end;
  SetLength(a,8);
  count := 0;
  allocated := 8;
  lasterr := 0;
  oldestnewindex := 0;
  errorscount := 0;
  warningscount := 0;
end;

///destruktor uvolnujuci log objekt z pamate
destructor TLog.Destroy;
var i: Integer;
begin
  for i := 0 to Pred(count) do begin
    dispose(a[i]);
  end;
  a := nil;
  inherited Destroy;
end;

///procedura na pridanie zaznamu do log objektu
procedure TLog.addinternal(StringFilePath: xString; p,l,c,id: Integer; s1,s2,s3: xString);
var tempS, StringTemp: xString;
begin
  if not FListBoxLogsEnabled then
    Exit;

  StringTemp := '';
  if (id > 1000) and (id <= 2000) then begin
    if not FListBoxShowErrors then
      Exit;
    if StringFilePath <> '' then
      StringTemp := GetLangString(STR_ERROR_IN_1)
    else
      StringTemp := GetLangString(STR_ERROR);
    StringTemp := StringReplace(StringTemp,'%1%',StringFilePath,[rfReplaceAll]);
    lasterr := count;
    errorscount := errorscount + 1;
  end
  else if (id > 2000) and (id <= 3000)then begin
    if not FListBoxShowWarnings then
      Exit;
    if StringFilePath <> '' then
      StringTemp := GetLangString(STR_WARNING_IN_1)
    else
      StringTemp := GetLangString(STR_WARNING);
    StringTemp := StringReplace(StringTemp,'%1%',StringFilePath,[rfReplaceAll]);
    warningscount := warningscount + 1;
  end
  else if (id > 3000) and (id < 4000) then begin
    if not FListBoxShowWarnings then
      Exit;
    if StringFilePath <> '' then
      StringTemp := GetLangString(STR_WARNING_IN_1)
    else
      StringTemp := GetLangString(STR_WARNING);
    StringTemp := StringReplace(StringTemp,'%1%',StringFilePath,[rfReplaceAll]);
    warningscount := warningscount + 1;
  end
  else if (id > 4000) then begin
    if not FListBoxShowMiscs then
      Exit;
    if StringFilePath <> '' then
      StringTemp := ''
    else
      StringTemp := '%1%';
    StringTemp := StringReplace(StringTemp,'%1%',StringFilePath,[rfReplaceAll]);
    warningscount := warningscount + 1;
  end
  else if (id = 0) then begin
    if StringFilePath <> '' then
      StringTemp := GetLangString(STR_SUCCESS_IN_1)
    else
      StringTemp := GetLangString(STR_SUCCESS);
    StringTemp := StringReplace(StringTemp,'%1%',StringFilePath,[rfReplaceAll]);
  end;

  tempS := '[' + StringTemp + ']';

  if (l >= 0) and (c >= 0) then begin
    tempS := tempS + ' ' + IntToStr(l) + ':' + IntToStr(c);
  end;
  if (p >= 0) then begin
    tempS := tempS + ' (' + IntToStr(p) + ')';
  end;

  if (id > 0) and (id < LANG_RES_SIZE) then begin
    StringTemp := GetLangString(id);
  end
  else begin
    StringTemp := GetLangString(LANG_RES_SIZE shr 1);
  end;

  StringTemp := StringReplace(StringTemp,'%1%',s1,[rfReplaceAll]);
  StringTemp := StringReplace(StringTemp,'%2%',s2,[rfReplaceAll]);
  StringTemp := StringReplace(StringTemp,'%3%',s3,[rfReplaceAll]);

  tempS := tempS + ' - ' + StringTemp;

  new(a[count]);
  a[count].s := tempS;
  a[count].p := p;
  a[count].l := l;
  a[count].c := c;
  a[count].eid := id;
  a[count].path := StringFilePath;
  a[count].s1 := s1;
  a[count].s2 := s2;
  a[count].s3 := s3;

  count := count + 1;
  if (count = allocated) then begin
    allocated := allocated * 2;
    SetLength(a,allocated);
  end;
end;

/// procedura na pridanie zaznamu do log objektu, kde pozicia, riadok, stlpec v ktorom
/// sa na vstupe vyskytla chyba bude vypocitany z vstupneho objektu na citanie subora,
/// na zaklade vstupnej delty;
/// id urcuje typ chybym ktory sa bude hladat v definiciach stringov, cez getLangString definovany v langres.pas;
/// s1,s2,s3 su parametre, ktore budu dosadene do stringu s chybou namiesto %1%,%2% a %3%
procedure TLog.addSFR2(TSFR: TSimpleReader; delta: Integer; id: Integer; s1: xString = ''; s2: xString = ''; s3: xString = '');
var l,c,p: Integer;
    StringFilePath: xString;
begin
  if TSFR <> nil then begin
    p := TSFR.getChangedFullPosition(l,c,delta);
    StringFilePath := TSFR.getFilepath;
  end
  else begin
    p := -1;
    l := -1;
    c := -1;
    StringFilePath := '';
  end;

  addinternal(StringFilePath,p,l,c,id,s1,s2,s3);
end;

/// procedura na pridanie zaznamu do log objektu, kde pozicia, riadok, stlpec v ktorom
/// sa na vstupe vyskytla chyba bude vypocitany z vstupneho objektu na citanie subora,
/// na zaklade vstupnej delty;
/// id urcuje typ chybym ktory sa bude hladat v definiciach stringov, cez getLangString definovany v langres.pas;
/// s1,s2,s3 su parametre, ktore budu dosadene do stringu s chybou namiesto %1%,%2% a %3%
procedure TLog.add(path: xString; pos: Integer; id: Integer; s1: xString = ''; s2: xString = ''; s3: xString = '');
var l,c,p: Integer;
    StringFilePath: xString;
begin
  if path <> '' then begin
    StringFilePath := path;
    p := pos;
    l := -1;
    c := -1;
  end
  else begin
    if pos >= 0 then
      p := pos
    else
      p := -1;
    l := -1;
    c := -1;
    StringFilePath := '';
  end;

  addinternal(StringFilePath,p,l,c,id,s1,s2,s3);
end;

/// funkcia na zobrazenie zaznamov z log objektu v listboxe
function TLog.fillListBox(ListBox: TListBox): boolean;
var i: Integer;
begin
  ListBox.Clear;
  if (ListBox <> nil) then begin
    for i := 0 to Pred(count) do begin
      ListBox.AddItem(a[i].s,TObject(a[i]));
    end;
    result := true;
  end
  else
    result := false;
  oldestnewindex := count;
end;

/// funkcia na obnovenie zobrazenia zaznamov z log objektu v listboxe
/// pricom sa do listboxu pridaju iba novsie zaznamy od posledneho volania
/// fillListBox alebo updateListBox
function TLog.updateListBox(ListBox: TListBox): boolean;
var i: Integer;
begin
  if (ListBox <> nil) then begin
    for i := oldestnewindex to Pred(count) do begin
      ListBox.AddItem(a[i].s,TObject(a[i]));
    end;
    result := true;
  end
  else
    result := false;
  oldestnewindex := count;
end;

/// funckia vypisujuca log objekt v tvare stringu
function TLog.toString: xString;
var i: Integer;
begin
  result := '';
  for i := 0 to Pred(count) do begin
    result := result + a[i].s + EOL;
  end;
end;

/// funkcia na vytvorenie identickej kopie log objektu (klonu)
function TLog.clone: TLog;
var I: Integer;
    plogitm: PLogItem;
begin
  result := TLog.create;
  SetLength(result.a,allocated);
  for I := 0 to Pred(count) do begin
    new(plogitm);
    plogitm^ := a[i]^;
    result.a[i] := plogitm;
  end;
  result.allocated := allocated;
  result.count := count;
  result.lasterr := lasterr;
  result.oldestnewindex := oldestnewindex;
  result.errorscount := errorscount;
  result.warningscount := warningscount;
end;

/// funkcia na pridanie zaznamov z ineho log objektu do tohto log objektu
procedure TLog.addLog(log: TLog);
var I,j: Integer;
    plogitm: PLogItem;
    base: Integer;
begin
//  result := TLog.create;
//  SetLength(result.a,allocated);
  if count + log.count > allocated then begin
    allocated := max(count + log.count + 1, allocated);
    SetLength(a,allocated);
  end;

  base := count;

  for I := 0 to Pred(log.count) do begin
    new(plogitm);
    plogitm^ := log.a[i]^;
    j := base + i;
    a[j] := plogitm;
  end;
  count := base + log.count;
  lasterr := log.lasterr;
  errorscount := errorscount + log.errorscount;
  warningscount := warningscount + log.warningscount;
end;

/// funkcia vracajuca cislo poslednej chyby, ktora bola pridana do log objektu
function TLog.getLastError: Integer;
begin
  result := lasterr;
  lasterr := 0;
end;

function TLog.getLastIndex: Integer;
begin
  result := count - 1;
end;

/// funkcia vracajuca cislo posledneho platneho indexu zaznamu v log objekte
function TLog.getString(i: Integer): xString;
begin
  if (i >= 0) and (i < count) then begin
    result := a[i].s;
  end
  else
    result := '';
end;

/// funkcia vracajuca pocet upozorneni v log objekte
function TLog.getNumOfWarnings: Integer;
begin
  result := warningscount;
end;

/// funkcia vracajuca pocet chyb v log objekte
function TLog.getNumOfErrors: Integer;
begin
  result := errorscount;
end;

end.
