Login
The big NamingConventions::Capitalization rejiggering. Need to make
[gknop/Perl-Critic.git] / lib / Perl / Critic / Utils / PPI.pm
CommitLineData
c251af83
ES
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Utils::PPI;
9
df6dee2b 10use 5.006001;
c251af83
ES
11use strict;
12use warnings;
13
1e904b0d
ES
14use Readonly;
15
84ed32d9
ES
16use Scalar::Util qw< blessed >;
17
c251af83
ES
18use base 'Exporter';
19
173667ce 20our $VERSION = '1.093_01';
c251af83
ES
21
22#-----------------------------------------------------------------------------
23
24our @EXPORT_OK = qw(
70f3f307
ES
25 is_ppi_expression_or_generic_statement
26 is_ppi_generic_statement
27 is_ppi_statement_subclass
6884b17a
ES
28 is_subroutine_declaration
29 is_in_subroutine
1e904b0d 30 get_constant_name_element_from_declaring_statement
c251af83
ES
31);
32
8ec219d9
ES
33our %EXPORT_TAGS = (
34 all => \@EXPORT_OK,
35);
36
c251af83
ES
37#-----------------------------------------------------------------------------
38
39sub is_ppi_expression_or_generic_statement {
40 my $element = shift;
41
6884b17a
ES
42 return if not $element;
43 return if not $element->isa('PPI::Statement');
c251af83
ES
44 return 1 if $element->isa('PPI::Statement::Expression');
45
84ed32d9
ES
46 my $element_class = blessed($element);
47
6884b17a 48 return if not $element_class;
c251af83
ES
49 return $element_class eq 'PPI::Statement';
50}
51
52#-----------------------------------------------------------------------------
53
54sub is_ppi_generic_statement {
55 my $element = shift;
56
84ed32d9 57 my $element_class = blessed($element);
c251af83 58
6884b17a
ES
59 return if not $element_class;
60 return if not $element->isa('PPI::Statement');
c251af83
ES
61
62 return $element_class eq 'PPI::Statement';
63}
64
65#-----------------------------------------------------------------------------
66
67sub is_ppi_statement_subclass {
68 my $element = shift;
69
84ed32d9 70 my $element_class = blessed($element);
c251af83 71
6884b17a
ES
72 return if not $element_class;
73 return if not $element->isa('PPI::Statement');
c251af83
ES
74
75 return $element_class ne 'PPI::Statement';
76}
77
6884b17a 78#-----------------------------------------------------------------------------
c251af83 79
6884b17a
ES
80sub is_subroutine_declaration {
81 my $element = shift;
82
83 return if not $element;
84
289ebff0 85 return 1 if $element->isa('PPI::Statement::Sub');
6884b17a
ES
86
87 if ( is_ppi_generic_statement($element) ) {
88 my $first_element = $element->first_element();
89
90 return 1 if
91 $first_element
92 and $first_element->isa('PPI::Token::Word')
93 and $first_element->content() eq 'sub';
94 }
95
96 return;
97}
c251af83
ES
98
99#-----------------------------------------------------------------------------
100
6884b17a
ES
101sub is_in_subroutine {
102 my ($element) = @_;
103
104 return if not $element;
105 return 1 if is_subroutine_declaration($element);
106
107 while ( $element = $element->parent() ) {
108 return 1 if is_subroutine_declaration($element);
109 }
110
111 return;
112}
113
114#-----------------------------------------------------------------------------
115
1e904b0d
ES
116sub get_constant_name_element_from_declaring_statement {
117 my ($element) = @_;
118
119 return if not $element;
120 return if not $element->isa('PPI::Statement');
121
122 if ( $element->isa('PPI::Statement::Include') ) {
123 my $pragma;
124 if ( $pragma = $element->pragma() and $pragma eq 'constant' ) {
125 return _constant_name_from_constant_pragma($element);
126 }
127 }
128 elsif (
129 is_ppi_generic_statement($element)
130 and $element->schild(0)->content() =~ m< \A Readonly \b >xms
131 ) {
132 return $element->schild(2);
133 }
134
135 return;
136}
137
138# Clean this up once PPI with module_version() is released.
139sub _constant_name_from_constant_pragma {
140 my ($include) = @_;
141
142 my $name_slot = 2;
143 my $argument_or_version = $include->schild($name_slot);
144 return if not $argument_or_version; # "use constant"
145 return if
146 $argument_or_version->isa('PPI::Token::Structure'); # "use constant;"
147
148 return $argument_or_version
149 if not $argument_or_version->isa('PPI::Token::Number');
150
151 my $follower = $include->schild($name_slot + 1);
152 return if not $follower; # "use constant 123"
153 return if $follower->isa('PPI::Token::Structure'); # "use constant 123;"
154 return $argument_or_version if $follower->isa('PPI::Token::Operator');
155 return $follower;
156}
157
158#-----------------------------------------------------------------------------
159
6884b17a
ES
1601;
161
162__END__
163
c251af83
ES
164=pod
165
166=for stopwords
167
168=head1 NAME
169
e3891dff
ES
170Perl::Critic::Utils::PPI - Utility functions for dealing with PPI objects.
171
c251af83
ES
172
173=head1 DESCRIPTION
174
11f53956 175Provides classification of L<PPI::Elements|PPI::Elements>.
c251af83
ES
176
177
178=head1 IMPORTABLE SUBS
179
180=over
181
182=item C<is_ppi_expression_or_generic_statement( $element )>
183
184Answers whether the parameter is an expression or an undifferentiated
185statement. I.e. the parameter either is a
11f53956
ES
186L<PPI::Statement::Expression|PPI::Statement::Expression> or the class
187of the parameter is L<PPI::Statement|PPI::Statement> and not one of
188its subclasses other than C<Expression>.
c251af83
ES
189
190
191=item C<is_ppi_generic_statement( $element )>
192
193Answers whether the parameter is an undifferentiated statement, i.e.
11f53956
ES
194the parameter is a L<PPI::Statement|PPI::Statement> but not one of its
195subclasses.
c251af83
ES
196
197
198=item C<is_ppi_statement_subclass( $element )>
199
200Answers whether the parameter is a specialized statement, i.e. the
11f53956
ES
201parameter is a L<PPI::Statement|PPI::Statement> but the class of the
202parameter is not L<PPI::Statement|PPI::Statement>.
c251af83
ES
203
204
6884b17a
ES
205=item C<is_subroutine_declaration( $element )>
206
207Is the parameter a subroutine declaration, named or not?
208
209
210=item C<is_in_subroutine( $element )>
211
212Is the parameter a subroutine or inside one?
213
214
1e904b0d
ES
215=item C<get_constant_name_element_from_declaring_statement($statement)>
216
217Given a L<PPI::Statement|PPI::Statement>, if the statement is a C<use
218constant> or L<Readonly:Readonly> declaration statement, return the name of
219the thing being defined.
220
221Given
222
223 use constant 1.16 FOO => 'bar';
224
225this will return "FOO". Similarly, given
226
227 Readonly::Hash my %FOO => ( bar => 'baz' );
228
229this will return "%FOO".
230
231
c251af83
ES
232=back
233
234
235=head1 AUTHOR
236
237Elliot Shank <perl@galumph.com>
238
11f53956 239
c251af83
ES
240=head1 COPYRIGHT
241
20dfddeb 242Copyright (c) 2007-2008 Elliot Shank. All rights reserved.
c251af83
ES
243
244This program is free software; you can redistribute it and/or modify
245it under the same terms as Perl itself. The full text of this license
246can be found in the LICENSE file included with this module.
247
248=cut
249
250# Local Variables:
251# mode: cperl
252# cperl-indent-level: 4
253# fill-column: 78
254# indent-tabs-mode: nil
255# c-indentation-style: bsd
256# End:
96fed375 257# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :