line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2007-2017 by [Mark Overmeer]. |
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.02. |
5
|
15
|
|
|
15
|
|
91
|
use warnings; |
|
15
|
|
|
|
|
30
|
|
|
15
|
|
|
|
|
437
|
|
6
|
15
|
|
|
15
|
|
71
|
use strict; |
|
15
|
|
|
|
|
24
|
|
|
15
|
|
|
|
|
431
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Log::Report::Exception; |
9
|
15
|
|
|
15
|
|
83
|
use vars '$VERSION'; |
|
15
|
|
|
|
|
26
|
|
|
15
|
|
|
|
|
636
|
|
10
|
|
|
|
|
|
|
$VERSION = '1.23'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
15
|
|
|
15
|
|
78
|
use Log::Report 'log-report'; |
|
15
|
|
|
|
|
26
|
|
|
15
|
|
|
|
|
73
|
|
14
|
15
|
|
|
15
|
|
86
|
use Log::Report::Util qw/is_fatal to_html/; |
|
15
|
|
|
|
|
26
|
|
|
15
|
|
|
|
|
654
|
|
15
|
15
|
|
|
15
|
|
74
|
use POSIX qw/locale_h/; |
|
15
|
|
|
|
|
25
|
|
|
15
|
|
|
|
|
95
|
|
16
|
15
|
|
|
15
|
|
1815
|
use Scalar::Util qw/blessed/; |
|
15
|
|
|
|
|
27
|
|
|
15
|
|
|
|
|
991
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use overload |
20
|
|
|
|
|
|
|
'""' => 'toString' |
21
|
15
|
|
|
15
|
|
44
|
, 'bool' => sub {1} # avoid accidental serialization of message |
22
|
15
|
|
|
15
|
|
94
|
, fallback => 1; |
|
15
|
|
|
|
|
25
|
|
|
15
|
|
|
|
|
98
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new($@) |
26
|
19
|
|
|
19
|
1
|
82
|
{ my ($class, %args) = @_; |
27
|
19
|
|
50
|
|
|
49
|
$args{report_opts} ||= {}; |
28
|
19
|
|
|
|
|
148
|
bless \%args, $class; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#---------------- |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
0
|
1
|
0
|
sub report_opts() {shift->{report_opts}} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub reason(;$) |
37
|
7
|
|
|
7
|
1
|
1807
|
{ my $self = shift; |
38
|
7
|
50
|
|
|
|
38
|
@_ ? $self->{reason} = uc(shift) : $self->{reason}; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
6
|
|
|
6
|
1
|
32
|
sub isFatal() { is_fatal shift->{reason} } |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub message(;$) |
46
|
15
|
|
|
15
|
1
|
1336
|
{ my $self = shift; |
47
|
15
|
50
|
|
|
|
100
|
@_ or return $self->{message}; |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
0
|
my $msg = shift; |
50
|
0
|
0
|
0
|
|
|
0
|
blessed $msg && $msg->isa('Log::Report::Message') |
51
|
|
|
|
|
|
|
or panic "message() of exception expects Log::Report::Message"; |
52
|
0
|
|
|
|
|
0
|
$self->{message} = $msg; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
#---------------- |
56
|
|
|
|
|
|
|
|
57
|
2
|
|
|
2
|
1
|
6
|
sub inClass($) { $_[0]->message->inClass($_[1]) } |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub throw(@) |
61
|
3
|
|
|
3
|
1
|
14
|
{ my $self = shift; |
62
|
3
|
100
|
|
|
|
10
|
my $opts = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts}; |
|
1
|
|
|
|
|
9
|
|
63
|
|
|
|
|
|
|
|
64
|
3
|
|
|
|
|
14
|
my $reason; |
65
|
3
|
100
|
|
|
|
12
|
if($reason = delete $opts->{reason}) |
66
|
1
|
|
|
|
|
4
|
{ $self->{reason} = $reason; |
67
|
|
|
|
|
|
|
$opts->{is_fatal} = is_fatal $reason |
68
|
1
|
50
|
|
|
|
8
|
unless exists $opts->{is_fatal}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
else |
71
|
2
|
|
|
|
|
4
|
{ $reason = $self->{reason}; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
3
|
|
33
|
|
|
19
|
$opts->{stack} ||= Log::Report::Dispatcher->collectStack; |
75
|
3
|
|
|
|
|
13
|
report $opts, $reason, $self; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# where the throw is handled is not interesting |
79
|
7
|
|
|
7
|
0
|
47
|
sub PROPAGATE($$) {shift} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub toString(;$) |
83
|
4
|
|
|
4
|
1
|
1905
|
{ my ($self, $locale) = @_; |
84
|
4
|
|
|
|
|
15
|
my $msg = $self->message; |
85
|
4
|
50
|
|
|
|
60
|
lc($self->{reason}).': '.(ref $msg ? $msg->toString($locale) : $msg)."\n"; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
0
|
|
|
0
|
1
|
|
sub toHTML(;$) { to_html($_[0]->toString($_[1])) } |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub print(;$) |
93
|
0
|
|
|
0
|
1
|
|
{ my $self = shift; |
94
|
0
|
|
0
|
|
|
|
(shift || *STDERR)->print($self->toString); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |