X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;fp=lib%2FFunction%2FParameters.pm;h=88c3e66b9a730f59acd6728214133d30e88fb75b;hb=10acc8b1a7d80a19b07671881718e5e3abe77926;hp=4bb18a8b0424a7509593c8fba8c5bdc262d834ca;hpb=832f857d8ec42df73abe42d785461c02d4f3b471;p=p5sagit%2FFunction-Parameters.git

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 4bb18a8..88c3e66 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -12,7 +12,6 @@ BEGIN {
 }
 
 use Carp qw(confess);
-use bytes ();
 
 sub _assert_valid_identifier {
 	my ($name, $with_dollar) = @_;
@@ -21,16 +20,29 @@ sub _assert_valid_identifier {
 		or confess qq{"$name" doesn't look like a valid identifier};
 }
 
+sub _assert_valid_attributes {
+	my ($attrs) = @_;
+	$attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/
+		or confess qq{"$attrs" doesn't look like valid attributes};
+}
+
 my @bare_arms = qw(function method);
 my %type_map = (
 	function => { name => 'optional' },
-	method   => { name => 'optional', shift => '$self' },
+	method   => {
+		name => 'optional',
+		shift => '$self',
+		attrs => ':method',
+	},
 );
 
 sub import {
 	my $class = shift;
 
-	@_ or @_ = ('fun', 'method');
+	@_ or @_ = {
+		fun => 'function',
+		method => 'method',
+	};
 	if (@_ == 1 && ref($_[0]) eq 'HASH') {
 		@_ = map [$_, $_[0]{$_}], keys %{$_[0]}
 			or return;
@@ -52,17 +64,19 @@ sub import {
 			$proto_type = $type_map{$proto_type}
 				|| confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
 		}
+
 		my %type = %$proto_type;
 		my %clean;
+
 		$clean{name} = delete $type{name} || 'optional';
 		$clean{name} =~ /^(?:optional|required|prohibited)\z/
 			or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
+
 		$clean{shift} = delete $type{shift} || '';
-		if ($clean{shift}) {
-			_assert_valid_identifier $clean{shift}, 1;
-			bytes::length($clean{shift}) < SHIFT_NAME_LIMIT
-				or confess qq["$clean{shift}" is longer than I can handle];
-		}
+		_assert_valid_identifier $clean{shift}, 1 if $clean{shift};
+
+		$clean{attrs} = delete $type{attrs} || '';
+		_assert_valid_attributes $clean{attrs} if $clean{attrs};
 		
 		%type and confess "Invalid keyword property: @{[keys %type]}";
 
@@ -73,6 +87,7 @@ sub import {
 		my $type = $spec{$kw};
 
 		$^H{HINTK_SHIFT_ . $kw} = $type->{shift};
+		$^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
 		$^H{HINTK_NAME_ . $kw} =
 			$type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED :
 			$type->{name} eq 'required' ? FLAG_NAME_REQUIRED :
@@ -231,10 +246,28 @@ Valid values: strings that look like a scalar variable. Any function created by
 this keyword will automatically L<shift|perlfunc/shift> its first argument into
 a local variable whose name is specified here.
 
+=item C<attrs>
+
+Valid values: strings that are valid source code for attributes. Any value
+specified here will be inserted as a subroutine attribute in the generated
+code. Thus:
+
+ use Function::Parameters { sub_l => { attrs => ':lvalue' } };
+ sub_l foo() {
+   ...
+ }
+
+turns into
+
+ sub foo :lvalue {
+   ...
+ }
+
 =back
 
 Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, and plain
-C<'method'> is equivalent to C<< { name => 'optional', shift => '$self' } >>.
+C<'method'> is equivalent to
+C<< { name => 'optional', shift => '$self', attrs => ':method' } >>.
 
 =head2 Syntax and generated code