implement Structure::Signature

Changes

@@ -13,7 +13,7 @@ Revision history for Perl extension PPI
 	  - PPI::Document->new( custom_feature_includes => ... )
 	  - PPI::Document->new( custom_feature_include_cb => ... )
 	- Added ability to parse features:
-	  - signatures, as PPI::Token::Signature
+	  - signatures, as PPI::Structure::Signature
 	  - try catch, as PPI::Statement::Compound
 
 1.279   2024-08-23 14:02:44Z

lib/PPI/Lexer.pm

@@ -1065,6 +1065,8 @@ sub _round {
 		return 'PPI::Structure::Given';
 	} elsif ( $Parent->isa('PPI::Statement::When') ) {
 		return 'PPI::Structure::When';
+	} elsif ( $Parent->isa('PPI::Statement::Sub') ) {
+		return 'PPI::Structure::Signature';
 	}
 
 	# Otherwise, it must be a list

lib/PPI/Structure.pm

@@ -108,6 +108,7 @@ use PPI::Structure::List        ();
 use PPI::Structure::Subscript   ();
 use PPI::Structure::Unknown     ();
 use PPI::Structure::When        ();
+use PPI::Structure::Signature   ();
 
 
 

lib/PPI/Structure/Signature.pm

@@ -0,0 +1,61 @@
+package PPI::Structure::Signature;
+
+=pod
+
+=head1 NAME
+
+PPI::Structure::Signature - List of subroutine signature elements
+
+=head1 SYNOPSIS
+
+  sub do_thing( $param, $arg ) {}
+
+=head1 INHERITANCE
+
+  PPI::Structure::Signature
+    isa PPI::Structure::List
+        isa PPI::Structure
+            isa PPI::Node
+                isa PPI::Element
+
+=head1 DESCRIPTION
+
+C<PPI::Structure::Signature> is the class used for circular braces that
+represent lists of signature elements.
+
+=head1 METHODS
+
+C<PPI::Structure::Signature> has no methods beyond those provided by the
+standard L<PPI::Structure::List>, L<PPI::Structure>, L<PPI::Node> and
+L<PPI::Element> methods.
+
+=cut
+
+use strict;
+use PPI::Structure ();
+
+our $VERSION = '1.277';
+
+our @ISA = "PPI::Structure::List";
+
+1;
+
+=head1 SUPPORT
+
+See the L<support section|PPI/SUPPORT> in the main module.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>[email protected]E<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2001 - 2011 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut

lib/PPI/Token/Unknown.pm

@@ -115,6 +115,15 @@ sub __TOKENIZER__on_char {
 			return 1;
 		}
 
+		# Is it a nameless arg in a signature?
+		if ( $char eq ')' or $char eq '=' or $char eq ',' ) {
+			my ($has_sig) = $t->_current_token_has_signatures_active;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		if ( $MAGIC{ $c . $char } ) {
 			# Magic variable
 			$t->{class} = $t->{token}->set_class( 'Magic' );
@@ -153,6 +162,15 @@ sub __TOKENIZER__on_char {
 			return 1;
 		}
 
+		# Is it a nameless arg in a signature?
+		if ( $char eq ')' ) {
+			my ($has_sig) = $t->_current_token_has_signatures_active;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		if ( $MAGIC{ $c . $char } ) {
 			# Magic variable
 			$t->{class} = $t->{token}->set_class( 'Magic' );
@@ -198,6 +216,15 @@ sub __TOKENIZER__on_char {
 			return $t->_finalize_token->__TOKENIZER__on_char( $t );
 		}
 
+		# Is it a nameless arg in a signature?
+		if ( $char eq ')' ) {
+			my ($has_sig) = $t->_current_token_has_signatures_active;
+			if ($has_sig) {
+				$t->{class} = $t->{token}->set_class('Symbol');
+				return $t->_finalize_token->__TOKENIZER__on_char($t);
+			}
+		}
+
 		# Is it a magic variable?
 		if ( $char eq '^' || $MAGIC{ $c . $char } ) {
 			$t->{class} = $t->{token}->set_class( 'Magic' );

lib/PPI/Token/Whitespace.pm

@@ -212,21 +212,8 @@ sub __TOKENIZER__on_char {
 		# 2. The one before that is the word 'sub'.
 		# 3. The one before that is a 'structure'
 
-		# Get at least the three previous significant tokens, and extend the
-		# retrieval range to include at least one token that can walk the
-		# already generated tree. (i.e. has a parent)
-		my ( $tokens_to_get, @tokens ) = (3);
-		while ( !@tokens or ( $tokens[-1] and !$tokens[-1]->parent ) ) {
-			@tokens = $t->_previous_significant_tokens($tokens_to_get);
-			last if @tokens < $tokens_to_get;
-			$tokens_to_get++;
-		}
-
-		my ($closest_parented_token) = grep $_->parent, @tokens;
-		die "no parented element found" unless    #
-		  $closest_parented_token ||= $t->_document;
-		return 'Signature'
-		  if $closest_parented_token->presumed_features->{signatures};
+		my ( $has_sig, @tokens ) = $t->_current_token_has_signatures_active;
+		return 'Structure' if $has_sig;
 
 		# A normal subroutine declaration
 		my $p1 = $tokens[1];

lib/PPI/Tokenizer.pm

@@ -858,6 +858,25 @@ sub __current_token_is_forced_word {
 	return '';
 }
 
+sub _current_token_has_signatures_active {
+	my ($t) = @_;
+
+	# Get at least the three previous significant tokens, and extend the
+	# retrieval range to include at least one token that can walk the
+	# already generated tree. (i.e. has a parent)
+	my ( $tokens_to_get, @tokens ) = (3);
+	while ( !@tokens or ( $tokens[-1] and !$tokens[-1]->parent ) ) {
+		@tokens = $t->_previous_significant_tokens($tokens_to_get);
+		last if @tokens < $tokens_to_get;
+		$tokens_to_get++;
+	}
+
+	my ($closest_parented_token) = grep $_->parent, @tokens;
+	die "no parented element found" unless    #
+	  $closest_parented_token ||= $t->_document;
+	return $closest_parented_token->presumed_features->{signatures}, @tokens;
+}
+
 1;
 
 =pod

prot.pl

@@ -0,0 +1,6 @@
+sub prot(
+		 (
+		  a
+		  \\
+		  )
+		 ){} prot(1)