1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
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
|
