libparse-debcontrol-perl 2.005-4 / usr / share / perl5 / Parse / DebControl / Error.pm

use strict;
use warnings;

package Parse::DebControl::Error;
=pod

=encoding utf-8

=head1 NAME
Parse::DebControl::Error - Exception classes for Parse::DebControl

=head1 SYNOPSIS

    use Parse::DebControl::Error;

    throw Parse::DebControl::Error();

    throw Parse::DebControl::Error::Parse( "reason for exception" );
    throw Parse::DebControl::Error::Parse( "reason for exception", $line_number_of_data );
    throw Parse::DebControl::Error::Parse( "reason for exception", $line_number_of_data, $context_line );

    throw Parse::DebControl::Error::IO( "information regarding the error" );

=head1 COPYRIGHT

Parse::DebControl is copyright 2003,2004 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>.

Parse::DebControl::Error is copyright 2009 Carl Fürstenberg E<lt>azatoth@gmail.comE<gt>.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
use base 'Error';
our $VERSION = '0.1';
sub new
{
    my $self = shift;
    local $Error::Depth = $Error::Depth + 1;

    $self->SUPER::new(@_);
}

package Parse::DebControl::Error::Parse;

use base 'Parse::DebControl::Error';
our $VERSION = '0.1';

sub new
{
    my $self = shift;
    my $text = "".shift;
    my @args = ();

    my $line = shift;
    my $context = shift;

    push(@args, '-context', $context) if defined($context);
    push(@args, '-line', $line) if defined($line);

    local $Error::Depth = $Error::Depth + 1;

    $self->SUPER::new(-text => $text, @args);
}

sub stringify {
    my $self = shift;
    my $text;
    if( $self->context ) {
        $text = sprintf("Parse error: %s at line %d of data (\"%s\").\n",  $self->SUPER::stringify, $self->line, $self->context);
    } elsif( $self->line ) {
        $text = sprintf("Parse error: %s at line %d of data.\n",  $self->SUPER::stringify, $self->line);
    } else {
        $text = sprintf("Parse error: %s.\n", $self->SUPER::stringify);
    }
    $text;
}

sub context {
    my $self = shift;
    exists $self->{'-context'} ? $self->{'-context'} : undef;
}

package Parse::DebControl::Error::IO;

use base 'Parse::DebControl::Error';
our $VERSION = '0.1';
sub new
{
    my $self = shift;
    my $text = "".shift;
    my @args = ();

    local $Error::Depth = $Error::Depth + 1;

    $self->SUPER::new(-text => $text, @args);
}

sub stringify {
    my $self = shift;
    my $text;
    $text = sprintf("IO error: %s.\n", $self->SUPER::stringify );
    $text;
}

1;