1 {
2 *****************************************************************************
3 This file is part of LazUtils.
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 *****************************************************************************
8 }
9 unit LazLoggerBase;
10
11 {$mode objfpc}{$H+}
12
13 (*
14 - All global variables, initialization and finalization use TObject instead
15 of TLazLogger.
16 This means: using the unit (without calling any of the functions) will not
17 make any reference to the classes, and they should be smart-linked away.
18 *)
19
20 interface
21
22 uses
23 Classes, SysUtils, Types, Math,
24 // LazUtils
25 LazClasses, LazUTF8;
26
27 type
28
29 TLazLoggerLogGroupFlag =
30 ( lgfAddedByParamParser, // Not added via Register. This is a placeholder for the enabled-state given by the user, via command line
31 lgfNoDefaultEnabledSpecified // Registered without default
32
33 );
34 TLazLoggerLogGroupFlags = set of TLazLoggerLogGroupFlag;
35
36 TLazLoggerLogGroup = record
37 ConfigName: String; // case insensitive
38 Enabled: Boolean;
39 Flags: TLazLoggerLogGroupFlags;
40 FOpenedIndents: Integer;
41 end;
42 PLazLoggerLogGroup = ^TLazLoggerLogGroup;
43
44 TLazLoggerLogEnabled = record
45 Enabled: Boolean;
46 Group: PLazLoggerLogGroup; // if only one group / remember nestlevel count
47 end;
48
49 TLazLoggerWriteTarget = (
50 lwtNone,
51 lwtStdOut, lwtStdErr,
52 lwtTextFile // Data will be ^Text
53 );
54
55 TLazLoggerWriteEvent = procedure(Sender: TObject; S: string; var Handled: Boolean) of object;
56 TLazLoggerWidgetSetWriteEvent = procedure(Sender: TObject;
57 S: string;
58 var Handled: Boolean;
59 Target: TLazLoggerWriteTarget;
60 Data: Pointer) of object;
61
62 type
63
64 TLazLogger = class;
65
66 { TLazLoggerBlockHandler
67 called for DebuglnEnter / Exit
68 }
69
70 TLazLoggerBlockHandler = class(TRefCountedObject)
71 public
72 procedure EnterBlock(Sender: TLazLogger; Level: Integer); virtual; abstract;
73 procedure ExitBlock(Sender: TLazLogger; Level: Integer); virtual; abstract;
74 end;
75
76 { TLazLoggerLogGroupList }
77
78 TLazLoggerLogGroupList = class(TRefCountedObject)
79 private
80 FList: TFPList;
81 procedure Clear;
GetItemnull82 function GetItem(Index: Integer): PLazLoggerLogGroup;
NewItemnull83 function NewItem(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
84 protected
Addnull85 function Add(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
FindOrAddnull86 function FindOrAdd(const AConfigName: String; ADefaulEnabled: Boolean = False) : PLazLoggerLogGroup;
87 procedure Remove(const AConfigName: String);
88 procedure Remove(const AnEntry: PLazLoggerLogGroup);
89 public
90 constructor Create;
91 destructor Destroy; override;
92 procedure Assign(Src: TLazLoggerLogGroupList);
IndexOfnull93 function IndexOf(const AConfigName: String): integer;
IndexOfnull94 function IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
Findnull95 function Find(const AConfigName: String): PLazLoggerLogGroup;
Countnull96 function Count: integer;
97 property Item[Index: Integer]: PLazLoggerLogGroup read GetItem; default;
98 end;
99
100 { TLazLogger }
101
102 TLazLogger = class(TRefCountedObject)
103 private
104 FLoggerCriticalSection: TRTLCriticalSection;
105 FIsInitialized: Boolean;
106
107 FMaxNestPrefixLen: Integer;
108 FNestLvlIndent: Integer;
109
110 FLogGroupList: TRefCountedObject; // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
111 FUseGlobalLogGroupList: Boolean;
112
113 procedure SetMaxNestPrefixLen(AValue: Integer);
114 procedure SetNestLvlIndent(AValue: Integer);
115
GetLogGroupListnull116 function GetLogGroupList: TLazLoggerLogGroupList;
117 procedure SetUseGlobalLogGroupList(AValue: Boolean);
118 protected
119 procedure DoInit; virtual;
120 procedure DoFinish; virtual;
121 procedure DoFinsh; deprecated 'Use DoFinish'; // Deprecated in 2.1 / 30.04.2020 / Remove in 2.3
122
123 procedure IncreaseIndent; overload; virtual;
124 procedure DecreaseIndent; overload; virtual;
125 procedure IncreaseIndent({%H-}LogEnabled: TLazLoggerLogEnabled); overload; virtual;
126 procedure DecreaseIndent({%H-}LogEnabled: TLazLoggerLogEnabled); overload; virtual;
127 procedure IndentChanged; virtual;
GetBlockHandlernull128 function GetBlockHandler({%H-}AIndex: Integer): TLazLoggerBlockHandler; virtual;
129
130 procedure DoDbgOut({%H-}s: string); virtual;
131 procedure DoDebugLn({%H-}s: string); virtual;
132 procedure DoDebuglnStack(const {%H-}s: string); virtual;
133
ArgsToStringnull134 function ArgsToString(Args: array of const): string;
135 property IsInitialized: Boolean read FIsInitialized;
136 public
137 constructor Create;
138 destructor Destroy; override;
139 procedure Assign(Src: TLazLogger); virtual;
140 procedure Init;
141 procedure Finish;
142
CurrentIndentLevelnull143 function CurrentIndentLevel: Integer; virtual;
144 property NestLvlIndent: Integer read FNestLvlIndent write SetNestLvlIndent;
145 property MaxNestPrefixLen: Integer read FMaxNestPrefixLen write SetMaxNestPrefixLen;
146
147 public
RegisterLogGroupnull148 function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
RegisterLogGroupnull149 function RegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
FindOrRegisterLogGroupnull150 function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean) : PLazLoggerLogGroup; virtual;
FindOrRegisterLogGroupnull151 function FindOrRegisterLogGroup(const AConfigName: String) : PLazLoggerLogGroup; virtual;
152 property LogGroupList: TLazLoggerLogGroupList read GetLogGroupList;
153 property UseGlobalLogGroupList: Boolean read FUseGlobalLogGroupList write SetUseGlobalLogGroupList;
154
155 procedure AddBlockHandler({%H-}AHandler: TLazLoggerBlockHandler); virtual;
156 procedure RemoveBlockHandler({%H-}AHandler: TLazLoggerBlockHandler); virtual;
BlockHandlerCountnull157 function BlockHandlerCount: Integer; virtual;
158 property BlockHandler[AIndex: Integer]: TLazLoggerBlockHandler read GetBlockHandler;
159 public
160 procedure DebuglnStack(const s: string = '');
161
162 procedure DbgOut(const s: string = ''); overload;
163 procedure DbgOut(Args: array of const); overload;
164 procedure DbgOut(const S: String; Args: array of const); overload;// similar to Format(s,Args)
165 procedure DbgOut(const s1, s2: string; const s3: string = '';
166 const s4: string = ''; const s5: string = ''; const s6: string = '';
167 const s7: string = ''; const s8: string = ''; const s9: string = '';
168 const s10: string = ''; const s11: string = ''; const s12: string = '';
169 const s13: string = ''; const s14: string = ''; const s15: string = '';
170 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
171
172 procedure DebugLn(const s: string = ''); overload;
173 procedure DebugLn(Args: array of const); overload;
174 procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
175 procedure DebugLn(const s1, s2: string; const s3: string = '';
176 const s4: string = ''; const s5: string = ''; const s6: string = '';
177 const s7: string = ''; const s8: string = ''; const s9: string = '';
178 const s10: string = ''; const s11: string = ''; const s12: string = '';
179 const s13: string = ''; const s14: string = ''; const s15: string = '';
180 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
181
182 procedure DebugLnEnter(); overload;
183 procedure DebugLnEnter(const s: string); overload;
184 procedure DebugLnEnter(Args: array of const); overload;
185 procedure DebugLnEnter(s: string; Args: array of const); overload;
186 procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
187 const s4: string = ''; const s5: string = ''; const s6: string = '';
188 const s7: string = ''; const s8: string = ''; const s9: string = '';
189 const s10: string = ''; const s11: string = ''; const s12: string = '';
190 const s13: string = ''; const s14: string = ''; const s15: string = '';
191 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
192
193 procedure DebugLnExit(); overload;
194 procedure DebugLnExit(const s: string); overload;
195 procedure DebugLnExit(Args: array of const); overload;
196 procedure DebugLnExit(s: string; Args: array of const); overload;
197 procedure DebugLnExit(const s1, s2: string; const s3: string = '';
198 const s4: string = ''; const s5: string = ''; const s6: string = '';
199 const s7: string = ''; const s8: string = ''; const s9: string = '';
200 const s10: string = ''; const s11: string = ''; const s12: string = '';
201 const s13: string = ''; const s14: string = ''; const s15: string = '';
202 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
203
204
205 procedure DebuglnStack(LogEnabled: TLazLoggerLogEnabled; const s: string = '');
206
207 procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const s: string = ''); overload;
208 procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; Args: array of const); overload;
209 procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const S: String; Args: array of const); overload;// similar to Format(s,Args)
210 procedure DbgOut(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string; const s3: string = '';
211 const s4: string = ''; const s5: string = ''; const s6: string = '';
212 const s7: string = ''; const s8: string = ''; const s9: string = '';
213 const s10: string = ''; const s11: string = ''; const s12: string = '';
214 const s13: string = ''; const s14: string = ''; const s15: string = '';
215 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
216
217 procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; const s: string = ''); overload;
218 procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; Args: array of const); overload;
219 procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; const S: String; Args: array of const); overload;// similar to Format(s,Args)
220 procedure DebugLn(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string; const s3: string = '';
221 const s4: string = ''; const s5: string = ''; const s6: string = '';
222 const s7: string = ''; const s8: string = ''; const s9: string = '';
223 const s10: string = ''; const s11: string = ''; const s12: string = '';
224 const s13: string = ''; const s14: string = ''; const s15: string = '';
225 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
226
227 procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled); overload;
228 procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s: string); overload;
229 procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; Args: array of const); overload;
230 procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; s: string; Args: array of const); overload;
231 procedure DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string; const s3: string = '';
232 const s4: string = ''; const s5: string = ''; const s6: string = '';
233 const s7: string = ''; const s8: string = ''; const s9: string = '';
234 const s10: string = ''; const s11: string = ''; const s12: string = '';
235 const s13: string = ''; const s14: string = ''; const s15: string = '';
236 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
237
238 procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled); overload;
239 procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s: string); overload;
240 procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; Args: array of const); overload;
241 procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; s: string; Args: array of const); overload;
242 procedure DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string; const s3: string = '';
243 const s4: string = ''; const s5: string = ''; const s6: string = '';
244 const s7: string = ''; const s8: string = ''; const s9: string = '';
245 const s10: string = ''; const s11: string = ''; const s12: string = '';
246 const s13: string = ''; const s14: string = ''; const s15: string = '';
247 const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
248
249 procedure DumpExceptionBackTrace;
250 end;
251
252 { TLazLoggerWithGroupParam
253 - Provides Enabling/disabling groups from commandline
254 - TLazLogger provides only storage for LogGroups, it does not need to
255 enable/disable them, as it discards all logging anyway
256 }
257
258 TLazLoggerWithGroupParam = class(TLazLogger)
259 private
260 FLogAllDefaultDisabled: Boolean;
261 FLogDefaultEnabled: Boolean;
262 FLogParamParsed: Boolean;
263 FParamForEnabledLogGroups: String;
264 procedure SetParamForEnabledLogGroups(AValue: String);
265 procedure ParseParamForEnabledLogGroups;
266 public
267 constructor Create;
268 procedure Assign(Src: TLazLogger); override;
RegisterLogGroupnull269 function RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
RegisterLogGroupnull270 function RegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
FindOrRegisterLogGroupnull271 function FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup; override;
FindOrRegisterLogGroupnull272 function FindOrRegisterLogGroup(const AConfigName: String; ADefaulEnabled: Boolean): PLazLoggerLogGroup; override;
273 // A param on the commandline, that may contain enabled/disabled LogGroups
274 // comma separated list / not present = defaults (none unless emabled in code) / - means none
275 property ParamForEnabledLogGroups: String read FParamForEnabledLogGroups write SetParamForEnabledLogGroups;
276 end;
277
278 TLazLoggerNoOutput = class(TLazLogger)
279 end;
280
281
282 {$DEFINE USED_BY_LAZLOGGER_BASE}
283 {$I LazLoggerIntf.inc}
284
GetParamByNameCountnull285 function GetParamByNameCount(const AName: String): integer;
GetParamByNamenull286 function GetParamByName(const AName: String; AnIndex: Integer): string;
287
GetDebugLoggerGroupsnull288 function GetDebugLoggerGroups: TLazLoggerLogGroupList; inline;
289 procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
290
GetDebugLoggernull291 function GetDebugLogger: TLazLogger; inline;
GetExistingDebugLoggernull292 function GetExistingDebugLogger: TLazLogger; inline; // No Autocreate
293 procedure SetDebugLogger(ALogger: TLazLogger);
294
295 procedure RecreateDebugLogger;
296
297 property DebugLogger: TLazLogger read GetDebugLogger write SetDebugLogger;
298 property DebugLoggerGroups: TLazLoggerLogGroupList read GetDebugLoggerGroups write SetDebugLoggerGroups;
299
DbgStrnull300 function DbgStr(const StringWithSpecialChars: string): string; overload;
DbgStrnull301 function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
DbgStrnull302 function DbgStr(const p: PChar; Len: PtrInt): string; overload;
DbgWideStrnull303 function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
304
305 procedure DumpStack; inline;
306
307 type
TRefCountedObjectnull308 TLazDebugLoggerCreator = function: TRefCountedObject;
309
310 // Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
311 var
312 LazDebugLoggerCreator: TLazDebugLoggerCreator = nil;
313 OnWidgetSetDebugLn: TLazLoggerWidgetSetWriteEvent;
314 OnWidgetSetDbgOut: TLazLoggerWidgetSetWriteEvent;
315
316 implementation
317
318 {$I LazLoggerImpl.inc}
319
320 var // Using base TRefCountedObject, so if none of the functions is used in the app, then even the class should be smart linked
321 TheLazLogger: TRefCountedObject = nil;
322 PrevLazLogger: TRefCountedObject = nil;
323 TheLazLoggerGroups: TRefCountedObject = nil;
324
325 procedure CreateDebugLogger;
326 begin
327 if (TheLazLogger <> nil) then
328 exit;
329 if (LazDebugLoggerCreator <> nil) then
330 TheLazLogger := LazDebugLoggerCreator();
331 if (TheLazLogger = nil) then
332 TheLazLogger := TLazLoggerNoOutput.Create;
333 TLazLogger(TheLazLogger).UseGlobalLogGroupList := True;
334 TheLazLogger.AddReference;
335 end;
336
GetDebugLoggernull337 function GetDebugLogger: TLazLogger;
338 begin
339 if (TheLazLogger = nil) then
340 CreateDebugLogger;
341 Result := TLazLogger(TheLazLogger);
342 end;
343
GetExistingDebugLoggernull344 function GetExistingDebugLogger: TLazLogger;
345 begin
346 if TheLazLogger <> nil then
347 Result := TLazLogger(TheLazLogger)
348 else
349 Result := TLazLogger(PrevLazLogger); // Pretend it still exists
350 end;
351
352 procedure SetDebugLogger(ALogger: TLazLogger);
353 begin
354 ReleaseRefAndNil(TheLazLogger);
355 TheLazLogger := ALogger;
356 if TheLazLogger <> nil then
357 TheLazLogger.AddReference;
358 end;
359
360 procedure RecreateDebugLogger;
361 begin
362 ReleaseRefAndNil(PrevLazLogger);
363 PrevLazLogger := TheLazLogger; // Pretend it still exists
364 TheLazLogger := nil; // Force creation
365 end;
366
GetDebugLoggerGroupsnull367 function GetDebugLoggerGroups: TLazLoggerLogGroupList;
368 begin
369 if (TheLazLoggerGroups = nil) then begin
370 TheLazLoggerGroups := TLazLoggerLogGroupList.Create;
371 TheLazLoggerGroups.AddReference;
372 end;
373 Result := TLazLoggerLogGroupList(TheLazLoggerGroups);
374 end;
375
376 procedure SetDebugLoggerGroups(ALogGroups: TLazLoggerLogGroupList);
377 begin
378 ReleaseRefAndNil(TheLazLoggerGroups);
379 TheLazLoggerGroups := ALogGroups;
380 TheLazLoggerGroups.AddReference;
381 end;
382
GetParamByNameCountnull383 function GetParamByNameCount(const AName: String): integer;
384 var
385 i, l: Integer;
386 begin
387 Result := 0;;
388 l := Length(AName);
389 for i:= 1 to Paramcount do begin
390 if copy(ParamStrUTF8(i),1, l) = AName then
391 inc(Result);
392 end;
393 end;
394
GetParamByNamenull395 function GetParamByName(const AName: String; AnIndex: Integer): string;
396 var
397 i, l: Integer;
398 begin
399 Result := '';
400 l := Length(AName);
401 for i:= 1 to Paramcount do begin
402 if copy(ParamStrUTF8(i),1, l) = AName then begin
403 dec(AnIndex);
404 if AnIndex < 0 then begin
405 Result := copy(ParamStrUTF8(i), l+1, Length(ParamStrUTF8(i))-l);
406 break;
407 end;
408 end;
409 end;
410 end;
411
DbgStrnull412 function DbgStr(const StringWithSpecialChars: string): string;
413 var
414 i: Integer;
415 s: String;
416 l: Integer;
417 begin
418 Result:=StringWithSpecialChars;
419 i:=1;
420 while (i<=length(Result)) do begin
421 case Result[i] of
422 ' '..#126: inc(i);
423 else
424 s:='#'+HexStr(ord(Result[i]),2);
425 // Note: do not use copy, fpc might change broken UTF-8 characters to '?'
426 l:=length(Result)-i;
427 SetLength(Result,length(Result)-1+length(s));
428 if l>0 then
429 system.Move(Result[i+1],Result[i+length(s)],l);
430 system.Move(s[1],Result[i],length(s));
431 inc(i,length(s));
432 end;
433 end;
434 end;
435
DbgStrnull436 function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt
437 ): string;
438 begin
439 Result:=dbgstr(copy(StringWithSpecialChars,StartPos,Len));
440 end;
441
DbgStrnull442 function DbgStr(const p: PChar; Len: PtrInt): string;
443 const
444 Hex: array[0..15] of char='0123456789ABCDEF';
445 var
446 UsedLen: PtrInt;
447 ResultLen: PtrInt;
448 Src: PChar;
449 Dest: PChar;
450 c: Char;
451 begin
452 if (p=nil) or (p^=#0) or (Len<=0) then exit('');
453 UsedLen:=0;
454 ResultLen:=0;
455 Src:=p;
456 while Src^<>#0 do begin
457 inc(UsedLen);
458 if Src^ in [' '..#126] then
459 inc(ResultLen)
460 else
461 inc(ResultLen,3);
462 if UsedLen>=Len then break;
463 inc(Src);
464 end;
465 SetLength(Result,ResultLen);
466 Src:=p;
467 Dest:=PChar(Result);
468 while UsedLen>0 do begin
469 dec(UsedLen);
470 c:=Src^;
471 if c in [' '..#126] then begin
472 Dest^:=c;
473 inc(Dest);
474 end else begin
475 Dest^:='#';
476 inc(Dest);
477 Dest^:=Hex[ord(c) shr 4];
478 inc(Dest);
479 Dest^:=Hex[ord(c) and $f];
480 inc(Dest);
481 end;
482 inc(Src);
483 end;
484 end;
485
DbgWideStrnull486 function DbgWideStr(const StringWithSpecialChars: widestring): string;
487 var
488 s: String;
489 SrcPos: Integer;
490 DestPos: Integer;
491 i: Integer;
492 begin
493 SetLength(Result{%H-},length(StringWithSpecialChars));
494 SrcPos:=1;
495 DestPos:=1;
496 while SrcPos<=length(StringWithSpecialChars) do begin
497 i:=ord(StringWithSpecialChars[SrcPos]);
498 case i of
499 32..126:
500 begin
501 Result[DestPos]:=chr(i);
502 inc(SrcPos);
503 inc(DestPos);
504 end;
505 else
506 s:='#'+HexStr(i,4);
507 inc(SrcPos);
508 Result:=copy(Result,1,DestPos-1)+s+copy(Result,DestPos+1,length(Result));
509 inc(DestPos,length(s));
510 end;
511 end;
512 end;
513
514 procedure DumpStack;
515 begin
516 DebuglnStack;
517 end;
518
519 { TLazLoggerLogGroupList }
520
521 procedure TLazLoggerLogGroupList.Clear;
522 begin
523 while FList.Count > 0 do begin
524 Dispose(Item[0]);
525 FList.Delete(0);
526 end;
527 end;
528
GetItemnull529 function TLazLoggerLogGroupList.GetItem(Index: Integer): PLazLoggerLogGroup;
530 begin
531 Result := PLazLoggerLogGroup(FList[Index])
532 end;
533
NewItemnull534 function TLazLoggerLogGroupList.NewItem(const AConfigName: String;
535 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
536 begin
537 New(Result);
538 Result^.ConfigName := UpperCase(AConfigName);
539 Result^.Enabled := ADefaulEnabled;
540 Result^.Flags := [];
541 Result^.FOpenedIndents := 0;
542 end;
543
544 constructor TLazLoggerLogGroupList.Create;
545 begin
546 inherited;
547 FList := TFPList.Create;
548 end;
549
550 destructor TLazLoggerLogGroupList.Destroy;
551 begin
552 Clear;
553 FreeAndNil(FList);
554 inherited Destroy;
555 end;
556
557 procedure TLazLoggerLogGroupList.Assign(Src: TLazLoggerLogGroupList);
558 var
559 i: Integer;
560 begin
561 Clear;
562 if (Src = nil) then
563 exit;
564 for i := 0 to Src.Count - 1 do
565 Add('')^ := Src.Item[i]^;
566 end;
567
Addnull568 function TLazLoggerLogGroupList.Add(const AConfigName: String;
569 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
570 begin
571 if Find(AConfigName) <> nil then
572 raise Exception.Create('Duplicate LogGroup ' + AConfigName);
573 Result := NewItem(AConfigName, ADefaulEnabled);
574 FList.Add(Result);
575 end;
576
FindOrAddnull577 function TLazLoggerLogGroupList.FindOrAdd(const AConfigName: String;
578 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
579 begin
580 Result := Find(AConfigName);
581 if Result <> nil then exit;
582 Result := NewItem(AConfigName, ADefaulEnabled);
583 FList.Add(Result);
584 end;
585
IndexOfnull586 function TLazLoggerLogGroupList.IndexOf(const AConfigName: String): integer;
587 begin
588 Result := Count - 1;
589 while (Result >= 0) and (CompareText(Item[Result]^.ConfigName, AConfigName) <> 0) do
590 dec(Result);
591 end;
592
IndexOfnull593 function TLazLoggerLogGroupList.IndexOf(const AnEntry: PLazLoggerLogGroup): integer;
594 begin
595 Result := Count - 1;
596 while (Result >= 0) and (Item[Result] <> AnEntry) do
597 dec(Result);
598 end;
599
TLazLoggerLogGroupList.Findnull600 function TLazLoggerLogGroupList.Find(const AConfigName: String): PLazLoggerLogGroup;
601 var
602 i: Integer;
603 begin
604 Result := nil;
605 i := IndexOf(AConfigName);
606 if i >= 0 then
607 Result := Item[i];
608 end;
609
610 procedure TLazLoggerLogGroupList.Remove(const AConfigName: String);
611 var
612 i: Integer;
613 begin
614 i := IndexOf(AConfigName);
615 if i >= 0 then begin
616 Dispose(Item[i]);
617 FList.Delete(i);
618 end;
619 end;
620
621 procedure TLazLoggerLogGroupList.Remove(const AnEntry: PLazLoggerLogGroup);
622 var
623 i: Integer;
624 begin
625 i := IndexOf(AnEntry);
626 if i >= 0 then begin
627 Dispose(Item[i]);
628 FList.Delete(i);
629 end;
630 end;
631
TLazLoggerLogGroupList.Countnull632 function TLazLoggerLogGroupList.Count: integer;
633 begin
634 Result := FList.Count;
635 end;
636
637 { TLazLogger }
638
TLazLogger.GetLogGroupListnull639 function TLazLogger.GetLogGroupList: TLazLoggerLogGroupList;
640 begin
641 if UseGlobalLogGroupList then begin
642 Result := DebugLoggerGroups;
643 exit;
644 end;
645
646 if FLogGroupList = nil then begin
647 FLogGroupList := TLazLoggerLogGroupList.Create;
648 FLogGroupList.AddReference;
649 end;
650 Result := TLazLoggerLogGroupList(FLogGroupList);
651 end;
652
653 procedure TLazLogger.SetUseGlobalLogGroupList(AValue: Boolean);
654 begin
655 if FUseGlobalLogGroupList = AValue then Exit;
656 FUseGlobalLogGroupList := AValue;
657 end;
658
659 procedure TLazLogger.SetMaxNestPrefixLen(AValue: Integer);
660 begin
661 if FMaxNestPrefixLen = AValue then Exit;
662 FMaxNestPrefixLen := AValue;
663 IndentChanged;
664 end;
665
GetBlockHandlernull666 function TLazLogger.GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler;
667 begin
668 Result := nil;;
669 end;
670
671 procedure TLazLogger.SetNestLvlIndent(AValue: Integer);
672 begin
673 if FNestLvlIndent = AValue then Exit;
674 FNestLvlIndent := AValue;
675 IndentChanged;
676 end;
677
678 procedure TLazLogger.DoInit;
679 begin
680 //
681 end;
682
683 procedure TLazLogger.DumpExceptionBackTrace;
684 procedure DumpAddr(Addr: Pointer);
685 begin
686 // preventing another exception, while dumping stack trace
687 try
688 DebugLn(BackTraceStrFunc(Addr));
689 except
690 DebugLn(SysBackTraceStr(Addr));
691 end;
692 end;
693 var
694 FrameCount: integer;
695 Frames: PPointer;
696 FrameNumber:Integer;
697 begin
698 DumpAddr(ExceptAddr);
699 FrameCount:=ExceptFrameCount;
700 Frames:=ExceptFrames;
701 for FrameNumber := 0 to FrameCount-1 do
702 DumpAddr(Frames[FrameNumber]);
703 end;
704
705 procedure TLazLogger.DoFinish;
706 begin
707 //
708 end;
709
710 procedure TLazLogger.DoFinsh;
711 begin
712 DoFinish;
713 end;
714
715 procedure TLazLogger.DoDebuglnStack(const s: string);
716 begin
717 //
718 end;
719
720 procedure TLazLogger.IncreaseIndent;
721 begin
722 //
723 end;
724
725 procedure TLazLogger.DecreaseIndent;
726 begin
727 //
728 end;
729
730 procedure TLazLogger.IncreaseIndent(LogEnabled: TLazLoggerLogEnabled);
731 begin
732 //
733 end;
734
735 procedure TLazLogger.DecreaseIndent(LogEnabled: TLazLoggerLogEnabled);
736 begin
737 //
738 end;
739
740 procedure TLazLogger.IndentChanged;
741 begin
742 //
743 end;
744
745 procedure TLazLogger.DoDbgOut(s: string);
746 begin
747 //
748 end;
749
750 procedure TLazLogger.DoDebugLn(s: string);
751 begin
752 //
753 end;
754
ArgsToStringnull755 function TLazLogger.ArgsToString(Args: array of const): string;
756 var
757 i: Integer;
758 begin
759 Result := '';
760 for i:=Low(Args) to High(Args) do begin
761 case Args[i].VType of
762 vtInteger: Result := Result + dbgs(Args[i].vinteger);
763 vtInt64: Result := Result + dbgs(Args[i].VInt64^);
764 vtQWord: Result := Result + dbgs(Args[i].VQWord^);
765 vtBoolean: Result := Result + dbgs(Args[i].vboolean);
766 vtExtended: Result := Result + dbgs(Args[i].VExtended^);
767 {$ifdef FPC_CURRENCY_IS_INT64}
768 // MWE:
769 // fpc 2.x has troubles in choosing the right dbgs()
770 // so we convert here
771 vtCurrency: Result := Result + dbgs(int64(Args[i].vCurrency^)/10000, 4);
772 {$else}
773 vtCurrency: Result := Result + dbgs(Args[i].vCurrency^);
774 {$endif}
775 vtString: Result := Result + Args[i].VString^;
776 vtAnsiString: Result := Result + AnsiString(Args[i].VAnsiString);
777 vtChar: Result := Result + Args[i].VChar;
778 vtPChar: Result := Result + Args[i].VPChar;
779 vtPWideChar: Result := {%H-}Result {%H-}+ Args[i].VPWideChar;
780 vtWideChar: Result := Result + AnsiString(Args[i].VWideChar);
781 vtWidestring: Result := Result + AnsiString(WideString(Args[i].VWideString));
782 vtObject: Result := Result + DbgSName(Args[i].VObject);
783 vtClass: Result := Result + DbgSName(Args[i].VClass);
784 vtPointer: Result := Result + Dbgs(Args[i].VPointer);
785 else Result := Result + '?unknown variant?';
786 end;
787 end;
788 end;
789
790 constructor TLazLogger.Create;
791 begin
792 inherited;
793 InitCriticalSection(FLoggerCriticalSection);
794 FIsInitialized := False;
795 FUseGlobalLogGroupList := False;
796
797 FMaxNestPrefixLen := 15;
798 FNestLvlIndent := 2;
799
800 FLogGroupList := nil;
801 end;
802
803 destructor TLazLogger.Destroy;
804 begin
805 Finish;
806 if TheLazLogger = Self then TheLazLogger := nil;
807 ReleaseRefAndNil(FLogGroupList);
808 inherited Destroy;
809 DoneCriticalsection(FLoggerCriticalSection);
810 end;
811
812 procedure TLazLogger.Assign(Src: TLazLogger);
813 begin
814 if (Src = nil) then
815 exit;
816 FMaxNestPrefixLen := Src.FMaxNestPrefixLen;
817 FNestLvlIndent := Src.FNestLvlIndent;
818
819 FUseGlobalLogGroupList := Src.FUseGlobalLogGroupList;
820 if (not FUseGlobalLogGroupList) and (Src.FLogGroupList <> nil) then
821 LogGroupList.Assign(Src.LogGroupList);
822 end;
823
824 procedure TLazLogger.Init;
825 begin
826 EnterCriticalsection(FLoggerCriticalSection);
827 try
828 if FIsInitialized then exit;
829 DoInit;
830 FIsInitialized := True;
831 finally
832 LeaveCriticalsection(FLoggerCriticalSection);
833 end;
834 end;
835
836 procedure TLazLogger.Finish;
837 begin
838 if FIsInitialized then
839 DoFinish;
840 FIsInitialized := False;
841 end;
842
CurrentIndentLevelnull843 function TLazLogger.CurrentIndentLevel: Integer;
844 begin
845 Result := 0;
846 end;
847
TLazLogger.RegisterLogGroupnull848 function TLazLogger.RegisterLogGroup(const AConfigName: String;
849 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
850 begin
851 // The basic logger does not add entries from parsig cmd-line. So no need to check
852 Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
853 end;
854
TLazLogger.RegisterLogGroupnull855 function TLazLogger.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
856 begin
857 Result := LogGroupList.Add(AConfigName);
858 Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
859 end;
860
FindOrRegisterLogGroupnull861 function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String;
862 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
863 begin
864 Result := LogGroupList.FindOrAdd(AConfigName, ADefaulEnabled);
865 end;
866
FindOrRegisterLogGroupnull867 function TLazLogger.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
868 begin
869 Result := LogGroupList.FindOrAdd(AConfigName);
870 Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
871 end;
872
873 procedure TLazLogger.AddBlockHandler(AHandler: TLazLoggerBlockHandler);
874 begin
875 //
876 end;
877
878 procedure TLazLogger.RemoveBlockHandler(AHandler: TLazLoggerBlockHandler);
879 begin
880 //
881 end;
882
TLazLogger.BlockHandlerCountnull883 function TLazLogger.BlockHandlerCount: Integer;
884 begin
885 Result := 0;
886 end;
887
888 procedure TLazLogger.DebuglnStack(const s: string);
889 begin
890 DoDebuglnStack(s);
891 end;
892
893 procedure TLazLogger.DbgOut(const s: string);
894 begin
895 DoDbgOut(s);
896 end;
897
898 procedure TLazLogger.DbgOut(Args: array of const);
899 begin
900 DoDbgOut(ArgsToString(Args));
901 end;
902
903 procedure TLazLogger.DbgOut(const S: String; Args: array of const);
904 begin
905 DoDbgOut(Format(S, Args));
906 end;
907
908 procedure TLazLogger.DbgOut(const s1, s2: string; const s3: string; const s4: string;
909 const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
910 const s10: string; const s11: string; const s12: string; const s13: string;
911 const s14: string; const s15: string; const s16: string; const s17: string;
912 const s18: string);
913 begin
914 DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
915 end;
916
917 procedure TLazLogger.DebugLn(const s: string);
918 begin
919 DoDebugLn(s);
920 end;
921
922 procedure TLazLogger.DebugLn(Args: array of const);
923 begin
924 DoDebugLn(ArgsToString(Args));
925 end;
926
927 procedure TLazLogger.DebugLn(const S: String; Args: array of const);
928 begin
929 DoDebugLn(Format(S, Args));
930 end;
931
932 procedure TLazLogger.DebugLn(const s1, s2: string; const s3: string; const s4: string;
933 const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
934 const s10: string; const s11: string; const s12: string; const s13: string;
935 const s14: string; const s15: string; const s16: string; const s17: string;
936 const s18: string);
937 begin
938 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
939 end;
940
941 procedure TLazLogger.DebugLnEnter();
942 begin
943 IncreaseIndent;
944 end;
945
946 procedure TLazLogger.DebugLnEnter(const s: string);
947 begin
948 DoDebugLn(s);
949 IncreaseIndent;
950 end;
951
952 procedure TLazLogger.DebugLnEnter(Args: array of const);
953 begin
954 if high(Args) >= low(Args) then
955 DoDebugLn(ArgsToString(Args));
956 IncreaseIndent;
957 end;
958
959 procedure TLazLogger.DebugLnEnter(s: string; Args: array of const);
960 begin
961 DoDebugLn(Format(S, Args));
962 IncreaseIndent;
963 end;
964
965 procedure TLazLogger.DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
966 const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
967 const s10: string; const s11: string; const s12: string; const s13: string;
968 const s14: string; const s15: string; const s16: string; const s17: string;
969 const s18: string);
970 begin
971 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
972 IncreaseIndent;
973 end;
974
975 procedure TLazLogger.DebugLnExit();
976 begin
977 DecreaseIndent;
978 end;
979
980 procedure TLazLogger.DebugLnExit(const s: string);
981 begin
982 DecreaseIndent;
983 DoDebugLn(s);
984 end;
985
986 procedure TLazLogger.DebugLnExit(Args: array of const);
987 begin
988 DecreaseIndent;
989 if high(Args) >= low(Args) then
990 DoDebugLn(ArgsToString(Args));
991 end;
992
993 procedure TLazLogger.DebugLnExit(s: string; Args: array of const);
994 begin
995 DecreaseIndent;
996 DoDebugLn(Format(S, Args));
997 end;
998
999 procedure TLazLogger.DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
1000 const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
1001 const s10: string; const s11: string; const s12: string; const s13: string;
1002 const s14: string; const s15: string; const s16: string; const s17: string;
1003 const s18: string);
1004 begin
1005 DecreaseIndent;
1006 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
1007 end;
1008
1009 procedure TLazLogger.DebuglnStack(LogEnabled: TLazLoggerLogEnabled; const s: string);
1010 begin
1011 if not LogEnabled.Enabled then exit;
1012 DebuglnStack(s);
1013 end;
1014
1015 procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const s: string);
1016 begin
1017 if not LogEnabled.Enabled then exit;
1018 DoDbgOut(s);
1019 end;
1020
1021 procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; Args: array of const);
1022 begin
1023 if not LogEnabled.Enabled then exit;
1024 DoDbgOut(ArgsToString(Args));
1025 end;
1026
1027 procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const S: String;
1028 Args: array of const);
1029 begin
1030 if not LogEnabled.Enabled then exit;
1031 DoDbgOut(Format(S, Args));
1032 end;
1033
1034 procedure TLazLogger.DbgOut(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string;
1035 const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
1036 const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
1037 const s13: string; const s14: string; const s15: string; const s16: string;
1038 const s17: string; const s18: string);
1039 begin
1040 if not LogEnabled.Enabled then exit;
1041 DoDbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
1042 end;
1043
1044 procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const s: string);
1045 begin
1046 if not LogEnabled.Enabled then exit;
1047 DoDebugLn(s);
1048 end;
1049
1050 procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; Args: array of const);
1051 begin
1052 if not LogEnabled.Enabled then exit;
1053 DoDebugLn(ArgsToString(Args));
1054 end;
1055
1056 procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const S: String;
1057 Args: array of const);
1058 begin
1059 if not LogEnabled.Enabled then exit;
1060 DoDebugLn(Format(S, Args));
1061 end;
1062
1063 procedure TLazLogger.DebugLn(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string;
1064 const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
1065 const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
1066 const s13: string; const s14: string; const s15: string; const s16: string;
1067 const s17: string; const s18: string);
1068 begin
1069 if not LogEnabled.Enabled then exit;
1070 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
1071 end;
1072
1073 procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled);
1074 begin
1075 IncreaseIndent(LogEnabled);
1076 end;
1077
1078 procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s: string);
1079 begin
1080 if LogEnabled.Enabled then
1081 DoDebugLn(s);
1082 IncreaseIndent(LogEnabled);
1083 end;
1084
1085 procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; Args: array of const);
1086 begin
1087 if LogEnabled.Enabled then
1088 DoDebugLn(ArgsToString(Args));
1089 IncreaseIndent(LogEnabled);
1090 end;
1091
1092 procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; s: string;
1093 Args: array of const);
1094 begin
1095 if LogEnabled.Enabled then
1096 DoDebugLn(Format(S, Args));
1097 IncreaseIndent(LogEnabled);
1098 end;
1099
1100 procedure TLazLogger.DebugLnEnter(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string;
1101 const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
1102 const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
1103 const s13: string; const s14: string; const s15: string; const s16: string;
1104 const s17: string; const s18: string);
1105 begin
1106 if LogEnabled.Enabled then
1107 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
1108 IncreaseIndent(LogEnabled);
1109 end;
1110
1111 procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled);
1112 begin
1113 DecreaseIndent(LogEnabled);
1114 end;
1115
1116 procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s: string);
1117 begin
1118 DecreaseIndent(LogEnabled);
1119 if not LogEnabled.Enabled then exit;
1120 DoDebugLn(s);
1121 end;
1122
1123 procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; Args: array of const);
1124 begin
1125 DecreaseIndent(LogEnabled);
1126 if not LogEnabled.Enabled then exit;
1127 DoDebugLn(ArgsToString(Args));
1128 end;
1129
1130 procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; s: string;
1131 Args: array of const);
1132 begin
1133 DecreaseIndent(LogEnabled);
1134 if not LogEnabled.Enabled then exit;
1135 DoDebugLn(Format(S, Args));
1136 end;
1137
1138 procedure TLazLogger.DebugLnExit(LogEnabled: TLazLoggerLogEnabled; const s1, s2: string;
1139 const s3: string; const s4: string; const s5: string; const s6: string; const s7: string;
1140 const s8: string; const s9: string; const s10: string; const s11: string; const s12: string;
1141 const s13: string; const s14: string; const s15: string; const s16: string;
1142 const s17: string; const s18: string);
1143 begin
1144 DecreaseIndent(LogEnabled);
1145 if not LogEnabled.Enabled then exit;
1146 DoDebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
1147 end;
1148
1149 { TLazLoggerWithGroupParam }
1150
1151 procedure TLazLoggerWithGroupParam.SetParamForEnabledLogGroups(AValue: String);
1152 begin
1153 if FParamForEnabledLogGroups = AValue then Exit;
1154 FParamForEnabledLogGroups := AValue;
1155 ParseParamForEnabledLogGroups;
1156 end;
1157
1158 procedure TLazLoggerWithGroupParam.ParseParamForEnabledLogGroups;
1159 var
1160 i, j, c: Integer;
1161 list: TStringList;
1162 g: PLazLoggerLogGroup;
1163 s: String;
1164 e: Boolean;
1165 begin
1166 c := GetParamByNameCount(FParamForEnabledLogGroups);
1167 FLogDefaultEnabled := False;
1168 FLogAllDefaultDisabled := FAlse;
1169
1170 list := TStringList.Create;
1171 for i := 0 to c - 1 do begin
1172 s := GetParamByName(FParamForEnabledLogGroups, i);
1173
1174 if s = '-' then begin
1175 // clear all
1176 FLogDefaultEnabled := False;
1177 for j := 0 to LogGroupList.Count - 1 do
1178 LogGroupList[j]^.Enabled := False;
1179 FLogAllDefaultDisabled := True;
1180 end
1181 else
1182 begin
1183 list.CommaText := s;
1184 for j := 0 to list.Count - 1 do begin
1185 s := list[j];
1186 if (s = '-') or (s='') then
1187 continue; // invalid, within comma list
1188 if s[1] = '-' then
1189 e := False
1190 else
1191 e := True;
1192 if s[1] in ['-', '+'] then delete(s,1,1);
1193 if (s='') then
1194 continue;
1195
1196 if e then
1197 FLogDefaultEnabled := False;
1198
1199 g := LogGroupList.Find(s);
1200 if g <> nil then begin
1201 g^.Enabled := e;
1202 g^.Flags := g^.Flags - [lgfNoDefaultEnabledSpecified];
1203 end
1204 else begin
1205 g := LogGroupList.Add(s, e);
1206 g^.Flags := g^.Flags + [lgfAddedByParamParser];
1207 end;
1208 end;
1209 end;
1210 end;
1211 list.Free;
1212
1213 if not FLogParamParsed then begin
1214 // first parse, reset default unless specified in RegisterLogGroup();
1215 for i := 0 to LogGroupList.Count - 1 do
1216 if lgfNoDefaultEnabledSpecified in LogGroupList[i]^.Flags then
1217 LogGroupList[i]^.Enabled := FLogDefaultEnabled;
1218 end;
1219
1220 FLogParamParsed := True;
1221 end;
1222
1223 constructor TLazLoggerWithGroupParam.Create;
1224 begin
1225 inherited;
1226 FLogDefaultEnabled := False;
1227 FLogAllDefaultDisabled := False;
1228 end;
1229
1230 procedure TLazLoggerWithGroupParam.Assign(Src: TLazLogger);
1231 var
1232 i: Integer;
1233 begin
1234 inherited Assign(Src);
1235 if Src is TLazLoggerWithGroupParam then begin
1236 FLogParamParsed := False;
1237 FParamForEnabledLogGroups := TLazLoggerWithGroupParam(Src).FParamForEnabledLogGroups;
1238 end;
1239
1240 if Src <> nil then
1241 for i := 0 to Src.BlockHandlerCount - 1 do
1242 AddBlockHandler(Src.BlockHandler[i]);
1243 end;
1244
TLazLoggerWithGroupParam.RegisterLogGroupnull1245 function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
1246 var
1247 Default, DefaultFound: Boolean;
1248 begin
1249 Result := LogGroupList.Find(AConfigName);
1250 Default := FLogDefaultEnabled;
1251 DefaultFound := False;
1252 if Result <> nil then begin
1253 Default := Result^.Enabled;
1254 DefaultFound := not(lgfNoDefaultEnabledSpecified in Result^.Flags);
1255 end;
1256
1257 Result := RegisterLogGroup(AConfigName, Default);
1258
1259 if not DefaultFound then
1260 Result^.Flags := Result^.Flags + [lgfNoDefaultEnabledSpecified];
1261 end;
1262
TLazLoggerWithGroupParam.RegisterLogGroupnull1263 function TLazLoggerWithGroupParam.RegisterLogGroup(const AConfigName: String;
1264 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
1265 begin
1266 if FLogAllDefaultDisabled then
1267 ADefaulEnabled := False;
1268 Result := LogGroupList.Find(AConfigName);
1269 if Result <> nil then begin
1270 if not(lgfAddedByParamParser in Result^.Flags) then
1271 raise Exception.Create('Duplicate LogGroup ' + AConfigName);
1272 if ADefaulEnabled and not(lgfAddedByParamParser in Result^.Flags) then
1273 Result^.Enabled := True;
1274 Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
1275 end
1276 else
1277 Result := LogGroupList.Add(AConfigName, ADefaulEnabled);
1278 end;
1279
TLazLoggerWithGroupParam.FindOrRegisterLogGroupnull1280 function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String): PLazLoggerLogGroup;
1281 begin
1282 Result := LogGroupList.Find(AConfigName);
1283 if Result = nil then
1284 Result := RegisterLogGroup(AConfigName)
1285 else
1286 Result^.Flags := Result^.Flags - [lgfAddedByParamParser];
1287 end;
1288
TLazLoggerWithGroupParam.FindOrRegisterLogGroupnull1289 function TLazLoggerWithGroupParam.FindOrRegisterLogGroup(const AConfigName: String;
1290 ADefaulEnabled: Boolean): PLazLoggerLogGroup;
1291 begin
1292 Result := LogGroupList.Find(AConfigName);
1293 if Result = nil then
1294 Result := RegisterLogGroup(AConfigName, ADefaulEnabled)
1295 else
1296 begin
1297 if (lgfNoDefaultEnabledSpecified in Result^.Flags) and
1298 not(lgfAddedByParamParser in Result^.Flags)
1299 then
1300 Result^.Enabled := ADefaulEnabled;
1301 Result^.Flags := Result^.Flags - [lgfNoDefaultEnabledSpecified, lgfAddedByParamParser];
1302 end;
1303 end;
1304
1305 finalization // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
1306 ReleaseRefAndNil(TheLazLogger);
1307 ReleaseRefAndNil(PrevLazLogger);
1308 ReleaseRefAndNil(TheLazLoggerGroups);
1309
1310 end.
1311
1312