Aspect::Pointcut::Throwing - Exception typing pointcut

  use Aspect;

  # Catch a Foo::Exception object exception
  after {
      $_->return_value(1)
  } throwing 'Foo::Exception';

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.01';
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__