view release on metacpan or  search on metacpan

lib/Aion/Carp.pm  view on Meta::CPAN

package Aion::Carp;
use 5.008001;
use common::sense;

our $VERSION = "1.6";

use Carp qw//;
use Scalar::Util qw//;

sub handler {
    my ($x) = @_;

    if(!ref $x) {
        no utf8; use bytes;
        if($x =~ s/\n[ \t]+\.\.\.propagated at .* line \d+\.\n\z/\n/) {}
        else {
            $x =~ s/ at .*? line \d+\.\n\z//;
            my $c = Carp::longmess('');
            $c =~ s/^( at .*? line \d+)\.\n/$x\n\tdie(...) called$1\n/;
            $x = $c;
        }
    }
    elsif(Scalar::Util::reftype($x) eq "HASH" && !exists $x->{STACKTRACE}) {
        my $c = Carp::longmess("die(...) called");
        $c =~ s/^(.*\d+)\.\n/$1\n/;
        $x->{STACKTRACE} = $c;
    }

    die $x;
}

sub import {
    $SIG{__DIE__} = \&handler;
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Carp - adds stack trace to exceptions

=head1 VERSION

1.6

=head1 SYNOPSIS

	use Aion::Carp;
	
	sub A { die "hi!" }
	sub B { A() }
	sub C { eval { B() }; die if $@ }
	sub D { C() }
	
	eval { D() };
	
	my $expected = "hi!
	    die(...) called at t/aion/carp.t line 15
	    main::A() called at t/aion/carp.t line 16
	    main::B() called at t/aion/carp.t line 17
	    eval {...} called at t/aion/carp.t line 17
	    main::C() called at t/aion/carp.t line 18
	    main::D() called at t/aion/carp.t line 20
	    eval {...} called at t/aion/carp.t line 20
	";
	$expected =~ s/^ {4}/\t/gm;
	
	substr($@, 0, length $expected) # => $expected