Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
DBIC	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Dispatcher	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Minimal	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
messages	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
Die.pm	3.92 KB	-rw-rw-rw-	2021-01-15 17:36
Die.pod	2.56 KB	-rw-rw-rw-	2021-01-15 17:36
Dispatcher.pm	9.32 KB	-rw-rw-rw-	2021-01-15 17:36
Dispatcher.pod	13.06 KB	-rw-rw-rw-	2021-01-15 17:36
Domain.pm	4.68 KB	-rw-rw-rw-	2021-01-15 17:36
Domain.pod	9.34 KB	-rw-rw-rw-	2021-01-15 17:36
Exception.pm	2.2 KB	-rw-rw-rw-	2021-01-15 17:36
Exception.pod	3.8 KB	-rw-rw-rw-	2021-01-15 17:36
Message.pm	4.73 KB	-rw-rw-rw-	2021-01-15 17:36
Message.pod	16.72 KB	-rw-rw-rw-	2021-01-15 17:36
Minimal.pm	5.83 KB	-rw-rw-rw-	2021-01-15 11:07
Minimal.pod	2.38 KB	-rw-rw-rw-	2021-01-15 11:07
Optional.pm	1.01 KB	-rw-rw-rw-	2021-01-15 11:07
Optional.pod	1.48 KB	-rw-rw-rw-	2021-01-15 11:07
Translator.pm	930 B	-rw-rw-rw-	2021-01-15 17:36
Translator.pod	1.99 KB	-rw-rw-rw-	2021-01-15 17:36
Util.pm	6.13 KB	-rw-rw-rw-	2021-01-15 11:07
Util.pod	4 KB	-rw-rw-rw-	2021-01-15 11:07

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::Exception;
use vars '$VERSION';
$VERSION = '1.31';

use warnings;
use strict;

use Log::Report      'log-report';
use Log::Report::Util qw/is_fatal to_html/;
use POSIX             qw/locale_h/;
use Scalar::Util      qw/blessed/;

use overload
    '""'     => 'toString'
  , 'bool'   => sub {1}    # avoid accidental serialization of message
  , fallback => 1;

sub new($@)
{   my ($class, %args) = @_;
    $args{report_opts} ||= {};
    bless \%args, $class;
}

#----------------

sub report_opts() {shift->{report_opts}}

sub reason(;$)
{   my $self = shift;
    @_ ? $self->{reason} = uc(shift) : $self->{reason};
}

sub isFatal() { is_fatal shift->{reason} }

sub message(;$)
{   my $self = shift;
    @_ or return $self->{message};

my $msg  = shift;
    blessed $msg && $msg->isa('Log::Report::Message')
        or panic "message() of exception expects Log::Report::Message";
    $self->{message} = $msg;
}

#----------------

sub inClass($) { $_[0]->message->inClass($_[1]) }

sub throw(@)
{   my $self    = shift;
    my $opts    = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts};

my $reason;
    if($reason = delete $opts->{reason})
    {   $self->{reason} = $reason;
        $opts->{is_fatal} = is_fatal $reason
            unless exists $opts->{is_fatal};
    }
    else
    {   $reason = $self->{reason};
    }

$opts->{stack} ||= Log::Report::Dispatcher->collectStack;
    report $opts, $reason, $self;
}

# where the throw is handled is not interesting
sub PROPAGATE($$) {shift}

sub toString(;$)
{   my ($self, $locale) = @_;
    my $msg  = $self->message;
    lc($self->{reason}).': '.(ref $msg ? $msg->toString($locale) : $msg)."\n";
}

sub toHTML(;$) { to_html($_[0]->toString($_[1])) }

sub print(;$)
{   my $self = shift;
    (shift || *STDERR)->print($self->toString);
}