# Error::TryCatch
#
# Copyright (c) 2005 Nilson S. F. Jr. <nilsonsfj@cpan.org>.
# All rights reserved. This program is free software;
# you can redistribute it and/or modify it under the same
# terms as perl itself.
#
# Some portions based on Error.pm from Graham Barr <gbarr@ti.com>
package Error::TryCatch;
use warnings;
use strict;
use vars qw($VERSION @EXPORT $DEFAULT_EXCEPTION $DEBUG);
use base 'Exporter';
use Filter::Simple;
use Parse::RecDescent;
use Carp;
$VERSION = 0.05;
@EXPORT = qw(throw);
$DEFAULT_EXCEPTION = 'Error::Unhandled' unless defined $DEFAULT_EXCEPTION;
my $grammar = q!
<autotree>
program: <skip: qr/[ \t]*/> statement(s)
statement: starting_bracket | except_handler(s) | non_relevant
starting_bracket: /^[\s]*[{}]/
non_relevant: <perl_quotelike> | /[^\n]*\n?/
exception_type: /[\w_]+(?:::[\w_]+)*/
except_handler: "try" /[\s]*/ <perl_codeblock> /[\s]*/
| "catch" /[\s]*/ exception_type "with" <perl_codeblock> /[\s]*/
| "otherwise" /[\s]*/ <perl_codeblock> /[\s]*/
| "finally" /[\s]*/ <perl_codeblock> /[\s]*/
!;
my $parser = new Parse::RecDescent($grammar);
FILTER {
my($type, %args) = @_;
return unless defined $_;
my $tree = $parser->program($_);
$_ = _traverse($tree);
};
sub _traverse {
my $tree = shift;
my $code;
for my $stm (@{$tree->{'statement(s)'}}) {
if (defined $stm->{'non_relevant'}) {
$code .= $stm->{'non_relevant'}->{'__VALUE__'}
if defined $stm->{'non_relevant'}->{'__VALUE__'};
}
elsif (defined $stm->{'starting_bracket'}) {
$code .= $stm->{'starting_bracket'}->{'__VALUE__'};
}
elsif (defined $stm->{'except_handler(s)'}) {
my %clauses;
for my $eh (@{$stm->{'except_handler(s)'}}) {
my $innertree = $parser->program($eh->{'__DIRECTIVE1__'});
my $innercode = _traverse($innertree);
# try to keep line count
$eh->{'__PATTERN1__'} =~ s/[^\n]//g;
$eh->{'__PATTERN2__'} =~ s/[^\n]//g;
$innercode = $eh->{'__PATTERN1__'} . $innercode . $eh->{'__PATTERN2__'};
my $clause = $eh->{'__STRING1__'};
if ($clause ne 'catch') {
$clauses{$clause} = $innercode;
}
elsif ($clause eq 'catch') {
push(@{$clauses{'catch'}}, {
exception => $eh->{'exception_type'}->{'__VALUE__'},
code => $innercode
});
}
else { die 'unexpected parse error(1)' }
}
if (defined $clauses{try}) {
my $innercode = "eval $clauses{try};";
if (defined($clauses{catch}) || defined $clauses{otherwise}) {
$innercode .= 'if ($@) {$@ = new '.$DEFAULT_EXCEPTION.'($@) unless ref($@);';
my $catch = defined $clauses{catch};
if ($catch) {
my $els = '';
for my $clause (@{$clauses{catch}}) {
$innercode .= "${els}if (\$\@->isa('$clause->{exception}')) $clause->{code}";
$els = 'els' if ($els eq '');
}
}
if (defined $clauses{otherwise}) {
$innercode .= 'else' if $catch;
$innercode .= $clauses{otherwise};
}
$innercode .= '}';
}
if (defined $clauses{finally}) {
$innercode = "eval{$innercode};$clauses{finally};if(\$\@){die \$\@}";
}
$code .= $innercode;
}
else { die "synthax error: no try clause found\n" }
}
else { die "unexpected parse error(2)\n" }
}
return $code;
}
sub throw { croak @_ }
1;
package Error::Generic;
use base 'Class::Accessor';
use Carp;
# overloadable
__PACKAGE__->mk_accessors(qw[package file line text value]);
sub stringify { $_[0]->text }
use overload (
'""' => 'stringify',
'0+' => 'value',
'bool' => sub { return 1 },
'fallback' => 1
);
sub get { $_[0]->{"-$_[1]"} }
sub set { $_[0]->{"-$_[1]"} = $_[2] }
sub new {
my $class = shift;
my ($pkg, $file, $line) = caller(1);
my %e = (
'-package' => $pkg,
'-file' => $file,
'-line' => $line,
'-value' => 0,
@_
);
if ($Error::TryCatch::DEBUG) {
warn "thrown $class\n";
for (keys %e) { warn "\t$_ => ". (defined($e{$_}) ? $e{$_} : "(undef)") ."\n" }
}
bless { %e }, $class;
}
1;
package Error::Unhandled;
use base 'Error::Generic';
sub new {
my $class = shift;
my $text = shift;
chomp $text;
my @args;
@args = ( -file => $1, -line => $2)
if($text =~ s/ at (\S+) line (\d+)([.\n]+)?$//s);
__PACKAGE__->SUPER::new(-text => $text, -value => $text, @args);
}
sub stringify { $_[0]->text . " at " . $_[0]->file . " line " . $_[0]->line . ".\n" }
1;
__END__
=head1 NAME
Error::TryCatch - OO-ish Exception Handling through source filtering
=head1 SYNOPSIS
use Error::TryCatch;
try {
dangerous_code();
even_more_dangerous_code();
throw new Error::Generic
-text => "well, no one can live in danger forever";
}
catch Error::Unhandled with {
# normal die()s are translated into Error::Unhandled exceptions
print "caught an unhandled perl exception: $@\n";
}
catch Error::NewExceptionClass with {
# code that handles Error::NewExceptionClass
}
otherwise {
# catch any other exception which might not have been caught
my $exception_class = ref($@};
print "someone has thrown a $exception_class exception: $@\n";
}
finally {
clean_up(); # which will always be executed
};
# don't forget the trailing ';' otherwise bad things *will* happen
=head1 DESCRIPTION
Error::TryCatch implements exception handling (try-catch) blocks
functionality with an interface similiar to Error.pm (in fact, it's almost
a drop-in replacement). The main difference is that it's a source filter
module.
As a source filter it can implement the same convenient interface without
those nasty memory leaks and implicit anonymous subroutines (which can trick
you, if you're not careful). Also after source parsing it converts the code
into "native" perl code, so it's probably a little faster than Error.pm's
approach.
And, well. As far as I can tell, Error::TryCatch accomplishes its duty nicely.
=head1 FUNCTIONS
The interface is pretty straight-forward. I think that reading the synopsis is
enough documentation.
If you *really* need an explanation about how exception handling blocks work,
you should take a look at Error.pm documentation. The only clause which I
chose not to implement was the 'except' clause, since I consider it rather
"exotic" and pretty much useless (at least for my purposes). And it would be
a pain to implement.
Unlike Error.pm, with Error::TryCatch you can return() from anywhere, but see
CAVEATS below.
=head1 EXCEPTION CLASSES
Error::TryCatch was built with exception classes in mind and will even wrap
anything it catches that is not a reference into a default unhandled exception
class, which defaults to Error::Unhandled (which inherits from Error::Generic).
If you want to use another exception class for any reason, you should set the
package variable $Error::TryCatch::DEFAULT_EXCEPTION to the classname. There's
a little gotcha, though: you need to do this *before* the module is loaded,
like so:
use warnings;
use strict;
BEGIN { $Error::TryCatch::DEFAULT_EXCEPTION = "Error::MyExceptionClass" }
use Error::TryCatch;
< ... code ... >
When creating unhandled exceptions, a single string argument (which is the
original die()/throw() message) will be passed to the constructor. So, you
should implement this sort of constructor.
Error::TryCatch also provides a base generic exception class (Error::Generic),
which you can inherit from or not. This class provides getter/setter methods
for the basic supported exception properties: package, file, line, text and
value. It also defines a stringify() method, which defaults to returning the
'text' property, however it should be overriden for more complex exception
classes. Besides that, Error::Generic has overloaded operators for stringifying
(which calls the stringify() method) and for numeric context (where the "value"
property is returned by default). It also returns true in boolean context.
For maximum compatibility with Error.pm, Error::Generic is compatible with
Error::Simple and should work as a drop-in replacement for it, as long as class
names aren't checked.
=head1 CAVEATS
The trailing ';' at the of the block is absolutely necessary right now. This
may change in the future but, unfortunately, right now, if you forget the
trailing ';' you'll get somewhat ugly errors.
Error.pm also needs them but, in its case, Perl always warns you about bad
synthax at compile time.
Synthax errors related to '}' (maybe '{' too) become a little harder to track,
since they end up confusing the parser's notion of "what a perl code block is".
So be sure to balance the '{' and '}' your code. Maybe in a later version I'll
come up with a better solution for this problem.
When you return from inside of an exception handling block, the "finally"
clause will not execute. I thought about work-arounds for this but all of them
seemed rather ugly, so I decided not to implement any of them.
Although throw() seems to work nicely, somehow I don't trust it and think that
it will make bad things happen somewhere. So, since it's plain syntatic sugar,
die() can be used as a replacement for it anywhere you like.
If you throw() or die() a reference which is not an object bad things may
happen. If there's any demand, I'll consider using Scalar::Util's blessed()
instead of just checking if it's a reference.
=head1 BUGS
If you have a try-catch construct inside a string it might get filtered also
(although the grammar tries to avoid id). If the try-catch construct is in a
heredoc it's almost certain it will get filtered.
There needs to be at least one line (it can be an empty one) after a exception
handling block. So if it's the last thing in your program, you better add a
newline at the end.
Besides that, none known. In fact, if the code is well-formed (no synthax
errors) I could almost guarantee that it works as expected.
If you find any other bugs, please, report them to me.
=head1 SEE ALSO
Error, Parse::RecDescent
=head1 AUTHOR
Nilson Santos F. Jr., C<< <nilsonsfj@cpan.org> >>
=head1 COPYRIGHT & LICENSE
Copyright 2005 Nilson Santos F. Jr., All Rights Reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.
=cut