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
198
199
200
201
202
203
204
205
206
207
208
209
210
|
package Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict;
use 5.010001;
use strict;
use warnings;
use version 0.77;
use Readonly;
use Scalar::Util qw{ blessed };
use Perl::Critic::Utils qw{ :severities $EMPTY };
use Perl::Critic::Utils::Constants qw{ :equivalent_modules };
use parent 'Perl::Critic::Policy';
our $VERSION = '1.156';
#-----------------------------------------------------------------------------
Readonly::Scalar my $DESC => q{Code before strictures are enabled};
Readonly::Scalar my $EXPL => [ 429 ];
Readonly::Scalar my $PERL_VERSION_WHICH_IMPLIES_STRICTURE => qv('v5.11.0');
#-----------------------------------------------------------------------------
sub supported_parameters {
return (
{
name => 'equivalent_modules',
description =>
q<The additional modules to treat as equivalent to "strict".>,
default_string => $EMPTY,
behavior => 'string list',
list_always_present_values => ['strict', @STRICT_EQUIVALENT_MODULES],
},
);
}
sub default_severity { return $SEVERITY_HIGHEST }
sub default_themes { return qw( core pbp bugs certrule certrec ) }
sub applies_to { return 'PPI::Document' }
sub default_maximum_violations_per_document { return 1; }
#-----------------------------------------------------------------------------
sub violates {
my ( $self, undef, $doc ) = @_;
# Find the first 'use strict' statement
my $strict_stmnt = $doc->find_first( $self->_generate_is_use_strict() );
my $strict_line = $strict_stmnt ? $strict_stmnt->location()->[0] : undef;
# Find all statements that aren't 'use', 'require', or 'package'
my $stmnts_ref = _find_isnt_include_or_package($doc);
return if not $stmnts_ref;
# If the 'use strict' statement is not defined, or the other
# statement appears before the 'use strict', then it violates.
my @viols;
for my $stmnt ( @{ $stmnts_ref } ) {
last if $stmnt->isa('PPI::Statement::End');
last if $stmnt->isa('PPI::Statement::Data');
my $stmnt_line = $stmnt->location()->[0];
if ( (! defined $strict_line) || ($stmnt_line < $strict_line) ) {
push @viols, $self->violation( $DESC, $EXPL, $stmnt );
}
}
return @viols;
}
#-----------------------------------------------------------------------------
sub _generate_is_use_strict {
my ($self) = @_;
return sub {
my (undef, $elem) = @_;
return 0 if !$elem->isa('PPI::Statement::Include');
return 0 if $elem->type() ne 'use';
# We only want file-scoped pragmas
my $parent = $elem->parent();
return 0 if !$parent->isa('PPI::Document');
if ( my $pragma = $elem->pragma() ) {
return 1 if $self->{_equivalent_modules}{$pragma};
}
elsif ( my $module = $elem->module() ) {
return 1 if $self->{_equivalent_modules}{$module};
}
elsif ( my $version = $elem->version() ) {
# Currently Adam returns a string here. He has said he may return
# a version object in the future, so best be prepared.
if ( not blessed( $version ) or not $version->isa( 'version' ) ) {
if ( 'v' ne substr $version, 0, 1
and ( $version =~ tr/././ ) > 1 ) {
$version = 'v' . $version;
}
$version = version->parse( $version );
}
return 1 if $PERL_VERSION_WHICH_IMPLIES_STRICTURE <= $version;
}
return 0;
};
}
#-----------------------------------------------------------------------------
# Here, we're using the fact that Perl::Critic::Document::find() is optimized
# to search for elements based on their type. This is faster than using the
# native PPI::Node::find() method with a custom callback function.
sub _find_isnt_include_or_package {
my ($doc) = @_;
my $all_statements = $doc->find('PPI::Statement') or return;
my @wanted_statements = grep { _statement_isnt_include_or_package($_) } @{$all_statements};
return @wanted_statements ? \@wanted_statements : ();
}
#-----------------------------------------------------------------------------
sub _statement_isnt_include_or_package {
my ($elem) = @_;
return 0 if $elem->isa('PPI::Statement::Package');
return 0 if $elem->isa('PPI::Statement::Include');
return 1;
}
1;
__END__
#-----------------------------------------------------------------------------
=pod
=head1 NAME
Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict - Always C<use strict>.
=head1 AFFILIATION
This Policy is part of the core L<Perl::Critic|Perl::Critic>
distribution.
=head1 DESCRIPTION
Using strictures is probably the single most effective way to improve
the quality of your code. This policy requires that the C<'use
strict'> statement must come before any other statements except
C<package>, C<require>, and other C<use> statements. Thus, all the
code in the entire package will be affected.
There are special exemptions for L<Moose|Moose>,
L<Moose::Role|Moose::Role>, and
L<Moose::Util::TypeConstraints|Moose::Util::TypeConstraints> because
they enforces strictness; e.g. C<'use Moose'> is treated as
equivalent to C<'use strict'>.
The maximum number of violations per document for this policy defaults
to 1.
=head1 CONFIGURATION
If you make use of things like
L<Moose::Exporter|Moose::Exporter>, you can create your own modules
that import the L<strict|strict> pragma into the code that is
C<use>ing them. There is an option to add to the default set of
pragmata and modules in your F<.perlcriticrc>: C<equivalent_modules>.
[TestingAndDebugging::RequireUseStrict]
equivalent_modules = MooseX::My::Sugar
=head1 SEE ALSO
L<Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict|Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict>
=head1 AUTHOR
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
=head1 COPYRIGHT
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. The full text of this license can be found in
the LICENSE file included with this module
=cut
##############################################################################
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 78
# indent-tabs-mode: nil
# c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
|
