1package Data::Util::Error;
2
3use strict;
4use warnings;
5use Data::Util ();
6
7sub import{
8	my $class = shift;
9	$class->fail_handler(scalar(caller) => @_) if @_;
10}
11
12my %FailHandler;
13sub fail_handler :method{
14	shift; # this class
15
16	my $pkg = shift;
17	my $h = $FailHandler{$pkg}; # old handler
18
19	if(@_){ # set
20		$FailHandler{$pkg} = Data::Util::code_ref(shift);
21	}
22	else{ # get
23		require MRO::Compat if $] <  5.010_000;
24		require mro         if $] >= 5.011_000;
25
26		foreach my $p(@{mro::get_linear_isa($pkg)}){
27			if(defined( $h = $FailHandler{$p} )){
28				last;
29			}
30		}
31	}
32
33
34	return $h;
35}
36
37sub croak{
38	require Carp;
39
40	my $caller_pkg;
41	my $i = 0;
42	while( defined( $caller_pkg = caller $i) ){
43		if($caller_pkg ne 'Data::Util'){
44			last;
45		}
46		$i++;
47	}
48
49	my $fail_handler = __PACKAGE__->fail_handler($caller_pkg);
50
51	local $Carp::CarpLevel = $Carp::CarpLevel + $i;
52	die $fail_handler ? &{$fail_handler} : &Carp::longmess;
53}
541;
55__END__
56
57=head1 NAME
58
59Data::Util::Error - Deals with class-specific error handlers in Data::Util
60
61=head1 SYNOPSIS
62
63	package Foo;
64	use Data::Util::Error sub{ Foo::InvalidArgument->throw_error(@_) };
65	use Data::Util qw(:validate);
66
67	sub f{
68		my $x_ref = array_ref shift; # Foo::InvalidArgument is thrown if invalid
69		# ...
70	}
71
72=head1 Functions
73
74=over 4
75
76=item Data::Util::Error->fail_handler()
77
78=item Data::Util::Error->fail_handler($handler)
79
80=item Data::Util::Error::croak(@args)
81
82=back
83
84=head1 SEE ALSO
85
86L<Data::Util>.
87
88=cut
89