git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.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::Miscellanea::RequireRcsKeywords;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use List::MoreUtils qw(none);
  16
  17 use Perl::Critic::Utils qw{
  18     :booleans :characters :severities :data_conversion
  19 };
  20
  21 use base 'Perl::Critic::Policy';
  22
  23 our $VERSION = '1.088';
  24
  25 #-----------------------------------------------------------------------------
  26
  27 Readonly::Scalar my $EXPL => [ 441 ];
  28
  29 #-----------------------------------------------------------------------------
  30
  31 sub supported_parameters {
  32     return (
  33         {
  34             name            => 'keywords',
  35             description     => 'The keywords to require in all files.',
  36             default_string  => $EMPTY,
  37             behavior        => 'string list',
  38         },
  39     );
  40 }
  41
  42 sub default_severity  { return $SEVERITY_LOW         }
  43 sub default_themes    { return qw(core pbp cosmetic) }
  44 sub applies_to        { return 'PPI::Document'       }
  45
  46 #-----------------------------------------------------------------------------
  47
  48 sub initialize_if_enabled {
  49     my ($self, $config) = @_;
  50
  51     # Any of these lists
  52     $self->{_keyword_sets} = [
  53
  54         # Minimal svk/svn
  55         [qw(Id)],
  56
  57         # Expansive svk/svn
  58         [qw(Revision HeadURL Date)],
  59
  60         # cvs?
  61         [qw(Revision Source Date)],
  62     ];
  63
  64     # Set configuration, if defined.
  65     my @keywords = keys %{ $self->{_keywords} };
  66     if ( @keywords ) {
  67         ## no critic ProhibitEmptyQuotes
  68         $self->{_keyword_sets} = [ [ @keywords ] ];
  69     }
  70
  71     return $TRUE;
  72 }
  73
  74 #-----------------------------------------------------------------------------
  75
  76 sub violates {
  77     my ( $self, $elem, $doc ) = @_;
  78     my @viols = ();
  79
  80     my $nodes = $doc->find( \&_wanted );
  81     for my $keywordset_ref ( @{ $self->{_keyword_sets} } ) {
  82         if ( not $nodes ) {
  83             my $desc = 'RCS keywords '
  84                 . join( ', ', map {"\$$_\$"} @{$keywordset_ref} )
  85                 . ' not found';
  86             push @viols, $self->violation( $desc, $EXPL, $doc );
  87         }
  88         else {
  89             my @missing_keywords = grep {
  90                 my $keyword_rx = qr/\$$_.*\$/xms;
  91                 !!none {
  92                     /$keyword_rx/    ## no critic
  93                     }
  94                     @{$nodes}
  95             } @{$keywordset_ref};
  96
  97             if (@missing_keywords) {
  98
  99                 # Provisionally flag a violation. See below.
 100                 my $desc = 'RCS keywords '
 101                     . join( ', ', map {"\$$_\$"} @missing_keywords )
 102                     . ' not found';
 103                 push @viols, $self->violation( $desc, $EXPL, $doc );
 104             }
 105             else {
 106
 107                 # Hey! I'm ignoring @viols for other keyword sets
 108                 # because this one is complete.
 109                 return;
 110             }
 111         }
 112     }
 113
 114     return @viols;
 115 }
 116
 117 sub _wanted {
 118     my ( undef, $elem ) = @_;
 119     return  $elem->isa('PPI::Token::Pod')
 120         || $elem->isa('PPI::Token::Comment')
 121         || $elem->isa('PPI::Token::Quote::Single')
 122         || $elem->isa('PPI::Token::Quote::Literal');
 123 }
 124
 125 1;
 126
 127 __END__
 128
 129 #-----------------------------------------------------------------------------
 130
 131 =pod
 132
 133 =for stopwords RCS
 134
 135 =head1 NAME
 136
 137 Perl::Critic::Policy::Miscellanea::RequireRcsKeywords - Put source-control keywords in every file.
 138
 139 =head1 AFFILIATION
 140
 141 This Policy is part of the core L<Perl::Critic> distribution.
 142
 143
 144 =head1 DESCRIPTION
 145
 146 Every code file, no matter how small, should be kept in a
 147 source-control repository.  Adding the magical RCS keywords to your
 148 file helps the reader know where the file comes from, in case he or
 149 she needs to modify it.  This Policy scans your file for comments that
 150 look like this:
 151
 152   # $Revision: 2489 $
 153   # $Source: /myproject/lib/foo.pm $
 154
 155 A common practice is to use the C<Revision> keyword to automatically
 156 define the C<$VERSION> variable like this:
 157
 158   our ($VERSION) = '$Revision: 2489 $' =~ m{ \$Revision: \s+ (\S+) }x;
 159
 160 =head1 CONFIGURATION
 161
 162 By default, this policy only requires the C<Revision>, C<Source>, and C<Date>
 163 keywords.  To specify alternate keywords, specify a value for C<keywords> of a
 164 whitespace delimited series of keywords (without the dollar-signs).  This would
 165 look something like the following in a F<.perlcriticrc> file:
 166
 167   [Miscellanea::RequireRcsKeywords]
 168   keywords = Revision Source Date Author Id
 169
 170 See the documentation on RCS for a list of supported keywords.  Many
 171 source control systems are descended from RCS, so the keywords
 172 supported by CVS and Subversion are probably the same.
 173
 174 =head1 AUTHOR
 175
 176 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 177
 178 =head1 COPYRIGHT
 179
 180 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 181
 182 This program is free software; you can redistribute it and/or modify
 183 it under the same terms as Perl itself.  The full text of this license
 184 can be found in the LICENSE file included with this module.
 185
 186 =cut
 187
 188 # Local Variables:
 189 #   mode: cperl
 190 #   cperl-indent-level: 4
 191 #   fill-column: 78
 192 #   indent-tabs-mode: nil
 193 #   c-indentation-style: bsd
 194 # End:
 195 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :