package PPI::Statement::Sub; =pod =head1 NAME PPI::Statement::Sub - Subroutine declaration =head1 INHERITANCE PPI::Statement::Sub isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION Except for the special BEGIN, CHECK, UNITCHECK, INIT, and END subroutines (which are part of L) all subroutine declarations are lexed as a PPI::Statement::Sub object. Primarily, this means all of the various C statements, but also forward declarations such as C or C. It B include anonymous subroutines, as these are merely part of a normal statement. =head1 METHODS C has a number of methods in addition to the standard L, L and L methods. =cut use strict; use List::Util (); use Params::Util qw{_INSTANCE}; use PPI::Statement (); our $VERSION = '1.276'; our @ISA = "PPI::Statement"; # Lexer clue sub __LEXER__normal() { '' } sub _complete { my $child = $_[0]->schild(-1); return !! ( defined $child and $child->isa('PPI::Structure::Block') and $child->complete ); } ##################################################################### # PPI::Statement::Sub Methods =pod =head2 name The C method returns the name of the subroutine being declared. In some rare cases such as a naked C at the end of the file, this may return false. =cut sub name { my ($self) = @_; # Usually the second token is the name. # The third token is the name if this is a lexical subroutine. my $token = $self->schild(defined $self->type ? 2 : 1); return $token->content if defined $token and $token->isa('PPI::Token::Word'); # In the case of special subs whose 'sub' can be omitted (AUTOLOAD # or DESTROY), the name will be the first token. $token = $self->schild(0); return $token->content if defined $token and $token->isa('PPI::Token::Word'); return ''; } =pod =head2 prototype If it has one, the C method returns the subroutine's prototype. It is returned in the same format as L, cleaned and removed from its brackets. Returns the subroutine's prototype, or undef if the subroutine does not define one. Note that when the sub has an empty prototype (C<()>) the return is an empty string. =cut sub prototype { my $self = shift; my $Prototype = List::Util::first { _INSTANCE($_, 'PPI::Token::Prototype') } $self->children; defined($Prototype) ? $Prototype->prototype : undef; } =pod =head2 block With its name and implementation shared with L, the C method finds and returns the actual Structure object of the code block for this subroutine. Returns false if this is a forward declaration, or otherwise does not have a code block. =cut sub block { my $self = shift; my $lastchild = $self->schild(-1) or return ''; $lastchild->isa('PPI::Structure::Block') and $lastchild; } =pod =head2 forward The C method returns true if the subroutine declaration is a forward declaration. That is, it returns false if the subroutine has a code block, or true if it does not. =cut sub forward { ! shift->block; } =pod =head2 reserved The C method provides a convenience method for checking to see if this is a special reserved subroutine. It does not check against any particular list of reserved sub names, but just returns true if the name is all uppercase, as defined in L. Note that in the case of BEGIN, CHECK, UNITCHECK, INIT and END, these will be defined as L objects, not subroutines. Returns true if it is a special reserved subroutine, or false if not. =cut sub reserved { my $self = shift; my $name = $self->name or return ''; # perlsub is silent on whether reserveds can contain: # - underscores; # we allow them due to existing practice like CLONE_SKIP and __SUB__. # - numbers; we allow them by PPI tradition. $name eq uc $name; } =pod =head2 type The C method checks and returns the declaration type of the statement, which will be one of 'my', 'our', or 'state'. Returns a string of the type, or C if the type is not declared. =cut sub type { my $self = shift; # Get the first significant child my @schild = grep { $_->significant } $self->children; # Ignore labels shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label'); # Get the type (_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|our|state)$/) ? $schild[0]->content : undef; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =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