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