Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
Callback.pm	912 B	-rw-rw-rw-
Callback.pod	4.74 KB	-rw-rw-rw-
File.pm	3.93 KB	-rw-rw-rw-
File.pod	7.21 KB	-rw-rw-rw-
Log4perl.pm	2.73 KB	-rw-rw-rw-
Log4perl.pod	6.94 KB	-rw-rw-rw-
LogDispatch.pm	2.13 KB	-rw-rw-rw-
LogDispatch.pod	5.8 KB	-rw-rw-rw-
Perl.pm	786 B	-rw-rw-rw-
Perl.pod	1.45 KB	-rw-rw-rw-
Syslog.pm	3.28 KB	-rw-rw-rw-
Syslog.pod	6.78 KB	-rw-rw-rw-
Try.pm	3.06 KB	-rw-rw-rw-
Try.pod	9.17 KB	-rw-rw-rw-

Code Editor : Try.pm

# Copyrights 2007-2019 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.29';

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/;
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($)
{   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()  {   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;
}

${this.title}

Code Editor : Try.pm