Attachment 597914 Details for Bug 839815 – Add Miscellanea::RequireRcsKeywords policy

[patch] Add Miscellanea::RequireRcsKeywords policy

Perl-Critic-More-1.000-Miscellanea::RequireRcsKeywords.patch (text/plain), 7.06 KB, created by Paul Howarth on 2012-07-12 23:10:19 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Paul Howarth

Created: 2012-07-12 23:10:19 UTC

Size: 7.06 KB

patch

obsolete

>--- Changes
>+++ Changes
>@@ -14,6 +14,8 @@
>      Policy moved:
>      * ValuesAndExpressions::ProhibitMagicNumbers has been moved into the
>        core Perl::Critic distribution.
>+     * Miscellanea::RequireRcsKeywords has been moved here from the core
>+       Perl::Critic distribution (RT #69546).
> 
>      Dependencies:
>      * Now requires Perl::Critic 1.082.
>--- lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
>+++ lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
>@@ -0,0 +1,202 @@
>+##############################################################################
>+#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/distributions/Perl-Critic/lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm $
>+#     $Date: 2011-12-21 14:40:10 -0800 (Wed, 21 Dec 2011) $
>+#   $Author: thaljef $
>+# $Revision: 4106 $
>+##############################################################################
>+
>+package Perl::Critic::Policy::Miscellanea::RequireRcsKeywords;
>+
>+use 5.006001;
>+use strict;
>+use warnings;
>+use Readonly;
>+
>+use List::MoreUtils qw(none);
>+
>+use Perl::Critic::Utils qw{
>+    :booleans :characters :severities :data_conversion
>+};
>+
>+use base 'Perl::Critic::Policy';
>+
>+our $VERSION = '1.000';
>+
>+#-----------------------------------------------------------------------------
>+
>+Readonly::Scalar my $EXPL => [ 441 ];
>+
>+#-----------------------------------------------------------------------------
>+
>+sub supported_parameters {
>+    return (
>+        {
>+            name            => 'keywords',
>+            description     => 'The keywords to require in all files.',
>+            default_string  => $EMPTY,
>+            behavior        => 'string list',
>+        },
>+    );
>+}
>+
>+sub default_severity  { return $SEVERITY_LOW              }
>+sub default_themes    { return qw(core more pbp cosmetic) }
>+sub applies_to        { return 'PPI::Document'            }
>+
>+#-----------------------------------------------------------------------------
>+
>+sub initialize_if_enabled {
>+    my ($self, $config) = @_;
>+
>+    # Any of these lists
>+    $self->{_keyword_sets} = [
>+
>+        # Minimal svk/svn
>+        [qw(Id)],
>+
>+        # Expansive svk/svn
>+        [qw(Revision HeadURL Date)],
>+
>+        # cvs?
>+        [qw(Revision Source Date)],
>+    ];
>+
>+    # Set configuration, if defined.
>+    my @keywords = keys %{ $self->{_keywords} };
>+    if ( @keywords ) {
>+        $self->{_keyword_sets} = [ [ @keywords ] ];
>+    }
>+
>+    return $TRUE;
>+}
>+
>+#-----------------------------------------------------------------------------
>+
>+sub violates {
>+    my ( $self, $elem, $doc ) = @_;
>+    my @viols = ();
>+
>+    my $nodes = $self->_find_wanted_nodes($doc);
>+    for my $keywordset_ref ( @{ $self->{_keyword_sets} } ) {
>+        if ( not $nodes ) {
>+            my $desc = 'RCS keywords '
>+                . join( ', ', map {"\$$_\$"} @{$keywordset_ref} )
>+                . ' not found';
>+            push @viols, $self->violation( $desc, $EXPL, $doc );
>+        }
>+        else {
>+            my @missing_keywords =
>+                grep
>+                    {
>+                        my $keyword_rx = qr< \$ $_ .* \$ >xms;
>+                        ! ! none { m/$keyword_rx/xms } @{$nodes}
>+                    }
>+                    @{$keywordset_ref};
>+
>+            if (@missing_keywords) {
>+                # Provisionally flag a violation. See below.
>+                my $desc =
>+                    'RCS keywords '
>+                        . join( ', ', map {"\$$_\$"} @missing_keywords )
>+                        . ' not found';
>+                push @viols, $self->violation( $desc, $EXPL, $doc );
>+            }
>+            else {
>+                # Hey! I'm ignoring @viols for other keyword sets
>+                # because this one is complete.
>+                return;
>+            }
>+        }
>+    }
>+
>+    return @viols;
>+}
>+
>+#-----------------------------------------------------------------------------
>+
>+sub _find_wanted_nodes {
>+    my ( $self, $doc ) = @_;
>+    my @wanted_types = qw(Pod Comment Quote::Single Quote::Literal End);
>+    my @found =  map { @{ $doc->find("PPI::Token::$_") || [] } } @wanted_types;
>+    push @found, grep { $_->content() =~ m/ \A qw\$ [^\$]* \$ \z /smx } @{
>+        $doc->find('PPI::Token::QuoteLike::Words') || [] };
>+    return @found ? \@found : $EMPTY;  # Behave like PPI::Node::find()
>+}
>+
>+1;
>+
>+__END__
>+
>+#-----------------------------------------------------------------------------
>+
>+=pod
>+
>+=for stopwords RCS
>+
>+=head1 NAME
>+
>+Perl::Critic::Policy::Miscellanea::RequireRcsKeywords - Put source-control keywords in every file.
>+
>+
>+=head1 AFFILIATION
>+
>+This Policy is part of the core L<Perl::Critic|Perl::Critic>
>+distribution.
>+
>+
>+=head1 DESCRIPTION
>+
>+Every code file, no matter how small, should be kept in a
>+source-control repository.  Adding the magical RCS keywords to your
>+file helps the reader know where the file comes from, in case he or
>+she needs to modify it.  This Policy scans your file for comments that
>+look like this:
>+
>+    # $Revision: 4106 $
>+    # $Source: /myproject/lib/foo.pm $
>+
>+A common practice is to use the C<Revision> keyword to automatically
>+define the C<$VERSION> variable like this:
>+
>+    our ($VERSION) = '$Revision: 4106 $' =~ m{ \$Revision: \s+ (\S+) }x;
>+
>+
>+=head1 CONFIGURATION
>+
>+By default, this policy only requires the C<Revision>, C<Source>, and
>+C<Date> keywords.  To specify alternate keywords, specify a value for
>+C<keywords> of a whitespace delimited series of keywords (without the
>+dollar-signs).  This would look something like the following in a
>+F<.perlcriticrc> file:
>+
>+    [Miscellanea::RequireRcsKeywords]
>+    keywords = Revision Source Date Author Id
>+
>+See the documentation on RCS for a list of supported keywords.  Many
>+source control systems are descended from RCS, so the keywords
>+supported by CVS and Subversion are probably the same.
>+
>+
>+=head1 AUTHOR
>+
>+Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
>+
>+
>+=head1 COPYRIGHT
>+
>+Copyright (c) 2005-2011 Imaginative Software Systems.  All rights reserved.
>+
>+This program is free software; you can redistribute it and/or modify
>+it under the same terms as Perl itself.  The full text of this license
>+can be found in the LICENSE file included with this module.
>+
>+=cut
>+
>+# Local Variables:
>+#   mode: cperl
>+#   cperl-indent-level: 4
>+#   fill-column: 78
>+#   indent-tabs-mode: nil
>+#   c-indentation-style: bsd
>+# End:
>+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
>--- MANIFEST
>+++ MANIFEST
>@@ -4,6 +4,7 @@ lib/Perl/Critic/More.pm
> lib/Perl/Critic/Policy/CodeLayout/RequireASCII.pm
> lib/Perl/Critic/Policy/Editor/RequireEmacsFileVariables.pm
> lib/Perl/Critic/Policy/ErrorHandling/RequireUseOfExceptions.pm
>+lib/Perl/Critic/Policy/Miscellanea/RequireRcsKeywords.pm
> lib/Perl/Critic/Policy/Modules/PerlMinimumVersion.pm
> lib/Perl/Critic/Policy/Modules/RequirePerlVersion.pm
> lib/Perl/Critic/Policy/ValuesAndExpressions/RestrictLongStrings.pm
>--- t/99_pod_coverage.t
>+++ t/99_pod_coverage.t
>@@ -49,6 +49,7 @@ sub get_trusted_methods {
>         applies_to
>         default_themes
>         default_severity
>+        initialize_if_enabled
>         supported_parameters
>     );
> }

Actions: View | Diff

Attachments on bug 839815: 597914