File Coverage

blib/lib/PPI/Exception.pm
Criterion Covered Total %
statement 17 22 77.2
branch 4 10 40.0
condition 1 4 25.0
subroutine 5 6 83.3
pod 4 4 100.0
total 31 46 67.3


line stmt bran cond sub pod time code
1             package PPI::Exception;
2              
3             =head1 NAME
4              
5             PPI::Exception - The PPI exception base class
6              
7             =head1 SYNOPSIS
8              
9             use PPI::Exception;
10            
11             my $e = PPI::Exception->new( 'something happened' );
12             $e->throw;
13              
14             PPI::Exception->new( message => 'something happened' )->throw;
15             PPI::Exception->throw( message => 'something happened' );
16              
17             =head1 DESCRIPTION
18              
19             All exceptions thrown from within PPI will be instances or derivations
20             of this class.
21              
22             =cut
23              
24 65     65   369 use strict;
  65         126  
  65         1779  
25 65     65   302 use Params::Util qw{_INSTANCE};
  65         109  
  65         16395  
26              
27             our $VERSION = '1.276';
28              
29              
30             =head1 METHODS
31              
32             =head2 new $message | message => $message, ...
33              
34             Constructs and returns a new C object.
35              
36             A message for the exception can be passed, either as a string
37             or as C<< message => $message >>. The message is available via the
38             C method.
39              
40             =cut
41              
42             sub new {
43 3     3 1 13 my $class = shift;
44 3 50       18 return bless { @_ }, $class if @_ > 1;
45 0 0       0 return bless { message => $_[0] }, $class if @_;
46 0         0 return bless { message => 'Unknown Exception' }, $class;
47             }
48              
49              
50             =head2 throw
51              
52             If called on a C object, throws the object.
53             If called on the class name, uses the arguments to construct a
54             C and then throw it.
55              
56             Each time the object is thrown, information from the Perl
57             call is saved and made available via the C method.
58              
59             This method never returns.
60              
61             =cut
62              
63             sub throw {
64 4     4 1 9 my $it = shift;
65 4 100       12 if ( _INSTANCE($it, 'PPI::Exception') ) {
66 1 50       4 if ( $it->{callers} ) {
67 1         1 push @{ $it->{callers} }, [ caller(0) ];
  1         6  
68             } else {
69 0   0     0 $it->{callers} ||= [];
70             }
71             } else {
72 3   50     7 my $message = $_[0] || 'Unknown Exception';
73 3         23 $it = $it->new(
74             message => $message,
75             callers => [
76             [ caller(0) ],
77             ],
78             );
79             }
80 4         29 die $it;
81             }
82              
83              
84             =head2 message
85              
86             Returns the exception message passed to the object's constructor,
87             or a default message.
88              
89             =cut
90              
91             sub message {
92 4     4 1 29 $_[0]->{message};
93             }
94              
95              
96             =head2 callers
97              
98             Returns a listref, each element of which is a listref of C
99             information. The returned listref can be empty.
100              
101             =cut
102              
103             sub callers {
104 0 0   0 1   @{ $_[0]->{callers} || [] };
  0            
105             }
106              
107              
108             1;