From: Lukas Mai <l.mai@web.de>
Date: Tue, 9 Aug 2011 09:25:41 +0000 (+0200)
Subject: implement extended import types
X-Git-Tag: v0.05_01~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d5cf47a7d7147a50f69b7135a5a1b9730346ef6;p=p5sagit%2FFunction-Parameters.git

implement extended import types
---

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index cbf42d1..2594d85 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -35,9 +35,20 @@ sub guess_caller {
 }
 
 
+sub _assert_valid_identifier {
+	my ($name, $with_dollar) = @_;
+	my $bonus = $with_dollar ? '\$' : '';
+	$name =~ /^${bonus}[^\W\d]\w*\z/
+		or confess qq{"$name" doesn't look like a valid identifier};
+}
+
 # Parse import spec and make shit happen.
 #
 my @bare_arms = qw(function method);
+my %type_map = (
+	function => { name => 'optional' },
+	method   => { name => 'optional', shift => '$self' },
+);
 
 sub import_into {
 	my $victim = shift;
@@ -57,12 +68,18 @@ sub import_into {
 			: [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
 		;
 		my ($name, $type) = @$item;
-		$name =~ /^[^\W\d]\w*\z/
-			or confess qq{"$name" doesn't look like a valid identifier};
-		my ($index) = grep $bare_arms[$_] eq $type, 0 .. $#bare_arms
-			or confess qq{"$type" doesn't look like a valid type (one of ${\join ', ', @bare_arms})};
+		_assert_valid_identifier $name;
+
+		unless (ref $type) {
+			# use '||' instead of 'or' to preserve $type in the error message
+			$type = $type_map{$type}
+				|| confess qq["$type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
+		}
+		$type->{name} ||= 'optional';
+		$type->{name} =~ /^(?:optional|required|prohibited)\z/
+			or confess qq["$type->{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
 		
-		$spec{$name} = {const => mk_parse($index)};
+		$spec{$name} = {const => mk_parse($type)};
 	}
 	
 	Devel::Declare->setup_for($victim, \%spec);
@@ -237,7 +254,7 @@ sub _grab_attr {
 #  fun (do { sub name (proto); sub name (proto) :attr { self? my (params) = @_; ... } });
 #
 sub _generate {
-	my ($ctx, $declarator, $implicit_self) = @_;
+	my ($ctx, $declarator, $shift) = @_;
 
 	my $gen = '(do{sub';
 
@@ -263,8 +280,9 @@ sub _generate {
 	$gen .= '{';
 	$gen .= "BEGIN{${\__PACKAGE__}::_fini($is_stmt)}";
 
-	if ($implicit_self) {
-		$gen .= 'my$self=shift;';
+	if ($shift) {
+		_assert_valid_identifier $shift, 1;
+		$gen .= "my$shift=shift;";
 	}
 	if (defined $ctx->{params}) {
 		$gen .= "my($ctx->{params})=\@_;";
@@ -273,7 +291,7 @@ sub _generate {
 }
 
 sub mk_parse {
-	my ($implicit_self) = @_;
+	my ($spec) = @_;
 
 	sub {
 		my ($declarator, $offset_orig) = @_;
@@ -287,7 +305,8 @@ sub mk_parse {
 
 		my $start = $ctx->{offset};
 
-		_grab_name $ctx;
+		_grab_name $ctx unless $spec->{name} eq 'prohibited';
+		$ctx->{name} or croak qq[I was expecting a function name, not "${\substr Devel::Declare::get_linestr, $ctx->{offset}}"] if $spec->{name} eq 'required';
 		_grab_params $ctx;
 		_grab_proto $ctx;
 		_grab_attr $ctx;
@@ -298,7 +317,7 @@ sub mk_parse {
 		substr($linestr, $offset, 1) eq '{'
 			or croak qq[I was expecting a function body, not "${\substr $linestr, $offset}"];
 
-		my $gen = _generate $ctx, $declarator, $implicit_self;
+		my $gen = _generate $ctx, $declarator, $spec->{shift};
 		my $oldlen = $offset + 1 - $start;
 		_substring $linestr, $start, $offset + 1, (' ' x $oldlen) . $gen;
 		Devel::Declare::set_linestr $linestr;