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
|
# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Kevin Ryde
# Perl-Critic-Pulp is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Perl-Critic-Pulp is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
package Perl::Critic::Policy::Compatibility::ProhibitUnixDevNull;
use 5.006;
use strict;
use warnings;
use List::Util;
use base 'Perl::Critic::Policy';
use Perl::Critic::Utils;
use Perl::Critic::Pulp;
our $VERSION = 96;
use constant supported_parameters => ();
use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW;
use constant default_themes => qw(pulp bugs);
use constant applies_to => qw(PPI::Token::Quote
PPI::Token::QuoteLike::Words);
# See Perl_do_openn() for IsSPACE allowed leading, after mode and trailing.
# No layers in a two-arg open, only < > >> etc.
#
use constant _DEV_NULL_RE => qr{^\s*
(\+?(<|>>?)\s*)?
/dev/null
\s*$
}sxo;
my %equality_operators = (eq => 1, ne => 1);
sub violates {
my ($self, $elem, $document) = @_;
if ($elem->isa('PPI::Token::QuoteLike::Words')) {
return unless List::Util::first {$_ eq '/dev/null'} $elem->literal;
} else { # PPI::Token::Quote
my $str = $elem->string;
return unless $str =~ _DEV_NULL_RE;
# Allow ... eq 'dev/null' or 'dev/null' eq ...
#
# Could think about the filetest operators too. -e '/dev/null' is
# probably a portability check, but believe still better to have
# File::Spec->devnull there.
#
foreach my $adj ($elem->sprevious_sibling, $elem->snext_sibling) {
if ($adj
&& $adj->isa('PPI::Token::Operator')
&& $equality_operators{$adj}) {
return;
}
}
}
return $self->violation
('For maximum portability use File::Spec->devnull instead of "/dev/null"',
'',
$elem);
}
1;
__END__
=for stopwords filename backticks Ryde
=head1 NAME
Perl::Critic::Policy::Compatibility::ProhibitUnixDevNull - don't use explicit /dev/null
=head1 DESCRIPTION
This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
add-on. It ask you to not to use filename
=over
F</dev/null>
=back
explicitly, but instead C<File::Spec-E<gt>devnull()> for maximum portability
across operating systems.
This policy is under the C<maintenance> theme (see
L<Perl::Critic/POLICY THEMES>) on the basis that even if you're on a Unix
system now you never know where your code might travel in the future.
C<devnull()> is new in C<File::Spec> version 0.8, so you should require that
version (it's included in Perl 5.6.0 and up).
The checks for F</dev/null> are unsophisticated. A violation is reported
for any string C</dev/null>, possibly with an C<open> style mode part, and
any C<qw> containing C</dev/null>.
open my $fh, '< /dev/null'; # bad
do_something ("/dev/null"); # bad
foreach my $file (qw(/dev/null /etc/passwd)) # bad
String comparisons are allowed because they're not uses of F</dev/null> as
such but likely some sort of cross-platform check.
if ($f eq '/dev/null') { ... } # ok
return ($f ne '>/dev/null'); # ok
F</dev/null> as just part of a string is allowed, including things like
backticks and C<system>.
print "Flames to /dev/null please\n" # ok
system ('rmdir /foo/bar >/dev/null 2>&1'); # ok
$hi = `echo hi </dev/null`; # ok
Whether F</dev/null> is a good idea in such command strings depends what
sort of shell you reach with that command and how much of Unix it might
emulate on a non-Unix system.
=head2 Disabling
If you only ever use a system with F</dev/null> or if everything else you
write is hopelessly wedded to Unix anyway then you can disable
C<ProhibitUnixDevNull> from your F<.perlcriticrc> in the usual way (see
L<Perl::Critic/CONFIGURATION>),
[-Compatibility::ProhibitUnixDevNull]
=head1 SEE ALSO
L<Perl::Critic::Pulp>, L<Perl::Critic>, L<File::Spec>
=head1 HOME PAGE
L<http://user42.tuxfamily.org/perl-critic-pulp/index.html>
=head1 COPYRIGHT
Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Kevin Ryde
Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Perl-Critic-Pulp is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
=cut
|
