File Coverage

blib/lib/Marpa/R3/X.pm

Criterion	Covered	Total	%
statement	46	72	63.8
branch	3	18	16.6
condition	3	13	23.0
subroutine	14	17	82.3
pod			n/a
total	66	120	55.0

# Marpa::R3 is Copyright (C) 2018, Jeffrey Kegler.
#
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl 5.10.1. For more details, see the full text
# of the licenses in the directory LICENSES.
#
# This program is distributed in the hope that it will be
# useful, but it is provided "as is" and without any express
# or implied warranties. For details, see the full text of
# of the licenses in the directory LICENSES.

# Marpa::R3 exceptions and their methods

# Adapted from CPAN's Exception::Class module

package Marpa::R3::X;

use 5.010001;
use warnings;
use strict;
use English qw( -no_match_vars );

use vars qw($VERSION $STRING_VERSION);
$VERSION        = '4.001_053';
$STRING_VERSION = $VERSION;
## no critic(BuiltinFunctions::ProhibitStringyEval)
$VERSION = eval $VERSION;
## use critic

package Marpa::R3::Internal::X;

use warnings;
use strict;
use English qw( -no_match_vars );
use Scalar::Util qw( blessed );

use overload

    # an exception is always true
    bool => sub {1}, '""' => 'as_string', fallback => 1;

# Create accessor routines

sub throw {
    my $proto = shift;
    $proto->rethrow if ref $proto;
    die $proto->new(@_);
}

sub rethrow {
    my $self = shift;
    die $self;
}

sub new {
    my ($class, $args)  = @_;
    $args //= { error => $_[0] };
    return bless $args, $class;
}

sub description {
    return 'Generic exception';
}

sub as_string {
    my $self      = shift;
    my $string    = q{};
    my $to_string = $self->{to_string};
    if ( $to_string and ref $to_string eq 'CODE' ) {
        $string = &{$to_string}($self);
    }
    else {
      FIELD: for my $field ( sort keys %{$self} ) {
            if ( $field eq 'try' ) {
                my $try_to_string = $self->{try};
                if ( ref $try_to_string ne 'CODE' ) {
                    $string .= qq{$field: [!not a CODE object!]\n};
                }
                $string .= &{$try_to_string}($self);
                next FIELD;
            }
            next FIELD if $field =~ /\A (slg|slr|tracer|msg|fatal) \z/;
            my $value = $self->{$field};
            if ( not defined $value ) {
                $string .= "$field: [not defined]\n";
                next FIELD;
            }
            my $ref_type = ref $value;
            if ($ref_type) {
                $string .= "$field: ref to $ref_type\n";
                next FIELD;
            }
            $string .= "$field: $value\n";
        }
    }
    my $fatal = $self->{fatal} // 1;
    if ($fatal) {
        $string =
            qq{========= Marpa::R3 Fatal error =========\n}
          . $string
          . qq{=========================================\n};
    }
    return $string;
}

sub caught {
    my $class = shift;
    my $e = $@;
    return unless defined $e && blessed($e) && $e->isa($class);
    return $e;
}

1;