File Coverage

blib/lib/Data/Object/Exception.pm
Criterion Covered Total %
statement 28 34 82.3
branch 6 12 50.0
condition 4 9 44.4
subroutine 7 9 77.7
pod 4 4 100.0
total 49 68 72.0


line stmt bran cond sub pod time code
1             # ABSTRACT: Exception Object for Perl 5
2             package Data::Object::Exception;
3              
4 1     1   24 use 5.010;
  1         2  
5              
6             use overload (
7 1         7 '""' => 'to_string',
8             '~~' => 'to_string',
9             fallback => 1,
10 1     1   5 );
  1         1  
11              
12 1     1   1017 use Data::Dumper ();
  1         5916  
  1         18  
13 1     1   6 use Scalar::Util ();
  1         2  
  1         15  
14              
15 1     1   519 use Data::Object::Class;
  1         3  
  1         8  
16              
17             our $VERSION = '0.42'; # VERSION
18              
19             has file => ( is => 'ro' );
20             has line => ( is => 'ro' );
21             has message => ( is => 'ro' );
22             has object => ( is => 'ro' );
23             has package => ( is => 'ro' );
24             has subroutine => ( is => 'ro' );
25              
26             around BUILDARGS => sub {
27             my $orig = shift;
28             my $self = shift;
29              
30             unshift @_, (ref $_[0] ? 'object' : 'message') if @_ == 1;
31              
32             return $self->$orig(@_);
33             };
34              
35             sub catch {
36 0     0 1 0 my $invocant = shift;
37 0         0 my $object = shift;
38 0 0       0 ! Scalar::Util::blessed($object)
39             && UNIVERSAL::isa($object, $invocant);
40             }
41              
42             sub dump {
43 0     0 1 0 my $invocant = shift;
44 0         0 local $Data::Dumper::Terse = 1;
45 0         0 Data::Dumper::Dumper($invocant);
46             }
47              
48             sub throw {
49 2     2 1 3 my $invocant = shift;
50 2   33     11 my $package = ref $invocant || $invocant;
51 2 50       9 unshift @_, (ref $_[0] ? 'object' : 'message') if @_ == 1;
    100          
52 2 50       52 die $package->new(ref $invocant ? (%$invocant) : (), @_,
53             file => (caller(0))[1],
54             line => (caller(0))[2],
55             package => (caller(0))[0],
56             subroutine => (caller(0))[3],
57             );
58             }
59              
60             sub to_string {
61 2     2 1 359 my $self = shift;
62 2         3 my $class = ref $self;
63 2         6 my $file = $self->file;
64 2         4 my $line = $self->line;
65 2         5 my $default = $self->message;
66 2         4 my $object = $self->object;
67              
68 2 50       5 my $objref = overload::StrVal $object if $object;
69 2   66     9 my $message = $default || "An exception ($class) was thrown";
70 2 50 33     7 my @with = join " ", "with", $objref if $objref and not $default;
71              
72 2         17 return join(" ", $message, @with, "in $file at line $line") . "\n";
73             }
74              
75             1;
76              
77             __END__