File Coverage

blib/lib/Aspect/Pointcut/And.pm

Criterion	Covered	Total	%
statement	95	111	85.5
branch	42	58	72.4
condition			n/a
subroutine	11	12	91.6
pod	6	7	85.7
total	154	188	81.9

package Aspect::Pointcut::And;

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

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





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

sub new {
	my $class = shift;
	my @parts = @_;

	# Validate the pointcut subexpressions
	foreach my $part ( @parts ) {
		next if Params::Util::_INSTANCE($part, 'Aspect::Pointcut');
		Carp::croak("Attempted to apply pointcut logic to non-pointcut '$part'");
	}

	# Collapse nested and statements at constructor time so we don't have
	# to do so multiple times later on during currying.
	while ( scalar grep { $_->isa('Aspect::Pointcut::And') } @parts ) {
		@parts = map {
			$_->isa('Aspect::Pointcut::And') ? @$_ : $_
		} @parts;
	}

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





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

sub compile_weave {
	my $self = shift;

	# Handle special cases
	my @children = grep {
		ref $_ or $_ ne 1
	} map {
		$_->compile_weave
	} @$self;
	unless ( @children ) {
		# Potential bug, but why would we legitimately be empty
		return 1;
	}
	if ( @children == 1 ) {
		return $children[0];
	}

	# Collapse string conditions together,
	# and further collapse code conditions together.
	my @string = ();
	my @code   = ();
	foreach my $child ( @children ) {
		unless ( ref $child ) {
			push @string, $child;
			next;
		}
		if ( @string ) {
			my $group = join ' and ', map { "( $_ )" } @string;
			push @code, eval "sub () { $group }";
			@string = ();
		}
		push @code, $child;
	}

	if ( @string ) {
		my $group = join ' and ', map { "( $_ )" } @string;
		unless ( @code ) {
			# This is the only thing we have
			return $group;
		}
		push @code, eval "sub () { $group }";
	}

	# Join the groups
	return sub {
		foreach my $child ( @code ) {
			return 0 unless $child->();
		}
		return 1;
	};
}

sub compile_runtime {
	my $self = shift;

	# Handle special cases
	my @children = grep {
		ref $_ or $_ ne 1
	} map {
		$_->compile_runtime
	} @$self;
	unless ( @children ) {
		# Potential bug, but why would we legitimately be empty
		return 1;
	}
	if ( @children == 1 ) {
		return $children[0];
	}

	# Collapse string conditions together,
	# and further collapse code conditions together.
	my @string = ();
	my @code   = ();
	foreach my $child ( @children ) {
		unless ( ref $child ) {
			push @string, $child;
			next;
		}
		if ( @string ) {
			my $group = join ' and ', map { "( $_ )" } @string;
			push @code, eval "sub () { $group }";
			@string = ();
		}
		push @code, $child;
	}

	if ( @string ) {
		my $group = join ' and ', map { "( $_ )" } @string;
		unless ( @code ) {
			# This is the only thing we have
			return $group;
		}
		push @code, eval "sub () { $group }";
	}

	# Join the groups
	return sub {
		foreach my $child ( @code ) {
			return 0 unless $child->();
		}
		return 1;
	};
}

sub match_contains {
	my $self  = shift;
	my $type  = shift;
	my $count = $self->isa($type) ? 1 : 0;
	foreach my $child ( @$self ) {
		$count += $child->match_contains($type);
	}
	return $count;
}

sub match_runtime {
	my $self = shift;
	foreach my $child ( @$self ) {
		return 1 if $child->match_runtime;
	}
	return 0;
}

sub curry_weave {
	my $self = shift;
	my @list = @$self;

	# Curry down our children. Anything that is not relevant at weave
	# time is considered to always match, but curries to null.
	# In an AND scenario, any "always" match can be savely removed.
	@list = grep { defined $_ } map { $_->curry_weave } @list;

	# If none are left, curry us away to nothing
	return unless @list;

	# If only one remains, curry us away to just that child
	return $list[0] if @list == 1;

	# Create our clone to hold the curried subset
	return ref($self)->new( @list );
}

sub curry_runtime {
	my $self = shift;
	my @list = @$self;

	# Should we strip out the call pointcuts
	my $strip = shift;
	unless ( defined $strip ) {
		# Are there any elements that MUST exist at run-time?
		if ( $self->match_runtime ) {
			# If we have any nested logic that themselves contain
			# call pointcuts, we can't strip.
			$strip = not scalar grep {
				$_->isa('Aspect::Pointcut::Logic')
				and
				$_->match_contains('Aspect::Pointcut::Call')
			} @list;
		} else {
			# Nothing at runtime, so we can strip
			$strip = 1;
		}
	}

	# Curry down our children
	@list = grep { defined $_ } map {
		$_->isa('Aspect::Pointcut::Call')
		? $strip
			? $_->curry_runtime($strip)
			: $_
		: $_->curry_runtime($strip)
	} @list;

	# If none are left, curry us away to nothing
	return unless @list;

	# If only one remains, curry us away to just that child
	return $list[0] if @list == 1;

	# Create our clone to hold the curried subset
	return ref($self)->new( @list );
}

1;

__END__