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