Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Callback.pm	912 B	-rw-rw-rw-	2021-01-15 17:36
Callback.pod	4.73 KB	-rw-rw-rw-	2021-01-15 17:36
File.pm	4.24 KB	-rw-rw-rw-	2021-01-15 17:36
File.pod	7.2 KB	-rw-rw-rw-	2021-01-15 17:36
Log4perl.pm	2.73 KB	-rw-rw-rw-	2021-01-15 17:36
Log4perl.pod	6.94 KB	-rw-rw-rw-	2021-01-15 17:36
LogDispatch.pm	2.13 KB	-rw-rw-rw-	2021-01-15 17:36
LogDispatch.pod	5.8 KB	-rw-rw-rw-	2021-01-15 17:36
Perl.pm	786 B	-rw-rw-rw-	2021-01-15 17:36
Perl.pod	1.45 KB	-rw-rw-rw-	2021-01-15 17:36
Syslog.pm	3.28 KB	-rw-rw-rw-	2021-01-15 17:36
Syslog.pod	6.78 KB	-rw-rw-rw-	2021-01-15 17:36
Try.pm	2.89 KB	-rw-rw-rw-	2021-01-15 17:36
Try.pod	9.68 KB	-rw-rw-rw-	2021-01-15 17:36

Rename

# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report. Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Log::Report::Dispatcher::Try;
use vars '$VERSION';
$VERSION = '1.31';

use base 'Log::Report::Dispatcher';

use warnings;
use strict;

use Log::Report 'log-report', syntax => 'SHORT';
use Log::Report::Exception ();
use Log::Report::Util      qw/%reason_code expand_reasons/;
use List::Util             qw/first/;

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 died(;$)
{   my $self = shift;
    @_ ? ($self->{died} = shift) : $self->{died};
}

sub exceptions() { @{shift->{exceptions}} }

sub hides($) { $_[0]->{LRDT_hides}{$_[1]} }

sub hide(@)
{   my $self = shift;
    my @reasons = expand_reasons(@_ > 1 ? \@_ : shift);
    $self->{LRDT_hides} = +{ map +($_ => 1), @reasons };
}

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()  {   defined shift->{died}}
sub success() { ! defined shift->{died}}

sub wasFatal(@)
{   my ($self, %args) = @_;
    defined $self->{died} or return ();

# An (hidden) eval between LR::try()s may add more messages
    my $ex = first { $_->isFatal } @{$self->{exceptions}}
        or return ();

(!$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;
}