File Coverage

blib/lib/PPI/Statement/Variable.pm
Criterion Covered Total %
statement 38 39 97.4
branch 14 22 63.6
condition 8 15 53.3
subroutine 7 7 100.0
pod 3 3 100.0
total 70 86 81.4


line stmt bran cond sub pod time code
1             package PPI::Statement::Variable;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PPI::Statement::Variable - Variable declaration statements
8              
9             =head1 SYNOPSIS
10              
11             # All of the following are variable declarations
12             my $foo = 1;
13             my ($foo, $bar) = (1, 2);
14             our $foo = 1;
15             local $foo;
16             local $foo = 1;
17             LABEL: my $foo = 1;
18              
19             =head1 INHERITANCE
20              
21             PPI::Statement::Variable
22             isa PPI::Statement::Expression
23             isa PPI::Statement
24             isa PPI::Node
25             isa PPI::Element
26              
27             =head1 DESCRIPTION
28              
29             The main intent of the C class is to describe
30             simple statements that explicitly declare new local or global variables.
31              
32             Note that this does not make it exclusively the only place where variables
33             are defined, and later on you should expect that the C method
34             will migrate deeper down the tree to either L or
35             L to recognise this fact, but for now it stays here.
36              
37             =head1 METHODS
38              
39             =cut
40              
41 64     64   379 use strict;
  64         127  
  64         1778  
42 64     64   289 use Params::Util qw{_INSTANCE};
  64         104  
  64         2235  
43 64     64   322 use PPI::Statement::Expression ();
  64         122  
  64         29377  
44              
45             our $VERSION = '1.276';
46              
47             our @ISA = "PPI::Statement::Expression";
48              
49             =pod
50              
51             =head2 type
52              
53             The C method checks and returns the declaration type of the statement,
54             which will be one of 'my', 'local', 'our', or 'state'.
55              
56             Returns a string of the type, or C if the type cannot be detected
57             (which is probably a bug).
58              
59             =cut
60              
61             sub type {
62 5     5 1 6 my $self = shift;
63              
64             # Get the first significant child
65 5         13 my @schild = grep { $_->significant } $self->children;
  25         41  
66              
67             # Ignore labels
68 5 50       24 shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');
69              
70             # Get the type
71 5 50 33     29 (_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|local|our|state)$/)
72             ? $schild[0]->content
73             : undef;
74             }
75              
76             =pod
77              
78             =head2 variables
79              
80             As for several other PDOM Element types that can declare variables, the
81             C method returns a list of the canonical forms of the variables
82             defined by the statement.
83              
84             Returns a list of the canonical string forms of variables, or the null list
85             if it is unable to find any variables.
86              
87             =cut
88              
89             sub variables {
90 8     8 1 3171 map { $_->canonical } $_[0]->symbols;
  11         25  
91             }
92              
93             =pod
94              
95             =head2 symbols
96              
97             Returns a list of the variables defined by the statement, as
98             Ls.
99              
100             =cut
101              
102             sub symbols {
103 8     8 1 16 my $self = shift;
104              
105             # Get the children we care about
106 8         26 my @schild = grep { $_->significant } $self->children;
  55         100  
107 8 50       66 shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label');
108              
109             # If the second child is a symbol, return its name
110 8 100       50 if ( _INSTANCE($schild[1], 'PPI::Token::Symbol') ) {
111 5         11 return $schild[1];
112             }
113              
114             # If it's a list, return as a list
115 3 50       11 if ( _INSTANCE($schild[1], 'PPI::Structure::List') ) {
116 3         13 my $Expression = $schild[1]->schild(0);
117 3 50 33     27 $Expression and
118             $Expression->isa('PPI::Statement::Expression') or return ();
119              
120             # my and our are simpler than local
121 3 50 66     10 if (
      66        
122             $self->type eq 'my'
123             or
124             $self->type eq 'our'
125             or
126             $self->type eq 'state'
127             ) {
128             return grep {
129 2         13 $_->isa('PPI::Token::Symbol')
  6         42  
130             } $Expression->schildren;
131             }
132              
133             # Local is much more icky (potentially).
134             # Not that we are actually going to deal with it now,
135             # but having this separate is likely going to be needed
136             # for future bug reports about local() things.
137              
138             # This is a slightly better way to check.
139             return grep {
140 4         7 $self->_local_variable($_)
141             } grep {
142 1         6 $_->isa('PPI::Token::Symbol')
  8         17  
143             } $Expression->schildren;
144             }
145              
146             # erm... this is unexpected
147 0         0 ();
148             }
149              
150             sub _local_variable {
151 4     4   15 my ($self, $el) = @_;
152              
153             # The last symbol should be a variable
154 4 100       10 my $n = $el->snext_sibling or return 1;
155 3         8 my $p = $el->sprevious_sibling;
156 3 100 66     19 if ( ! $p or $p eq ',' ) {
157             # In the middle of a list
158 1 50       4 return 1 if $n eq ',';
159              
160             # The first half of an assignment
161 1 50       3 return 1 if $n eq '=';
162             }
163              
164             # Lets say no for know... additional work
165             # should go here.
166 2         4 return '';
167             }
168              
169             1;
170              
171             =pod
172              
173             =head1 TO DO
174              
175             - Write unit tests for this
176              
177             =head1 SUPPORT
178              
179             See the L in the main module.
180              
181             =head1 AUTHOR
182              
183             Adam Kennedy Eadamk@cpan.orgE
184              
185             =head1 COPYRIGHT
186              
187             Copyright 2001 - 2011 Adam Kennedy.
188              
189             This program is free software; you can redistribute
190             it and/or modify it under the same terms as Perl itself.
191              
192             The full text of the license can be found in the
193             LICENSE file included with this module.
194              
195             =cut