Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
Repository URL to install this package:
|
Version:
1.6 ▾
|
unit LazLoggerBase;
{$mode objfpc}{$H+}
(*
- All global variables, initialization and finalization use TObject instead
of TLazLogger.
This means: using the unit (without calling any of the functions) will not
make any reference to the classes, and they should be smart-linked away.
*)
interface
uses
Classes, SysUtils, types, math, LazClasses, LazUTF8;
type
TLazLoggerLogGroupFlag =
( lgfAddedByParamParser, // Not added via Register. This is a placeholder for the enabled-state given by the user, via command line
lgfNoDefaultEnabledSpecified // Registered without default
);
TLazLoggerLogGroupFlags = set of TLazLoggerLogGroupFlag;
TLazLoggerLogGroup = record
ConfigName: String; // case insensitive
Enabled: Boolean;
Flags: TLazLoggerLogGroupFlags;
FOpenedIndents: Integer;
end;
PLazLoggerLogGroup = ^TLazLoggerLogGroup;
TLazLoggerWriteTarget = (
lwtNone,
lwtStdOut, lwtStdErr,
lwtTextFile // Data will be ^Text
);
TLazLoggerWriteEvent = procedure(Sender: TObject; S: string; var Handled: Boolean) of object;
TLazLoggerWidgetSetWriteEvent = procedure(Sender: TObject;
S: string;
var Handled: Boolean;
Target: TLazLoggerWriteTarget;
Data: Pointer) of object;
type
TLazLogger = class;
{ TLazLoggerBlockHandler
called for DebuglnEnter / Exit
}
TLazLoggerBlockHandler = class(TRefCountedObject)
public
procedure EnterBlock(Sender: TLazLogger; Level: Integer); virtual; abstract;
procedure ExitBlock(Sender: TLazLogger; Level: Integer); virtual; abstract;
end;
{ TLazLoggerLogGroupList }
TLazLoggerLogGroupList = class(TRefCountedObject)
private
FList: TFPList;
procedure Clear;
function GetItem(Index: Integer): PLazLoggerLogGroup;
function NewItem(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
protected
function Add(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
function FindOrAdd(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
procedure Remove(const AConfigName: String);
procedure Remove(const AnEntry: PLazLoggerLogGroup);
public
constructor Create;
destructor Destroy; override;
procedure Assign(Src: TLazLoggerLogGroupList);
function IndexOf(const AConfigName: String): integer;
function IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
function Find(const AConfigName: String): PLazLoggerLogGroup;
function Count: integer;
property Item[Index: Integer]: PLazLoggerLogGroup read GetItem; default;
end;
{ TLazLogger }
TLazLogger = class(TRefCountedObject)
private
FIsInitialized: Boolean;
FMaxNestPrefixLen: Integer;
FNestLvlIndent: Integer;
FLogGroupList: TRefCountedObject; // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
FUseGlobalLogGroupList: Boolean;
procedure SetMaxNestPrefixLen(AValue: Integer);
procedure SetNestLvlIndent(AValue: Integer);
function GetLogGroupList: TLazLoggerLogGroupList;
procedure SetUseGlobalLogGroupList(AValue: Boolean);
protected
procedure DoInit; virtual;
procedure DoFinsh; virtual;
procedure IncreaseIndent; overload; virtual;
procedure DecreaseIndent; overload; virtual;
procedure IncreaseIndent({%H-}LogGroup: PLazLoggerLogGroup); overload; virtual;
procedure DecreaseIndent({%H-}LogGroup: PLazLoggerLogGroup); overload; virtual;
procedure IndentChanged; virtual;
function GetBlockHandler({%H-}AIndex: Integer): TLazLoggerBlockHandler; virtual;
procedure DoDbgOut(const {%H-}s: string); virtual;
procedure DoDebugLn(const {%H-}s: string); virtual;
procedure DoDebuglnStack(const {%H-}s: string); virtual;
function ArgsToString(Args: array of const): string;
property IsInitialized: Boolean read FIsInitialized;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Src: TLazLogger); virtual;
procedure Init;
procedure Finish;
function CurrentIndentLevel: Integer; virtual;
property NestLvlIndent: Integer read FNestLvlIndent write SetNestLvlIndent;
property MaxNestPrefixLen: Integer read FMaxNestPrefixLen write SetMaxNestPrefixLen;
public
function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
function RegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
function FindOrRegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
property LogGroupList: TLazLoggerLogGroupList read GetLogGroupList;
property UseGlobalLogGroupList: Boolean read FUseGlobalLogGroupList write SetUseGlobalLogGroupList;
procedure AddBlockHandler({%H-}AHandler: TLazLoggerBlockHandler); virtual;
procedure RemoveBlockHandler({%H-}AHandler: TLazLoggerBlockHandler); virtual;
function BlockHandlerCount: Integer; virtual;
property BlockHandler[AIndex: Integer]: TLazLoggerBlockHandler read GetBlockHandler;
public
procedure DebuglnStack(const s: string = '');
procedure DbgOut(const s: string = ''); overload;
procedure DbgOut(Args: array of const); overload;
procedure DbgOut(const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DbgOut(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLn(const s: string = ''); overload;
procedure DebugLn(Args: array of const); overload;
procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnEnter(const s: string = ''); overload;
procedure DebugLnEnter(Args: array of const); overload;
procedure DebugLnEnter(s: string; Args: array of const); overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(const s: string = ''); overload;
procedure DebugLnExit(Args: array of const); overload;
procedure DebugLnExit(s: string; Args: array of const); overload;
procedure DebugLnExit(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string = '');
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string = ''); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string; Args: array of const); overload;
procedure DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
end;
{ TLazLoggerWithGroupParam
- Provides Enabling/disabling groups from commandline
- TLazLogger provides only storage for LogGroups, it does not need to
enable/disable them, as it discards all logging anyway
}
TLazLoggerWithGroupParam = class(TLazLogger)
private
FLogAllDefaultDisabled: Boolean;
FLogDefaultEnabled: Boolean;
FLogParamParsed: Boolean;
FParamForEnabledLogGroups: String;
procedure SetParamForEnabledLogGroups(AValue: String);
procedure ParseParamForEnabledLogGroups;
public
constructor Create;
procedure Assign(Src: TLazLogger); override;
function RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
function FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
// A param on the commandline, that may contain enabled/disabled LogGroups
// comma separated list / not present = defaults (none unless emabled in code) / - means none
property ParamForEnabledLogGroups: String read FParamForEnabledLogGroups write SetParamForEnabledLogGroups;
end;
TLazLoggerNoOutput = class(TLazLogger)
end;
{$DEFINE USED_BY_LAZLOGGER_BASE}
{$I LazLoggerIntf.inc}
function ConvertLineEndings(const s: string): string;
function GetParamByNameCount(const AName: String): integer;
function GetParamByName(const AName: String; AnIndex: Integer): string;
function GetDebugLoggerGroups: TLazLoggerLogGroupList; inline;
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
function GetDebugLogger: TLazLogger; inline;
function GetExistingDebugLogger: TLazLogger; inline; // No Autocreate
procedure SetDebugLogger(ALogger: TLazLogger);
procedure RecreateDebugLogger;
property DebugLogger: TLazLogger read GetDebugLogger write SetDebugLogger;
property DebugLoggerGroups: TLazLoggerLogGroupList read GetDebugLoggerGroups write SetDebugLoggerGroups;
type
TLazDebugLoggerCreator = function: TRefCountedObject;
// Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
var
LazDebugLoggerCreator: TLazDebugLoggerCreator = nil;
OnWidgetSetDebugLn: TLazLoggerWidgetSetWriteEvent;
OnWidgetSetDbgOut: TLazLoggerWidgetSetWriteEvent;
implementation
{$I LazLoggerImpl.inc}
var // Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
TheLazLogger: TRefCountedObject = nil;
PrevLazLogger: TRefCountedObject = nil;
TheLazLoggerGroups: TRefCountedObject = nil;
procedure CreateDebugLogger;
begin
if (TheLazLogger <> nil) then
exit;
if (LazDebugLoggerCreator <> nil) then
TheLazLogger := LazDebugLoggerCreator();
if (TheLazLogger = nil) then
TheLazLogger := TLazLoggerNoOutput.Create;
TLazLogger(TheLazLogger).UseGlobalLogGroupList := True;
TheLazLogger.AddReference;
end;
function GetDebugLogger: TLazLogger;
begin
if (TheLazLogger = nil) then
CreateDebugLogger;
Result := TLazLogger(TheLazLogger);
end;
function GetExistingDebugLogger: TLazLogger;
begin
if TheLazLogger <> nil then
Result := TLazLogger(TheLazLogger)
else
Result := TLazLogger(PrevLazLogger); // Pretend it still exists
end;
procedure SetDebugLogger(ALogger: TLazLogger);
begin
ReleaseRefAndNil(TheLazLogger);
TheLazLogger := ALogger;
TheLazLogger.AddReference;
end;
procedure RecreateDebugLogger;
begin
ReleaseRefAndNil(PrevLazLogger);
PrevLazLogger := TheLazLogger; // Pretend it still exists
TheLazLogger := nil; // Force creation
end;
function GetDebugLoggerGroups: TLazLoggerLogGroupList;
begin
if (TheLazLoggerGroups = nil) then begin
TheLazLoggerGroups := TLazLoggerLogGroupList.Create;
TheLazLoggerGroups.AddReference;
end;
Result := TLazLoggerLogGroupList(TheLazLoggerGroups);
end;
procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
begin
ReleaseRefAndNil(TheLazLoggerGroups);
TheLazLoggerGroups := ALogGroups;
TheLazLoggerGroups.AddReference;
end;
function GetParamByNameCount(const AName: String): integer;
var
i, l: Integer;
begin
Result := 0;;
l := Length(AName);
for i:= 1 to Paramcount do begin
if copy(ParamStrUTF8(i),1, l) = AName then
inc(Result);
end;
end;
function GetParamByName(const AName: String; AnIndex: Integer): string;
var
i, l: Integer;
begin
l := Length(AName);
for i:= 1 to Paramcount do begin
if copy(ParamStrUTF8(i),1, l) = AName then begin
dec(AnIndex);
if AnIndex < 0 then begin
Result := copy(ParamStrUTF8(i), l+1, Length(ParamStrUTF8(i))-l);
break;
end;
end;
end;
end;
{ TLazLoggerLogGroupList }
procedure TLazLoggerLogGroupList.Clear;
begin
while FList.Count > 0 do begin
Dispose(Item[0]);
FList.Delete(0);
end;
end;
function TLazLoggerLogGroupList.GetItem(Index: Integer): PLazLoggerLogGroup;
begin
Result := PLazLoggerLogGroup(FList[Index])
end;
function TLazLoggerLogGroupList.NewItem(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
New(Result);
Result^.ConfigName := UpperCase(AConfigName);
Result^.Enabled := ADefaulEnabled;
Result^.Flags := [];
Result^.FOpenedIndents := 0;
end;
constructor TLazLoggerLogGroupList.Create;
begin
FList := TFPList.Create;
end;
destructor TLazLoggerLogGroupList.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited Destroy;
end;
procedure TLazLoggerLogGroupList.Assign(Src: TLazLoggerLogGroupList);
var
i: Integer;
begin
Clear;
if (Src = nil) then
exit;
for i := 0 to Src.Count - 1 do
Add('')^ := Src.Item[i]^;
end;
function TLazLoggerLogGroupList.Add(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
if Find(AConfigName) <> nil then
raise Exception.Create('Duplicate LogGroup ' + AConfigName);
Result := NewItem(AConfigName, ADefaulEnabled);
FList.Add(Result);
end;
function TLazLoggerLogGroupList.FindOrAdd(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
Result := Find(AConfigName);
if Result <> nil then exit;
Result := NewItem(AConfigName, ADefaulEnabled);
FList.Add(Result);
end;
function TLazLoggerLogGroupList.IndexOf(const AConfigName: String): integer;
var
s: String;
begin
Result := Count - 1;
s := UpperCase(AConfigName);
while (Result >= 0) and (Item[Result]^.ConfigName <> s) do
dec(Result);
end;
function TLazLoggerLogGroupList.IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
begin
Result := Count - 1;
while (Result >= 0) and (Item[Result] <> AnEntry) do
dec(Result);
end;
function TLazLoggerLogGroupList.Find(const AConfigName: String): PLazLoggerLogGroup;
var
i: Integer;
begin
Result := nil;
i := IndexOf(AConfigName);
if i >= 0 then
Result := Item[i];
end;
procedure TLazLoggerLogGroupList.Remove(const AConfigName: String);
var
i: Integer;
begin
i := IndexOf(AConfigName);
if i >= 0 then begin
Dispose(Item[i]);
FList.Delete(i);
end;
end;
procedure TLazLoggerLogGroupList.Remove(const AnEntry: PLazLoggerLogGroup);
var
i: Integer;
begin
i := IndexOf(AnEntry);
if i >= 0 then begin
Dispose(Item[i]);
FList.Delete(i);
end;
end;
function TLazLoggerLogGroupList.Count: integer;
begin
Result := FList.Count;
end;
{ TLazLogger }
function TLazLogger.GetLogGroupList: TLazLoggerLogGroupList;
begin
if UseGlobalLogGroupList then begin
Result := DebugLoggerGroups;
exit;
end;
if FLogGroupList = nil then begin
FLogGroupList := TLazLoggerLogGroupList.Create;
FLogGroupList.AddReference;
end;
Result := TLazLoggerLogGroupList(FLogGroupList);
end;
procedure TLazLogger.SetUseGlobalLogGroupList(AValue: Boolean);
begin
if FUseGlobalLogGroupList = AValue then Exit;
FUseGlobalLogGroupList := AValue;
end;
procedure TLazLogger.SetMaxNestPrefixLen(AValue: Integer);
begin
if FMaxNestPrefixLen = AValue then Exit;
FMaxNestPrefixLen := AValue;
IndentChanged;
end;
function TLazLogger.GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler;
begin
Result := nil;;
end;
procedure TLazLogger.SetNestLvlIndent(AValue: Integer);
begin
if FNestLvlIndent = AValue then Exit;
FNestLvlIndent := AValue;
IndentChanged;
end;
procedure TLazLogger.DoInit;
begin
//
end;
procedure TLazLogger.DoFinsh;
begin
//
end;
procedure TLazLogger.DoDebuglnStack(const s: string);
begin
//
end;
procedure TLazLogger.IncreaseIndent;
begin
//
end;
procedure TLazLogger.DecreaseIndent;
begin
//
end;
procedure TLazLogger.IncreaseIndent(LogGroup: PLazLoggerLogGroup);
begin
//
end;
procedure TLazLogger.DecreaseIndent(LogGroup: PLazLoggerLogGroup);
begin
//
end;
procedure TLazLogger.IndentChanged;
begin
//
end;
procedure TLazLogger.DoDbgOut(const s: string);
begin
//
end;
procedure TLazLogger.DoDebugLn(const s: string);
begin
//
end;
function TLazLogger.ArgsToString(Args: array of const): string;
var
i: Integer;
begin
Result := '';
for i:=Low(Args) to High(Args) do begin
case Args[i].VType of
vtInteger: Result := Result + dbgs(Args[i].vinteger);
vtInt64: Result := Result + dbgs(Args[i].VInt64^);
vtQWord: Result := Result + dbgs(Args[i].VQWord^);
vtBoolean: Result := Result + dbgs(Args[i].vboolean);
vtExtended: Result := Result + dbgs(Args[i].VExtended^);
{$ifdef FPC_CURRENCY_IS_INT64}
// MWE:
// fpc 2.x has troubles in choosing the right dbgs()
// so we convert here
vtCurrency: Result := Result + dbgs(int64(Args[i].vCurrency^)/10000, 4);
{$else}
vtCurrency: Result := Result + dbgs(Args[i].vCurrency^);
{$endif}
vtString: Result := Result + Args[i].VString^;
vtAnsiString: Result := Result + AnsiString(Args[i].VAnsiString);
vtChar: Result := Result + Args[i].VChar;
vtPChar: Result := Result + Args[i].VPChar;
vtPWideChar: Result := {%H-}Result {%H-}+ Args[i].VPWideChar;
vtWideChar: Result := Result + AnsiString(Args[i].VWideChar);
vtWidestring: Result := Result + AnsiString(WideString(Args[i].VWideString));
vtObject: Result := Result + DbgSName(Args[i].VObject);
vtClass: Result := Result + DbgSName(Args[i].VClass);
vtPointer: Result := Result + Dbgs(Args[i].VPointer);
else Result := Result + '?unknown variant?';
end;
end;
end;
constructor TLazLogger.Create;
begin
FIsInitialized := False;
FUseGlobalLogGroupList := False;
FMaxNestPrefixLen := 15;
FNestLvlIndent := 2;
FLogGroupList := nil;
end;
destructor TLazLogger.Destroy;
begin
Finish;
if TheLazLogger = Self then TheLazLogger := nil;
ReleaseRefAndNil(FLogGroupList);
inherited Destroy;
end;
procedure TLazLogger.Assign(Src: TLazLogger);
begin
if (Src = nil) then
exit;
FMaxNestPrefixLen := Src.FMaxNestPrefixLen;
FNestLvlIndent := Src.FNestLvlIndent;
FUseGlobalLogGroupList := Src.FUseGlobalLogGroupList;
if (not FUseGlobalLogGroupList) and (Src.FLogGroupList <> nil) then
LogGroupList.Assign(Src.LogGroupList);
end;
procedure TLazLogger.Init;
begin
if FIsInitialized then exit;
DoInit;
FIsInitialized := True;
end;
procedure TLazLogger.Finish;
begin
if FIsInitialized then
DoFinsh;
FIsInitialized := False;
end;
function TLazLogger.CurrentIndentLevel: Integer;
begin
Result := 0;
end;
function TLazLogger.RegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
// The basic logger does not add entries from parsig cmd-line. So no need to check
Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
end;
function TLazLogger.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := LogGroupList.Add(AConfigName);
Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
end;
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
Result := LogGroupList.FindOrAdd(AConfigName, ADefaulEnabled);
end;
function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := LogGroupList.FindOrAdd(AConfigName);
Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
end;
procedure TLazLogger.AddBlockHandler(AHandler: TLazLoggerBlockHandler);
begin
//
end;
procedure TLazLogger.RemoveBlockHandler(AHandler: TLazLoggerBlockHandler);
begin
//
end;
function TLazLogger.BlockHandlerCount: Integer;
begin
Result := 0;
end;
procedure TLazLogger.DebuglnStack(const s: string);
begin
DoDebuglnStack(s);
end;
procedure TLazLogger.DbgOut(const s: string);
begin
DoDbgOut(s);
end;
procedure TLazLogger.DbgOut(Args: array of const);
begin
DoDbgOut(ArgsToString(Args));
end;
procedure TLazLogger.DbgOut(const S: String; Args: array of const);
begin
DoDbgOut(Format(S, Args));
end;
procedure TLazLogger.DbgOut(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
procedure TLazLogger.DebugLn(const s: string);
begin
DoDebugLn(s);
end;
procedure TLazLogger.DebugLn(Args: array of const);
begin
DoDebugLn(ArgsToString(Args));
end;
procedure TLazLogger.DebugLn(const S: String; Args: array of const);
begin
DoDebugLn(Format(S, Args));
end;
procedure TLazLogger.DebugLn(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
procedure TLazLogger.DebugLnEnter(const s: string);
begin
DoDebugLn(s);
IncreaseIndent;
end;
procedure TLazLogger.DebugLnEnter(Args: array of const);
begin
if high(Args) >= low(Args) then
DoDebugLn(ArgsToString(Args));
IncreaseIndent;
end;
procedure TLazLogger.DebugLnEnter(s: string; Args: array of const);
begin
DoDebugLn(Format(S, Args));
IncreaseIndent;
end;
procedure TLazLogger.DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
IncreaseIndent;
end;
procedure TLazLogger.DebugLnExit(const s: string);
begin
DecreaseIndent;
DoDebugLn(s);
end;
procedure TLazLogger.DebugLnExit(Args: array of const);
begin
DecreaseIndent;
if high(Args) >= low(Args) then
DoDebugLn(ArgsToString(Args));
end;
procedure TLazLogger.DebugLnExit(s: string; Args: array of const);
begin
DecreaseIndent;
DoDebugLn(Format(S, Args));
end;
procedure TLazLogger.DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DecreaseIndent;
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
procedure TLazLogger.DebuglnStack(LogGroup: PLazLoggerLogGroup; const s: string);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DebuglnStack(s);
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s: string);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDbgOut(s);
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDbgOut(ArgsToString(Args));
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const S: String;
Args: array of const);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDbgOut(Format(S, Args));
end;
procedure TLazLogger.DbgOut(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s: string);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(s);
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(ArgsToString(Args));
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const S: String;
Args: array of const);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(Format(S, Args));
end;
procedure TLazLogger.DebugLn(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s: string);
begin
if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
DoDebugLn(s);
IncreaseIndent(LogGroup);
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
DoDebugLn(ArgsToString(Args));
IncreaseIndent(LogGroup);
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; s: string;
Args: array of const);
begin
if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
DoDebugLn(Format(S, Args));
IncreaseIndent(LogGroup);
end;
procedure TLazLogger.DebugLnEnter(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
if not( (LogGroup <> nil) and (not LogGroup^.Enabled) ) then
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
IncreaseIndent(LogGroup);
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s: string);
begin
DecreaseIndent(LogGroup);
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(s);
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; Args: array of const);
begin
DecreaseIndent(LogGroup);
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(ArgsToString(Args));
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; s: string;
Args: array of const);
begin
DecreaseIndent(LogGroup);
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(Format(S, Args));
end;
procedure TLazLogger.DebugLnExit(LogGroup: PLazLoggerLogGroup; const s1, s2: string;
const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
const s13: string; const s14: string; const s15: string; const s16: string;
const s17: string; const s18: string);
begin
DecreaseIndent(LogGroup);
if (LogGroup <> nil) and (not LogGroup^.Enabled) then exit;
DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
{ TLazLoggerWithGroupParam }
procedure TLazLoggerWithGroupParam.SetParamForEnabledLogGroups(AValue: String);
begin
if FParamForEnabledLogGroups = AValue then Exit;
FParamForEnabledLogGroups := AValue;
ParseParamForEnabledLogGroups;
end;
procedure TLazLoggerWithGroupParam.ParseParamForEnabledLogGroups;
var
i, j, c: Integer;
list: TStringList;
g: PLazLoggerLogGroup;
s: String;
e: Boolean;
begin
c := GetParamByNameCount(FParamForEnabledLogGroups);
FLogDefaultEnabled := False;
FLogAllDefaultDisabled := FAlse;
list := TStringList.Create;
for i := 0 to c - 1 do begin
s := GetParamByName(FParamForEnabledLogGroups, i);
if s = '-' then begin
// clear all
FLogDefaultEnabled := False;
for j := 0 to LogGroupList.Count - 1 do
LogGroupList[j]^.Enabled := False;
FLogAllDefaultDisabled := True;
end
else
begin
list.CommaText := s;
for j := 0 to list.Count - 1 do begin
s := list[j];
if (s = '-') or (s='') then
continue; // invalid, within comma list
if s[1] = '-' then
e := False
else
e := True;
if s[1] in ['-', '+'] then delete(s,1,1);
if (s='') then
continue;
if e then
FLogDefaultEnabled := False;
g := LogGroupList.Find(s);
if g <> nil then begin
g^.Enabled := e;
g^.Flags := g^.Flags - [lgfNoDefaultEnabledSpecified];
end
else begin
g := LogGroupList.Add(s, e);
g^.Flags := g^.Flags + [lgfAddedByParamParser];
end;
end;
end;
end;
list.Free;
if not FLogParamParsed then begin
// first parse, reset default unless specified in RegisterLogGroup();
for i := 0 to LogGroupList.Count - 1 do
if lgfNoDefaultEnabledSpecified in LogGroupList[i]^.Flags then
LogGroupList[i]^.Enabled := FLogDefaultEnabled;
end;
FLogParamParsed := True;
end;
constructor TLazLoggerWithGroupParam.Create;
begin
inherited;
FLogDefaultEnabled := False;
FLogAllDefaultDisabled := False;
end;
procedure TLazLoggerWithGroupParam.Assign(Src: TLazLogger);
var
i: Integer;
begin
inherited Assign(Src);
if (Src <> nil) and (Src is TLazLoggerWithGroupParam) then begin
FLogParamParsed := False;
FParamForEnabledLogGroups := TLazLoggerWithGroupParam(Src).FParamForEnabledLogGroups;
end;
if (Src <> nil) then
for i := 0 to Src.BlockHandlerCount - 1 do
AddBlockHandler(BlockHandler[i]);
end;
function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
var
Default, DefaultFound: Boolean;
begin
Result := LogGroupList.Find(AConfigName);
Default := FLogDefaultEnabled;
DefaultFound := False;
if Result <> nil then begin
Default := Result^.Enabled;
DefaultFound := not(lgfNoDefaultEnabledSpecified in Result^.Flags);
end;
Result := RegisterLogGroup(AConfigName, Default);
if not DefaultFound then
Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
end;
function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
if FLogAllDefaultDisabled then
ADefaulEnabled := False;
Result := LogGroupList.Find(AConfigName);
if Result <> nil then begin
if not(lgfAddedByParamParser in Result^.Flags) then
raise Exception.Create('Duplicate LogGroup ' + AConfigName);
if ADefaulEnabled and not(lgfAddedByParamParser in Result^.Flags) then
Result^.Enabled := True;
Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
end
else
Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
end;
function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
begin
Result := LogGroupList.Find(AConfigName);
if Result = nil then
Result := RegisterLogGroup(AConfigName)
else
Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
end;
function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
Result := LogGroupList.Find(AConfigName);
if Result = nil then
Result := RegisterLogGroup(AConfigName, ADefaulEnabled)
else
begin
if (lgfNoDefaultEnabledSpecified in Result^.Flags) and
not(lgfAddedByParamParser in Result^.Flags)
then
Result^.Enabled := ADefaulEnabled;
Result^.Flags := Result^.Flags - [lgfNoDefaultEnabledSpecified, lgfAddedByParamParser];
end;
end;
function ConvertLineEndings(const s: string): string;
var
i: Integer;
EndingStart: LongInt;
begin
Result:=s;
i:=1;
while (i<=length(Result)) do begin
if Result[i] in [#10,#13] then begin
EndingStart:=i;
inc(i);
if (i<=length(Result)) and (Result[i] in [#10,#13])
and (Result[i]<>Result[i-1]) then begin
inc(i);
end;
if (length(LineEnding)<>i-EndingStart)
or (LineEnding<>copy(Result,EndingStart,length(LineEnding))) then begin
// line end differs => replace with current LineEnding
Result:=
copy(Result,1,EndingStart-1)+LineEnding+copy(Result,i,length(Result));
i:=EndingStart+length(LineEnding);
end;
end else
inc(i);
end;
end;
finalization // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
ReleaseRefAndNil(TheLazLogger);
ReleaseRefAndNil(PrevLazLogger);
ReleaseRefAndNil(TheLazLoggerGroups);
end.