X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDebug.pm;h=691c410122c99615e5043f0059ec0934c8349d81;hb=124e0718367cbdfff9985d07bfb0587a85c83d76;hp=634bf97211bda5e8d70cb48621e69059342dffda;hpb=ea783c61e83adb1b7f4ca0314b3ddf4171896bf1;p=spider.git diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 634bf972..691c4101 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); @@ -96,7 +96,8 @@ 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); @@ -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; }