/usr/share/perl5/Log/Report/Dispatcher/Try.pm is in liblog-report-perl 1.18-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | # Copyrights 2007-2016 by [Mark Overmeer].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
use warnings;
use strict;
package Log::Report::Dispatcher::Try;
use vars '$VERSION';
$VERSION = '1.18';
use base 'Log::Report::Dispatcher';
use Log::Report 'log-report', syntax => 'SHORT';
use Log::Report::Exception ();
use Log::Report::Util qw/%reason_code/;
use overload
bool => 'failed'
, '""' => 'showStatus'
, fallback => 1;
#-----------------
sub init($)
{ my ($self, $args) = @_;
defined $self->SUPER::init($args) or return;
$self->{exceptions} = delete $args->{exceptions} || [];
$self->{died} = delete $args->{died};
$self->hide($args->{hide} // 'NONE');
$self->{on_die} = $args->{on_die} // 'ERROR';
$self;
}
sub close()
{ my $self = shift;
$self->SUPER::close or return;
$self;
}
#-----------------
sub died(;$)
{ my $self = shift;
@_ ? ($self->{died} = shift) : $self->{died};
}
sub exceptions() { @{shift->{exceptions}} }
sub hides($)
{ my $h = shift->{hides} or return 0;
keys %$h ? $h->{(shift)} : 1;
}
sub hide(@)
{ my $self = shift;
my @h = map { ref $_ eq 'ARRAY' ? @$_ : defined($_) ? $_ : () } @_;
$self->{hides}
= @h==0 ? undef
: @h==1 && $h[0] eq 'ALL' ? {} # empty HASH = ALL
: @h==1 && $h[0] eq 'NONE' ? undef
: +{ map +($_ => 1), @h };
}
sub die2reason() { shift->{on_die} }
#-----------------
sub log($$$$)
{ my ($self, $opts, $reason, $message, $domain) = @_;
unless($opts->{stack})
{ my $mode = $self->mode;
$opts->{stack} = $self->collectStack
if $reason eq 'PANIC'
|| ($mode==2 && $reason_code{$reason} >= $reason_code{ALERT})
|| ($mode==3 && $reason_code{$reason} >= $reason_code{ERROR});
}
$opts->{location} ||= '';
my $e = Log::Report::Exception->new
( reason => $reason
, report_opts => $opts
, message => $message
);
push @{$self->{exceptions}}, $e;
$self->{died} ||=
exists $opts->{is_fatal} ? $opts->{is_fatal} : $e->isFatal;
$self;
}
sub reportFatal(@) { $_->throw(@_) for shift->wasFatal }
sub reportAll(@) { $_->throw(@_) for shift->exceptions }
#-----------------
sub failed() { shift->{died}}
sub success() { ! shift->{died}}
sub wasFatal(@)
{ my ($self, %args) = @_;
$self->{died} or return ();
my $ex = $self->{exceptions}[-1];
(!$args{class} || $ex->inClass($args{class})) ? $ex : ();
}
sub showStatus()
{ my $self = shift;
my $fatal = $self->wasFatal or return '';
__x"try-block stopped with {reason}: {text}"
, reason => $fatal->reason
, text => $self->died;
}
1;
|