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