From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ELLIOTJS / Perl-Critic-1.083_004 / lib / Perl / Critic / Policy / TestingAndDebugging / ProhibitNoWarnings.pm 

            

              
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

              
##############################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitNoWarnings.pm $
#     $Date: 2008-05-18 18:49:57 -0500 (Sun, 18 May 2008) $
#   $Author: clonezone $
# $Revision: 2367 $
##############################################################################
package Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings;
use strict;
use warnings;
use Readonly;
use List::MoreUtils qw(all);
use Perl::Critic::Utils qw{ :characters :severities :data_conversion };
use base 'Perl::Critic::Policy';
our $VERSION = '1.083_004';
#-----------------------------------------------------------------------------
Readonly::Scalar my $DESC => q{Warnings disabled};
Readonly::Scalar my $EXPL => [ 431 ];
#-----------------------------------------------------------------------------
sub supported_parameters {
    return (
        {
            name            => 'allow',
            description     => 'Permitted warning categories.',
            default_string  => $EMPTY,
            parser          => \&_parse_allow,
        },
    );
}
sub default_severity { return $SEVERITY_HIGH            }
sub default_themes   { return qw( core bugs pbp )       }
sub applies_to       { return 'PPI::Statement::Include' }
#-----------------------------------------------------------------------------
sub _parse_allow {
    my ($self, $parameter, $config_string) = @_;
    $self->{_allow} = {};
    if( defined $config_string ) {
        my $allowed = lc $config_string; #String of words
        my %allowed = hashify( $allowed =~ m/ (\w+) /gmx );
        $self->{_allow} = \%allowed;
    }
    return;
}
#-----------------------------------------------------------------------------
sub violates {
    my ( $self, $elem, undef ) = @_;
    return if $elem->type()   ne 'no';
    return if $elem->pragma() ne 'warnings';
    #Arguments to 'no warnings' are usually a list of literals or a
    #qw() list.  Rather than trying to parse the various PPI elements,
    #I just use a regex to split the statement into words.  This is
    #kinda lame, but it does the trick for now.
    # TODO consider: a possible alternate implementation:
    #   my $re = join q{|}, keys %{$self->{allow}};
    #   return if $re && $stmnt =~ m/\b(?:$re)\b/mx;
    # May need to detaint for that to work...  Not sure.
    my $stmnt = $elem->statement();
    return if !$stmnt;
    my @words = $stmnt =~ m/ ([[:lower:]]+) /gmx;
    @words = grep { $_ ne 'qw' && $_ ne 'no' && $_ ne 'warnings' } @words;
    return if all { exists $self->{_allow}->{$_} } @words;
    #If we get here, then it must be a violation
    return $self->violation( $DESC, $EXPL, $elem );
}
1;
__END__
#-----------------------------------------------------------------------------
=pod
=head1 NAME
Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings - Prohibit various flavors of C<no warnings>.
=head1 AFFILIATION
This Policy is part of the core L<Perl::Critic> distribution.
=head1 DESCRIPTION
There are good reasons for disabling certain kinds of warnings.  But if you
were wise enough to C<use warnings> in the first place, then it doesn't make
sense to disable them completely.  By default, any C<no warnings> statement
will violate this policy.  However, you can configure this Policy to allow
certain types of warnings to be disabled (See L<Configuration>).  A bare C<no
warnings> statement will always raise a violation.
=head1 CONFIGURATION
The permitted warning types can be configured via the C<allow> option.  The
value is a list of whitespace-delimited warning types that you want to be able
to disable.  See L<perllexwarn> for a list of possible warning types.  An
example of this customization:
  [TestingAndDebugging::ProhibitNoWarnings]
  allow = uninitialized once
=head1 SEE ALSO
L<Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings>
=head1 AUTHOR
Jeffrey Ryan Thalhammer <thaljef@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  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 :