local-lib5/lib/perl5/PPI/Statement/Sub.pm

   1 package PPI::Statement::Sub;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Statement::Sub - Subroutine declaration
   8
   9 =head1 INHERITANCE
  10
  11   PPI::Statement::Sub
  12   isa PPI::Statement
  13       isa PPI::Node
  14           isa PPI::Element
  15
  16 =head1 DESCRIPTION
  17
  18 Except for the special BEGIN, CHECK, UNITCHECK, INIT, and END subroutines
  19 (which are part of L<PPI::Statement::Scheduled>) all subroutine declarations
  20 are lexed as a PPI::Statement::Sub object.
  21
  22 Primarily, this means all of the various C<sub foo {}> statements, but also
  23 forward declarations such as C<sub foo;> or C<sub foo($);>. It B<does not>
  24 include anonymous subroutines, as these are merely part of a normal statement.
  25
  26 =head1 METHODS
  27
  28 C<PPI::Statement::Sub> has a number of methods in addition to the standard
  29 L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  30
  31 =cut
  32
  33 use strict;
  34 use List::Util     ();
  35 use Params::Util   qw{_INSTANCE};
  36 use PPI::Statement ();
  37
  38 use vars qw{$VERSION @ISA};
  39 BEGIN {
  40         $VERSION = '1.206';
  41         @ISA     = 'PPI::Statement';
  42 }
  43
  44 # Lexer clue
  45 sub __LEXER__normal { '' }
  46
  47 sub _complete {
  48         my $child = $_[0]->schild(-1);
  49         return !! (
  50                 defined $child
  51                 and
  52                 $child->isa('PPI::Structure::Block')
  53                 and
  54                 $child->complete
  55         );
  56 }
  57
  58
  59
  60
  61
  62 #####################################################################
  63 # PPI::Statement::Sub Methods
  64
  65 =pod
  66
  67 =head2 name
  68
  69 The C<name> method returns the name of the subroutine being declared.
  70
  71 In some rare cases such as a naked C<sub> at the end of the file, this may return
  72 false.
  73
  74 =cut
  75
  76 sub name {
  77         my $self = shift;
  78
  79         # The second token should be the name, if we have one
  80         my $Token = $self->schild(1) or return '';
  81         $Token->isa('PPI::Token::Word') and $Token->content;
  82 }
  83
  84 =pod
  85
  86 =head2 prototype
  87
  88 If it has one, the C<prototype> method returns the subroutine's prototype.
  89 It is returned in the same format as L<PPI::Token::Prototype/prototype>,
  90 cleaned and removed from its brackets.
  91
  92 Returns false if the subroutine does not define a prototype
  93
  94 =cut
  95
  96 sub prototype {
  97         my $self      = shift;
  98         my $Prototype = List::Util::first {
  99                 _INSTANCE($_, 'PPI::Token::Prototype')
 100         } $self->children;
 101         defined($Prototype) ? $Prototype->prototype : '';
 102 }
 103
 104 =pod
 105
 106 =head2 block
 107
 108 With its name and implementation shared with L<PPI::Statement::Scheduled>,
 109 the C<block> method finds and returns the actual Structure object of the
 110 code block for this subroutine.
 111
 112 Returns false if this is a forward declaration, or otherwise does not have a
 113 code block.
 114
 115 =cut
 116
 117 sub block {
 118         my $self = shift;
 119         my $lastchild = $self->schild(-1) or return '';
 120         $lastchild->isa('PPI::Structure::Block') and $lastchild;
 121 }
 122
 123 =pod
 124
 125 =head2 forward
 126
 127 The C<forward> method returns true if the subroutine declaration is a
 128 forward declaration.
 129
 130 That is, it returns false if the subroutine has a code block, or true
 131 if it does not.
 132
 133 =cut
 134
 135 sub forward {
 136         ! shift->block;
 137 }
 138
 139 =pod
 140
 141 =head2 reserved
 142
 143 The C<reserved> method provides a convenience method for checking to see
 144 if this is a special reserved subroutine. It does not check against any
 145 particular list of reserved sub names, but just returns true if the name
 146 is all uppercase, as defined in L<perlsub>.
 147
 148 Note that in the case of BEGIN, CHECK, UNITCHECK, INIT and END, these will be
 149 defined as L<PPI::Statement::Scheduled> objects, not subroutines.
 150
 151 Returns true if it is a special reserved subroutine, or false if not.
 152
 153 =cut
 154
 155 sub reserved {
 156         my $self = shift;
 157         my $name = $self->name or return '';
 158         $name eq uc $name;
 159 }
 160
 161 1;
 162
 163 =pod
 164
 165 =head1 TO DO
 166
 167 - Write unit tests for this package
 168
 169 =head1 SUPPORT
 170
 171 See the L<support section|PPI/SUPPORT> in the main module.
 172
 173 =head1 AUTHOR
 174
 175 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 176
 177 =head1 COPYRIGHT
 178
 179 Copyright 2001 - 2009 Adam Kennedy.
 180
 181 This program is free software; you can redistribute
 182 it and/or modify it under the same terms as Perl itself.
 183
 184 The full text of the license can be found in the
 185 LICENSE file included with this module.
 186
 187 =cut