File Coverage

blib/lib/Data/Util/Error.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	12	14	85.7
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	54	56	96.4

package Data::Util::Error;

use strict;
use warnings;
use Data::Util ();

sub import{
	my $class = shift;
	$class->fail_handler(scalar(caller) => @_) if @_;
}

my %FailHandler;
sub fail_handler :method{
	shift; # this class

	my $pkg = shift;
	my $h = $FailHandler{$pkg}; # old handler

	if(@_){ # set
		$FailHandler{$pkg} = Data::Util::code_ref(shift);
	}
	else{ # get
		require MRO::Compat if $] <  5.010_000;
		require mro         if $] >= 5.011_000;

		foreach my $p(@{mro::get_linear_isa($pkg)}){
			if(defined( $h = $FailHandler{$p} )){
				last;
			}
		}
	}


	return $h;
}

sub croak{
	require Carp;

	my $caller_pkg;
	my $i = 0;
	while( defined( $caller_pkg = caller $i) ){
		if($caller_pkg ne 'Data::Util'){
			last;
		}
		$i++;
	}

	my $fail_handler = __PACKAGE__->fail_handler($caller_pkg);

	local $Carp::CarpLevel = $Carp::CarpLevel + $i;
	die $fail_handler ? &{$fail_handler} : &Carp::longmess;
}
1;
__END__