File Coverage

blib/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
Criterion Covered Total %
statement 58 63 92.0
branch 10 12 83.3
condition n/a
subroutine 14 15 93.3
pod 5 6 83.3
total 87 96 90.6


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