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