/usr/share/perl5/PPI/Statement/Variable.pm is in libppi-perl 1.220-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 188 189 190 191 192 193 194 195 196 197 | package PPI::Statement::Variable;
=pod
=head1 NAME
PPI::Statement::Variable - Variable declaration statements
=head1 SYNOPSIS
# All of the following are variable declarations
my $foo = 1;
my ($foo, $bar) = (1, 2);
our $foo = 1;
local $foo;
local $foo = 1;
LABEL: my $foo = 1;
=head1 INHERITANCE
PPI::Statement::Variable
isa PPI::Statement::Expression
isa PPI::Statement
isa PPI::Node
isa PPI::Element
=head1 DESCRIPTION
The main intent of the C<PPI::Statement::Variable> class is to describe
simple statements that explicitly declare new local or global variables.
Note that this does not make it exclusively the only place where variables
are defined, and later on you should expect that the C<variables> method
will migrate deeper down the tree to either L<PPI::Statement> or
L<PPI::Node> to recognise this fact, but for now it stays here.
=head1 METHODS
=cut
use strict;
use Params::Util qw{_INSTANCE};
use PPI::Statement::Expression ();
use vars qw{$VERSION @ISA};
BEGIN {
$VERSION = '1.220';
@ISA = 'PPI::Statement::Expression';
}
=pod
=head2 type
The C<type> method checks and returns the declaration type of the statement,
which will be one of 'my', 'local', 'our', or 'state'.
Returns a string of the type, or C<undef> if the type cannot be detected
(which is probably a bug).
=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|local|our|state)$/)
? $schild[0]->content
: undef;
}
=pod
=head2 variables
As for several other PDOM Element types that can declare variables, the
C<variables> method returns a list of the canonical forms of the variables
defined by the statement.
Returns a list of the canonical string forms of variables, or the null list
if it is unable to find any variables.
=cut
sub variables {
map { $_->canonical } $_[0]->symbols;
}
=pod
=head2 symbols
Returns a list of the variables defined by the statement, as
L<PPI::Token::Symbol>s.
=cut
sub symbols {
my $self = shift;
# Get the children we care about
my @schild = grep { $_->significant } $self->children;
shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');
# If the second child is a symbol, return its name
if ( _INSTANCE($schild[1], 'PPI::Token::Symbol') ) {
return $schild[1];
}
# If it's a list, return as a list
if ( _INSTANCE($schild[1], 'PPI::Structure::List') ) {
my $Expression = $schild[1]->schild(0);
$Expression and
$Expression->isa('PPI::Statement::Expression') or return ();
# my and our are simpler than local
if (
$self->type eq 'my'
or
$self->type eq 'our'
or
$self->type eq 'state'
) {
return grep {
$_->isa('PPI::Token::Symbol')
} $Expression->schildren;
}
# Local is much more icky (potentially).
# Not that we are actually going to deal with it now,
# but having this separate is likely going to be needed
# for future bug reports about local() things.
# This is a slightly better way to check.
return grep {
$self->_local_variable($_)
} grep {
$_->isa('PPI::Token::Symbol')
} $Expression->schildren;
}
# erm... this is unexpected
();
}
sub _local_variable {
my ($self, $el) = @_;
# The last symbol should be a variable
my $n = $el->snext_sibling or return 1;
my $p = $el->sprevious_sibling;
if ( ! $p or $p eq ',' ) {
# In the middle of a list
return 1 if $n eq ',';
# The first half of an assignment
return 1 if $n eq '=';
}
# Lets say no for know... additional work
# should go here.
return '';
}
1;
=pod
=head1 TO DO
- Write unit tests for this
=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
|