view release on metacpan or  search on metacpan

lib/Attribute/Handlers/Prospective.pm  view on Meta::CPAN

		if (($extracted) = extract_quotelike($_,q//) and $extracted or
		    ($extracted) = extract_variable($_,q//) and $extracted ) {
			$newcode .= $extracted;
		}
		elsif (m/\G$sub_decl/gc) {
			my ($name, $attrs, $params) = ($1,$2||"",$3||"");
			my ($block) = extract_codeblock;
			$DB::single = 1;
			$newcode .= "sub $name $params $block ;"
			          . impl_attrs($attrs,$name,$caller,'&','sub');
		}
		elsif (m/\G$sub_anon/gc) {
			my ($attrs, $params) = ($1||"",$2||"");
			my ($block) = extract_codeblock;
			$newcode .= "do { local \$_ = sub $params $block; "
			          . impl_attrs($attrs,undef,$caller,'&','sub')
				  . ' ; $_ }';
		}
		elsif (m/\G$var_noattrs/gc) {
			$newcode .= $1;
		}
		elsif (m/\G$var_decl/gc) {
			my ($decl, $type, $sigil, $name, $attrs, $nextchar)
			 = ($1,    $2||"",$3,     $4,    $5||"", $6);
			$newcode .= "$decl $type $sigil$name; "
			          . impl_attrs($attrs,$name,$caller,$sigil,$decl,$type)
				  . "; "
				  . ($nextchar eq '=' ? "$sigil$name " : "")
				  . $nextchar;
		}
		elsif (m/\G($id|$parens|.)/gcs) {
		        $newcode .= $1;
		}
		else {
			die "Internal error";
		}
	}
	$_ = $newcode;
	# print STDERR if $_;
}
qr/^__(END|DATA)__$/m;

no warnings;
my $filterer = *import{CODE};
my $mod_filterer = sub { unshift @_, scalar caller; goto &$filterer };
*import = sub {
	if (grep /Perl\s*6/, @_) {
		$attr_list   = $attr_list6;
		$sub_decl    = $sub_decl6;
		$sub_anon    = $sub_anon6;
		$var_decl    = $var_decl6;
		$var_noattrs = $var_noattr6;
	}
	else {
		$attr_list   = $attr_list5;
		$sub_decl    = $sub_decl5;
		$sub_anon    = $sub_anon5;
		$var_decl    = $var_decl5;
		$var_noattrs = $var_noattr5;
	}
	*{caller()."::import"} = $mod_filterer;
	goto &$mod_filterer
};

1;

__END__

=head1 NAME

Attribute::Handlers::Prospective - Richer semantics for attribute handlers

=head1 VERSION

This document describes version 0.01 of Attribute::Handlers::Prospective,
released October 25, 2001.

=head1 SYNOPSIS

	package MyClass;
	require v5.6.1;
	use Attribute::Handlers::Prospective;

	sub Good : ATTR(SCALAR) {
		my ($package, $symbol, $referent, $attr, $data, $phase) = @_;

		# Invoked for any scalar variable with a :Good attribute,
		# provided the variable was declared in MyClass (or
		# a derived class) or typed to MyClass.

		# Do whatever to $referent here (executed in INIT phase).
		...
	}

	sub Bad : ATTR(SCALAR) {
		# Invoked for any scalar variable with a :Bad attribute,
		# provided the variable was declared in MyClass (or
		# a derived class) or typed to MyClass.
		...
	}

	sub Good : ATTR(ARRAY) {
		# Invoked for any array variable with a :Good attribute,
		# provided the variable was declared in MyClass (or
		# a derived class) or typed to MyClass.
		...
	}

	sub Ugly : ATTR(CODE) {
		# Invoked for any subroutine declared in MyClass (or a 
		# derived class) with an :Ugly attribute.
		...
	}

	sub Omni : ATTR {
		# Invoked for any scalar, array, hash, or subroutine
		# with an :Omni attribute, provided the variable or
		# subroutine was declared in MyClass (or a derived class)
		# or the variable was typed to MyClass.
		# Use ref($_[2]) to determine what kind of referent it was.
		...