File Coverage

blib/lib/Perl/Critic/Policy/Community/DeprecatedFeatures.pm
Criterion Covered Total %
statement 104 107 97.2
branch 104 108 96.3
condition 159 193 82.3
subroutine 13 14 92.8
pod 4 5 80.0
total 384 427 89.9


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Community::DeprecatedFeatures;
2              
3 1     1   515 use strict;
  1         3  
  1         30  
4 1     1   6 use warnings;
  1         3  
  1         27  
5              
6 1     1   7 use List::Util 'any', 'none';
  1         3  
  1         94  
7 1     1   8 use Perl::Critic::Utils qw(:severities :classification :ppi);
  1         2  
  1         69  
8 1     1   397 use parent 'Perl::Critic::Policy';
  1         2  
  1         7  
9              
10             our $VERSION = 'v1.0.1';
11              
12 4     4 0 40774 sub supported_parameters { () }
13 75     75 1 898 sub default_severity { $SEVERITY_HIGH }
14 0     0 1 0 sub default_themes { 'community' }
15 4     4 1 227153 sub applies_to { 'PPI::Element' }
16              
17             my %features = (
18             ':=' => 'Use of := as an empty attribute list is deprecated in perl v5.12.0, use = alone.',
19             '$[' => 'Use of $[ is deprecated in perl v5.12.0. See Array::Base and String::Base.',
20             '/\\C/' => 'Use of the \\C character class in regular expressions is deprecated in perl v5.20.0. To examine a string\'s UTF-8-encoded byte representation, encode it to UTF-8.',
21             '?PATTERN?' => 'Use of ? as a match regex delimiter without an initial m is deprecated in perl v5.14.0. Use m?PATTERN? instead.',
22             'autoderef' => 'Use of each/keys/pop/push/shift/splice/unshift/values on a reference is an experimental feature that is removed in perl v5.24.0. Dereference the array or hash to use these functions on it.',
23             'Bare here-doc' => 'Use of bare << to create a here-doc with an empty string terminator is deprecated in perl 5. Use a quoted empty string like <<\'\'.',
24             'chdir(\'\')' => 'Use of chdir(\'\') or chdir(undef) to chdir home is deprecated in perl v5.8.0. Use chdir() instead.',
25             'defined on array/hash' => 'Use of defined() on an array or hash is deprecated in perl v5.6.2. The array or hash can be tested directly to check for non-emptiness: if (@foo) { ... }',
26             'do SUBROUTINE(LIST)' => 'Use of do to call a subroutine is deprecated in perl 5.',
27             'NBSP in \\N{...}' => 'Use of the "no-break space" character in character names is deprecated in perl v5.22.0.',
28             'POSIX character function' => 'Several character matching functions in POSIX.pm are deprecated in perl v5.20.0: isalnum, isalpha, iscntrl, isdigit, isgraph, islower, isprint, ispunct, isspace, isupper, and isxdigit. Regular expressions are a more portable and correct way to test character strings.',
29             'POSIX::tmpnam()' => 'The tmpnam() function from POSIX is deprecated in perl v5.22.0. Use File::Temp instead.',
30             'qw(...) as parentheses' => 'Use of qw(...) as parentheses is deprecated in perl v5.14.0. Wrap the list in literal parentheses when required, such as in a foreach loop.',
31             'require ::Foo::Bar' => 'Bareword require starting with a double colon is an error in perl v5.26.0.',
32             'UNIVERSAL->import()' => 'The method UNIVERSAL->import() (or passing import arguments to "use UNIVERSAL") is deprecated in perl v5.12.0.',
33             );
34              
35             my %posix_deprecated = map { ($_ => 1, "POSIX::$_" => 1) }
36             qw(isalnum isalpha iscntrl isdigit isgraph islower isprint ispunct isspace isupper isxdigit);
37              
38             my %autoderef_functions = map { ($_ => 1) }
39             qw(each keys pop push shift splice unshift values);
40              
41             sub _violation {
42 75     75   409 my ($self, $feature, $elem) = @_;
43 75         284 my $desc = "$feature is deprecated";
44 75   33     416 my $expl = $features{$feature} // "$feature is deprecated or removed from recent versions of Perl.";
45 75         343 return $self->violation($desc, $expl, $elem);
46             }
47              
48             sub violates {
49 1161     1161 1 7501 my ($self, $elem) = @_;
50 1161         4453 my $next;
51             my $prev;
52 1161         0 my $parent;
53 1161         0 my @args;
54 1161         0 my @violations;
55 1161 100       4730 if ($elem->isa('PPI::Statement')) {
    100          
56 199 100       720 if ($elem->isa('PPI::Statement::Include')) {
57             # use UNIVERSAL ...;
58 13 100 66     52 if ($elem->type eq 'use' and defined $elem->module and $elem->module eq 'UNIVERSAL') {
      100        
59 3         284 my @args = $elem->arguments;
60 3 100 100     142 if (!@args or !$args[0]->isa('PPI::Structure::List') or $args[0]->schildren) {
      66        
61 2         8 push @violations, $self->_violation('UNIVERSAL->import()', $elem);
62             }
63             }
64             # require ::Foo::Bar
65 13 100 66     1030 if (defined $elem->module and $elem->module =~ m/^::/) {
66 3         164 push @violations, $self->_violation('require ::Foo::Bar', $elem);
67             }
68             }
69             } elsif ($elem->isa('PPI::Token')) {
70 903 100       7624 if ($elem->isa('PPI::Token::Symbol')) {
    100          
    100          
    100          
    100          
    100          
    100          
71             # $[
72 92 100       318 if ($elem eq '$[') {
73 1         30 push @violations, $self->_violation('$[', $elem);
74             }
75             } elsif ($elem->isa('PPI::Token::Operator')) {
76             # :=
77 47 100 66     135 if ($elem eq ':' and $next = $elem->next_sibling and $next->isa('PPI::Token::Operator') and $next eq '=') {
    100 100        
    100 66        
      66        
      66        
      66        
      66        
78 1         88 push @violations, $self->_violation(':=', $elem);
79             # ?PATTERN? - PPI parses this as multiple ? operators
80             } elsif ($elem eq '?' and $parent = $elem->parent and $parent->isa('PPI::Statement')) {
81 6         218 $next = $elem->snext_sibling;
82 6   100     190 until (!$next or ($next->isa('PPI::Token::Operator') and $next eq '?')) {
      100        
83 14         305 $next = $next->snext_sibling;
84             }
85             # If the statement has a : operator, this is probably a ternary operator.
86             # PPI also tends to detect the : as a loop label.
87 6 100 100 17   279 if ($next and none { ($_->isa('PPI::Token::Operator') and $_ eq ':') or $_->isa('PPI::Token::Label') } $parent->schildren) {
  17 100 100     262  
88 1         8 push @violations, $self->_violation('?PATTERN?', $elem);
89             }
90             # Bare here-doc - differentiate this from the legitimate << operator
91             } elsif ($elem eq '<<' and (!($next = $elem->snext_sibling)
92             or ($next->isa('PPI::Token::Operator') and $next ne '~' and $next ne '!' and $next ne '+' and $next ne '-')
93             or ($next->isa('PPI::Token::Structure') and $next ne '(' and $next ne '{' and $next ne '['))) {
94 4         426 push @violations, $self->_violation('Bare here-doc', $elem);
95             }
96             } elsif ($elem->isa('PPI::Token::Word')) {
97             # UNIVERSAL->import()
98 152 100 66     486 if ($elem eq 'UNIVERSAL'
    100 100        
    100 66        
    100 66        
      33        
      66        
      66        
      100        
      66        
      100        
      100        
99             and $next = $elem->snext_sibling and $next->isa('PPI::Token::Operator') and $next eq '->'
100             and $next = $next->snext_sibling and $next->isa('PPI::Token::Word') and $next eq 'import') {
101 1         126 push @violations, $self->_violation('UNIVERSAL->import()', $next);
102             # for $x qw(...)
103             } elsif (($elem eq 'for' or $elem eq 'foreach') and !$elem->sprevious_sibling) {
104 2         96 $next = $elem->snext_sibling;
105 2   66     87 until (!$next or $next->isa('PPI::Structure::List')
      100        
106             or $next->isa('PPI::Token::QuoteLike::Words')) {
107 4         70 $next = $next->snext_sibling;
108             }
109 2 100 66     101 if ($next and $next->isa('PPI::Token::QuoteLike::Words')) {
110 1         6 push @violations, $self->_violation('qw(...) as parentheses', $next);
111             }
112             # do SUBROUTINE(LIST)
113             } elsif ($elem eq 'do' and $next = $elem->snext_sibling) {
114 6 100 66     520 if ((($next->isa('PPI::Token::Word') and is_function_call $next)
      66        
      66        
115             or ($next->isa('PPI::Token::Symbol') and ($next->raw_type eq '&' or $next->raw_type eq '$')))
116             and ($next = $next->snext_sibling and $next->isa('PPI::Structure::List'))) {
117 3         613 push @violations, $self->_violation('do SUBROUTINE(LIST)', $elem);
118             }
119             # avoid false positives for method calls
120             } elsif (!($prev = $elem->sprevious_sibling) or !$prev->isa('PPI::Token::Operator') or $prev ne '->') {
121             # POSIX character function or POSIX::tmpnam()
122 139 100 100     11062 if (exists $posix_deprecated{$elem} or $elem eq 'tmpnam' or $elem eq 'POSIX::tmpnam') {
    100 100        
    100 66        
    100 66        
      66        
123 48 100       424 my $is_posix = $elem =~ m/^POSIX::/ ? 1 : 0;
124 48         337 (my $function_name = $elem) =~ s/^POSIX:://;
125 48 100       308 unless ($is_posix) {
126 36   50     127 my $includes = $elem->document->find('PPI::Statement::Include') || [];
127 36   50     224446 foreach my $stmt (grep { ($_->module // '') eq 'POSIX' } @$includes) {
  96         1636  
128 36         1107 my @args = $stmt->arguments;
129 36 100 100 24   1425 $is_posix = 1 if !@args or any { $_ =~ m/\b\Q$function_name\E\b/ } @args;
  24         88  
130             }
131             }
132 48 100       982 if ($is_posix) {
133 36 100       133 push @violations, $self->_violation('POSIX::tmpnam()', $elem) if $function_name eq 'tmpnam';
134 36 100       1046 push @violations, $self->_violation('POSIX character function', $elem) if exists $posix_deprecated{$elem};
135             }
136             # defined array/hash
137             } elsif ($elem eq 'defined' and $next = $elem->snext_sibling) {
138 8 100       558 $next = $next->schild(0) if $next->isa('PPI::Structure::List');
139 8 100 66     144 if ($next and $next->isa('PPI::Token::Symbol')
      100        
      100        
      66        
140             and ($next->raw_type eq '@' or $next->raw_type eq '%')
141             and $next->raw_type eq $next->symbol_type) {
142 2         189 push @violations, $self->_violation('defined on array/hash', $elem);
143             }
144             # autoderef
145             } elsif (exists $autoderef_functions{$elem} and $next = $elem->snext_sibling) {
146 21 100       1417 $next = $next->schild(0) if $next->isa('PPI::Structure::List');
147 21 100 100     239 $next = $next->schild(0) if $next and $next->isa('PPI::Statement::Expression');
148 21 100 100     198 if ($next and $next->isa('PPI::Token::Symbol') and $next->raw_type eq '$') {
      100        
149 11         122 my $is_postderef;
150 11   66     119 until (!$next or ($next->isa('PPI::Token::Structure') and $next eq ';')
      100        
      100        
      100        
151             or ($next->isa('PPI::Token::Operator') and $next eq ',')) {
152 29         193 $next = $next->snext_sibling;
153 29 50 100     922 if ($next and $next->isa('PPI::Token::Cast') and ($next eq '@*' or $next eq '%*')) {
      66        
      100        
154 3         66 $is_postderef = 1;
155 3         8 last;
156             }
157             }
158 11 100       129 push @violations, $self->_violation('autoderef', $elem) unless $is_postderef;
159             }
160             } elsif ($elem eq 'chdir' and $next = $elem->snext_sibling) {
161 7 100       573 $next = $next->schild(0) if $next->isa('PPI::Structure::List');
162 7 100 100     156 $next = $next->schild(0) if $next and $next->isa('PPI::Statement::Expression');
163 7 100 100     89 if ($next and (($next->isa('PPI::Token::Quote') and !length $next->string)
      100        
164             or ($next->isa('PPI::Token::Word') and $next eq 'undef'))) {
165 3         58 push @violations, $self->_violation('chdir(\'\')', $elem);
166             }
167             }
168             }
169             } elsif ($elem->isa('PPI::Token::Regexp')) {
170             # ?PATTERN?
171 8 50 100     53 if ($elem->isa('PPI::Token::Regexp::Match') and ($elem->get_delimiters)[0] eq '??' and $elem !~ m/^m/) {
      66        
172 0         0 push @violations, $self->_violation('?PATTERN?', $elem);
173             }
174 8 50       181 if (!$elem->isa('PPI::Token::Regexp::Transliterate')) {
175 8         22 push @violations, $self->_violates_interpolated($elem);
176             }
177             } elsif ($elem->isa('PPI::Token::HereDoc')) {
178             # Bare here-doc
179 3 50       8 if ($elem eq '<<') {
180 0         0 push @violations, $self->_violation('Bare here-doc', $elem);
181             }
182             } elsif ($elem->isa('PPI::Token::QuoteLike')) {
183 12 100 100     110 if ($elem->isa('PPI::Token::QuoteLike::Regexp') or $elem->isa('PPI::Token::QuoteLike::Backtick') or $elem->isa('PPI::Token::QuoteLike::Command')) {
      100        
184 8         61 push @violations, $self->_violates_interpolated($elem);
185             }
186             } elsif ($elem->isa('PPI::Token::Quote')) {
187 14 100 100     91 if ($elem->isa('PPI::Token::Quote::Double') or $elem->isa('PPI::Token::Quote::Interpolate')) {
188 5         30 push @violations, $self->_violates_interpolated($elem);
189             }
190             }
191             }
192 1161         24524 return @violations;
193             }
194              
195             sub _violates_interpolated {
196 21     21   51 my ($self, $elem) = @_;
197 21         51 my @violations;
198             # NBSP in \N{...}
199             my $contents;
200 21 100 100     151 if ($elem->isa('PPI::Token::Regexp') or $elem->isa('PPI::Token::QuoteLike::Regexp')) {
    100          
201 12         55 $contents = $elem->get_match_string;
202             # /\C/
203 12 100       269 push @violations, $self->_violation('/\\C/', $elem) if $contents =~ m/(?<!\\)\\C/;
204             } elsif ($elem->isa('PPI::Token::Quote')) {
205 5         34 $contents = $elem->string;
206             } else {
207             # Backticks and qx elements have no contents method
208 4         9 $contents = $elem;
209             }
210 21 100       613 push @violations, $self->_violation('NBSP in \\N{...}', $elem) if $contents =~ m/\\N\{[^}]*\x{a0}[^}]*\}/;
211 21         1658 return @violations;
212             }
213              
214             1;
215              
216             =head1 NAME
217              
218             Perl::Critic::Policy::Community::DeprecatedFeatures - Avoid features that have
219             been deprecated or removed from Perl
220              
221             =head1 DESCRIPTION
222              
223             While L<Perl::Critic::Policy::Community::StrictWarnings> will expose usage of
224             deprecated or removed features when a modern perl is used, this policy will
225             detect such features in use regardless of perl version, to assist in keeping
226             your code modern and forward-compatible.
227              
228             =head1 FEATURES
229              
230             =head2 :=
231              
232             Because the whitespace between an attribute list and assignment operator is not
233             significant, it was possible to specify assignment to a variable with an empty
234             attribute list with a construction like C<my $foo := 'bar'>. This is deprecated
235             in perl v5.12.0 to allow the possibility of a future C<:=> operator. Avoid the
236             issue by either putting whitespace between the C<:> and C<=> characters or
237             simply omitting the empty attribute list.
238              
239             =head2 $[
240              
241             The magic L<perlvar/"$["> variable was used in very old perls to determine the
242             index of the first element of arrays or the first character in substrings, and
243             also allow modifying this value. It was discouraged from the start of Perl 5,
244             its functionality changed in v5.10.0, deprecated in v5.12.0, re-implemented as
245             L<arybase>.pm in v5.16.0, and it is essentially a synonym for C<0> under
246             C<use v5.16> or C<no feature "array_base">. While it is probably a bad idea in
247             general, the modules L<Array::Base> and L<String::Base> can now be used to
248             replace this functionality.
249              
250             =head2 /\C/
251              
252             The C<\C> regular expression character class would match a single byte of the
253             internal representation of the string, which was dangerous because it violated
254             the logical character abstraction of Perl strings, and substitutions using it
255             could result in malformed UTF-8 sequences. It was deprecated in perl v5.20.0
256             and removed in perl v5.24.0. Instead, explicitly encode the string to UTF-8
257             using L<Encode> to examine its UTF-8-encoded byte representation.
258              
259             =head2 ?PATTERN?
260              
261             The C<?PATTERN?> regex match syntax is deprecated in perl v5.14.0 and removed
262             in perl v5.22.0. Use C<m?PATTERN?> instead.
263              
264             =head2 autoderef
265              
266             An experimental feature was introduced in perl v5.14.0 to allow calling various
267             builtin functions (which operate on arrays or hashes) on a reference, which
268             would automatically dereference the operand. This led to ambiguity when passed
269             objects that overload both array and hash dereferencing, and so was removed in
270             perl v5.24.0. Instead, explicitly dereference the reference when calling these
271             functions. The functions affected are C<each>, C<keys>, C<pop>, C<push>,
272             C<shift>, C<splice>, C<unshift>, and C<values>.
273              
274             =head2 Bare here-doc
275              
276             Using C< << > to initiate a here-doc would create it with an empty terminator,
277             similar to C< <<'' >, so the here-doc would terminate on the next empty line.
278             Omitting the quoted empty string has been deprecated since perl 5, and is a
279             fatal error in perl v5.28.0.
280              
281             =head2 chdir('')
282              
283             Passing an empty string or C<undef> to C<chdir()> would change to the home
284             directory, but this usage is deprecated in perl v5.8.0 and throws an error in
285             perl v5.24.0. Instead, call C<chdir()> with no arguments for this behavior.
286              
287             =head2 defined on array/hash
288              
289             Using the function C<defined()> on an array or hash probably does not do what
290             you expected, and is deprecated in perl v5.6.2 and throws a fatal error in perl
291             v5.22.0. To check if an array or hash is non-empty, test if it has elements.
292              
293             if (@foo) { ... }
294             if (keys %bar) { ... }
295              
296             =head2 do SUBROUTINE(LIST)
297              
298             This form of C<do> to call a subroutine has been deprecated since perl 5, and
299             is removed in perl v5.20.0.
300              
301             =head2 NBSP in \N{...}
302              
303             Use of the "no-break space" character in L<character names|charnames> is
304             deprecated in perl v5.22.0 and an error in perl v5.26.0.
305              
306             =head2 POSIX character functions
307              
308             Several character matching functions in L<POSIX>.pm are deprecated in perl
309             v5.20.0. See the L<POSIX> documentation for more details. Most uses of these
310             functions can be replaced with appropriate regex matches.
311              
312             isalnum, isalpha, iscntrl, isdigit, isgraph, islower, isprint, ispunct, isspace, issuper, isxdigit
313              
314             =head2 POSIX::tmpnam()
315              
316             The C<tmpnam()> function from L<POSIX>.pm is deprecated in perl v5.22.0 and
317             removed in perl v5.26.0. Use L<File::Temp> instead.
318              
319             =head2 qw(...) as parentheses
320              
321             Literal parentheses are required for certain statements such as a
322             C<for my $foo (...) { ... }> construct. Using a C<qw(...)> list literal without
323             surrounding parentheses in this syntax is deprecated in perl v5.14.0 and a
324             syntax error in perl v5.18.0. Wrap the literal in parentheses:
325             C<for my $foo (qw(...)) { ... }>.
326              
327             =head2 require ::Foo::Bar
328              
329             A bareword C<require> (or C<use>) starting with a double colon would
330             inadvertently translate to a path starting with C</>. Starting in perl v5.26.0,
331             this is a fatal error.
332              
333             =head2 UNIVERSAL->import()
334              
335             The method C<< UNIVERSAL->import() >> and similarly passing import arguments to
336             C<use UNIVERSAL> is deprecated in perl v5.12.0 and throws a fatal error in perl
337             v5.22.0. Calling C<use UNIVERSAL> with no arguments is not an error, but serves
338             no purpose.
339              
340             =head1 AFFILIATION
341              
342             This policy is part of L<Perl::Critic::Community>.
343              
344             =head1 CONFIGURATION
345              
346             This policy is not configurable except for the standard options.
347              
348             =head1 CAVEATS
349              
350             This policy is incomplete, as many deprecations are difficult to test for
351             statically. It is recommended to use L<perlbrew> or L<perl-build> to test your
352             code under newer versions of Perl, with C<warnings> enabled.
353              
354             =head1 AUTHOR
355              
356             Dan Book, C<dbook@cpan.org>
357              
358             =head1 COPYRIGHT AND LICENSE
359              
360             Copyright 2015, Dan Book.
361              
362             This library is free software; you may redistribute it and/or modify it under
363             the terms of the Artistic License version 2.0.
364              
365             =head1 SEE ALSO
366              
367             L<Perl::Critic>