File Coverage

blib/lib/Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm
Criterion Covered Total %
statement 49 50 98.0
branch 11 12 91.6
condition 4 6 66.6
subroutine 13 13 100.0
pod 5 6 83.3
total 82 87 94.2


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage;
2              
3 40     40   26725 use 5.010001;
  40         184  
4 40     40   257 use strict;
  40         298  
  40         876  
5 40     40   210 use warnings;
  40         93  
  40         1201  
6 40     40   243 use Readonly;
  40         97  
  40         1828  
7              
8 40     40   257 use File::Spec;
  40         127  
  40         1410  
9              
10 40     40   257 use Perl::Critic::Utils qw{ :characters :severities };
  40         102  
  40         2107  
11              
12 40     40   12023 use parent 'Perl::Critic::Policy';
  40         153  
  40         263  
13              
14             our $VERSION = '1.146';
15              
16             #-----------------------------------------------------------------------------
17              
18             Readonly::Scalar my $DESC => q{Package declaration must match filename};
19             Readonly::Scalar my $EXPL => q{Correct the filename or package statement};
20              
21             #-----------------------------------------------------------------------------
22              
23 119     119 0 1756 sub supported_parameters { return () }
24 85     85 1 387 sub default_severity { return $SEVERITY_HIGHEST }
25 74     74 1 306 sub default_themes { return qw(core bugs) }
26 64     64 1 228 sub applies_to { return 'PPI::Document' }
27              
28             #-----------------------------------------------------------------------------
29              
30             sub prepare_to_scan_document {
31 66     66 1 190 my ( $self, $document ) = @_;
32 66         243 return $document->is_module(); # Must be a library or module.
33             }
34              
35             #-----------------------------------------------------------------------------
36              
37             sub violates {
38 64     64 1 200 my ($self, $elem, $doc) = @_;
39              
40             # 'Foo::Bar' -> ('Foo', 'Bar')
41 64         233 my $pkg_node = $doc->find_first('PPI::Statement::Package');
42 64 100       390 return if not $pkg_node;
43 57         322 my $pkg = $pkg_node->namespace();
44 57 100       1901 return if $pkg eq 'main';
45 56         428 my @pkg_parts = split m/(?:\'|::)/xms, $pkg;
46              
47              
48             # 'lib/Foo/Bar.pm' -> ('lib', 'Foo', 'Bar')
49 56   66     290 my $filename = $pkg_node->logical_filename() || $doc->filename();
50 56 100       1043 return if not $filename;
51              
52 26         445 my @path = File::Spec->splitpath($filename);
53 26         74 $filename = $path[2];
54 26         151 $filename =~ s/ [.] \w+ \z //xms;
55             my @path_parts =
56 26         144 grep {$_ ne $EMPTY} File::Spec->splitdir($path[1]), $filename;
  132         312  
57              
58              
59             # To succeed, at least the lastmost must match
60             # Beyond that, the search terminates if a dirname is an impossible package name
61 26         59 my $matched_any;
62 26   66     158 while (@pkg_parts && @path_parts) {
63 43         96 my $pkg_part = pop @pkg_parts;
64 43         77 my $path_part = pop @path_parts;
65 43 100       133 if ($pkg_part eq $path_part) {
66 26         54 $matched_any = 1;
67 26         90 next;
68             }
69              
70             # if it's a path that's not a possible package (like 'Foo-Bar-1.00'), that's OK
71 17 100       81 last if ($path_part =~ m/\W/xms);
72              
73             # Mismatched name
74 11         52 return $self->violation( $DESC, $EXPL, $pkg_node );
75             }
76              
77 15 50       104 return if $matched_any;
78 0           return $self->violation( $DESC, $EXPL, $pkg_node );
79             }
80              
81             1;
82              
83             #-----------------------------------------------------------------------------
84              
85             __END__
86              
87             =pod
88              
89             =head1 NAME
90              
91             Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage - Package declaration must match filename.
92              
93              
94             =head1 AFFILIATION
95              
96             This Policy is part of the core L<Perl::Critic|Perl::Critic>
97             distribution.
98              
99              
100             =head1 DESCRIPTION
101              
102             The package declaration should always match the name of the file that contains
103             it. For example, C<package Foo::Bar;> should be in a file called C<Bar.pm>.
104             This makes it easier for developers to figure out which file a symbol comes
105             from when they see it in your code. For instance, when you see C<<
106             Foo::Bar->new() >>, you should be able to find the class definition for a
107             C<Foo::Bar> in a file called F<Bar.pm>
108              
109             Therefore, this Policy requires the last component of the first package name
110             declared in the file to match the physical filename. Or if C<#line>
111             directives are used, then it must match the logical filename defined by the
112             prevailing C<#line> directive at the point of the package declaration. Here
113             are some examples:
114              
115             # Any of the following in file "Foo/Bar/Baz.pm":
116             package Foo::Bar::Baz; # ok
117             package Baz; # ok
118             package Nuts; # not ok (doesn't match physical filename)
119              
120             # using #line directives in file "Foo/Bar/Baz.pm":
121             #line 1 Nuts.pm
122             package Nuts; # ok
123             package Baz; # not ok (contradicts #line directive)
124              
125             If the file is not deemed to be a module, then this Policy does not apply.
126             Also, if the first package namespace found in the file is "main" then this
127             Policy does not apply.
128              
129             =head1 CONFIGURATION
130              
131             This Policy is not configurable except for the standard options.
132              
133              
134             =head1 AUTHOR
135              
136             Chris Dolan <cdolan@cpan.org>
137              
138              
139             =head1 COPYRIGHT
140              
141             Copyright (c) 2006-2011 Chris Dolan.
142              
143             This program is free software; you can redistribute it and/or modify
144             it under the same terms as Perl itself.
145              
146             =cut
147              
148             ##############################################################################
149             # Local Variables:
150             # mode: cperl
151             # cperl-indent-level: 4
152             # fill-column: 78
153             # indent-tabs-mode: nil
154             # c-indentation-style: bsd
155             # End:
156             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :