Attribute-Lexical

 view release on metacpan or  search on metacpan

lib/Attribute/Lexical.pm  view on Meta::CPAN

=head1 NAME

Attribute::Lexical - sane scoping of function/variable attributes

=head1 SYNOPSIS

    use Attribute::Lexical "CODE:Funky" => \&funky_attr_handler;
    sub thingy :Funky { ... }

    $handler = Attribute::Lexical->handler_for_caller([caller(0)],
		"CODE:Funky");

=head1 DESCRIPTION

This module manages attributes that can be attached to subroutine and
variable declarations.  Although it can be used directly, it is mainly
intended to be infrastructure for modules that supply particular attribute
semantics.

Meanings are assigned to attributes by code which is usually supplied

lib/Attribute/Lexical.pm  view on Meta::CPAN

use constant _KLUDGE_FAKE_MRO           => "$]" < 5.009005;
use constant _KLUDGE_UNIVERSAL_INVOCANT => 1;   # bug#68654 or bug#81098

use Carp qw(croak);
use Params::Classify 0.000 qw(is_string is_ref);
use if !_KLUDGE_FAKE_MRO, "mro";

our $VERSION = "0.005";

# Hints stored in %^H only maintain referenceful structure during the
# compilation phase.  Copies of %^H that are accessible via caller(),
# which we need in order to support runtime use of the lexical state,
# flatten all values to plain strings.  So %interned_handler permanently
# holds references to all handler functions seen, keyed by the string
# form of the reference.
my %interned_handler;

{
	package Attribute::Lexical::UNIVERSAL;
	our $VERSION = "0.005";
}

lib/Attribute/Lexical.pm  view on Meta::CPAN

foreach my $type (qw(SCALAR ARRAY HASH CODE)) { eval "
	package Attribute::Lexical::UNIVERSAL;
	my \$type = \"$type\";
	sub MODIFY_${type}_ATTRIBUTES
{".q{
	my $invocant = shift(@_);
	my $target = shift(@_);
	my @unhandled;
	my @caller;
	for(my $i = 0; ; $i++) {
		@caller = caller($i);
		if(!@caller || $caller[3] =~ /::BEGIN\z/) {
			# Strangely not called via attributes::import.
			# No idea of the relevant lexical environment,
			# so don't handle any attributes.
			ALL_UNHANDLED:
			@unhandled = @_;
			goto HANDLE_UNHANDLED;
		}
		if($caller[3] eq "attributes::import") {
			if(Attribute::Lexical::_KLUDGE_RUNTIME_HINTS) {
				# On earlier perls we can only get lexical
				# hints during compilation, because %^H
				# isn't shown by caller().  In that case,
				# we check here that the attributes are
				# being applied as part of compilation,
				# indicated by attributes::import being
				# called directly from a BEGIN block.
				# If it's called elsewhere, including
				# indirectly from within a BEGIN
				# block, then it's a runtime attribute
				# application, which we can't handle.
				my @nextcall = caller($i+1);
				unless(@nextcall &&
						$nextcall[3] =~ /::BEGIN\z/) {
					goto ALL_UNHANDLED;
				}
			}
			last;
		}
	}
	foreach my $attr (@_) {
		my($ident, $arg) = ($attr =~ /\A
			([A-Za-z_][0-9A-Za-z_]*)
			(?:\((.*)\))?
		\z/sx);
		if(defined($ident) && defined(my $handler = (
			Attribute::Lexical::_KLUDGE_RUNTIME_HINTS ? 
				# %^H is not available through caller() on
				# earlier perls.  In that case, if called
				# during compilation, we can kludge by
				# looking at the current compilation %^H.
				Attribute::Lexical->handler_for_compilation(
					"$type:$ident")
			:
				Attribute::Lexical->handler_for_caller(
					\@caller, "$type:$ident")
		))) {
			$handler->($target, $ident, $arg, \@caller);
		} else {
			push @unhandled, $attr;
		}
	}
	HANDLE_UNHANDLED:
	return () unless @unhandled;
	my $next;

lib/Attribute/Lexical.pm  view on Meta::CPAN

	\z/x;
}

=head1 PACKAGE METHODS

All these methods are meant to be invoked on the C<Attribute::Lexical>
package.

=over

=item Attribute::Lexical->handler_for_caller(CALLER, NAME)

Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>")
according to the lexical declarations prevailing in a specified place.
I<CALLER> must be a reference to an array of the form returned by
the L<caller|perlfunc/caller> function, describing the lexical site
of interest.  If the requested attribute is declared in scope then
a reference to the handler function is returned, otherwise C<undef>
is returned.

This method is not available prior to Perl 5.9.4, because earlier Perls

lib/Attribute/Lexical.pm  view on Meta::CPAN

to the lexical declarations prevailing at the site of the call to this
method.  If the requested attribute is declared in scope then a reference
to the handler function is returned, otherwise C<undef> is returned.

This method is not available prior to Perl 5.9.4, because earlier Perls
don't make lexical state available at runtime.

=cut

BEGIN { unless(_KLUDGE_RUNTIME_HINTS) { eval q{
	sub handler { shift->handler_for_caller([caller(0)], @_) }
1; } or die $@; } }

=item Attribute::Lexical->handler_for_compilation(NAME)

Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>") according to
the lexical declarations prevailing in the code currently being compiled.
If the requested attribute is declared in scope then a reference to the
handler function is returned, otherwise C<undef> is returned.

=cut

t/caller.t  view on Meta::CPAN

use warnings;
use strict;

use Test::More tests => 4;

BEGIN { $^H |= 0x20000 if "$]" < 5.008; }

sub foo { }

sub munge_caller(@) { [ @_[0,1,2,10] ] }

sub caller_here() { munge_caller(caller(0)) }

my @attributes;
sub atthandler { push @attributes, [ @_[0..2], munge_caller(@{$_[3]}) ] }

use Attribute::Lexical "CODE:c0", \&atthandler;

sub foo :c0;    is_deeply $attributes[0], [\&foo,"c0",undef,caller_here()];
sub foo :c0(x); is_deeply $attributes[1], [\&foo,"c0","x",caller_here()];

sub bar() {
	sub foo :c0; is_deeply $attributes[2], [\&foo,"c0",undef,caller_here()];
	use Attribute::Lexical "CODE:c1", \&atthandler;
	sub foo :c0; is_deeply $attributes[3], [\&foo,"c0",undef,caller_here()];