RnQ/for.RnQ/RQlog.pas

{
  This file is part of R&Q.
  Under same license
}
unit RQlog;
{$I ForRnQConfig.inc}

interface

uses
  System.SysUtils, System.Classes, System.JSON, System.Generics.Collections,
  SciterJS, SciterJSAPI, RDGlobal, BaseWindow;

{$I PubRTTI.inc}

type
  PLogItem = ^TLogItem;

  TLogItem = record
    pkt: Boolean;
    Cpt, Text: String;
    PktData: String;
    Img: TPicName;
  end;

  TLogEntry = record
    time, method, caption, text, original: String;
    json: Boolean;
    icon: TPicName;
  end;

  {$I NoRTTI.inc}

  TLog = class(TBaseWindow)
  public
    procedure Init;
    procedure Add(Entry: TLogEntry);
  end;

  procedure AddToLog(const Time, Method, Caption, Text, Icon: String);
  procedure LogEvent(const Text: String; const Img: TPicName = ''; const pFlush: Boolean = False);
  procedure LogPacket(const Method, Head: String; const Data: String; const Img: TPicName);
  procedure FlushLogEvFile;

  function PrettyPrintJSON(Value: TJSONValue; Indent: Integer = 0): String; forward;

implementation

uses
  SciterLib, GlobalLib, UtilLib,
  RQUtil, RDFileUtil, RnQGlobal, RnQLangs;

var
  LogEvFileData: String;

const
  INDENT_SIZE = 2;

function PrettyPrintPair(Value: TJSONPair; Last: Boolean; Indent: Integer): String;
const
  TEMPLATE = '%s : %s';
var
  Line: string;
  JSONText: String;
begin
  try
    JSONText := PrettyPrintJSON(Value.JsonValue, Indent);
    Line := Format(TEMPLATE, [Value.JsonString.ToString, Trim(JSONText)]);
  except end;

  Line := StringOfChar(' ', Indent * INDENT_SIZE) + Line;
  if not Last then
    Line := Line + ',';
  Result := Line;
end;

function PrettyPrintArrayValue(Value: TJSONValue; Last: Boolean; Indent: Integer): String;
const
  TEMPLATE = '%s';
var
  Line: string;
  JSONText: String;
begin
  try
    JSONText := PrettyPrintJSON(Value, Indent);
    Line := Format(TEMPLATE, [Trim(JSONText)]);
  except end;

  Line := StringOfChar(' ', Indent * INDENT_SIZE) + Line;
  if not Last then
    Line := Line + ',';
  Result := Line;
end;

function PrettyPrintJSON(Value: TJSONValue; Indent: Integer = 0): String;
var
  i: Integer;
begin
  if Value is TJSONObject then
  begin
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '{';
    for i := 0 to TJSONObject(Value).Count - 1 do
      Result := Result + CRLF + PrettyPrintPair(TJSONObject(Value).Pairs[i], i = TJSONObject(Value).Count - 1, Indent + 1);
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '}';
  end
  else if Value is TJSONArray then
  begin
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '[';
    for i := 0 to TJSONArray(Value).Count - 1 do
      Result := Result + CRLF + PrettyPrintArrayValue(TJSONArray(Value).Items[i], i = TJSONArray(Value).Count - 1, Indent + 1);
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + ']';
  end else
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + Value.ToString;
end;

procedure AddToLog(const Time, Method, Caption, Text, Icon: String);
var
  JSON: TJSONValue;
  Entry: TLogEntry;
  SL: TStringList;
  I: Integer;
const
  MaxLines: Integer = 10000;
begin
  if not Running then
    Exit;

  Entry.time := Time;
  Entry.caption := Caption;
  Entry.icon := Icon;
  Entry.method := Method;
  Entry.json := False;
  Entry.text := Text;
  Entry.original := Text;

  if not (Caption = Text) then
  try
    JSON := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(Text), 0); // Broken double encoding
    Entry.json := Assigned(JSON);
    if Entry.json then
      Entry.text := Trim(PrettyPrintJSON(JSON));
    JSON.Free;

    if (Entry.text.CountChar(#10) + 1 > MaxLines) then
    begin
      SL := TStringList.Create;
      SL.Sorted := False;
      SL.Text := Entry.text;
      for I := SL.Count - 1 downto MaxLines do
        SL.Delete(I);
      Entry.text := TrimRight(SL.Text) + ' ...' + CRLF + CRLF + '<' + GetTranslation('Text was truncated to 10000 lines') + '>';
      SL.Free;
    end;
  except end;

  if Assigned(UI) and Assigned(UI.Log) then
    UI.Log.Add(Entry);
end;

procedure TLog.Init;
begin
  Call('init', []);
end;

procedure TLog.Add(Entry: TLogEntry);
begin
  Call('addEntry', [UI.RecordToVar(Entry)]);
end;

procedure LogEvent(const Text: String; const Img: TPicName = ''; const pFlush: Boolean = False);
var
  Lines: TArray;
  ToWindow, ToFile, Time: String;
begin
  Time := LogTimestamp;
  Lines := Text.Split([#13#10, #10]);
  ToWindow := String.Join(#10, Lines).TrimRight([#13, #10]);
  ToFile := Time + '> ' + String.Join(#13#10, Lines).TrimRight([#13, #10]);

  if LogPref.evts.onFile then
    LogEvFileData := LogEvFileData + ToFile + CRLF;

  if pFlush then
    FlushLogEvFile
  else
    ActionManager.Execute(AK_FLUSHEVENTS, 1000);

  if LogPref.evts.onWindow then
    AddToLog(Time, '', Lines[0], ToWindow, Img);
end;

procedure LogPacket(const Method, Head: String; const Data: String; const Img: TPicName);
begin
  if LogPref.pkts.onWindow then
    AddToLog(LogTimestamp, Method, Head, Data, Img);
end;

procedure FlushLogEvFile;
begin
  if Length(LogEvFileData) > 0 then
    if AppendFile(LogPath + EventsLogFilename, LogEvFileData) or (Length(LogEvFileData) > MByte) then
      LogEvFileData := '';
end;

end.