mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-28 04:33:48 +02:00
911 lines
23 KiB
ObjectPascal
911 lines
23 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
This file is part of LazUtils.
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
unit LazLogger;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, types, math,
|
|
// LazUtils
|
|
LazLoggerBase, LazClasses, LazFileUtils, LazStringUtils, LazUTF8;
|
|
|
|
type
|
|
|
|
PLazLoggerLogGroup = LazLoggerBase.PLazLoggerLogGroup;
|
|
|
|
{$DEFINE USED_BY_LAZLOGGER}
|
|
{$I LazLoggerIntf.inc}
|
|
|
|
|
|
function DbgStr(const StringWithSpecialChars: string): string; overload;
|
|
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
|
|
function DbgStr(const p: PChar; Len: PtrInt): string; overload;
|
|
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
|
|
|
|
type
|
|
|
|
{ TLazLoggerFileHandle }
|
|
|
|
TLazLoggerFileHandle = class
|
|
private
|
|
FActiveLogText: PText; // may point to stdout
|
|
FCloseLogFileBetweenWrites: Boolean;
|
|
FLastWriteFailed: Boolean;
|
|
FLogName: String;
|
|
FLogText: Text;
|
|
FLogTextInUse, FLogTextFailed: Boolean;
|
|
FUseStdOut: Boolean;
|
|
FWriteFailedCount: Integer;
|
|
procedure DoOpenFile;
|
|
procedure DoCloseFile;
|
|
function GetWriteTarget: TLazLoggerWriteTarget;
|
|
procedure SetCloseLogFileBetweenWrites(AValue: Boolean);
|
|
procedure SetLogName(AValue: String);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure OpenFile;
|
|
procedure CloseFile;
|
|
procedure ResetWriteFailedCounter;
|
|
|
|
procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); virtual;
|
|
procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); virtual;
|
|
|
|
property LogName: String read FLogName write SetLogName;
|
|
property UseStdOut: Boolean read FUseStdOut write FUseStdOut;
|
|
property CloseLogFileBetweenWrites: Boolean read FCloseLogFileBetweenWrites write SetCloseLogFileBetweenWrites;
|
|
property WriteTarget: TLazLoggerWriteTarget read GetWriteTarget;
|
|
property ActiveLogText: PText read FActiveLogText;
|
|
property WriteFailedCount: Integer read FWriteFailedCount;
|
|
property LastWriteFailed: Boolean read FLastWriteFailed;
|
|
end;
|
|
|
|
{ TLazLoggerFileHandleThreadSave
|
|
file operations in critical section
|
|
|
|
Requires that DoOpenFile is called by main thread. Otherwise the filehandle may get closed...
|
|
}
|
|
|
|
TLazLoggerFileHandleThreadSave = class (TLazLoggerFileHandle)
|
|
private
|
|
FWriteToFileLock: TRTLCriticalSection;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); override;
|
|
procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); override;
|
|
end;
|
|
|
|
{ TLazLoggerFileHandleMainThread
|
|
file operations queued for main thread
|
|
}
|
|
|
|
TLazLoggerFileHandleMainThread = class (TLazLoggerFileHandle)
|
|
private
|
|
type
|
|
PWriteListEntry = ^TWriteListEntry;
|
|
TWriteListEntry = record
|
|
Next: PWriteListEntry;
|
|
Data: String;
|
|
Ln: Boolean;
|
|
Logger: TLazLogger;
|
|
end;
|
|
private
|
|
FWriteToFileLock: TRTLCriticalSection;
|
|
FFirst, FLast: PWriteListEntry;
|
|
|
|
procedure MainThreadWrite;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); override;
|
|
procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); override;
|
|
end;
|
|
|
|
|
|
{ TLazLoggerFile }
|
|
|
|
TLazLoggerFile = class(TLazLoggerWithGroupParam)
|
|
private
|
|
FFileHandle: TLazLoggerFileHandle;
|
|
FOnDbgOut: TLazLoggerWriteEvent;
|
|
FOnDebugLn: TLazLoggerWriteEvent;
|
|
FBlockHandler: TList;
|
|
|
|
|
|
FEnvironmentForLogFileName: String;
|
|
//FLogName: String;
|
|
|
|
FParamForLogFileName: String;
|
|
FGetLogFileNameDone: Boolean;
|
|
|
|
FIndentCriticalSection: TRTLCriticalSection;
|
|
FDebugNestLvl: Integer;
|
|
FDebugIndent: String;
|
|
FDebugNestAtBOL: Boolean;
|
|
|
|
function GetFileHandle: TLazLoggerFileHandle;
|
|
procedure SetEnvironmentForLogFileName(AValue: String);
|
|
procedure SetFileHandle(AValue: TLazLoggerFileHandle);
|
|
procedure SetParamForLogFileName(AValue: String);
|
|
function GetLogFileName: string;
|
|
private
|
|
// forward to TLazLoggerFileHandle
|
|
function GetCloseLogFileBetweenWrites: Boolean;
|
|
function GetLogName: String;
|
|
function GetUseStdOut: Boolean;
|
|
procedure SetCloseLogFileBetweenWrites(AValue: Boolean);
|
|
procedure SetLogName(AValue: String);
|
|
procedure SetUseStdOut(AValue: Boolean);
|
|
protected
|
|
procedure DoInit; override;
|
|
procedure DoFinish; override;
|
|
|
|
procedure IncreaseIndent; overload; override;
|
|
procedure DecreaseIndent; overload; override;
|
|
procedure IncreaseIndent(LogEnabled: TLazLoggerLogEnabled); overload; override;
|
|
procedure DecreaseIndent(LogEnabled: TLazLoggerLogEnabled); overload; override;
|
|
procedure IndentChanged; override;
|
|
procedure CreateIndent; virtual;
|
|
function GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler; override;
|
|
procedure ClearAllBlockHandler;
|
|
|
|
|
|
procedure DoDbgOut(s: string); override;
|
|
procedure DoDebugLn(s: string); override;
|
|
procedure DoDebuglnStack(const s: string); override;
|
|
|
|
property FileHandle: TLazLoggerFileHandle read GetFileHandle write SetFileHandle;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Assign(Src: TLazLogger); override;
|
|
function CurrentIndentLevel: Integer; override;
|
|
// A param on the commandline, that may contain the name (if not already set)
|
|
// example/default: --debug-log=
|
|
property ParamForLogFileName: String read FParamForLogFileName write SetParamForLogFileName;
|
|
// Environment variable used to specify log file name
|
|
// * is replaced by param(0) - the application name without extension
|
|
// example/default: *_debuglog
|
|
property EnvironmentForLogFileName: String read FEnvironmentForLogFileName write SetEnvironmentForLogFileName;
|
|
|
|
property OnDebugLn: TLazLoggerWriteEvent read FOnDebugLn write FOnDebugLn;
|
|
property OnDbgOut: TLazLoggerWriteEvent read FOnDbgOut write FOnDbgOut;
|
|
|
|
procedure AddBlockHandler(AHandler: TLazLoggerBlockHandler); override;
|
|
procedure RemoveBlockHandler(AHandler: TLazLoggerBlockHandler); override;
|
|
function BlockHandlerCount: Integer; override;
|
|
|
|
// forward to TLazLoggerFileHandle
|
|
property LogName: String read GetLogName write SetLogName;
|
|
property UseStdOut: Boolean read GetUseStdOut write SetUseStdOut;
|
|
property CloseLogFileBetweenWrites: Boolean read GetCloseLogFileBetweenWrites write SetCloseLogFileBetweenWrites;
|
|
end;
|
|
|
|
function GetDebugLogger: TLazLoggerFile; inline;
|
|
procedure SetDebugLogger(ALogger: TLazLoggerFile);
|
|
|
|
property DebugLogger: TLazLoggerFile read GetDebugLogger write SetDebugLogger;
|
|
|
|
implementation
|
|
|
|
{$I LazLoggerImpl.inc}
|
|
|
|
{$ifdef wince}
|
|
const
|
|
Str_LCL_Debug_File = 'lcldebug.log';
|
|
{$endif}
|
|
|
|
(* Creation / Access *)
|
|
|
|
function CreateDebugLogger: TRefCountedObject;
|
|
begin
|
|
Result := TLazLoggerFile.Create;
|
|
TLazLoggerFile(Result).Assign(GetExistingDebugLogger);
|
|
end;
|
|
|
|
function GetDebugLogger: TLazLoggerFile; inline;
|
|
begin
|
|
Result := TLazLoggerFile(LazLoggerBase.DebugLogger);
|
|
end;
|
|
|
|
procedure SetDebugLogger(ALogger: TLazLoggerFile);
|
|
begin
|
|
LazLoggerBase.DebugLogger := ALogger;
|
|
end;
|
|
|
|
{ TLazLoggerFileHandleMainThread }
|
|
|
|
procedure TLazLoggerFileHandleMainThread.MainThreadWrite;
|
|
var
|
|
Data, NextData: PWriteListEntry;
|
|
begin
|
|
EnterCriticalsection(FWriteToFileLock);
|
|
try
|
|
Data := FFirst;
|
|
FFirst := nil;
|
|
FLast := nil;
|
|
finally
|
|
LeaveCriticalsection(FWriteToFileLock);
|
|
end;
|
|
|
|
while Data <> nil do begin
|
|
NextData := Data^.Next;
|
|
if Data^.Ln
|
|
then inherited WriteLnToFile(Data^.Data, Data^.Logger)
|
|
else inherited WriteToFile(Data^.Data, Data^.Logger);
|
|
Dispose(Data);
|
|
Data := NextData;
|
|
end;
|
|
end;
|
|
|
|
constructor TLazLoggerFileHandleMainThread.Create;
|
|
begin
|
|
InitCriticalSection(FWriteToFileLock);
|
|
inherited;
|
|
end;
|
|
|
|
destructor TLazLoggerFileHandleMainThread.Destroy;
|
|
begin
|
|
// Call Syncronize (in the main thread) before destroy to catch any pending log
|
|
TThread.RemoveQueuedEvents(@MainThreadWrite);
|
|
inherited Destroy;
|
|
DoneCriticalsection(FWriteToFileLock);
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandleMainThread.WriteToFile(const s: string;
|
|
ALogger: TLazLogger);
|
|
var
|
|
Data: PWriteListEntry;
|
|
begin
|
|
if (not System.IsMultiThread) or (GetCurrentThreadID = MainThreadID) then begin
|
|
if FFirst <> nil then MainThreadWrite; // Dirty read of FFirst is ok
|
|
inherited WriteToFile(s, ALogger);
|
|
exit;
|
|
end;
|
|
|
|
New(Data);
|
|
Data^.Data := s;
|
|
Data^.Ln := False;
|
|
Data^.Logger := ALogger;
|
|
Data^.Next := nil;
|
|
EnterCriticalsection(FWriteToFileLock);
|
|
try
|
|
if FLast = nil then
|
|
FFirst := Data
|
|
else
|
|
FLast^.Next := Data;
|
|
FLast := Data;
|
|
finally
|
|
LeaveCriticalsection(FWriteToFileLock);
|
|
end;
|
|
TThread.Queue(nil, @MainThreadWrite);
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandleMainThread.WriteLnToFile(const s: string;
|
|
ALogger: TLazLogger);
|
|
var
|
|
Data: PWriteListEntry;
|
|
begin
|
|
if (not System.IsMultiThread) or (GetCurrentThreadID = MainThreadID) then begin
|
|
if FFirst <> nil then MainThreadWrite; // Dirty read of FFirst is ok
|
|
inherited WriteLnToFile(s, ALogger);
|
|
exit;
|
|
end;
|
|
|
|
New(Data);
|
|
Data^.Data := s;
|
|
Data^.Ln := True;
|
|
Data^.Logger := ALogger;
|
|
Data^.Next := nil;
|
|
EnterCriticalsection(FWriteToFileLock);
|
|
try
|
|
if FLast = nil then
|
|
FFirst := Data
|
|
else
|
|
FLast^.Next := Data;
|
|
FLast := Data;
|
|
finally
|
|
LeaveCriticalsection(FWriteToFileLock);
|
|
end;
|
|
TThread.Queue(nil, @MainThreadWrite);
|
|
end;
|
|
|
|
{ TLazLoggerFileHandleThreadSave }
|
|
|
|
constructor TLazLoggerFileHandleThreadSave.Create;
|
|
begin
|
|
InitCriticalSection(FWriteToFileLock);
|
|
inherited;
|
|
end;
|
|
|
|
destructor TLazLoggerFileHandleThreadSave.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
DoneCriticalsection(FWriteToFileLock);
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandleThreadSave.WriteToFile(const s: string;
|
|
ALogger: TLazLogger);
|
|
begin
|
|
EnterCriticalsection(FWriteToFileLock);
|
|
try
|
|
inherited WriteToFile(s, ALogger);
|
|
finally
|
|
LeaveCriticalsection(FWriteToFileLock);
|
|
end;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandleThreadSave.WriteLnToFile(const s: string;
|
|
ALogger: TLazLogger);
|
|
begin
|
|
EnterCriticalsection(FWriteToFileLock);
|
|
try
|
|
inherited WriteLnToFile(s, ALogger);
|
|
finally
|
|
LeaveCriticalsection(FWriteToFileLock);
|
|
end;
|
|
end;
|
|
|
|
(* ArgV *)
|
|
|
|
|
|
{ TLazLoggerFileHandle }
|
|
|
|
procedure TLazLoggerFileHandle.DoOpenFile;
|
|
var
|
|
fm: Byte;
|
|
begin
|
|
if FActiveLogText <> nil then exit;
|
|
|
|
if (not FLogTextFailed) and (length(FLogName)>0)
|
|
{$ifNdef WinCE}
|
|
and (DirPathExists(ExtractFileDir(FLogName)))
|
|
{$endif}
|
|
then begin
|
|
fm:=Filemode;
|
|
try
|
|
{$ifdef WinCE}
|
|
Assign(FLogText, FLogName);
|
|
{$I-}
|
|
Append(FLogText);
|
|
if IOResult <> 0 then
|
|
Rewrite(FLogText);
|
|
{$I+}
|
|
{$else}
|
|
Filemode:=fmShareDenyNone;
|
|
Assign(FLogText, FLogName);
|
|
if FileExistsUTF8(FLogName) then
|
|
Append(FLogText)
|
|
else
|
|
Rewrite(FLogText);
|
|
{$endif}
|
|
FActiveLogText := @FLogText;
|
|
FLogTextInUse := true;
|
|
except
|
|
FLogTextInUse := false;
|
|
FActiveLogText := nil;
|
|
FLogTextFailed := True;
|
|
// Add extra line ending: a dialog will be shown in windows gui application
|
|
writeln(StdOut, 'Cannot open file: ', FLogName+LineEnding);
|
|
end;
|
|
Filemode:=fm;
|
|
end;
|
|
|
|
if (not FLogTextInUse) and (FUseStdOut) then
|
|
begin
|
|
if not(TextRec(Output).Mode=fmClosed) then
|
|
FActiveLogText := @Output;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.DoCloseFile;
|
|
begin
|
|
if FLogTextInUse then begin
|
|
try
|
|
Close(FLogText);
|
|
except
|
|
end;
|
|
FLogTextInUse := false;
|
|
end;
|
|
FActiveLogText := nil;
|
|
end;
|
|
|
|
function TLazLoggerFileHandle.GetWriteTarget: TLazLoggerWriteTarget;
|
|
begin
|
|
Result := lwtNone;
|
|
if FActiveLogText = @Output then
|
|
Result := lwtStdOut
|
|
else
|
|
if FLogTextInUse then
|
|
Result := lwtTextFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.SetCloseLogFileBetweenWrites(AValue: Boolean);
|
|
begin
|
|
if FCloseLogFileBetweenWrites = AValue then Exit;
|
|
FCloseLogFileBetweenWrites := AValue;
|
|
if FCloseLogFileBetweenWrites then
|
|
DoCloseFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.SetLogName(AValue: String);
|
|
begin
|
|
if FLogName = AValue then Exit;
|
|
DoCloseFile;
|
|
|
|
FLogName := CleanAndExpandFilename(AValue);
|
|
|
|
FLogTextFailed := False;
|
|
end;
|
|
|
|
constructor TLazLoggerFileHandle.Create;
|
|
begin
|
|
FLogTextInUse := False;
|
|
FLogTextFailed := False;
|
|
{$ifdef WinCE}
|
|
FLogName := ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File;
|
|
FUseStdOut := False;
|
|
FCloseLogFileBetweenWrites := True;
|
|
{$else}
|
|
FLogName := '';
|
|
FUseStdOut := True;
|
|
FCloseLogFileBetweenWrites := False;
|
|
{$endif}
|
|
end;
|
|
|
|
destructor TLazLoggerFileHandle.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
DoCloseFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.OpenFile;
|
|
begin
|
|
if not CloseLogFileBetweenWrites then
|
|
DoOpenFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.CloseFile;
|
|
begin
|
|
DoCloseFile;
|
|
FLogTextFailed := False;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.ResetWriteFailedCounter;
|
|
begin
|
|
FWriteFailedCount := 0;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.WriteToFile(const s: string; ALogger: TLazLogger
|
|
);
|
|
var
|
|
Handled: Boolean;
|
|
begin
|
|
try
|
|
if OnWidgetSetDbgOut <> nil then
|
|
begin
|
|
Handled := False;
|
|
OnWidgetSetDbgOut(ALogger, s, Handled, WriteTarget, ActiveLogText);
|
|
if Handled then
|
|
Exit;
|
|
end;
|
|
|
|
DoOpenFile;
|
|
if FActiveLogText = nil then exit;
|
|
|
|
Write(FActiveLogText^, s);
|
|
{$IFDEF LAZLOGGER_FLUSH} Flush(FActiveLogText^); {$ENDIF}
|
|
|
|
if FCloseLogFileBetweenWrites then
|
|
DoCloseFile;
|
|
FLastWriteFailed := False;
|
|
except
|
|
inc(FWriteFailedCount);
|
|
FLastWriteFailed := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazLoggerFileHandle.WriteLnToFile(const s: string;
|
|
ALogger: TLazLogger);
|
|
var
|
|
Handled: Boolean;
|
|
begin
|
|
try
|
|
if OnWidgetSetDebugLn <> nil then
|
|
begin
|
|
Handled := False;
|
|
OnWidgetSetDebugLn(ALogger, s, Handled, WriteTarget, ActiveLogText);
|
|
if Handled then
|
|
Exit;
|
|
end;
|
|
|
|
DoOpenFile;
|
|
if FActiveLogText = nil then exit;
|
|
|
|
WriteLn(FActiveLogText^, s);
|
|
|
|
if FCloseLogFileBetweenWrites then
|
|
DoCloseFile;
|
|
FLastWriteFailed := False;
|
|
except
|
|
inc(FWriteFailedCount);
|
|
FLastWriteFailed := True;
|
|
end;
|
|
end;
|
|
|
|
{ TLazLoggerFile }
|
|
|
|
function TLazLoggerFile.GetFileHandle: TLazLoggerFileHandle;
|
|
begin
|
|
if FFileHandle = nil then
|
|
FFileHandle := TLazLoggerFileHandleMainThread.Create;
|
|
Result := FFileHandle;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetEnvironmentForLogFileName(AValue: String);
|
|
begin
|
|
if FEnvironmentForLogFileName = AValue then Exit;
|
|
Finish;
|
|
FGetLogFileNameDone := False;
|
|
FEnvironmentForLogFileName := AValue;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetFileHandle(AValue: TLazLoggerFileHandle);
|
|
begin
|
|
if FFileHandle = AValue then Exit;
|
|
Finish;
|
|
FreeAndNil(FFileHandle);
|
|
FFileHandle := AValue;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetParamForLogFileName(AValue: String);
|
|
begin
|
|
if FParamForLogFileName = AValue then Exit;
|
|
Finish;
|
|
FGetLogFileNameDone := False;
|
|
FParamForLogFileName := AValue;
|
|
end;
|
|
|
|
function TLazLoggerFile.GetCloseLogFileBetweenWrites: Boolean;
|
|
begin
|
|
Result := FileHandle.CloseLogFileBetweenWrites;
|
|
end;
|
|
|
|
function TLazLoggerFile.GetLogName: String;
|
|
begin
|
|
Result := FileHandle.LogName;
|
|
end;
|
|
|
|
function TLazLoggerFile.GetUseStdOut: Boolean;
|
|
begin
|
|
Result := FileHandle.UseStdOut;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetCloseLogFileBetweenWrites(AValue: Boolean);
|
|
begin
|
|
FileHandle.CloseLogFileBetweenWrites := AValue;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetLogName(AValue: String);
|
|
begin
|
|
if FileHandle.LogName = AValue then Exit;
|
|
Finish;
|
|
FileHandle.LogName := AValue;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.SetUseStdOut(AValue: Boolean);
|
|
begin
|
|
FileHandle.UseStdOut := AValue;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DoInit;
|
|
begin
|
|
inherited DoInit;
|
|
|
|
FDebugNestLvl := 0;
|
|
FDebugNestAtBOL := True;
|
|
if (LogName = '') and not FGetLogFileNameDone then
|
|
LogName := GetLogFileName;
|
|
|
|
FileHandle.OpenFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DoFinish;
|
|
begin
|
|
inherited DoFinish;
|
|
|
|
FileHandle.CloseFile;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.IncreaseIndent;
|
|
var
|
|
i: Integer;
|
|
l: LongInt;
|
|
begin
|
|
l := InterLockedIncrement(FDebugNestLvl);
|
|
CreateIndent;
|
|
for i := 0 to BlockHandlerCount - 1 do
|
|
BlockHandler[i].EnterBlock(Self, l);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DecreaseIndent;
|
|
var
|
|
i: Integer;
|
|
l: LongInt;
|
|
begin
|
|
if not FDebugNestAtBOL then DebugLn;
|
|
|
|
l := InterLockedDecrement(FDebugNestLvl);
|
|
if l < 0 then
|
|
l := InterLockedIncrement(FDebugNestLvl);
|
|
|
|
if l >= 0 then begin
|
|
inc(l);
|
|
for i := 0 to BlockHandlerCount - 1 do
|
|
BlockHandler[i].ExitBlock(Self, l);
|
|
end;
|
|
CreateIndent;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.IncreaseIndent(LogEnabled: TLazLoggerLogEnabled);
|
|
begin
|
|
if not (LogEnabled.Enabled) then exit;
|
|
|
|
if (LogEnabled.Group <> nil) and (LogEnabled.Group^.Enabled) then
|
|
inc(LogEnabled.Group^.FOpenedIndents);
|
|
IncreaseIndent;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DecreaseIndent(LogEnabled: TLazLoggerLogEnabled);
|
|
begin
|
|
if (LogEnabled.Enabled) then begin
|
|
if LogEnabled.Group <> nil then
|
|
dec(LogEnabled.Group^.FOpenedIndents);
|
|
DecreaseIndent;
|
|
end
|
|
else
|
|
if (LogEnabled.Group <> nil) and (LogEnabled.Group^.FOpenedIndents > 0) then begin
|
|
dec(LogEnabled.Group^.FOpenedIndents);
|
|
DecreaseIndent;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.IndentChanged;
|
|
begin
|
|
CreateIndent;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.CreateIndent;
|
|
var
|
|
s: String;
|
|
NewLen: Integer;
|
|
l: Integer;
|
|
begin
|
|
l := InterlockedCompareExchange(FDebugNestLvl, -1, -1);
|
|
NewLen := l * NestLvlIndent;
|
|
if NewLen < 0 then NewLen := 0;
|
|
if (NewLen >= MaxNestPrefixLen) then begin
|
|
s := IntToStr(l);
|
|
NewLen := MaxNestPrefixLen - Length(s);
|
|
if NewLen < 1 then
|
|
NewLen := 1;
|
|
end else
|
|
s := '';
|
|
|
|
EnterCriticalsection(FIndentCriticalSection);
|
|
if NewLen <> Length(FDebugIndent) then
|
|
FDebugIndent := s + StringOfChar(' ', NewLen);
|
|
LeaveCriticalsection(FIndentCriticalSection);
|
|
end;
|
|
|
|
function TLazLoggerFile.GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler;
|
|
begin
|
|
Result := TLazLoggerBlockHandler(FBlockHandler[AIndex]);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.ClearAllBlockHandler;
|
|
begin
|
|
while BlockHandlerCount > 0 do RemoveBlockHandler(BlockHandler[0]);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DoDbgOut(s: string);
|
|
var
|
|
Handled: Boolean;
|
|
CB: TLazLoggerWriteEvent;
|
|
begin
|
|
if not IsInitialized then Init;
|
|
|
|
(* DoDbgOut in not useful in threaded environment.
|
|
Therefore FDebugNestAtBOL is not handled in a thread safe way.
|
|
If DoDbgOut is *not* used at all, the FDebugNestAtBOL is always true, and
|
|
dirty reads should therefore yield the correct value: "true"
|
|
*)
|
|
|
|
if s <> '' then begin
|
|
if FDebugNestAtBOL then begin
|
|
EnterCriticalsection(FIndentCriticalSection);
|
|
s := FDebugIndent + s;
|
|
LeaveCriticalsection(FIndentCriticalSection);
|
|
end;
|
|
FDebugNestAtBOL := (s[length(s)] in [#10,#13]);
|
|
end;
|
|
|
|
CB := OnDbgOut;
|
|
if CB <> nil then
|
|
begin
|
|
Handled := False;
|
|
CB(Self, s, Handled);
|
|
if Handled then
|
|
Exit;
|
|
end;
|
|
|
|
FileHandle.WriteToFile(s, Self);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DoDebugLn(s: string);
|
|
var
|
|
Handled: Boolean;
|
|
CB: TLazLoggerWriteEvent;
|
|
begin
|
|
if not IsInitialized then Init;
|
|
|
|
if FDebugNestAtBOL and (s <> '') then begin
|
|
EnterCriticalsection(FIndentCriticalSection);
|
|
s := FDebugIndent + s;
|
|
LeaveCriticalsection(FIndentCriticalSection);
|
|
end;
|
|
FDebugNestAtBOL := True;
|
|
|
|
CB := OnDebugLn;
|
|
if CB <> nil then
|
|
begin
|
|
Handled := False;
|
|
CB(Self, s, Handled);
|
|
if Handled then
|
|
Exit;
|
|
end;
|
|
|
|
FileHandle.WriteLnToFile(LineBreaksToSystemLineBreaks(s), Self);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.DoDebuglnStack(const s: string);
|
|
begin
|
|
DebugLn(s);
|
|
FileHandle.DoOpenFile;
|
|
if FileHandle.FActiveLogText = nil then exit;
|
|
|
|
Dump_Stack(FileHandle.FActiveLogText^, get_frame);
|
|
|
|
if CloseLogFileBetweenWrites then
|
|
FileHandle.DoCloseFile;
|
|
end;
|
|
|
|
constructor TLazLoggerFile.Create;
|
|
begin
|
|
InitCriticalSection(FIndentCriticalSection);
|
|
inherited;
|
|
FDebugNestLvl := 0;
|
|
FBlockHandler := TList.Create;
|
|
|
|
{$ifdef WinCE}
|
|
FParamForLogFileName := '';
|
|
FEnvironmentForLogFileName := '';
|
|
{$else}
|
|
FParamForLogFileName := '--debug-log=';
|
|
FEnvironmentForLogFileName := '*_debuglog';
|
|
{$endif}
|
|
end;
|
|
|
|
destructor TLazLoggerFile.Destroy;
|
|
begin
|
|
ClearAllBlockHandler;
|
|
inherited Destroy;
|
|
FreeAndNil(FFileHandle);
|
|
FreeAndNil(FBlockHandler);
|
|
DoneCriticalsection(FIndentCriticalSection);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.Assign(Src: TLazLogger);
|
|
begin
|
|
inherited Assign(Src);
|
|
if Src is TLazLoggerFile then begin
|
|
FOnDbgOut := TLazLoggerFile(Src).FOnDbgOut;
|
|
FOnDebugLn := TLazLoggerFile(Src).FOnDebugLn;;
|
|
|
|
FEnvironmentForLogFileName := TLazLoggerFile(Src).FEnvironmentForLogFileName;
|
|
FParamForLogFileName := TLazLoggerFile(Src).FParamForLogFileName;
|
|
FGetLogFileNameDone := TLazLoggerFile(Src).FGetLogFileNameDone;
|
|
|
|
LogName := TLazLoggerFile(Src).LogName;
|
|
UseStdOut := TLazLoggerFile(Src).UseStdOut;
|
|
CloseLogFileBetweenWrites := TLazLoggerFile(Src).CloseLogFileBetweenWrites;
|
|
end;
|
|
end;
|
|
|
|
function TLazLoggerFile.CurrentIndentLevel: Integer;
|
|
begin
|
|
Result := InterlockedCompareExchange(FDebugNestLvl, -1, -1);
|
|
end;
|
|
|
|
procedure TLazLoggerFile.AddBlockHandler(AHandler: TLazLoggerBlockHandler);
|
|
begin
|
|
FBlockHandler.Add(AHandler);
|
|
AHandler.AddReference;
|
|
end;
|
|
|
|
procedure TLazLoggerFile.RemoveBlockHandler(AHandler: TLazLoggerBlockHandler);
|
|
begin
|
|
FBlockHandler.Remove(AHandler);
|
|
AHandler.ReleaseReference;
|
|
end;
|
|
|
|
function TLazLoggerFile.BlockHandlerCount: Integer;
|
|
begin
|
|
Result := FBlockHandler.Count;
|
|
end;
|
|
|
|
function TLazLoggerFile.GetLogFileName: string;
|
|
var
|
|
EnvVarName: string;
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
FGetLogFileNameDone := True;
|
|
if FParamForLogFileName <> '' then begin
|
|
// first try to find the log file name in the command line parameters
|
|
i := GetParamByNameCount(FParamForLogFileName) - 1;
|
|
if i >= 0 then
|
|
Result := GetParamByName(FParamForLogFileName, i);
|
|
end;
|
|
if FEnvironmentForLogFileName <> '' then begin;
|
|
// if not found yet, then try to find in the environment variables
|
|
if (length(result)=0) then begin
|
|
// Substitute * with executable filename without extension
|
|
EnvVarName:=StringReplace(FEnvironmentForLogFileName,
|
|
'*',
|
|
ChangeFileExt(ExtractFileName(ParamStrUTF8(0)),''),
|
|
[rfReplaceAll,rfIgnoreCase]);
|
|
Result := GetEnvironmentVariableUTF8(EnvVarName);
|
|
end;
|
|
end;
|
|
if (length(result)>0) then
|
|
Result := ExpandFileNameUTF8(Result);
|
|
end;
|
|
|
|
|
|
function DbgStr(const StringWithSpecialChars: string): string;
|
|
begin
|
|
Result := LazLoggerBase.DbgStr(StringWithSpecialChars);
|
|
end;
|
|
|
|
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt
|
|
): string;
|
|
begin
|
|
Result := LazLoggerBase.DbgStr(StringWithSpecialChars, StartPos, Len);
|
|
end;
|
|
|
|
function DbgStr(const p: PChar; Len: PtrInt): string;
|
|
begin
|
|
Result := LazLoggerBase.DbgStr(p, Len);
|
|
end;
|
|
|
|
function DbgWideStr(const StringWithSpecialChars: widestring): string;
|
|
begin
|
|
Result := LazLoggerBase.DbgWideStr(StringWithSpecialChars);
|
|
end;
|
|
|
|
initialization
|
|
LazDebugLoggerCreator := @CreateDebugLogger;
|
|
RecreateDebugLogger;
|
|
end.
|
|
|