Login
Rename is_document_exempt() to prepare_to_scan_document().
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / Documentation / RequirePackageMatchesPodName.pm
CommitLineData
fc1fcfaf
CD
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName;
9
df6dee2b 10use 5.006001;
fc1fcfaf
CD
11use strict;
12use warnings;
13use Readonly;
14
15use Perl::Critic::Utils qw{ :severities :classification };
16use base 'Perl::Critic::Policy';
17
173667ce 18our $VERSION = '1.093_01';
fc1fcfaf
CD
19
20#-----------------------------------------------------------------------------
21
a0dcf06f 22Readonly::Scalar my $PKG_RX => qr{ [[:alpha:]](?:[\w:\']*\w)? }xms;
fc1fcfaf
CD
23Readonly::Scalar my $DESC => q{Pod NAME does not match the package declaration};
24Readonly::Scalar my $EXPL => q{};
25
26#-----------------------------------------------------------------------------
27
28sub supported_parameters { return () }
29sub default_severity { return $SEVERITY_LOWEST }
30sub default_themes { return qw( core cosmetic ) }
31sub applies_to { return 'PPI::Document' }
32
33#-----------------------------------------------------------------------------
34
78afb6d4 35sub prepare_to_scan_document {
3de28bcc
ES
36 my ( $self, $document ) = @_;
37
38 # idea: force NAME to match the file name in scripts?
78afb6d4 39 return not is_script($document); # mismatch is normal in program entry points
3de28bcc
ES
40}
41
fc1fcfaf
CD
42sub violates {
43 my ( $self, $elem, $doc ) = @_;
44
45 # No POD means no violation
46 my $pods_ref = $doc->find('PPI::Token::Pod');
47 return if !$pods_ref;
48
49 for my $pod (@{$pods_ref}) {
11f53956 50 my $content = $pod->content;
fc1fcfaf 51
11f53956 52 next if $content !~ m{^=head1 [ \t]+ NAME [ \t]*$ \s*}cgxms;
fc1fcfaf 53
11f53956 54 my ($pod_pkg) = $content =~ m{\G (\S+) }cgxms;
fc1fcfaf 55
11f53956
ES
56 if (!$pod_pkg) {
57 return $self->violation( $DESC, q{Empty name declaration}, $elem );
58 }
fc1fcfaf 59
11f53956
ES
60 # idea: worry about POD escapes?
61 $pod_pkg =~ s{\A [CL]<(.*)>\z}{$1}gxms; # unwrap
62 $pod_pkg =~ s{\'}{::}gxms; # perl4 -> perl5
fc1fcfaf 63
11f53956
ES
64 my $pkgs = $doc->find('PPI::Statement::Package');
65 # no package statement means no possible match
66 my $pkg = $pkgs ? $pkgs->[0]->namespace : q{};
67 $pkg =~ s{\'}{::}gxms;
fc1fcfaf 68
11f53956
ES
69 return if $pkg eq $pod_pkg;
70 return $self->violation( $DESC, $EXPL, $pod );
fc1fcfaf 71 }
11f53956 72
fc1fcfaf
CD
73 return; # no NAME section found
74}
75
761;
77
78__END__
79
80#-----------------------------------------------------------------------------
81
82=pod
83
84=head1 NAME
85
86Perl::Critic::Policy::Documentation::RequirePackageMatchesPodName - The C<=head1 NAME> section should match the package.
87
11f53956 88
fc1fcfaf
CD
89=head1 AFFILIATION
90
11f53956
ES
91This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
92
fc1fcfaf
CD
93
94=head1 DESCRIPTION
95
96
97=head1 CONFIGURATION
98
99This Policy is not configurable except for the standard options.
100
11f53956 101
fc1fcfaf
CD
102=head1 AUTHOR
103
104Chris Dolan <cdolan@cpan.org>
105
11f53956 106
fc1fcfaf
CD
107=head1 COPYRIGHT
108
109Copyright (c) 2008 Chris Dolan
110
111This program is free software; you can redistribute it and/or modify
112it under the same terms as Perl itself. The full text of this license
113can be found in the LICENSE file included with this module
114
115=cut
116
117# Local Variables:
118# mode: cperl
119# cperl-indent-level: 4
120# fill-column: 78
121# indent-tabs-mode: nil
122# c-indentation-style: bsd
123# End:
124# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :