package neb::Exception; use strict; use warnings; use Exporter; our @ISA = ('Exporter'); our @EXPORT = qw(throw throw_expat); sub throw_expat { my ($msg, $expat) = @_; my $n = 0; my @context = split /\n/, $expat->position_in_context(0); throw($msg, $expat->{'neb_file_name'}, $expat->current_line - $expat->{'neb_offset'}, $expat->current_column, @context ); } sub throw { my $msg = shift; my $file = shift; my $line = shift; my $col = shift; my @context = @_; my $n = 0; print STDERR "$msg:\n"; printf( STDERR "%s:%s:%s: %n%s\n", $file, $line, $col, $n, shift @context ); $n = ' 'x$n; print STDERR "$n$_\n" foreach (@context); exit 1; }