view release on metacpan or  search on metacpan

lib/Aspect/Advice/Before.pm  view on Meta::CPAN

				type      => 'before',
				pointcut  => \$pointcut,
				original  => \$original,
				sub_name  => \$name,
				wantarray => \$wantarray,
				args      => \\\@_,
				exception => \$\@, ### Not used (yet)
			}, 'Aspect::Point';

			local \$_ = \$Aspect::POINT;
			goto &\$original unless $MATCH_RUN;

			# Run the advice code
			&\$code(\$_);

			# Shortcut if they set a return value
			if ( exists \$_->{return_value} ) {
				return \@{\$_->{return_value}} if \$wantarray;
				return \$_->{return_value};
			}

			# Proceed to the original function
			\@_ = \$_->args; ### Superfluous?
			goto &\$original;
		};
END_PERL
		$self->{installed}++;
	}

	# If this will run lexical we don't need a descoping hook
	return unless $lexical;

	# Return the lexical descoping hook.
	# This MUST be stored and run at DESTROY-time by the
	# parent object calling _install. This is less bullet-proof
	# than the DESTROY-time self-executing blessed coderef
	return sub { $out_of_scope = 1 };
}

# Check for pointcut usage not supported by the advice type
sub _validate {
	my $self     = shift;
	my $pointcut = $self->pointcut;

	# The method used by the Highest pointcut is incompatible
	# with the goto optimisation used by the before() advice.
	if ( $pointcut->match_contains('Aspect::Pointcut::Highest') ) {
		return 'The pointcut highest is not currently supported by before advice';
	}

	# Pointcuts using "throwing" are irrelevant in before advice
	if ( $pointcut->match_contains('Aspect::Pointcut::Throwing') ) {
		return 'The pointcut throwing is illegal when used by before advice';
	}

	# Pointcuts using "throwing" are irrelevant in before advice
	if ( $pointcut->match_contains('Aspect::Pointcut::Returning') ) {
		return 'The pointcut returning is illegal when used by before advice';
	}

	$self->SUPER::_validate(@_);
}

1;

__END__

=pod

=head1 NAME

Aspect::Advice::Before - Execute code before a function is called

=head1 SYNOPSIS

  use Aspect;
  
  before {
  
      # Trace all calls to your module
      print STDERR "Called my function " . $_->sub_name . "\n";
  
      # Shortcut calls to foo() to always be true
      if ( $_->short_name eq 'foo' ) {
          return $_->return_value(1);
      }
  
      # Add an extra flag to bar() but call as normal
      if ( $_->short_name eq 'bar' ) {
          $_->args( $_->args, 'flag' );
      }

  } call qr/^ MyModule::\w+ $/

=head1 DESCRIPTION

The C<before> advice type is used to execute advice code prior to entry
into a target function. It is implemented by B<Aspect::Advice::Before>.

As well as creating side effects that run before the main code, the
C<before> advice type is particularly useful for changing parameters or
shortcutting calls to functions entirely and replacing the value they
would normally return with a different value.

Please note that the C<highest> pointcut (L<Aspect::Pointcut::Highest>) is
incompatible with C<before>. Creating a C<before> advice with a pointcut
tree that contains a C<highest> pointcut will result in an exception.

If speed is important to your program then C<before> is particular
interesting as the C<before> implementation is the only one that can take
advantage of tail calls via Perl's C<goto> function, where the rest of the
advice types need the more costly L<Sub::Uplevel> to keep caller() returning
correctly.

=head1 AUTHORS

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2010 - 2013 Adam Kennedy.