package SIGS; # We're going to use Carp so we can get longmess use Carp; use if (scalar grep {m{Carp}} (keys %INC)), "Carp::Heavy"; # Now redefine Carp::format_arg so we can dump refs too! no warnings qw(once redefine); *Carp::format_arg = sub { package Carp; my $arg=shift; if (not defined $arg) { $arg='undef'; } elsif (ref $arg) { # we'll use Data::Dumper require Data::Dumper; #no warnings qw(once); local $Data::Dumper::Indent=0; local $Data::Dumper::Terse=0; #use warnings; $arg=Data::Dumper::Dumper($arg); $arg=~ s/^\$VAR\d+\s*=\s*//; $arg=~ s/;\s*$//; } else { $arg=~ s/'/\\'/g; #no warnings qw(once); $arg=str_len_trim($arg,$Carp::Heavy::MaxArgLen); #use warnings; $arg="'$arg'" unless $arg =~ /^-?[\d.]+\z/; } $arg=~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg; return $arg; } if (scalar grep {m{^Carp}} (keys %INC)); use warnings; use strict; use warnings; # Someplace to put messages our (@Messages); INIT { ### program INIT ... close(STDERR); open(STDERR,'>','nul') or die ""; $SIG{__WARN__}= sub { return unless (defined($main::DEBUG) and $main::DEBUG); # Carp's longmess includes the at ... line ... so remove it from $_[-1] my @a=@_; $a[-1]=~ s/ at .+? line \d+.$//s; # Save message and traceback push(@Messages,@a,Carp::longmess()); # and warn --- output goes to nul warn @_; }; $SIG{__DIE__}= sub { # Carp's longmess includes the at ... line ... so remove it from $_[-1] my @a=@_; $a[-1]=~ s/ at .+? line \d+.$//s; # Save message and traceback push(@Messages,@a,Carp::longmess()); # and die --- output goes to nul and dies die @_; }; } # INIT; END { ### program END ... close(STDERR); if ($?) { # email @Messages from here print "Emailing these messages:\n"; print @Messages; }; } # END; 0 == 0;