{ ***************************************************************************** This file is part of LazUtils. See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } 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, // LazUtils 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; TLazLoggerLogEnabled = record Enabled: Boolean; Group: PLazLoggerLogGroup; // if only one group / remember nestlevel count end; TLazLoggerWriteTarget = ( lwtNone, lwtStdOut, lwtStdErr, lwtTextFile // Data will be ^Text ); TLazLoggerWriteExEventInfo = record Group: PLazLoggerLogGroup; // if only one group / remember nestlevel count DbgOutAtBOL: Boolean; // Only for DbgOut, True if first segment in new line end; TLazLoggerWriteEvent = procedure(Sender: TObject; S: string; var Handled: Boolean) of object; TLazLoggerWriteExEvent = procedure(Sender: TObject; var LogTxt, LogIndent: string; var Handled: Boolean; const AnInfo: TLazLoggerWriteExEventInfo) 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 FLoggerCriticalSection: TRTLCriticalSection; 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 DoFinish; virtual; procedure IncreaseIndent; overload; virtual; procedure DecreaseIndent; overload; virtual; procedure IncreaseIndent({%H-}LogEnabled: TLazLoggerLogEnabled); overload; virtual; procedure DecreaseIndent({%H-}LogEnabled: TLazLoggerLogEnabled); overload; virtual; procedure IndentChanged; virtual; function GetBlockHandler({%H-}AIndex: Integer): TLazLoggerBlockHandler; virtual; procedure DoDbgOut({%H-}s: string; {%H-}AGroup: PLazLoggerLogGroup = nil); virtual; procedure DoDebugLn({%H-}s: string; {%H-}AGroup: PLazLoggerLogGroup = nil); virtual; procedure DoDebuglnStack(const {%H-}s: string; {%H-}AGroup: PLazLoggerLogGroup = nil); virtual; function ArgsToString(const 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(const Args: array of const); overload; procedure DbgOut(const S: String; const 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(const 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(); overload; procedure DebugLnEnter(const s: string); overload; procedure DebugLnEnter(const Args: array of const); overload; procedure DebugLnEnter(s: string; const 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(); overload; procedure DebugLnExit(const s: string); overload; procedure DebugLnExit(const Args: array of const); overload; procedure DebugLnExit(s: string; const 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(LogEnabled: TLazLoggerLogEnabled; const s: string = ''); procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const s: string = ''); overload; procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); overload; procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const S: String; const Args: array of const); overload;// similar to Format(s,Args) procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; 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(LogEnabled: TLazLoggerLogEnabled; const s: string = ''); overload; procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); overload; procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; const S: String; const Args: array of const); overload;// similar to Format(s,Args) procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; 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(LogEnabled: TLazLoggerLogEnabled); overload; procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s: string); overload; procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); overload; procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; s: string; const Args: array of const); overload; procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; 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(LogEnabled: TLazLoggerLogEnabled); overload; procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s: string); overload; procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); overload; procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; s: string; const Args: array of const); overload; procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; 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 DumpExceptionBackTrace; procedure DumpExceptionBackTrace(LogEnabled: TLazLoggerLogEnabled); 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 GetParamByNameCount(const AName: String): integer; function GetParamByName(const AName: String; AnIndex: Integer): string; function GetDebugLoggerGroups: TLazLoggerLogGroupList; inline; procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList); function GetDebugLogger: TLazLogger; {$If FPC_FULLVERSION >= 030300} inline; {$EndIf} 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; 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; procedure DumpStack; inline; 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; if TheLazLogger <> nil then 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; s: String; begin Result := 0; l := Length(AName); for i:= 1 to Paramcount do begin s := ParamStrUTF8(i); if (copy(s, 1, l) = AName) and ((length(s) = l) or (s[l+1] = '=')) then inc(Result); end; end; function GetParamByName(const AName: String; AnIndex: Integer): string; var i, l: Integer; s: String; begin Result := ''; l := Length(AName); for i:= 1 to Paramcount do begin s := ParamStrUTF8(i); if (copy(s, 1, l) = AName) and ((length(s) = l) or (s[l+1] = '=')) then begin dec(AnIndex); if AnIndex < 0 then begin inc(l); // skip = sign Result := copy(ParamStrUTF8(i), l+1, Length(ParamStrUTF8(i))-l); break; end; end; end; end; function DbgStr(const StringWithSpecialChars: string): string; var i: Integer; s: String; l: Integer; begin Result:=StringWithSpecialChars; i:=1; while (i<=length(Result)) do begin case Result[i] of ' '..#126: inc(i); else s:='#'+HexStr(ord(Result[i]),2); // Note: do not use copy, fpc might change broken UTF-8 characters to '?' l:=length(Result)-i; SetLength(Result,length(Result)-1+length(s)); if l>0 then system.Move(Result[i+1],Result[i+length(s)],l); system.Move(s[1],Result[i],length(s)); inc(i,length(s)); end; end; end; function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt ): string; begin Result:=dbgstr(copy(StringWithSpecialChars,StartPos,Len)); end; function DbgStr(const p: PChar; Len: PtrInt): string; const Hex: array[0..15] of char='0123456789ABCDEF'; var UsedLen: PtrInt; ResultLen: PtrInt; Src: PChar; Dest: PChar; c: Char; begin if (p=nil) or (p^=#0) or (Len<=0) then exit(''); UsedLen:=0; ResultLen:=0; Src:=p; while Src^<>#0 do begin inc(UsedLen); if Src^ in [' '..#126] then inc(ResultLen) else inc(ResultLen,3); if UsedLen>=Len then break; inc(Src); end; SetLength(Result,ResultLen); Src:=p; Dest:=PChar(Result); while UsedLen>0 do begin dec(UsedLen); c:=Src^; if c in [' '..#126] then begin Dest^:=c; inc(Dest); end else begin Dest^:='#'; inc(Dest); Dest^:=Hex[ord(c) shr 4]; inc(Dest); Dest^:=Hex[ord(c) and $f]; inc(Dest); end; inc(Src); end; end; function DbgWideStr(const StringWithSpecialChars: widestring): string; var s: String; SrcPos: Integer; DestPos: Integer; i: Integer; begin SetLength(Result{%H-},length(StringWithSpecialChars)); SrcPos:=1; DestPos:=1; while SrcPos<=length(StringWithSpecialChars) do begin i:=ord(StringWithSpecialChars[SrcPos]); case i of 32..126: begin Result[DestPos]:=chr(i); inc(SrcPos); inc(DestPos); end; else s:='#'+HexStr(i,4); inc(SrcPos); Result:=copy(Result,1,DestPos-1)+s+copy(Result,DestPos+1,length(Result)); inc(DestPos,length(s)); end; end; end; procedure DumpStack; begin DebuglnStack; 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 inherited; 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; begin Result := Count - 1; while (Result >= 0) and (CompareText(Item[Result]^.ConfigName, AConfigName) <> 0) 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.DumpExceptionBackTrace; procedure DumpAddr(Addr: Pointer); begin // preventing another exception, while dumping stack trace try DebugLn(BackTraceStrFunc(Addr)); except DebugLn(SysBackTraceStr(Addr)); end; end; var FrameCount: integer; Frames: PPointer; FrameNumber:Integer; begin DumpAddr(ExceptAddr); FrameCount:=ExceptFrameCount; Frames:=ExceptFrames; for FrameNumber := 0 to FrameCount-1 do DumpAddr(Frames[FrameNumber]); end; procedure TLazLogger.DumpExceptionBackTrace(LogEnabled: TLazLoggerLogEnabled); begin if not LogEnabled.Enabled then exit; DumpExceptionBackTrace; end; procedure TLazLogger.DoFinish; begin // end; procedure TLazLogger.DoDebuglnStack(const s: string; AGroup: PLazLoggerLogGroup); begin // end; procedure TLazLogger.IncreaseIndent; begin // end; procedure TLazLogger.DecreaseIndent; begin // end; procedure TLazLogger.IncreaseIndent(LogEnabled: TLazLoggerLogEnabled); begin // end; procedure TLazLogger.DecreaseIndent(LogEnabled: TLazLoggerLogEnabled); begin // end; procedure TLazLogger.IndentChanged; begin // end; procedure TLazLogger.DoDbgOut(s: string; AGroup: PLazLoggerLogGroup); begin // end; procedure TLazLogger.DoDebugLn(s: string; AGroup: PLazLoggerLogGroup); begin // end; function TLazLogger.ArgsToString(const 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 inherited; InitCriticalSection(FLoggerCriticalSection); 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; DoneCriticalsection(FLoggerCriticalSection); 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 EnterCriticalsection(FLoggerCriticalSection); try if FIsInitialized then exit; DoInit; FIsInitialized := True; finally LeaveCriticalsection(FLoggerCriticalSection); end; end; procedure TLazLogger.Finish; begin if FIsInitialized then DoFinish; 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(const Args: array of const); begin DoDbgOut(ArgsToString(Args)); end; procedure TLazLogger.DbgOut(const S: String; const 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(const 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(); begin IncreaseIndent; end; procedure TLazLogger.DebugLnEnter(const s: string); begin DoDebugLn(s); IncreaseIndent; end; procedure TLazLogger.DebugLnEnter(const Args: array of const); begin if high(Args) >= low(Args) then DoDebugLn(ArgsToString(Args)); IncreaseIndent; end; procedure TLazLogger.DebugLnEnter(s: string; const 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(); begin DecreaseIndent; end; procedure TLazLogger.DebugLnExit(const s: string); begin DecreaseIndent; DoDebugLn(s); end; procedure TLazLogger.DebugLnExit(const Args: array of const); var t: String; begin t := ArgsToString(Args); DecreaseIndent; if high(Args) >= low(Args) then DoDebugLn(t); end; procedure TLazLogger.DebugLnExit(s: string; const Args: array of const); var t: String; begin t := Format(S, Args); DecreaseIndent; DoDebugLn(t); 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(LogEnabled: TLazLoggerLogEnabled; const s: string); begin if not LogEnabled.Enabled then exit; DoDebuglnStack(s, LogEnabled.Group); end; procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const s: string); begin if not LogEnabled.Enabled then exit; DoDbgOut(s, LogEnabled.Group); end; procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); begin if not LogEnabled.Enabled then exit; DoDbgOut(ArgsToString(Args), LogEnabled.Group); end; procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const S: String; const Args: array of const); begin if not LogEnabled.Enabled then exit; DoDbgOut(Format(S, Args), LogEnabled.Group); end; procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; 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 LogEnabled.Enabled then exit; DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18, LogEnabled.Group); end; procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const s: string); begin if not LogEnabled.Enabled then exit; DoDebugLn(s, LogEnabled.Group); end; procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); begin if not LogEnabled.Enabled then exit; DoDebugLn(ArgsToString(Args), LogEnabled.Group); end; procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const S: String; const Args: array of const); begin if not LogEnabled.Enabled then exit; DoDebugLn(Format(S, Args), LogEnabled.Group); end; procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; 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 LogEnabled.Enabled then exit; DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18, LogEnabled.Group); end; procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled); begin IncreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s: string); begin if LogEnabled.Enabled then DoDebugLn(s, LogEnabled.Group); IncreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); begin if LogEnabled.Enabled then DoDebugLn(ArgsToString(Args), LogEnabled.Group); IncreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; s: string; const Args: array of const); begin if LogEnabled.Enabled then DoDebugLn(Format(S, Args), LogEnabled.Group); IncreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; 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 LogEnabled.Enabled then DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18, LogEnabled.Group); IncreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled); begin DecreaseIndent(LogEnabled); end; procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s: string); begin DecreaseIndent(LogEnabled); if not LogEnabled.Enabled then exit; DoDebugLn(s, LogEnabled.Group); end; procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const Args: array of const); var t: String; begin if LogEnabled.Enabled then t := ArgsToString(Args); DecreaseIndent(LogEnabled); if not LogEnabled.Enabled then exit; DoDebugLn(t, LogEnabled.Group); end; procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; s: string; const Args: array of const); var t: String; begin if LogEnabled.Enabled then t := Format(S, Args); DecreaseIndent(LogEnabled); if not LogEnabled.Enabled then exit; DoDebugLn(t, LogEnabled.Group); end; procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; 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(LogEnabled); if not LogEnabled.Enabled then exit; DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18, LogEnabled.Group); end; { TLazLoggerWithGroupParam } procedure TLazLoggerWithGroupParam.SetParamForEnabledLogGroups(AValue: String); begin if (AValue <> '') and (AValue[Length(AValue)] = '=') then Delete(AValue, Length(AValue), 1); 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 is TLazLoggerWithGroupParam then begin FLogParamParsed := False; FParamForEnabledLogGroups := TLazLoggerWithGroupParam(Src).FParamForEnabledLogGroups; end; if Src <> nil then for i := 0 to Src.BlockHandlerCount - 1 do AddBlockHandler(Src.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; 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.