Aspect

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	my $string = do { local $/; <FH> };

inc/Module/Install/Makefile.pm  view on Meta::CPAN

}

sub Makefile { $_[0] }

my %seen = ();

sub prompt {
	shift;

	# Infinite loop protection
	my @c = caller();
	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
	}

	# In automated testing or non-interactive session, always use defaults
	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;

lib/Aspect.pm  view on Meta::CPAN

but are also available directly in Aspect:: namespace as well if needed.

They are documented in order from the simplest and and most common pointcut
declarator to the highest level declarator for enabling complete aspect classes.

=cut

use 5.008002;
use strict;

# Added by eilara as hack around caller() core dump
# NOTE: Now we've switched to Sub::Uplevel can this be removed?
# -- ADAMK
use Carp::Heavy                 ();
use Carp                        ();
use Params::Util           1.00 ();
use Sub::Install           0.92 ();
use Sub::Uplevel         0.2002 ();
use Aspect::Pointcut            ();
use Aspect::Pointcut::Or        ();
use Aspect::Pointcut::And       ();

lib/Aspect.pm  view on Meta::CPAN

	Sub::Install::install_sub( {
		into => $_[1],
		code => $_[2],
		as   => $_[3] || $_[2],
	} );
	$EXPORTED{"$_[1]::$_[2]"} = 1;
}

sub import {
	my $class  = shift;
	my $into   = caller();
	my %flag   = ();
	my @export = ();

	# Handle import params
	while ( @_ ) {
		my $value = shift;
		if ( $value =~ /^:(\w+)$/ ) {
			$flag{$1} = 1;
		} else {
			push @export, $_;

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

package Aspect::Advice::After;

use strict;

# Added by eilara as hack around caller() core dump
# NOTE: Now we've switched to Sub::Uplevel can this be removed? --ADAMK
use Carp::Heavy    (); 
use Carp           ();
use Sub::Uplevel   ();
use Aspect::Hook   ();
use Aspect::Advice ();
use Aspect::Point  ();

our $VERSION = '1.04';
our @ISA     = 'Aspect::Advice';

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

package Aspect::Advice::Around;

use strict;

# Added by eilara as hack around caller() core dump
# NOTE: Now we've switched to Sub::Uplevel can this be removed? --ADAMK
use Carp::Heavy    (); 
use Carp           ();
use Sub::Uplevel   ();
use Aspect::Hook   ();
use Aspect::Advice ();
use Aspect::Point  ();

our $VERSION = '1.04';
our @ISA     = 'Aspect::Advice';

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

package Aspect::Advice::Before;

use strict;

# Added by eilara as hack around caller() core dump
# NOTE: Now we've switched to Sub::Uplevel can this be removed? --ADAMK
use Carp::Heavy    (); 
use Carp           ();
use Aspect::Hook   ();
use Aspect::Advice ();
use Aspect::Point  ();

our $VERSION = '1.04';
our @ISA     = 'Aspect::Advice';

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

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.

lib/Aspect/Library/Listenable.pm  view on Meta::CPAN

use Scalar::Util                       ();
use Sub::Install                       ();
use Aspect::Modular                    ();
use Aspect::Advice::Before             ();
use Aspect::Library::Listenable::Event ();

our $VERSION = '1.04';
our @ISA     = 'Aspect::Modular';

sub import {
	my $into = caller();

	Sub::Install::install_sub( {
		code => $_,
		into => $into,
	} ) foreach qw{
		add_listener
		remove_listener
	};

	return 1;

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

sub caller_info {
	my $level = shift;

	package DB;

	my %call_info;
	@call_info{ qw(
		calling_package
		sub_name
		has_params
	) } = (CORE::caller($level))[0, 3, 4];

	return defined $call_info{calling_package}
		? {
			%call_info,
			args => [
				$call_info{has_params} ? @DB::args : ()
			],
		} : 0;
}

t/22_advice_around.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/23_advice_before.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/24_advice_after.t  view on Meta::CPAN

	}

	sub dfoo {
		My::Three->dbar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}

	sub dbar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		die 'value';
	}
}





######################################################################

t/31_feature_caller.t  view on Meta::CPAN

	}

	sub three {
		Bar1->bar;
	}

	package Bar1;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/31_feature_caller.t  view on Meta::CPAN

	}

	sub three {
		Bar2->bar;
	}

	package Bar2;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/31_feature_caller.t  view on Meta::CPAN

	}

	sub three {
		Bar3->bar;
	}

	package Bar3;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}

t/33_feature_topic.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/34_point_functions.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/60_legacy_after_returning.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}
}





######################################################################

t/61_legacy_after_throwing.t  view on Meta::CPAN

	package My::Two;

	sub foo {
		My::Three->bar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		die 'value';
	}
}





######################################################################