X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDebug.pm;h=4b8d4f250575ed198ec5357db1ba7b88c2dd3a8e;hb=b326a39e5cf429a4c8fe52026f937f7b011cbca2;hp=f7598c151bb4db5a420ac654a4fea40b659ab47c;hpb=febdc9bd8f6cd065d217ba089fab4361e9980f35;p=spider.git diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index f7598c15..4b8d4f25 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -11,7 +11,7 @@ package DXDebug; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbgstore dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); +@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); use strict; use vars qw(%dbglevel $fp); @@ -29,16 +29,18 @@ if (!defined $DB::VERSION) { local $^W=0; eval qq( sub confess { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgstore(\$@, Carp::shortmess(\@_)); + DXDebug::dbg(\$@); + DXDebug::dbg(Carp::shortmess(\@_)); exit(-1); } sub croak { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgstore(\$@, Carp::longmess(\@_)); + DXDebug::dbg(\$@); + DXDebug::dbg(Carp::longmess(\@_)); exit(-1); } - sub carp { DXDebug::dbgstore(Carp::shortmess(\@_)); } - sub cluck { DXDebug::dbgstore(Carp::longmess(\@_)); } + sub carp { DXDebug::dbg(Carp::shortmess(\@_)); } + sub cluck { DXDebug::dbg(Carp::longmess(\@_)); } ); CORE::die(Carp::shortmess($@)) if $@; @@ -51,8 +53,9 @@ if (!defined $DB::VERSION) { } -sub dbgstore +sub dbg($) { + return unless $fp; my $t = time; for (@_) { my $r = $_; @@ -70,8 +73,18 @@ sub dbginit { # add sig{__DIE__} handling if (!defined $DB::VERSION) { - $SIG{__WARN__} = sub { dbgstore($@, Carp::shortmess(@_)); }; - $SIG{__DIE__} = sub { dbgstore($@, Carp::longmess(@_)); }; + $SIG{__WARN__} = sub { + if ($_[0] =~ /Deep\s+recursion/i) { + dbg($@); + dbg(Carp::longmess(@_)); + CORE::die; + } else { + dbg($@); + dbg(Carp::shortmess(@_)); + } + }; + + $SIG{__DIE__} = sub { dbg($@); dbg(Carp::longmess(@_)); }; } $fp = DXLog::new('debug', 'dat', 'd'); @@ -84,14 +97,6 @@ sub dbgclose undef $fp; } -sub dbg -{ - my $l = shift; - if ($fp && ($dbglevel{$l} || $l eq 'err')) { - dbgstore(@_); - } -} - sub dbgdump { my $l = shift; @@ -104,7 +109,7 @@ sub dbgdump $c =~ s/[\x00-\x1f\x7f-\xff]/./g; my $left = 16 - length $c; $h .= ' ' x (2 * $left) if $left > 0; - dbgstore($m . sprintf("%4d:", $o) . "$h $c"); + dbg($m . sprintf("%4d:", $o) . "$h $c"); $m = ' ' x (length $m); } } @@ -134,10 +139,10 @@ sub dbglist return keys (%dbglevel); } -sub isdbg +sub isdbg($) { - my $s = shift; - return $dbglevel{$s}; + return unless $fp; + return $dbglevel{$_[0]}; } sub shortmess