vcs.maemo.org Git - dh-make-perl/blob - dev/arm/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/Documentation/RequirePackageMatchesPodName.pm

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