libobject-insideout-perl 4.04-1 / usr / share / perl5 / Object / InsideOut / Exception.pm

package Object::InsideOut::Exception; {

use strict;
use warnings;

our $VERSION = '4.04';
$VERSION = eval $VERSION;

# Exceptions generated by this module
use Exception::Class 1.29 (
    'OIO' => {
        'description' => 'Generic Object::InsideOut exception',
        # First 3 fields must be:  'Package', 'File', 'Line'
        'fields' => ['Error', 'Chain'],
    },

    'OIO::Code' => {
        'isa' => 'OIO',
        'description' =>
            'Object::InsideOut exception that indicates a coding error',
        'fields' => ['Info', 'Code'],
    },

    'OIO::Internal' => {
        'isa' => 'OIO::Code',
        'description' =>
            'Object::InsideOut exception that indicates a internal problem',
        'fields' => ['Code', 'Declaration'],
    },

    'OIO::Attribute' => {
        'isa' => 'OIO::Code',
        'description' =>
            'Object::InsideOut exception that indicates a coding error',
        'fields' => ['Attribute'],
    },

    'OIO::Method' => {
        'isa' => 'OIO',
        'description' =>
            'Object::InsideOut exception that indicates an method calling error',
    },

    'OIO::Args' => {
        'isa' => 'OIO::Method',
        'description' =>
            'Object::InsideOut exception that indicates an argument error',
        'fields' => ['Usage', 'Arg'],
    },

    'OIO::Args::Unhandled' => {
        'isa' => 'OIO::Args',
        'description' =>
            'Object::InsideOut exception that indicates an unhandled argument',
        'fields' => ['Usage', 'Arg'],
    },

    'OIO::Runtime' => {
        'isa' => 'OIO::Code',
        'description' =>
            'Object::InsideOut exception that indicates a runtime error',
        'fields' => ['Class1', 'Class2'],
    },
);


# Turn on stack trace by default
OIO->Trace(1);


# A 'throw' method that adds location information to the exception object
sub OIO::die
{
    my $class = shift;
    my %args  = @_;

    # Report on ourself?
    my $report_self = delete($args{'self'});

    # Ignore ourselves in stack trace, unless told not to
    if (! $report_self) {
        my @ignore = ('Object::InsideOut::Exception', 'Object::InsideOut');
        if (exists($args{'ignore_package'})) {
            if (ref($args{'ignore_package'})) {
                push(@ignore, @{$args{'ignore_package'}});
            } else {
                push(@ignore, $args{'ignore_package'});
            }
        }
        $args{'ignore_package'} = \@ignore;
    }

    # Remove any location information
    my $location = delete($args{'location'});

    # Create exception object
    my $e = $class->new(%args);

    # Override location information, if applicable
    if ($location) {
        $e->{'package'} = $$location[0];
        $e->{'file'}    = $$location[1];
        $e->{'line'}    = $$location[2];
    }

    # If reporting on ourself, then correct location info
    elsif ($report_self) {
        my $frame = $e->trace->frame(1);
        $e->{'package'} = $frame->package();
        $e->{'line'}    = $frame->line();
        $e->{'file'}    = $frame->filename();
    }

    # Throw error
    no strict 'refs';
    no warnings 'once';
    if (${$class.'::WARN_ONLY'}) {
        warn $e->OIO::full_message();
    } else {
        $e->throw(%args);
    }
}


# Provides a fully formatted error message for the exception object
sub OIO::full_message
{
    my $self = shift;

    # Start with error class and message
    my $msg = ref($self) . ' error: ' . $self->message();
    chomp($msg);

    # Add fields, if any
    my @fields = $self->Fields();
    foreach my $field (@fields) {
        next if ($field eq 'Chain');
        if (exists($self->{$field})) {
            $msg .= "\n$field: " . $self->{$field};
            chomp($msg);
        }
    }

    # Add location
    $msg .= "\nPackage: " . $self->package()
          . "\nFile: "    . $self->file()
          . "\nLine: "    . $self->line();

    # Chained error messages
    if (exists($self->{'Chain'})) {
        my $chain = OIO::full_message($self->{'Chain'});
        chomp($chain);
        $chain =~ s/^/    /mg;
        $msg .= "\n\nSubsequent to the above, the following error also occurred:\n"
              . $chain;
    }

    return ($msg . "\n");
}


# Catch untrapped errors
# Usage:  local $SIG{'__DIE__'} = 'OIO::trap';
sub OIO::trap
{
    # Just rethrow if already an exception object
    if (Object::InsideOut::Util::is_it($_[0], 'Exception::Class::Base')) {
        die($_[0]);
    }

    # Package the error into an object
    OIO->die(
        'location' => [ caller() ],
        'message'  => 'Trapped uncaught error',
        'Error'    => join('', @_));
}


# Combine errors into a single error object
sub OIO::combine
{
    my ($err1, $err2) = @_;

    # Massage second error, if needed
    if ($err2 && ! ref($err2)) {
        my $e = OIO->new(
            'message'  => "$err2",
            'ignore_package' => [ 'Object::InsideOut::Exception' ]
        );

        my $frame = $e->trace->frame(1);
        $e->{'package'} = $frame->package();
        $e->{'line'}    = $frame->line();
        $e->{'file'}    = $frame->filename();

        $err2 = $e;
    }

    # Massage first error, if needed
    if ($err1) {
        if (! ref($err1)) {
            my $e = OIO->new(
                'message'  => "$err1",
                'ignore_package' => [ 'Object::InsideOut::Exception' ]
            );

            my $frame = $e->trace->frame(1);
            $e->{'package'} = $frame->package();
            $e->{'line'}    = $frame->line();
            $e->{'file'}    = $frame->filename();

            $err1 = $e;
        }

        # Combine errors, if possible
        if ($err2) {
            if (Object::InsideOut::Util::is_it($err1, 'OIO')) {
                $err1->{'Chain'} = $err2;
            } else {
                warn($err2);   # Can't combine
            }
        }

    } else {
        $err1 = $err2;
        undef($err2);
    }

    return ($err1);
}

}  # End of package's lexical scope

1;