initial commit moved from svn
This commit is contained in:
fatalerrors
358
udebug.pas
Normal file
358
udebug.pas
Normal file
@@ -0,0 +1,358 @@
|
||||
{
|
||||
********************************************************************************
|
||||
|
||||
YaPeTaVi - Yet another Periodic Table Viewer
|
||||
Copyright (C) 2000-2012 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
||||
All rights reserved.
|
||||
http://www.geoffray-levasseur.org/
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it under
|
||||
the terms of the GNU General Public License as published by the Free Software
|
||||
Foundation; either version 3 of the License, or (at your option) any later
|
||||
version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along with
|
||||
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
|
||||
********************************************************************************
|
||||
|
||||
Description:
|
||||
Console debuging facilities
|
||||
|
||||
}
|
||||
unit uDebug;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
type
|
||||
TVerboseLevel = (vlFull, vlHigh, vlLow, vlNone);
|
||||
|
||||
var
|
||||
DebugLevel: Integer;
|
||||
VerboseLevel: TVerboseLevel;
|
||||
LogError: Boolean;
|
||||
sLogFileName: string;
|
||||
FLogFile: Text;
|
||||
|
||||
// init logging facilities
|
||||
function InitDbg(const FileName: string): Boolean;
|
||||
|
||||
// close logging file
|
||||
procedure TerminateDbg;
|
||||
|
||||
// print and log messages
|
||||
procedure PrintDbg(Mes: string; Verbosity: TVerboseLevel);
|
||||
procedure PrintDbg(Mes: string);
|
||||
procedure PrintLnDbg(Mes: string; Verbosity: TVerboseLevel);
|
||||
procedure PrintLnDbg(Mes: TStringList; Verbosity: TVerboseLevel);
|
||||
procedure PrintLnDbg(Verbosity: TVerboseLevel);
|
||||
procedure PrintLnDbg(Mes: string);
|
||||
procedure PrintDbgStat(Stat: Boolean; Verbosity: TVerboseLevel);
|
||||
procedure PrintDbgResult(Res: Boolean; Verbosity: TVerboseLevel);
|
||||
procedure PrintDbgResult(Res: string; Verbosity: TVerboseLevel);
|
||||
|
||||
// put full informations about heap inside a string
|
||||
function GetHeapStatus(aHS: THeapStatus): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Crt, SysUtils;
|
||||
|
||||
const
|
||||
dbgStatOk = '-';
|
||||
dbgStatWarn = '!';
|
||||
dbgOk = 'Ok';
|
||||
dbgFail = 'Fail';
|
||||
sTimeJump = ' '; //number of space = time length with braces
|
||||
|
||||
resourcestring
|
||||
rsErrorBase = '*** ERROR: ';
|
||||
rsWarningBase = '! WARNING: ';
|
||||
rsInfoBase = 'Info: ';
|
||||
rsDebugBase = '[Debug]: ';
|
||||
|
||||
rsErrorLogrotate = 'E logrotate failed on file %s';
|
||||
rsErrorButLogrotate = 'E logrotate worked but the log file %s still exists';
|
||||
rsErrorCreatingLogfile = 'E could not create log file %s';
|
||||
rsErrorWritingLogFile = 'E unable to write in logfile %s';
|
||||
rsWarningNoLogfile = 'W no log file will be created, ' +
|
||||
'logging on stdout (console) only';
|
||||
rsInfoLoggingStarted = 'Logging started: %s';
|
||||
rsInfoLoggingTerminated = 'Closing log file %s: application terminated';
|
||||
|
||||
procedure LoggingError(Msg: string);
|
||||
begin
|
||||
LogError := True;
|
||||
PrintLnDbg(Msg, vlLow);
|
||||
PrintLnDbg(rsWarningNoLogfile, vlLow);
|
||||
end;
|
||||
|
||||
//create logfile and rotate old ones (10 max)
|
||||
function InitDbg(const FileName: string): Boolean;
|
||||
var
|
||||
Count: Byte;
|
||||
I: Integer;
|
||||
F: File;
|
||||
Orig, Dest: string;
|
||||
begin
|
||||
{$I-}
|
||||
//init some vars
|
||||
Count := 1;
|
||||
Result := True;
|
||||
//first step: do the logrotate (10 logfile max fixed)
|
||||
if FileExists(Trim(FileName)) then
|
||||
while FileExists(Trim(FileName) + '.' + IntToStr(Count)) do
|
||||
Inc(Count)
|
||||
else
|
||||
Count := 0;
|
||||
if Count > 0 then
|
||||
for I := Count downto 1 do
|
||||
begin
|
||||
Assign(F, Trim(FileName) + '.' + IntToStr(I - 1));
|
||||
if I = 1 then
|
||||
Orig := Trim(FileName)
|
||||
else
|
||||
Orig := Trim(FileName) + '.' + IntToStr(I - 1);
|
||||
Dest := Trim(FileName) + '.' + IntToStr(I);
|
||||
if I >= 10 then
|
||||
if not FileIsReadOnly(Orig) then
|
||||
Erase(F)
|
||||
else
|
||||
begin
|
||||
LoggingError(Format(rsErrorLogrotate, [Trim(FileName)]));
|
||||
Result := False;
|
||||
Exit;
|
||||
end
|
||||
else
|
||||
if (not FileIsReadOnly(Orig)) and (not FileExists(Dest)) then
|
||||
RenameFile(Orig, Dest)
|
||||
else
|
||||
begin
|
||||
LoggingError(Format(rsErrorLogrotate, [Trim(FileName)]));
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
{$I+}
|
||||
//second step: check if file can be safely created and create it
|
||||
if FileExists(Trim(FileName)) then
|
||||
begin
|
||||
LoggingError(Format(rsErrorButLogrotate, [Trim(FileName)]));
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
Assign(FLogFile, Trim(FileName));
|
||||
{$I-}
|
||||
Rewrite(FLogFile);
|
||||
{$I+}
|
||||
if IOResult <> 0 then
|
||||
begin
|
||||
LoggingError(Format(rsErrorCreatingLogfile, [Trim(FileName)]));
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
//third step: write header and assign vars
|
||||
LogError := False;
|
||||
sLogFileName := Trim(FileName);
|
||||
PrintLnDbg(Format(rsInfoLoggingStarted, [sLogFileName]), vlLow);
|
||||
end;
|
||||
|
||||
procedure TerminateDbg;
|
||||
begin
|
||||
PrintLnDbg(Format(rsInfoLoggingTerminated, [sLogFileName]), vlLow);
|
||||
if (not LogError) and (Trim(sLogFileName) <> '') then
|
||||
CloseFile(FLogFile);
|
||||
end;
|
||||
|
||||
function VerbosityToInt(V: TVerboseLevel): integer;
|
||||
begin
|
||||
Result := 4; //default is all the messages to be shown
|
||||
case V of
|
||||
vlFull: Result := 4;
|
||||
vlHigh: Result := 2;
|
||||
vlLow: Result := 1;
|
||||
vlNone: Result := 0; //nothing is displayed
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PrintDbg(Mes: string; Verbosity: TVerboseLevel);
|
||||
var
|
||||
I: integer;
|
||||
Err: Boolean;
|
||||
C: Char;
|
||||
LineBegining: Boolean;
|
||||
begin
|
||||
//showing debugging message only if Debug is defined
|
||||
{$IFNDEF Debug}
|
||||
if LineBegining and (Length(Mes) > 2) and (Mes[2] = ' ') and
|
||||
(Mes[1] = 'D') then
|
||||
Exit;
|
||||
{$ENDIF}
|
||||
//if it's not meant to be displayed get out of here
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
//init error state
|
||||
{$I-}
|
||||
Err := False;
|
||||
//display time only if we are on a new line
|
||||
try
|
||||
LineBegining := WhereX <= 1;
|
||||
if LineBegining or ((Length(Mes) > Length(sTimeJump)) and
|
||||
(Copy(Mes, 1, Length(sTimeJump)) = sTimeJump)) then
|
||||
begin
|
||||
Write('[' + TimeToStr(Time) + '] ');
|
||||
if (not LogError) and (Trim(sLogFileName) <> '') then
|
||||
begin
|
||||
Write(FLogFile, '[' + TimeToStr(Time) + '] ');
|
||||
Err := (IOResult <> 0) or Err;
|
||||
end;
|
||||
//this is used in case where indentation is needed in log
|
||||
if DebugLevel > 0 then
|
||||
for I := 0 to DebugLevel do
|
||||
begin
|
||||
Write(' '); //this is 3 spaces
|
||||
if (not LogError) and (Trim(sLogFileName) <> '') then
|
||||
begin
|
||||
Write(FLogFile, ' '); //this is 3 spaces
|
||||
Err := (IOResult <> 0) or Err;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// we use the first char to know if it's error warning or info
|
||||
if LineBegining and (Length(Mes) > 2) and (Mes[2] = ' ') and
|
||||
(Mes[1] in ['E', 'W', 'i', 'D']) then
|
||||
begin
|
||||
C := Mes[1];
|
||||
Mes := Copy(Mes, 3, Length(Mes) - 2);
|
||||
case C of
|
||||
'E': Mes := rsErrorBase + Mes;
|
||||
'W': Mes := rsWarningBase + Mes;
|
||||
'i': Mes := rsInfoBase + Mes;
|
||||
'D': Mes := rsDebugBase + Mes;
|
||||
end;
|
||||
end;
|
||||
//write the message
|
||||
Write(Mes);
|
||||
if (not LogError) and (Trim(sLogFileName) <> '') then
|
||||
begin
|
||||
Write(FLogFile, Mes);
|
||||
Err := (IOResult <> 0) or Err;
|
||||
end;
|
||||
except
|
||||
Err := True;
|
||||
end;
|
||||
{$I+}
|
||||
//force truely writing the file
|
||||
if not LogError then
|
||||
Flush(FLogFile);
|
||||
//if error occurs somewhere, trigger an error
|
||||
if Err then
|
||||
LoggingError(Format(rsErrorWritingLogFile, [sLogFileName]));
|
||||
end;
|
||||
|
||||
procedure PrintDbg(Mes: string);
|
||||
begin
|
||||
PrintDbg(Mes, vlFull);
|
||||
end;
|
||||
|
||||
procedure PrintLnDbg(Mes: TStringList; Verbosity: TVerboseLevel);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
for I := 0 to Mes.Count - 1 do
|
||||
if I = 0 then
|
||||
PrintLnDbg(Mes[I], Verbosity)
|
||||
else
|
||||
PrintDbg(sTimeJump + Mes[I] + sLineBreak, Verbosity);
|
||||
end;
|
||||
|
||||
procedure PrintLnDbg(Mes: string);
|
||||
begin
|
||||
PrintLnDbg(Mes, vlFull);
|
||||
end;
|
||||
|
||||
procedure PrintLnDbg(Mes: string; Verbosity: TVerboseLevel);
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
PrintDbg(Mes + sLineBreak, Verbosity);
|
||||
end;
|
||||
|
||||
procedure PrintLnDbg(Verbosity: TVerboseLevel);
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
Writeln;
|
||||
if (not LogError) and (Trim(sLogFileName) <> '') then
|
||||
Writeln(FLogFile);
|
||||
end;
|
||||
|
||||
procedure PrintDbgStat(Stat: Boolean; Verbosity: TVerboseLevel);
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
if Stat then
|
||||
PrintDbg(dbgStatOk, Verbosity)
|
||||
else
|
||||
PrintDbg(dbgStatWarn, Verbosity);
|
||||
end;
|
||||
|
||||
procedure PrintDbgResult(Res: Boolean; Verbosity: TVerboseLevel);
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
if Res then
|
||||
PrintLnDbg(dbgOk, Verbosity)
|
||||
else
|
||||
PrintLnDbg(dbgFail, Verbosity);
|
||||
end;
|
||||
|
||||
procedure PrintDbgResult(Res: string; Verbosity: TVerboseLevel);
|
||||
begin
|
||||
if VerbosityToInt(Verbosity) > VerbosityToInt(VerboseLevel) then
|
||||
Exit;
|
||||
PrintLnDbg(Res, Verbosity);
|
||||
end;
|
||||
|
||||
function GetHeapStatus(aHS: THeapStatus): string;
|
||||
begin
|
||||
Result := Format(
|
||||
'Heap Status: ' + LineEnding + LineEnding +
|
||||
'Addr Space: ' + #9 + ' %d ' + LineEnding +
|
||||
'Uncommitted: ' + #9 + ' %d ' + LineEnding +
|
||||
'Committed: ' + #9 + ' %d ' + LineEnding +
|
||||
'Allocated: ' + #9 + ' %d ' + LineEnding +
|
||||
'Free: ' + #9 + ' %d ' + LineEnding +
|
||||
'Free Small: ' + #9 + ' %d ' + LineEnding +
|
||||
'Free Big: ' + #9 + ' %d ' + LineEnding +
|
||||
'Unused: ' + #9 + ' %d ' + LineEnding +
|
||||
'Overhead: ' + #9 + ' %d ' + LineEnding +
|
||||
'Heap Errorcode:' + #9 + ' %d ',
|
||||
[aHS.TotalAddrSpace, aHS.TotalUncommitted, aHS.TotalCommitted,
|
||||
aHS.TotalAllocated, aHS.TotalFree, aHS.FreeSmall, aHS.FreeBig,
|
||||
aHS.Unused, aHS.Overhead, aHS.HeapErrorCode]);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$IFDEF Debug}
|
||||
VerboseLevel := vlFull;
|
||||
{$ELSE}
|
||||
VerboseLevel := vlLow;
|
||||
{$ENDIF}
|
||||
DebugLevel := 0;
|
||||
LogError := True; //means that we can't write in the log file as it's not opened
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user