unit uLogManager;

interface

uses
  SysUtils, Classes, System.JSON, System.Threading, System.Generics.Collections,
  FMX.Forms, FMX.Controls, System.DateUtils;

type
  TLogCategory = (lcSystem, lcNetwork, lcDatabase, lcBusiness, lcDevice, lcUI, lcSecurity, lcPerformance);

  TLogCategories = set of TLogCategory;

  TLogLevel = (llTrace, llDebug, llInfo, llWarn, llError, llFatal);

  TLogEntry = record
    Timestamp: TDateTime;
    Level: TLogLevel;
    Category: TLogCategory;
    Message: string;
    Tag: string;
    UserID: string;
    ThreadID: Cardinal;
    procedure Clear;
  end;

  TOnLogEvent = reference to procedure(const LogEntry: TLogEntry);

  TLogManager = class
  private
    FLogs: TList<TLogEntry>;
    FMaxLogCount: Integer;
    FEnabled: Boolean;
    FCategories: TLogCategories;
    FMinLevel: TLogLevel;
    FOnLog: TOnLogEvent;
    FLock: TObject;
    FLogFileDir: string;
    procedure AddLogInternal(const Entry: TLogEntry);
    function GetLevelString(Level: TLogLevel): string;
    function GetCategoryString(Category: TLogCategory): string;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Log(Level: TLogLevel; Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure Log(Level: TLogLevel; Category: TLogCategory; const Message: string); overload;
    procedure Trace(const Message: string; const Args: array of const); overload;
    procedure Trace(const Message: string); overload;
    procedure Debug(const Message: string; const Args: array of const); overload;
    procedure Debug(const Message: string); overload;
    procedure Info(const Message: string; const Args: array of const); overload;
    procedure Info(const Message: string); overload;
    procedure Warn(const Message: string; const Args: array of const); overload;
    procedure Warn(const Message: string); overload;
    procedure Error(const Message: string; const Args: array of const); overload;
    procedure Error(const Message: string); overload;
    procedure Fatal(const Message: string; const Args: array of const); overload;
    procedure Fatal(const Message: string); overload;
    procedure TraceCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure TraceCategory(Category: TLogCategory; const Message: string); overload;
    procedure DebugCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure DebugCategory(Category: TLogCategory; const Message: string); overload;
    procedure InfoCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure InfoCategory(Category: TLogCategory; const Message: string); overload;
    procedure WarnCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure WarnCategory(Category: TLogCategory; const Message: string); overload;
    procedure ErrorCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure ErrorCategory(Category: TLogCategory; const Message: string); overload;
    procedure FatalCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
    procedure FatalCategory(Category: TLogCategory; const Message: string); overload;
    procedure LogException(E: Exception; Category: TLogCategory; const AdditionalInfo: string = ''); overload;
    procedure LogException(E: Exception; const AdditionalInfo: string = ''); overload;
    procedure LogPerformance(const OperationName: string; const ElapsedMS: Int64);
    procedure ClearLogs;
    function GetLogs(Level: TLogLevel; Category: TLogCategory): TArray<TLogEntry>; overload;
    function GetLogs(Level: TLogLevel; Categories: TLogCategories): TArray<TLogEntry>; overload;
    function GetLogs(Level: TLogLevel = llTrace): TArray<TLogEntry>; overload;
    function ExportToJSON: TJSONArray;
    procedure SaveToFile(const FileName: string);
    property Enabled: Boolean read FEnabled write FEnabled;
    property Categories: TLogCategories read FCategories write FCategories;
    property MinLevel: TLogLevel read FMinLevel write FMinLevel;
    property MaxLogCount: Integer read FMaxLogCount write FMaxLogCount;
    property OnLog: TOnLogEvent read FOnLog write FOnLog;
    property LogFileDir: string read FLogFileDir write FLogFileDir;
    procedure LogUIOperation(const UIOperation: string; const ControlName: string; const ElapsedMS: Int64 = -1);
    procedure LogNetworkRequest(const URL: string; const Method: string; const StatusCode: Integer; const ElapsedMS: Int64);
    procedure LogFormShow(const FormName: string; const ElapsedMS: Int64 = -1);
    procedure LogFormClose(const FormName: string; const ElapsedMS: Int64 = -1);
    procedure LogDataOperation(const Operation: string; const RecordCount: Integer; const ElapsedMS: Int64 = -1);
  end;

  TPerformanceLogger = class
  private
    FOperationName: string;
    FStartTime: TDateTime;
    FTag: string;
  public
    constructor Create(const AOperationName: string; ATag: string = '');
    destructor Destroy; override;
    procedure Finish;
    procedure FinishWithInfo(const Info: string);
    class function Measure<T>(const AOperationName: string; AFunc: TFunc<T>; ATag: string = ''): T;
    class procedure MeasureProc(const AOperationName: string; AProc: TProc; ATag: string = '');
  end;

  TOperationContext = class
  private
    FUserID: string;
    FSessionID: string;
    FRequestID: string;
    FStartTime: TDateTime;
    FTags: TDictionary<string, string>;
  public
    constructor Create(const AUserID: string = '');
    destructor Destroy; override;
    procedure SetTag(const Key, Value: string);
    function GetTag(const Key: string): string;
    procedure ClearTags;
    property UserID: string read FUserID write FUserID;
    property SessionID: string read FSessionID write FSessionID;
    property RequestID: string read FRequestID write FRequestID;
  end;

function LogManager: TLogManager;

implementation

var
  FLogManager: TLogManager;

function LogManager: TLogManager;
begin
  if FLogManager = nil then
    FLogManager := TLogManager.Create;
  Result := FLogManager;
end;

{ TLogEntry }

procedure TLogEntry.Clear;
begin
  Timestamp := 0;
  Level := llTrace;
  Category := lcSystem;
  Message := '';
  Tag := '';
  UserID := '';
  ThreadID := 0;
end;

{ TLogManager }

constructor TLogManager.Create;
begin
  inherited;
  FLogs := TList<TLogEntry>.Create;
  FMaxLogCount := 10000;
  FEnabled := True;
  FCategories := [Low(TLogCategory)..High(TLogCategory)];
  FMinLevel := llTrace;
  FLock := TObject.Create;
  FLogFileDir := ExtractFilePath(ParamStr(0)) + 'log\';
end;

destructor TLogManager.Destroy;
begin
  FLogs.Free;
  FLock.Free;
  inherited;
end;

procedure TLogManager.AddLogInternal(const Entry: TLogEntry);
begin
  TMonitor.Enter(FLock);
  try
    if FLogs.Count >= FMaxLogCount then
      FLogs.Delete(0);
    FLogs.Add(Entry);
  finally
    TMonitor.Exit(FLock);
  end;

  if Assigned(FOnLog) then
    FOnLog(Entry);
end;

function TLogManager.GetLevelString(Level: TLogLevel): string;
begin
  case Level of
    llTrace: Result := '[TRACE]';
    llDebug: Result := '[DEBUG]';
    llInfo:  Result := '[INFO]';
    llWarn:  Result := '[WARN]';
    llError: Result := '[ERROR]';
    llFatal: Result := '[FATAL]';
  else
    Result := '[UNKNOWN]';
  end;
end;

function TLogManager.GetCategoryString(Category: TLogCategory): string;
begin
  case Category of
    lcSystem:     Result := 'System';
    lcNetwork:    Result := 'Network';
    lcDatabase:   Result := 'Database';
    lcBusiness:   Result := 'Business';
    lcDevice:     Result := 'Device';
    lcUI:         Result := 'UI';
    lcSecurity:   Result := 'Security';
    lcPerformance:Result := 'Performance';
  else
    Result := 'Unknown';
  end;
end;

procedure TLogManager.Log(Level: TLogLevel; Category: TLogCategory; const Message: string; const Args: array of const);
var
  Entry: TLogEntry;
begin
  if not FEnabled then Exit;
  if not (Category in FCategories) then Exit;
  if Ord(Level) < Ord(FMinLevel) then Exit;

  Entry.Timestamp := Now;
  Entry.Level := Level;
  Entry.Category := Category;
  if Length(Args) > 0 then
    Entry.Message := Format(Message, Args)
  else
    Entry.Message := Message;
  Entry.Tag := '';
  Entry.UserID := '';
  Entry.ThreadID := TThread.CurrentThread.ThreadID;

  AddLogInternal(Entry);
end;

procedure TLogManager.Log(Level: TLogLevel; Category: TLogCategory; const Message: string);
begin
  Log(Level, Category, Message, []);
end;

procedure TLogManager.Trace(const Message: string; const Args: array of const);
begin
  Log(llTrace, lcSystem, Message, Args);
end;

procedure TLogManager.Trace(const Message: string);
begin
  Trace(Message, []);
end;

procedure TLogManager.Debug(const Message: string; const Args: array of const);
begin
  Log(llDebug, lcSystem, Message, Args);
end;

procedure TLogManager.Debug(const Message: string);
begin
  Debug(Message, []);
end;

procedure TLogManager.Info(const Message: string; const Args: array of const);
begin
  Log(llInfo, lcSystem, Message, Args);
end;

procedure TLogManager.Info(const Message: string);
begin
  Info(Message, []);
end;

procedure TLogManager.Warn(const Message: string; const Args: array of const);
begin
  Log(llWarn, lcSystem, Message, Args);
end;

procedure TLogManager.Warn(const Message: string);
begin
  Warn(Message, []);
end;

procedure TLogManager.Error(const Message: string; const Args: array of const);
begin
  Log(llError, lcSystem, Message, Args);
end;

procedure TLogManager.Error(const Message: string);
begin
  Error(Message, []);
end;

procedure TLogManager.Fatal(const Message: string; const Args: array of const);
begin
  Log(llFatal, lcSystem, Message, Args);
end;

procedure TLogManager.Fatal(const Message: string);
begin
  Fatal(Message, []);
end;

procedure TLogManager.TraceCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llTrace, Category, Message, Args);
end;

procedure TLogManager.TraceCategory(Category: TLogCategory; const Message: string);
begin
  TraceCategory(Category, Message, []);
end;

procedure TLogManager.DebugCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llDebug, Category, Message, Args);
end;

procedure TLogManager.DebugCategory(Category: TLogCategory; const Message: string);
begin
  DebugCategory(Category, Message, []);
end;

procedure TLogManager.InfoCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llInfo, Category, Message, Args);
end;

procedure TLogManager.InfoCategory(Category: TLogCategory; const Message: string);
begin
  InfoCategory(Category, Message, []);
end;

procedure TLogManager.WarnCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llWarn, Category, Message, Args);
end;

procedure TLogManager.WarnCategory(Category: TLogCategory; const Message: string);
begin
  WarnCategory(Category, Message, []);
end;

procedure TLogManager.ErrorCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llError, Category, Message, Args);
end;

procedure TLogManager.ErrorCategory(Category: TLogCategory; const Message: string);
begin
  ErrorCategory(Category, Message, []);
end;

procedure TLogManager.FatalCategory(Category: TLogCategory; const Message: string; const Args: array of const);
begin
  Log(llFatal, Category, Message, Args);
end;

procedure TLogManager.FatalCategory(Category: TLogCategory; const Message: string);
begin
  FatalCategory(Category, Message, []);
end;

procedure TLogManager.LogException(E: Exception; Category: TLogCategory; const AdditionalInfo: string);
var
  Msg: string;
begin
  if AdditionalInfo <> '' then
    Msg := Format('%s [Additional: %s]', [E.Message, AdditionalInfo])
  else
    Msg := E.Message;
  Log(llError, Category, 'Exception: %s: %s', [E.ClassName, Msg]);
end;

procedure TLogManager.LogException(E: Exception; const AdditionalInfo: string);
begin
  LogException(E, lcSystem, AdditionalInfo);
end;

procedure TLogManager.LogPerformance(const OperationName: string; const ElapsedMS: Int64);
begin
  Log(llInfo, lcPerformance, 'Operation [%s] took %d ms', [OperationName, Integer(ElapsedMS)]);
end;

procedure TLogManager.LogUIOperation(const UIOperation: string; const ControlName: string; const ElapsedMS: Int64);
begin
  if ElapsedMS >= 0 then
    Log(llInfo, lcUI, 'UI Operation [%s] on [%s] took %d ms', [UIOperation, ControlName, Integer(ElapsedMS)])
  else
    Log(llInfo, lcUI, 'UI Operation [%s] on [%s]', [UIOperation, ControlName]);
end;

procedure TLogManager.LogNetworkRequest(const URL: string; const Method: string; const StatusCode: Integer; const ElapsedMS: Int64);
begin
  if (StatusCode >= 200) and (StatusCode < 300) then
    Log(llInfo, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)])
  else if StatusCode >= 400 then
    Log(llError, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)])
  else
    Log(llWarn, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)]);
end;

procedure TLogManager.LogFormShow(const FormName: string; const ElapsedMS: Int64);
begin
  if ElapsedMS >= 0 then
    Log(llInfo, lcUI, 'Form Show [%s] took %d ms', [FormName, Integer(ElapsedMS)])
  else
    Log(llInfo, lcUI, 'Form Show [%s]', [FormName]);
end;

procedure TLogManager.LogFormClose(const FormName: string; const ElapsedMS: Int64);
begin
  if ElapsedMS >= 0 then
    Log(llInfo, lcUI, 'Form Close [%s] took %d ms', [FormName, Integer(ElapsedMS)])
  else
    Log(llInfo, lcUI, 'Form Close [%s]', [FormName]);
end;

procedure TLogManager.LogDataOperation(const Operation: string; const RecordCount: Integer; const ElapsedMS: Int64);
begin
  if ElapsedMS >= 0 then
    Log(llInfo, lcDatabase, 'Data Operation [%s] (%d records) took %d ms', [Operation, RecordCount, Integer(ElapsedMS)])
  else
    Log(llInfo, lcDatabase, 'Data Operation [%s] (%d records)', [Operation, RecordCount]);
end;

procedure TLogManager.ClearLogs;
begin
  TMonitor.Enter(FLock);
  try
    FLogs.Clear;
  finally
    TMonitor.Exit(FLock);
  end;
end;

function TLogManager.GetLogs(Level: TLogLevel; Category: TLogCategory): TArray<TLogEntry>;
var
  I, Count: Integer;
begin
  TMonitor.Enter(FLock);
  try
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if (FLogs[I].Level = Level) and (FLogs[I].Category = Category) then
        Inc(Count);
    end;
    SetLength(Result, Count);
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if (FLogs[I].Level = Level) and (FLogs[I].Category = Category) then
      begin
        Result[Count] := FLogs[I];
        Inc(Count);
      end;
    end;
  finally
    TMonitor.Exit(FLock);
  end;
end;

function TLogManager.GetLogs(Level: TLogLevel; Categories: TLogCategories): TArray<TLogEntry>;
var
  I, Count: Integer;
begin
  TMonitor.Enter(FLock);
  try
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if (FLogs[I].Level >= Level) and (FLogs[I].Category in Categories) then
        Inc(Count);
    end;
    SetLength(Result, Count);
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if (FLogs[I].Level >= Level) and (FLogs[I].Category in Categories) then
      begin
        Result[Count] := FLogs[I];
        Inc(Count);
      end;
    end;
  finally
    TMonitor.Exit(FLock);
  end;
end;

function TLogManager.GetLogs(Level: TLogLevel): TArray<TLogEntry>;
var
  I, Count: Integer;
begin
  TMonitor.Enter(FLock);
  try
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if FLogs[I].Level >= Level then
        Inc(Count);
    end;
    SetLength(Result, Count);
    Count := 0;
    for I := 0 to FLogs.Count - 1 do
    begin
      if FLogs[I].Level >= Level then
      begin
        Result[Count] := FLogs[I];
        Inc(Count);
      end;
    end;
  finally
    TMonitor.Exit(FLock);
  end;
end;

function TLogManager.ExportToJSON: TJSONArray;
var
  I: Integer;
  Entry: TJSONObject;
begin
  Result := TJSONArray.Create;
  TMonitor.Enter(FLock);
  try
    for I := 0 to FLogs.Count - 1 do
    begin
      Entry := TJSONObject.Create;
      Entry.AddPair('timestamp', FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', FLogs[I].Timestamp));
      Entry.AddPair('level', GetLevelString(FLogs[I].Level));
      Entry.AddPair('category', GetCategoryString(FLogs[I].Category));
      Entry.AddPair('message', FLogs[I].Message);
      Entry.AddPair('threadId', TJSONNumber.Create(FLogs[I].ThreadID));
      Result.AddElement(Entry);
    end;
  finally
    TMonitor.Exit(FLock);
  end;
end;

procedure TLogManager.SaveToFile(const FileName: string);
var
  I: Integer;
  Lines: TStringList;
  Line: string;
begin
  Lines := TStringList.Create;
  try
    TMonitor.Enter(FLock);
    try
      for I := 0 to FLogs.Count - 1 do
      begin
        Line := Format('%s %s [%s] %s',
          [FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', FLogs[I].Timestamp),
           GetLevelString(FLogs[I].Level),
           GetCategoryString(FLogs[I].Category),
           FLogs[I].Message]);
        Lines.Add(Line);
      end;
    finally
      TMonitor.Exit(FLock);
    end;
    if not ForceDirectories(ExtractFilePath(FileName)) then
      Exit;
    Lines.SaveToFile(FileName, TEncoding.UTF8);
  finally
    Lines.Free;
  end;
end;

{ TPerformanceLogger }

constructor TPerformanceLogger.Create(const AOperationName: string; ATag: string);
begin
  inherited Create;
  FOperationName := AOperationName;
  FStartTime := Now;
  FTag := ATag;
end;

destructor TPerformanceLogger.Destroy;
begin
  Finish;
  inherited;
end;

procedure TPerformanceLogger.Finish;
var
  ElapsedMS: Int64;
begin
  ElapsedMS := MilliSecondsBetween(Now, FStartTime);
  LogManager.LogPerformance(FOperationName, ElapsedMS);
end;

procedure TPerformanceLogger.FinishWithInfo(const Info: string);
var
  ElapsedMS: Int64;
begin
  ElapsedMS := MilliSecondsBetween(Now, FStartTime);
  LogManager.InfoCategory(lcPerformance, 'Operation [%s] with info [%s] took %d ms', [FOperationName, Info, Integer(ElapsedMS)]);
end;

class function TPerformanceLogger.Measure<T>(const AOperationName: string; AFunc: TFunc<T>; ATag: string): T;
var
  StartTime: TDateTime;
begin
  StartTime := Now;
  try
    Result := AFunc;
  finally
    LogManager.LogPerformance(AOperationName, MilliSecondsBetween(Now, StartTime));
  end;
end;

class procedure TPerformanceLogger.MeasureProc(const AOperationName: string; AProc: TProc; ATag: string);
var
  StartTime: TDateTime;
begin
  StartTime := Now;
  try
    AProc;
  finally
    LogManager.LogPerformance(AOperationName, MilliSecondsBetween(Now, StartTime));
  end;
end;

{ TOperationContext }

constructor TOperationContext.Create(const AUserID: string);
begin
  inherited Create;
  FUserID := AUserID;
  FSessionID := '';
  FRequestID := '';
  FStartTime := Now;
  FTags := TDictionary<string, string>.Create;
end;

destructor TOperationContext.Destroy;
begin
  FTags.Free;
  inherited;
end;

procedure TOperationContext.SetTag(const Key, Value: string);
begin
  FTags.AddOrSetValue(Key, Value);
end;

function TOperationContext.GetTag(const Key: string): string;
begin
  if not FTags.TryGetValue(Key, Result) then
    Result := '';
end;

procedure TOperationContext.ClearTags;
begin
  FTags.Clear;
end;

end.