X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDebug.pm;h=b0b723ce00f161b0464a7929507eb853ca6da513;hb=28b69e599fe9672c5ec52332d8dd5649b22c6317;hp=634bf97211bda5e8d70cb48621e69059342dffda;hpb=ea783c61e83adb1b7f4ca0314b3ddf4171896bf1;p=spider.git diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 634bf972..b0b723ce 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -26,7 +26,7 @@ package DXDebug; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); +@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck carp); use strict; use vars qw(%dbglevel $fp $callback $cleandays $keepdays $dbgringlth); @@ -52,14 +52,14 @@ if (!defined $DB::VERSION) { local $^W=0; eval qq( sub confess { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgprintring() if DXDebug('nologchan'); + DXDebug::dbgprintring() if DXDebug::isdbg('nologchan'); DXDebug::dbg(\$@); DXDebug::dbg(Carp::shortmess(\@_)); exit(-1); } sub croak { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgprintring() if DXDebug('nologchan'); + DXDebug::dbgprintring() if DXDebug::isdbg('nologchan'); DXDebug::dbg(\$@); DXDebug::dbg(Carp::longmess(\@_)); exit(-1); @@ -87,7 +87,7 @@ my $_isdbg; # current dbg level we are processing sub dbg($) { - return unless $fp; +# return unless $fp; my $t = time; for (@_) { my $r = $_; @@ -96,13 +96,14 @@ sub dbg($) for (@l) { s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; print "$_\n" if defined \*STDOUT && !$no_stdout; - my $str = "$t^$_"; + my $tag = $_isdbg ? "($_isdbg) " : ''; + my $str = "$t^$tag$_"; &$callback($str) if $callback; if ($dbgringlth) { shift @dbgring while (@dbgring > $dbgringlth); push @dbgring, $str; } - $fp->writeunix($t, $str) unless $dbglevel{"nolog$_isdbg"}; + $fp->writeunix($t, $str) unless !$fp || $dbglevel{"nolog$_isdbg"} ; } } $_isdbg = ''; @@ -217,16 +218,18 @@ sub longmess sub dbgprintring { return unless $fp; - my $count = shift || $dbgringlth+1; + my $count = shift; my $first; my $l; - for ( ; $count > 0 && ($l = shift @dbgring); --$count) { - my ($t, $str) = split /\^/, $l, 2; + my $i = defined $count ? @dbgring-$count : 0; + $count = @dbgring; + for ( ; $i < $count; ++$i) { + my ($t, $str) = split /\^/, $dbgring[$i], 2; next unless $t; my $lt = time; unless ($first) { $fp->writeunix($lt, "$lt^###"); - $fp->writeunix($lt, "$lt^### RINGBUFFER START"); + $fp->writeunix($lt, "$lt^### RINGBUFFER START at line $i (zero base)"); $fp->writeunix($lt, "$lt^###"); $first = $t; }