File Coverage

blib/lib/Aspect/Pointcut/Throwing.pm

Criterion	Covered	Total	%
statement	32	39	82.0
branch	1	6	16.6
condition			n/a
subroutine	12	12	100.0
pod	3	3	100.0
total	48	60	80.0

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 = '0.97_06';
our @ISA     = 'Aspect::Pointcut';





######################################################################
# Constructor

sub new {
	my $class = shift;
	my $spec  = shift;

	# Handle the any exception case
	unless ( defined $spec ) {
		return bless [
			$spec,
			"\$_->{exception}",
		], $class;
	}

	# Handle a specific die message
	if ( Params::Util::_STRING($spec) ) {
		return bless [
			$spec,
			"Params::Util::_INSTANCE(\$_->{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 \$_->{exception} and not ref \$_->{exception} and \$_->{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__