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 LazLogger;
10
11 {$mode objfpc}{$H+}
12
13 interface
14
15 uses
16 Classes, SysUtils, types, math,
17 // LazUtils
18 LazLoggerBase, LazClasses, LazFileUtils, LazStringUtils, LazUTF8;
19
20 type
21
22 PLazLoggerLogGroup = LazLoggerBase.PLazLoggerLogGroup;
23
24 {$DEFINE USED_BY_LAZLOGGER}
25 {$I LazLoggerIntf.inc}
26
27
DbgStrnull28 function DbgStr(const StringWithSpecialChars: string): string; overload;
DbgStrnull29 function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
DbgStrnull30 function DbgStr(const p: PChar; Len: PtrInt): string; overload;
DbgWideStrnull31 function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
32
33 type
34
35 { TLazLoggerFileHandle }
36
37 TLazLoggerFileHandle = class
38 private
39 FActiveLogText: PText; // may point to stdout
40 FCloseLogFileBetweenWrites: Boolean;
41 FLastWriteFailed: Boolean;
42 FLogName: String;
43 FLogText: Text;
44 FLogTextInUse, FLogTextFailed: Boolean;
45 FUseStdOut: Boolean;
46 FWriteFailedCount: Integer;
47 procedure DoOpenFile;
48 procedure DoCloseFile;
GetWriteTargetnull49 function GetWriteTarget: TLazLoggerWriteTarget;
50 procedure SetCloseLogFileBetweenWrites(AValue: Boolean);
51 procedure SetLogName(AValue: String);
52 public
53 constructor Create;
54 destructor Destroy; override;
55 procedure OpenFile;
56 procedure CloseFile;
57 procedure ResetWriteFailedCounter;
58
59 procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); virtual;
60 procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); virtual;
61
62 property LogName: String read FLogName write SetLogName;
63 property UseStdOut: Boolean read FUseStdOut write FUseStdOut;
64 property CloseLogFileBetweenWrites: Boolean read FCloseLogFileBetweenWrites write SetCloseLogFileBetweenWrites;
65 property WriteTarget: TLazLoggerWriteTarget read GetWriteTarget;
66 property ActiveLogText: PText read FActiveLogText;
67 property WriteFailedCount: Integer read FWriteFailedCount;
68 property LastWriteFailed: Boolean read FLastWriteFailed;
69 end;
70
71 { TLazLoggerFileHandleThreadSave
72 file operations in critical section
73
74 Requires that DoOpenFile is called by main thread. Otherwise the filehandle may get closed...
75 }
76
77 TLazLoggerFileHandleThreadSave = class (TLazLoggerFileHandle)
78 private
79 FWriteToFileLock: TRTLCriticalSection;
80 public
81 constructor Create;
82 destructor Destroy; override;
83 procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); override;
84 procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); override;
85 end;
86
87 { TLazLoggerFileHandleMainThread
88 file operations queued for main thread
89 }
90
91 TLazLoggerFileHandleMainThread = class (TLazLoggerFileHandle)
92 private
93 type
94 PWriteListEntry = ^TWriteListEntry;
95 TWriteListEntry = record
96 Next: PWriteListEntry;
97 Data: String;
98 Ln: Boolean;
99 Logger: TLazLogger;
100 end;
101 private
102 FWriteToFileLock: TRTLCriticalSection;
103 FFirst, FLast: PWriteListEntry;
104
105 procedure MainThreadWrite;
106 public
107 constructor Create;
108 destructor Destroy; override;
109 procedure WriteToFile(const s: string; ALogger: TLazLogger = nil); override;
110 procedure WriteLnToFile(const s: string; ALogger: TLazLogger = nil); override;
111 end;
112
113
114 { TLazLoggerFile }
115
116 TLazLoggerFile = class(TLazLoggerWithGroupParam)
117 private
118 FFileHandle: TLazLoggerFileHandle;
119 FOnDbgOut: TLazLoggerWriteEvent;
120 FOnDebugLn: TLazLoggerWriteEvent;
121 FBlockHandler: TList;
122
123
124 FEnvironmentForLogFileName: String;
125 //FLogName: String;
126
127 FParamForLogFileName: String;
128 FGetLogFileNameDone: Boolean;
129
130 FIndentCriticalSection: TRTLCriticalSection;
131 FDebugNestLvl: Integer;
132 FDebugIndent: String;
133 FDebugNestAtBOL: Boolean;
134
GetFileHandlenull135 function GetFileHandle: TLazLoggerFileHandle;
136 procedure SetEnvironmentForLogFileName(AValue: String);
137 procedure SetFileHandle(AValue: TLazLoggerFileHandle);
138 procedure SetParamForLogFileName(AValue: String);
GetLogFileNamenull139 function GetLogFileName: string;
140 private
141 // forward to TLazLoggerFileHandle
GetCloseLogFileBetweenWritesnull142 function GetCloseLogFileBetweenWrites: Boolean;
GetLogNamenull143 function GetLogName: String;
GetUseStdOutnull144 function GetUseStdOut: Boolean;
145 procedure SetCloseLogFileBetweenWrites(AValue: Boolean);
146 procedure SetLogName(AValue: String);
147 procedure SetUseStdOut(AValue: Boolean);
148 protected
149 procedure DoInit; override;
150 procedure DoFinish; override;
151
152 procedure IncreaseIndent; overload; override;
153 procedure DecreaseIndent; overload; override;
154 procedure IncreaseIndent(LogEnabled: TLazLoggerLogEnabled); overload; override;
155 procedure DecreaseIndent(LogEnabled: TLazLoggerLogEnabled); overload; override;
156 procedure IndentChanged; override;
157 procedure CreateIndent; virtual;
GetBlockHandlernull158 function GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler; override;
159 procedure ClearAllBlockHandler;
160
161
162 procedure DoDbgOut(s: string); override;
163 procedure DoDebugLn(s: string); override;
164 procedure DoDebuglnStack(const s: string); override;
165
166 property FileHandle: TLazLoggerFileHandle read GetFileHandle write SetFileHandle;
167 public
168 constructor Create;
169 destructor Destroy; override;
170 procedure Assign(Src: TLazLogger); override;
CurrentIndentLevelnull171 function CurrentIndentLevel: Integer; override;
172 // A param on the commandline, that may contain the name (if not already set)
173 // example/default: --debug-log=
174 property ParamForLogFileName: String read FParamForLogFileName write SetParamForLogFileName;
175 // Environment variable used to specify log file name
176 // * is replaced by param(0) - the application name without extension
177 // example/default: *_debuglog
178 property EnvironmentForLogFileName: String read FEnvironmentForLogFileName write SetEnvironmentForLogFileName;
179
180 property OnDebugLn: TLazLoggerWriteEvent read FOnDebugLn write FOnDebugLn;
181 property OnDbgOut: TLazLoggerWriteEvent read FOnDbgOut write FOnDbgOut;
182
183 procedure AddBlockHandler(AHandler: TLazLoggerBlockHandler); override;
184 procedure RemoveBlockHandler(AHandler: TLazLoggerBlockHandler); override;
BlockHandlerCountnull185 function BlockHandlerCount: Integer; override;
186
187 // forward to TLazLoggerFileHandle
188 property LogName: String read GetLogName write SetLogName;
189 property UseStdOut: Boolean read GetUseStdOut write SetUseStdOut;
190 property CloseLogFileBetweenWrites: Boolean read GetCloseLogFileBetweenWrites write SetCloseLogFileBetweenWrites;
191 end;
192
GetDebugLoggernull193 function GetDebugLogger: TLazLoggerFile; inline;
194 procedure SetDebugLogger(ALogger: TLazLoggerFile);
195
196 property DebugLogger: TLazLoggerFile read GetDebugLogger write SetDebugLogger;
197
198 implementation
199
200 {$I LazLoggerImpl.inc}
201
202 {$ifdef wince}
203 const
204 Str_LCL_Debug_File = 'lcldebug.log';
205 {$endif}
206
207 (* Creation / Access *)
208
CreateDebugLoggernull209 function CreateDebugLogger: TRefCountedObject;
210 begin
211 Result := TLazLoggerFile.Create;
212 TLazLoggerFile(Result).Assign(GetExistingDebugLogger);
213 end;
214
GetDebugLoggernull215 function GetDebugLogger: TLazLoggerFile; inline;
216 begin
217 Result := TLazLoggerFile(LazLoggerBase.DebugLogger);
218 end;
219
220 procedure SetDebugLogger(ALogger: TLazLoggerFile);
221 begin
222 LazLoggerBase.DebugLogger := ALogger;
223 end;
224
225 { TLazLoggerFileHandleMainThread }
226
227 procedure TLazLoggerFileHandleMainThread.MainThreadWrite;
228 var
229 Data, NextData: PWriteListEntry;
230 begin
231 EnterCriticalsection(FWriteToFileLock);
232 try
233 Data := FFirst;
234 FFirst := nil;
235 FLast := nil;
236 finally
237 LeaveCriticalsection(FWriteToFileLock);
238 end;
239
240 while Data <> nil do begin
241 NextData := Data^.Next;
242 if Data^.Ln
243 then inherited WriteLnToFile(Data^.Data, Data^.Logger)
244 else inherited WriteToFile(Data^.Data, Data^.Logger);
245 Dispose(Data);
246 Data := NextData;
247 end;
248 end;
249
250 constructor TLazLoggerFileHandleMainThread.Create;
251 begin
252 InitCriticalSection(FWriteToFileLock);
253 inherited;
254 end;
255
256 destructor TLazLoggerFileHandleMainThread.Destroy;
257 begin
258 // Call Syncronize (in the main thread) before destroy to catch any pending log
259 TThread.RemoveQueuedEvents(@MainThreadWrite);
260 inherited Destroy;
261 DoneCriticalsection(FWriteToFileLock);
262 end;
263
264 procedure TLazLoggerFileHandleMainThread.WriteToFile(const s: string;
265 ALogger: TLazLogger);
266 var
267 Data: PWriteListEntry;
268 begin
269 if (not System.IsMultiThread) or (GetCurrentThreadID = MainThreadID) then begin
270 if FFirst <> nil then MainThreadWrite; // Dirty read of FFirst is ok
271 inherited WriteToFile(s, ALogger);
272 exit;
273 end;
274
275 New(Data);
276 Data^.Data := s;
277 Data^.Ln := False;
278 Data^.Logger := ALogger;
279 Data^.Next := nil;
280 EnterCriticalsection(FWriteToFileLock);
281 try
282 if FLast = nil then
283 FFirst := Data
284 else
285 FLast^.Next := Data;
286 FLast := Data;
287 finally
288 LeaveCriticalsection(FWriteToFileLock);
289 end;
290 TThread.Queue(nil, @MainThreadWrite);
291 end;
292
293 procedure TLazLoggerFileHandleMainThread.WriteLnToFile(const s: string;
294 ALogger: TLazLogger);
295 var
296 Data: PWriteListEntry;
297 begin
298 if (not System.IsMultiThread) or (GetCurrentThreadID = MainThreadID) then begin
299 if FFirst <> nil then MainThreadWrite; // Dirty read of FFirst is ok
300 inherited WriteLnToFile(s, ALogger);
301 exit;
302 end;
303
304 New(Data);
305 Data^.Data := s;
306 Data^.Ln := True;
307 Data^.Logger := ALogger;
308 Data^.Next := nil;
309 EnterCriticalsection(FWriteToFileLock);
310 try
311 if FLast = nil then
312 FFirst := Data
313 else
314 FLast^.Next := Data;
315 FLast := Data;
316 finally
317 LeaveCriticalsection(FWriteToFileLock);
318 end;
319 TThread.Queue(nil, @MainThreadWrite);
320 end;
321
322 { TLazLoggerFileHandleThreadSave }
323
324 constructor TLazLoggerFileHandleThreadSave.Create;
325 begin
326 InitCriticalSection(FWriteToFileLock);
327 inherited;
328 end;
329
330 destructor TLazLoggerFileHandleThreadSave.Destroy;
331 begin
332 inherited Destroy;
333 DoneCriticalsection(FWriteToFileLock);
334 end;
335
336 procedure TLazLoggerFileHandleThreadSave.WriteToFile(const s: string;
337 ALogger: TLazLogger);
338 begin
339 EnterCriticalsection(FWriteToFileLock);
340 try
341 inherited WriteToFile(s, ALogger);
342 finally
343 LeaveCriticalsection(FWriteToFileLock);
344 end;
345 end;
346
347 procedure TLazLoggerFileHandleThreadSave.WriteLnToFile(const s: string;
348 ALogger: TLazLogger);
349 begin
350 EnterCriticalsection(FWriteToFileLock);
351 try
352 inherited WriteLnToFile(s, ALogger);
353 finally
354 LeaveCriticalsection(FWriteToFileLock);
355 end;
356 end;
357
358 (* ArgV *)
359
360
361 { TLazLoggerFileHandle }
362
363 procedure TLazLoggerFileHandle.DoOpenFile;
364 var
365 fm: Byte;
366 begin
367 if FActiveLogText <> nil then exit;
368
369 if (not FLogTextFailed) and (length(FLogName)>0)
370 {$ifNdef WinCE}
371 and (DirPathExists(ExtractFileDir(FLogName)))
372 {$endif}
373 then begin
374 fm:=Filemode;
375 try
376 {$ifdef WinCE}
377 Assign(FLogText, FLogName);
378 {$I-}
379 Append(FLogText);
380 if IOResult <> 0 then
381 Rewrite(FLogText);
382 {$I+}
383 {$else}
384 Filemode:=fmShareDenyNone;
385 Assign(FLogText, FLogName);
386 if FileExistsUTF8(FLogName) then
387 Append(FLogText)
388 else
389 Rewrite(FLogText);
390 {$endif}
391 FActiveLogText := @FLogText;
392 FLogTextInUse := true;
393 except
394 FLogTextInUse := false;
395 FActiveLogText := nil;
396 FLogTextFailed := True;
397 // Add extra line ending: a dialog will be shown in windows gui application
398 writeln(StdOut, 'Cannot open file: ', FLogName+LineEnding);
399 end;
400 Filemode:=fm;
401 end;
402
403 if (not FLogTextInUse) and (FUseStdOut) then
404 begin
405 if not(TextRec(Output).Mode=fmClosed) then
406 FActiveLogText := @Output;
407 end;
408 end;
409
410 procedure TLazLoggerFileHandle.DoCloseFile;
411 begin
412 if FLogTextInUse then begin
413 try
414 Close(FLogText);
415 except
416 end;
417 FLogTextInUse := false;
418 end;
419 FActiveLogText := nil;
420 end;
421
GetWriteTargetnull422 function TLazLoggerFileHandle.GetWriteTarget: TLazLoggerWriteTarget;
423 begin
424 Result := lwtNone;
425 if FActiveLogText = @Output then
426 Result := lwtStdOut
427 else
428 if FLogTextInUse then
429 Result := lwtTextFile;
430 end;
431
432 procedure TLazLoggerFileHandle.SetCloseLogFileBetweenWrites(AValue: Boolean);
433 begin
434 if FCloseLogFileBetweenWrites = AValue then Exit;
435 FCloseLogFileBetweenWrites := AValue;
436 if FCloseLogFileBetweenWrites then
437 DoCloseFile;
438 end;
439
440 procedure TLazLoggerFileHandle.SetLogName(AValue: String);
441 begin
442 if FLogName = AValue then Exit;
443 DoCloseFile;
444
445 FLogName := CleanAndExpandFilename(AValue);
446
447 FLogTextFailed := False;
448 end;
449
450 constructor TLazLoggerFileHandle.Create;
451 begin
452 FLogTextInUse := False;
453 FLogTextFailed := False;
454 {$ifdef WinCE}
455 FLogName := ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File;
456 FUseStdOut := False;
457 FCloseLogFileBetweenWrites := True;
458 {$else}
459 FLogName := '';
460 FUseStdOut := True;
461 FCloseLogFileBetweenWrites := False;
462 {$endif}
463 end;
464
465 destructor TLazLoggerFileHandle.Destroy;
466 begin
467 inherited Destroy;
468 DoCloseFile;
469 end;
470
471 procedure TLazLoggerFileHandle.OpenFile;
472 begin
473 if not CloseLogFileBetweenWrites then
474 DoOpenFile;
475 end;
476
477 procedure TLazLoggerFileHandle.CloseFile;
478 begin
479 DoCloseFile;
480 FLogTextFailed := False;
481 end;
482
483 procedure TLazLoggerFileHandle.ResetWriteFailedCounter;
484 begin
485 FWriteFailedCount := 0;
486 end;
487
488 procedure TLazLoggerFileHandle.WriteToFile(const s: string; ALogger: TLazLogger
489 );
490 var
491 Handled: Boolean;
492 begin
493 try
494 if OnWidgetSetDbgOut <> nil then
495 begin
496 Handled := False;
497 OnWidgetSetDbgOut(ALogger, s, Handled, WriteTarget, ActiveLogText);
498 if Handled then
499 Exit;
500 end;
501
502 DoOpenFile;
503 if FActiveLogText = nil then exit;
504
505 Write(FActiveLogText^, s);
506 {$IFDEF LAZLOGGER_FLUSH} Flush(FActiveLogText^); {$ENDIF}
507
508 if FCloseLogFileBetweenWrites then
509 DoCloseFile;
510 FLastWriteFailed := False;
511 except
512 inc(FWriteFailedCount);
513 FLastWriteFailed := True;
514 end;
515 end;
516
517 procedure TLazLoggerFileHandle.WriteLnToFile(const s: string;
518 ALogger: TLazLogger);
519 var
520 Handled: Boolean;
521 begin
522 try
523 if OnWidgetSetDebugLn <> nil then
524 begin
525 Handled := False;
526 OnWidgetSetDebugLn(ALogger, s, Handled, WriteTarget, ActiveLogText);
527 if Handled then
528 Exit;
529 end;
530
531 DoOpenFile;
532 if FActiveLogText = nil then exit;
533
534 WriteLn(FActiveLogText^, s);
535
536 if FCloseLogFileBetweenWrites then
537 DoCloseFile;
538 FLastWriteFailed := False;
539 except
540 inc(FWriteFailedCount);
541 FLastWriteFailed := True;
542 end;
543 end;
544
545 { TLazLoggerFile }
546
GetFileHandlenull547 function TLazLoggerFile.GetFileHandle: TLazLoggerFileHandle;
548 begin
549 if FFileHandle = nil then
550 FFileHandle := TLazLoggerFileHandleMainThread.Create;
551 Result := FFileHandle;
552 end;
553
554 procedure TLazLoggerFile.SetEnvironmentForLogFileName(AValue: String);
555 begin
556 if FEnvironmentForLogFileName = AValue then Exit;
557 Finish;
558 FGetLogFileNameDone := False;
559 FEnvironmentForLogFileName := AValue;
560 end;
561
562 procedure TLazLoggerFile.SetFileHandle(AValue: TLazLoggerFileHandle);
563 begin
564 if FFileHandle = AValue then Exit;
565 Finish;
566 FreeAndNil(FFileHandle);
567 FFileHandle := AValue;
568 end;
569
570 procedure TLazLoggerFile.SetParamForLogFileName(AValue: String);
571 begin
572 if FParamForLogFileName = AValue then Exit;
573 Finish;
574 FGetLogFileNameDone := False;
575 FParamForLogFileName := AValue;
576 end;
577
TLazLoggerFile.GetCloseLogFileBetweenWritesnull578 function TLazLoggerFile.GetCloseLogFileBetweenWrites: Boolean;
579 begin
580 Result := FileHandle.CloseLogFileBetweenWrites;
581 end;
582
GetLogNamenull583 function TLazLoggerFile.GetLogName: String;
584 begin
585 Result := FileHandle.LogName;
586 end;
587
GetUseStdOutnull588 function TLazLoggerFile.GetUseStdOut: Boolean;
589 begin
590 Result := FileHandle.UseStdOut;
591 end;
592
593 procedure TLazLoggerFile.SetCloseLogFileBetweenWrites(AValue: Boolean);
594 begin
595 FileHandle.CloseLogFileBetweenWrites := AValue;
596 end;
597
598 procedure TLazLoggerFile.SetLogName(AValue: String);
599 begin
600 if FileHandle.LogName = AValue then Exit;
601 Finish;
602 FileHandle.LogName := AValue;
603 end;
604
605 procedure TLazLoggerFile.SetUseStdOut(AValue: Boolean);
606 begin
607 FileHandle.UseStdOut := AValue;
608 end;
609
610 procedure TLazLoggerFile.DoInit;
611 begin
612 inherited DoInit;
613
614 FDebugNestLvl := 0;
615 FDebugNestAtBOL := True;
616 if (LogName = '') and not FGetLogFileNameDone then
617 LogName := GetLogFileName;
618
619 FileHandle.OpenFile;
620 end;
621
622 procedure TLazLoggerFile.DoFinish;
623 begin
624 inherited DoFinish;
625
626 FileHandle.CloseFile;
627 end;
628
629 procedure TLazLoggerFile.IncreaseIndent;
630 var
631 i: Integer;
632 l: LongInt;
633 begin
634 l := InterLockedIncrement(FDebugNestLvl);
635 CreateIndent;
636 for i := 0 to BlockHandlerCount - 1 do
637 BlockHandler[i].EnterBlock(Self, l);
638 end;
639
640 procedure TLazLoggerFile.DecreaseIndent;
641 var
642 i: Integer;
643 l: LongInt;
644 begin
645 if not FDebugNestAtBOL then DebugLn;
646
647 l := InterLockedDecrement(FDebugNestLvl);
648 if l < 0 then
649 l := InterLockedIncrement(FDebugNestLvl);
650
651 if l >= 0 then begin
652 inc(l);
653 for i := 0 to BlockHandlerCount - 1 do
654 BlockHandler[i].ExitBlock(Self, l);
655 end;
656 CreateIndent;
657 end;
658
659 procedure TLazLoggerFile.IncreaseIndent(LogEnabled: TLazLoggerLogEnabled);
660 begin
661 if not (LogEnabled.Enabled) then exit;
662
663 if (LogEnabled.Group <> nil) and (LogEnabled.Group^.Enabled) then
664 inc(LogEnabled.Group^.FOpenedIndents);
665 IncreaseIndent;
666 end;
667
668 procedure TLazLoggerFile.DecreaseIndent(LogEnabled: TLazLoggerLogEnabled);
669 begin
670 if (LogEnabled.Enabled) then begin
671 if LogEnabled.Group <> nil then
672 dec(LogEnabled.Group^.FOpenedIndents);
673 DecreaseIndent;
674 end
675 else
676 if (LogEnabled.Group <> nil) and (LogEnabled.Group^.FOpenedIndents > 0) then begin
677 dec(LogEnabled.Group^.FOpenedIndents);
678 DecreaseIndent;
679 end;
680 end;
681
682 procedure TLazLoggerFile.IndentChanged;
683 begin
684 CreateIndent;
685 end;
686
687 procedure TLazLoggerFile.CreateIndent;
688 var
689 s: String;
690 NewLen: Integer;
691 l: Integer;
692 begin
693 l := InterlockedCompareExchange(FDebugNestLvl, -1, -1);
694 NewLen := l * NestLvlIndent;
695 if NewLen < 0 then NewLen := 0;
696 if (NewLen >= MaxNestPrefixLen) then begin
697 s := IntToStr(l);
698 NewLen := MaxNestPrefixLen - Length(s);
699 if NewLen < 1 then
700 NewLen := 1;
701 end else
702 s := '';
703
704 EnterCriticalsection(FIndentCriticalSection);
705 if NewLen <> Length(FDebugIndent) then
706 FDebugIndent := s + StringOfChar(' ', NewLen);
707 LeaveCriticalsection(FIndentCriticalSection);
708 end;
709
GetBlockHandlernull710 function TLazLoggerFile.GetBlockHandler(AIndex: Integer): TLazLoggerBlockHandler;
711 begin
712 Result := TLazLoggerBlockHandler(FBlockHandler[AIndex]);
713 end;
714
715 procedure TLazLoggerFile.ClearAllBlockHandler;
716 begin
717 while BlockHandlerCount > 0 do RemoveBlockHandler(BlockHandler[0]);
718 end;
719
720 procedure TLazLoggerFile.DoDbgOut(s: string);
721 var
722 Handled: Boolean;
723 CB: TLazLoggerWriteEvent;
724 begin
725 if not IsInitialized then Init;
726
727 (* DoDbgOut in not useful in threaded environment.
728 Therefore FDebugNestAtBOL is not handled in a thread safe way.
729 If DoDbgOut is *not* used at all, the FDebugNestAtBOL is always true, and
730 dirty reads should therefore yield the correct value: "true"
731 *)
732
733 if s <> '' then begin
734 if FDebugNestAtBOL then begin
735 EnterCriticalsection(FIndentCriticalSection);
736 s := FDebugIndent + s;
737 LeaveCriticalsection(FIndentCriticalSection);
738 end;
739 FDebugNestAtBOL := (s[length(s)] in [#10,#13]);
740 end;
741
742 CB := OnDbgOut;
743 if CB <> nil then
744 begin
745 Handled := False;
746 CB(Self, s, Handled);
747 if Handled then
748 Exit;
749 end;
750
751 FileHandle.WriteToFile(s, Self);
752 end;
753
754 procedure TLazLoggerFile.DoDebugLn(s: string);
755 var
756 Handled: Boolean;
757 CB: TLazLoggerWriteEvent;
758 begin
759 if not IsInitialized then Init;
760
761 if FDebugNestAtBOL and (s <> '') then begin
762 EnterCriticalsection(FIndentCriticalSection);
763 s := FDebugIndent + s;
764 LeaveCriticalsection(FIndentCriticalSection);
765 end;
766 FDebugNestAtBOL := True;
767
768 CB := OnDebugLn;
769 if CB <> nil then
770 begin
771 Handled := False;
772 CB(Self, s, Handled);
773 if Handled then
774 Exit;
775 end;
776
777 FileHandle.WriteLnToFile(LineBreaksToSystemLineBreaks(s), Self);
778 end;
779
780 procedure TLazLoggerFile.DoDebuglnStack(const s: string);
781 begin
782 DebugLn(s);
783 FileHandle.DoOpenFile;
784 if FileHandle.FActiveLogText = nil then exit;
785
786 Dump_Stack(FileHandle.FActiveLogText^, get_frame);
787
788 if CloseLogFileBetweenWrites then
789 FileHandle.DoCloseFile;
790 end;
791
792 constructor TLazLoggerFile.Create;
793 begin
794 InitCriticalSection(FIndentCriticalSection);
795 inherited;
796 FDebugNestLvl := 0;
797 FBlockHandler := TList.Create;
798
799 {$ifdef WinCE}
800 FParamForLogFileName := '';
801 FEnvironmentForLogFileName := '';
802 {$else}
803 FParamForLogFileName := '--debug-log=';
804 FEnvironmentForLogFileName := '*_debuglog';
805 {$endif}
806 end;
807
808 destructor TLazLoggerFile.Destroy;
809 begin
810 ClearAllBlockHandler;
811 inherited Destroy;
812 FreeAndNil(FFileHandle);
813 FreeAndNil(FBlockHandler);
814 DoneCriticalsection(FIndentCriticalSection);
815 end;
816
817 procedure TLazLoggerFile.Assign(Src: TLazLogger);
818 begin
819 inherited Assign(Src);
820 if Src is TLazLoggerFile then begin
821 FOnDbgOut := TLazLoggerFile(Src).FOnDbgOut;
822 FOnDebugLn := TLazLoggerFile(Src).FOnDebugLn;;
823
824 FEnvironmentForLogFileName := TLazLoggerFile(Src).FEnvironmentForLogFileName;
825 FParamForLogFileName := TLazLoggerFile(Src).FParamForLogFileName;
826 FGetLogFileNameDone := TLazLoggerFile(Src).FGetLogFileNameDone;
827
828 LogName := TLazLoggerFile(Src).LogName;
829 UseStdOut := TLazLoggerFile(Src).UseStdOut;
830 CloseLogFileBetweenWrites := TLazLoggerFile(Src).CloseLogFileBetweenWrites;
831 end;
832 end;
833
CurrentIndentLevelnull834 function TLazLoggerFile.CurrentIndentLevel: Integer;
835 begin
836 Result := InterlockedCompareExchange(FDebugNestLvl, -1, -1);
837 end;
838
839 procedure TLazLoggerFile.AddBlockHandler(AHandler: TLazLoggerBlockHandler);
840 begin
841 FBlockHandler.Add(AHandler);
842 AHandler.AddReference;
843 end;
844
845 procedure TLazLoggerFile.RemoveBlockHandler(AHandler: TLazLoggerBlockHandler);
846 begin
847 FBlockHandler.Remove(AHandler);
848 AHandler.ReleaseReference;
849 end;
850
TLazLoggerFile.BlockHandlerCountnull851 function TLazLoggerFile.BlockHandlerCount: Integer;
852 begin
853 Result := FBlockHandler.Count;
854 end;
855
GetLogFileNamenull856 function TLazLoggerFile.GetLogFileName: string;
857 var
858 EnvVarName: string;
859 i: Integer;
860 begin
861 Result := '';
862 FGetLogFileNameDone := True;
863 if FParamForLogFileName <> '' then begin
864 // first try to find the log file name in the command line parameters
865 i := GetParamByNameCount(FParamForLogFileName) - 1;
866 if i >= 0 then
867 Result := GetParamByName(FParamForLogFileName, i);
868 end;
869 if FEnvironmentForLogFileName <> '' then begin;
870 // if not found yet, then try to find in the environment variables
871 if (length(result)=0) then begin
872 // Substitute * with executable filename without extension
873 EnvVarName:=StringReplace(FEnvironmentForLogFileName,
874 '*',
875 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)),''),
876 [rfReplaceAll,rfIgnoreCase]);
877 Result := GetEnvironmentVariableUTF8(EnvVarName);
878 end;
879 end;
880 if (length(result)>0) then
881 Result := ExpandFileNameUTF8(Result);
882 end;
883
884
DbgStrnull885 function DbgStr(const StringWithSpecialChars: string): string;
886 begin
887 Result := LazLoggerBase.DbgStr(StringWithSpecialChars);
888 end;
889
DbgStrnull890 function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt
891 ): string;
892 begin
893 Result := LazLoggerBase.DbgStr(StringWithSpecialChars, StartPos, Len);
894 end;
895
DbgStrnull896 function DbgStr(const p: PChar; Len: PtrInt): string;
897 begin
898 Result := LazLoggerBase.DbgStr(p, Len);
899 end;
900
DbgWideStrnull901 function DbgWideStr(const StringWithSpecialChars: widestring): string;
902 begin
903 Result := LazLoggerBase.DbgWideStr(StringWithSpecialChars);
904 end;
905
906 initialization
907 LazDebugLoggerCreator := @CreateDebugLogger;
908 RecreateDebugLogger;
909 end.
910
911