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 fr
+om $_[-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 fr
+om $_[-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;
[download]

use strict;
use warnings;

    sub A {
        ((1 x shift) !~  m{^(11+)\1+$}) or die "argument is not prime"
+;
        A(@_);
         };
    warn "\$DEBUG testing!";
    A(1,2,3,4,5);
    exit;
[download]

Emailing these messages:
argument is not prime
 at SIGS.pl line 16
        main::A(4, 5) called at SIGS.pl line 17
        main::A(3, 4, 5) called at SIGS.pl line 17
        main::A(2, 3, 4, 5) called at SIGS.pl line 17
        main::A(1, 2, 3, 4, 5) called at SIGS.pl line 20
[download]