view release on metacpan or  search on metacpan

lib/Aspect/Pointcut/Not.pm  view on Meta::CPAN

package Aspect::Pointcut::Not;

use strict;
use Aspect::Pointcut::Logic ();

our $VERSION = '1.04';
our @ISA     = 'Aspect::Pointcut::Logic';





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

sub new {
	my $class = shift;

	# Check the thing we are negating
	unless ( Params::Util::_INSTANCE($_[0], 'Aspect::Pointcut') ) {
		Carp::croak("Attempted to apply pointcut logic to non-pointcut '$_[0]'");
	}

	$class->SUPER::new(@_);
}





######################################################################
# Weaving Methods

sub compile_weave {
	my $child = $_[0]->[0]->compile_weave;
	if ( ref $child ) {
		return sub { not $child->() };
	}
	unless ( $child eq '1' ) {
		return "not ( $child )";
	}

	# When the child matches everything, the negation doesn't negate
	# the set of things matched. So we match everything too.
	return 1;
}

sub compile_runtime {
	my $child = $_[0]->[0]->compile_runtime;
	if ( ref $child ) {
		return sub { not $child->() };
	} else {
		return "not ( $child )";
	}
}

sub match_contains {
	my $self  = shift;
	my $count = $self->[0]->match_contains($_[0]);
	return $self->isa($_[0]) ? ++$count : $count;
}

sub match_runtime {
	$_[0]->[0]->match_runtime;
}

# Logical not inherits it's curryability from the element contained
# within it. We continue to be needed if and only if something below us
# continues to be needed as well.
sub curry_weave {
	my $self = shift;
	my $child = $self->[0]->curry_weave or return;

	# Handle the special case where the collapsing pointcut results
	# in a "double not". Fetch the child of our child not and return
	# it directly.
	if ( $child->isa('Aspect::Pointcut::Not') ) {
		return $child->[0];
	}

	# Return our clone with the curried child
	my $class = ref($self);
	return $class->new( $child );
}