package Aspect::Pointcut::Throwing; use strict; use warnings; use Carp (); use Params::Util (); use Aspect::Pointcut (); use Aspect::Pointcut::Not (); use Aspect::Pointcut::Returning (); our $VERSION = '1.02'; our @ISA = 'Aspect::Pointcut'; ###################################################################### # Constructor sub new { my $class = shift; my $spec = shift; # Handle the any exception case unless ( defined $spec ) { return bless [ $spec, '$Aspect::POINT->{exception}', ], $class; } # Handle a specific die message if ( Params::Util::_STRING($spec) ) { return bless [ $spec, "Params::Util::_INSTANCE(\$Aspect::POINT->{exception}, '$spec')", ], $class; } # Handle a specific exception class if ( Params::Util::_REGEX($spec) ) { my $regex = "/$spec/"; $regex =~ s|^/\(\?([xism]*)-[xism]*:(.*)\)/\z|/$2/$1|s; return bless [ $spec, "defined \$Aspect::POINT->{exception} and not ref \$Aspect::POINT->{exception} and \$Aspect::POINT->{exception} =~ $regex", ], $class; } Carp::croak("Invalid throwing pointcut specification"); } ###################################################################### # Weaving Methods # Exception pointcuts always match at weave time and should curry away sub curry_weave { return; } # Throwing pointcuts do not curry. # (But maybe they should, when used with say a before {} block) sub curry_runtime { return $_[0]; } sub compile_runtime { $_[0]->[1]; } ###################################################################### # Optional XS Acceleration BEGIN { local $@; eval <<'END_PERL'; use Class::XSAccessor::Array 1.08 { replace => 1, getters => { 'compile_runtime' => 1, }, }; END_PERL } 1; __END__ =pod =head1 NAME Aspect::Pointcut::Throwing - Exception typing pointcut use Aspect; # Catch a Foo::Exception object exception after { $_->return_value(1) } throwing 'Foo::Exception'; =head1 DESCRIPTION The B pointcut is used to match situations in which an after() advice block wishes to intercept the throwing of a specific exception string or object. =head1 AUTHORS Adam Kennedy Eadamk@cpan.orgE Marcel GrEnauer Emarcel@cpan.orgE Ran Eilam Eeilara@cpan.orgE =head1 COPYRIGHT Copyright 2001 by Marcel GrEnauer Some parts copyright 2009 - 2012 Adam Kennedy. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut