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