X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXDebug.pm;h=2cbdc2956e937b2e64fce2bf12354f271a37cdab;hb=95a03441d20680a914673d1b6bbf46c0d673ad4c;hp=7640a2a1cd5d594607d77932a370379d23902128;hpb=d339a58bd419901bf4294aaa138c000a8c2ae139;p=spider.git diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 7640a2a1..2cbdc295 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -11,14 +11,14 @@ package DXDebug; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbgstore dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck cluck); +@EXPORT = qw(dbginit dbgstore dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); use strict; use vars qw(%dbglevel $fp); use DXUtil; use DXLog (); -use Carp qw(cluck); +use Carp (); %dbglevel = (); $fp = undef; @@ -43,8 +43,10 @@ if (!defined $DB::VERSION) { CORE::die(Carp::shortmess($@)) if $@; } else { - eval qq( sub confess { Carp::confess(\@_); }; - sub cluck { Carp::cluck(\@_); }; + eval qq( sub confess { die Carp::longmess(\@_); }; + sub croak { die Carp::shortmess(\@_); }; + sub cluck { warn Carp::longmess(\@_); }; + sub carp { warn Carp::shortmess(\@_); }; ); } @@ -57,7 +59,7 @@ sub dbgstore chomp $r; my @l = split /\n/, $r; for (@l) { - s/([\x00\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; + s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; print "$_\n" if defined \*STDOUT; $fp->writeunix($t, "$t^$_"); } @@ -68,7 +70,15 @@ sub dbginit { # add sig{__DIE__} handling if (!defined $DB::VERSION) { - $SIG{__WARN__} = sub { dbgstore($@, Carp::shortmess(@_)); }; + $SIG{__WARN__} = sub { + if ($_[0] =~ /Deep\s+recursion/i) { + dbgstore($@, Carp::longmess(@_)); + CORE::die; + } else { + dbgstore($@, Carp::shortmess(@_)); + } + }; + $SIG{__DIE__} = sub { dbgstore($@, Carp::longmess(@_)); }; }