View file File name : Error.pm Content :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;