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