The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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<Aspect::Pointcut::Throwing> 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 E<lt>adamk@cpan.orgE<gt>

Marcel GrE<uuml>nauer E<lt>marcel@cpan.orgE<gt>

Ran Eilam E<lt>eilara@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2001 by Marcel GrE<uuml>nauer

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