The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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__

=head1 NAME

Data::Util::Error - Deals with class-specific error handlers in Data::Util

=head1 SYNOPSIS

	package Foo;
	use Data::Util::Error sub{ Foo::InvalidArgument->throw_error(@_) };
	use Data::Util qw(:validate);

	sub f{
		my $x_ref = array_ref shift; # Foo::InvalidArgument is thrown if invalid
		# ...
	}

=head1 Functions

=over 4

=item Data::Util::Error->fail_handler()

=item Data::Util::Error->fail_handler($handler)

=item Data::Util::Error::croak(@args)

=back

=head1 SEE ALSO

L<Data::Util>.

=cut