File Coverage

blib/lib/Perl/Critic/Policy/Lax/RequireExplicitPackage/ExceptForPragmata.pm
Criterion Covered Total %
statement 35 38 92.1
branch 9 12 75.0
condition 7 9 77.7
subroutine 9 10 90.0
pod 6 6 100.0
total 66 75 88.0


line stmt bran cond sub pod time code
1 7     7   3790 use strict;
  7         16  
  7         182  
2 7     7   31 use warnings;
  7         12  
  7         321  
3             package Perl::Critic::Policy::Lax::RequireExplicitPackage::ExceptForPragmata 0.014;
4             # ABSTRACT: you can put strict and warnings before "package"
5              
6             #pod =head1 DESCRIPTION
7             #pod
8             #pod This policy is meant to replace Modules::RequireExplicitPackage. That policy's
9             #pod POD says:
10             #pod
11             #pod In general, the first statement of any Perl module or library should be a
12             #pod package statement. Otherwise, all the code that comes before the package
13             #pod statement is getting executed in the caller's package, and you have no idea
14             #pod who that is. Good encapsulation and common decency require your module to
15             #pod keep its innards to itself.
16             #pod
17             #pod Sure, that's swell for code that has effect at a package level, but
18             #pod some statements are lexical. This policy makes allowance for some of
19             #pod those cases. By default, it permits turning on strictures, warnings,
20             #pod features, and diagnostics, as well as requiring a minimum Perl
21             #pod version.
22             #pod
23             #pod =cut
24              
25 7     7   33 use Perl::Critic::Utils;
  7         22  
  7         90  
26 7     7   5153 use parent qw(Perl::Critic::Policy);
  7         20  
  7         38  
27              
28             my $EXPLANATION = 'Violates encapsulation';
29             my $DESCRIPTION = 'Code (other than strict/warnings) not in explicit package';
30              
31 4     4 1 44 sub default_severity { $SEVERITY_HIGH }
32 0     0 1 0 sub default_themes { qw( risky ) }
33 9     9 1 46454 sub applies_to { 'PPI::Document' }
34              
35             #pod =method supported_parameters
36             #pod
37             #pod The default list of pragmata that are permitted before a C<package>
38             #pod declaration can be changed via the C<allowed_pragmata> configuration
39             #pod parameter. Its value is a space-separated list of pragma names to be
40             #pod permitted. In this list, the name C<perlversion> is special: it
41             #pod allows a C<use 5.xxx> statement.
42             #pod
43             #pod This module understands the C<exempt_scripts> configuration parameter just like
44             #pod L<Perl::Critic::Policy::Modules::RequireExplicitPackage>.
45             #pod
46             #pod =cut
47              
48             sub supported_parameters {
49             return (
50             {
51 9     9 1 39433 name => 'allowed_pragmata',
52             description =>
53             'Names of pragmata that are permitted before package declaration',
54             default_string => 'diagnostics feature perlversion strict warnings',
55             behavior => 'string list',
56             },
57             {
58             name => 'exempt_scripts',
59             description => q(Don't require programs to have a package statement.),
60             default_string => '1',
61             behavior => 'boolean',
62             },
63             );
64             }
65              
66             sub initialize_if_enabled {
67 9     9 1 26334 my($self, $config) = @_;
68             # The real parsing was done to spec in supported_parameters, but we
69             # convert the list to a hash here for ease of use later.
70 0         0 $self->{_allowed_pragmata} = { map { {$_ => 1} } @{$self->{_allowed_pragmata}} }
  0         0  
71 9 50       39 if ref $self->{_allowed_pragmata} eq 'ARRAY';
72 9         20 return $TRUE;
73             }
74              
75             sub violates {
76 9     9 1 114 my ($self, $elem, $doc) = @_;
77              
78             # You can configure this policy to exclude scripts
79 9 100 66     44 return if $self->{_exempt_scripts} && $doc->is_program;
80              
81             # Find the first 'package' statement
82 8         99 my $package_stmnt = $doc->find_first('PPI::Statement::Package');
83 8 50       186 my $package_line = $package_stmnt ? $package_stmnt->location()->[0] : undef;
84              
85             # Find all statements that aren't 'package' statements
86 8         167 my $stmnts_ref = $doc->find('PPI::Statement');
87 8 50       81 return if !$stmnts_ref;
88             my @non_packages =
89             grep { not(
90             $_->isa('PPI::Statement::Include') && $_->type eq 'use'
91             && ( $_->version && exists $self->{_allowed_pragmata}{perlversion} ||
92 25   100     926 exists $self->{_allowed_pragmata}{ $_->module } )
93             ) }
94 8         26 grep { !$_->isa('PPI::Statement::Package') } @{$stmnts_ref};
  33         108  
  8         18  
95 8 100       136 return if !@non_packages;
96              
97             # If the 'package' statement is not defined, or the other
98             # statements appear before the 'package', then it violates.
99              
100 7         20 my @viols = ();
101 7         15 for my $statement (@non_packages) {
102 10         565 my $statement_line = $statement->location->[0];
103 10 100 66     182 if ((not defined $package_line) || ($statement_line < $package_line)) {
104 4         21 push @viols, $self->violation($DESCRIPTION, $EXPLANATION, $statement);
105             }
106             }
107              
108 7         185 return @viols;
109             }
110              
111             1;
112              
113             __END__
114              
115             =pod
116              
117             =encoding UTF-8
118              
119             =head1 NAME
120              
121             Perl::Critic::Policy::Lax::RequireExplicitPackage::ExceptForPragmata - you can put strict and warnings before "package"
122              
123             =head1 VERSION
124              
125             version 0.014
126              
127             =head1 DESCRIPTION
128              
129             This policy is meant to replace Modules::RequireExplicitPackage. That policy's
130             POD says:
131              
132             In general, the first statement of any Perl module or library should be a
133             package statement. Otherwise, all the code that comes before the package
134             statement is getting executed in the caller's package, and you have no idea
135             who that is. Good encapsulation and common decency require your module to
136             keep its innards to itself.
137              
138             Sure, that's swell for code that has effect at a package level, but
139             some statements are lexical. This policy makes allowance for some of
140             those cases. By default, it permits turning on strictures, warnings,
141             features, and diagnostics, as well as requiring a minimum Perl
142             version.
143              
144             =head1 PERL VERSION
145              
146             This library should run on perls released even a long time ago. It should work
147             on any version of perl released in the last five years.
148              
149             Although it may work on older versions of perl, no guarantee is made that the
150             minimum required version will not be increased. The version may be increased
151             for any reason, and there is no promise that patches will be accepted to lower
152             the minimum required perl.
153              
154             =head1 METHODS
155              
156             =head2 supported_parameters
157              
158             The default list of pragmata that are permitted before a C<package>
159             declaration can be changed via the C<allowed_pragmata> configuration
160             parameter. Its value is a space-separated list of pragma names to be
161             permitted. In this list, the name C<perlversion> is special: it
162             allows a C<use 5.xxx> statement.
163              
164             This module understands the C<exempt_scripts> configuration parameter just like
165             L<Perl::Critic::Policy::Modules::RequireExplicitPackage>.
166              
167             =head1 AUTHOR
168              
169             Ricardo Signes <cpan@semiotic.systems>
170              
171             =head1 COPYRIGHT AND LICENSE
172              
173             This software is copyright (c) 2022 by Ricardo Signes <cpan@semiotic.systems>.
174              
175             This is free software; you can redistribute it and/or modify it under
176             the same terms as the Perl 5 programming language system itself.
177              
178             =cut