File Coverage

blib/lib/Games/Go/AGA/Parse/Exceptions.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch	6	6	100.0
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	31	31	100.0

#
#===============================================================================
#
#         FILE:  Games::Go::AGA::Parse::Exceptions.pm
#
#  DESCRIPTION:  Exception classes for AGA parsers
#
#      PODNAME:  Games::Go::AGA::Parse::Exceptions
#     ABSTRACT:  Exceptions classes for AGA Parsers
#
#       AUTHOR:  Reid Augustin (REID),
#      COMPANY:  LucidPort Technology, Inc.
#      CREATED:  01/18/2011 01:45:36 PM
#===============================================================================

use strict;
use warnings;

package Games::Go::AGA::Parse::Exceptions;

use Exception::Class (
    'Games::Go::AGA::Parse::Exception' => {
        description => 'base class for AGA parser exceptions',
        fields      => ['filename',         # if we know the filename
                        'handle',           # if we have the file handle
                        'line_number',      # if we know the line_number in the file
                        'source',           # source string that caused error
                        ],
      # alias       => 'parse_exception',   # Sadly, aliasing doesn't seem to work unless
                                            #   Exception::Class is 'use'd in the same
                                            #   module.  Makes it fairly worthless.
    },
);

our $VERSION = '0.042'; # VERSION

# Games::Go::AGA::Parse->Trace(1);     # provide stack trace

sub Games::Go::AGA::Parse::Exception::full_message {
    my ($self) = @_;

    my $msg         = $self->error;
    my $fname       = $self->filename;
    my $handle      = $self->handle;
    my $line_number = $self->line_number;
    my $source      = $self->source;

    $msg .= " while parsing:\n$source\n" if ($source);
    eval {
        $line_number = $handle->input_line_number;
    };
    $msg .= " at line $line_number"      if ($line_number);
    $msg .= " in $fname"                 if ($fname);
    return $msg;
}

1;

__END__