view release on metacpan or  search on metacpan

lib/Perl/Critic/Policy/Compatibility/ProhibitUnixDevNull.pm  view on Meta::CPAN

# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 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 = 100;

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