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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Modules/RequireVersionVar.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::Modules::RequireVersionVar;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use List::MoreUtils qw(any);
  16
  17 use Perl::Critic::Utils qw{ :severities };
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Scalar my $DESC => q{No "VERSION" variable found};
  25 Readonly::Scalar my $EXPL => [ 404 ];
  26
  27 #-----------------------------------------------------------------------------
  28
  29 sub supported_parameters { return ()                       }
  30 sub default_severity     { return $SEVERITY_LOW            }
  31 sub default_themes       { return qw(core pbp readability) }
  32 sub applies_to           { return 'PPI::Document'          }
  33
  34 #-----------------------------------------------------------------------------
  35
  36 sub violates {
  37     my ( $self, $elem, $doc ) = @_;
  38
  39     return if $doc->find_first( \&_is_VERSION_declaration );
  40
  41     #If we get here, then no $VERSION was found
  42     return $self->violation( $DESC, $EXPL, $doc );
  43 }
  44
  45 #-----------------------------------------------------------------------------
  46
  47 sub _is_VERSION_declaration {  ##no critic(ArgUnpacking)
  48     return 1 if _is_our_VERSION(@_);
  49     return 1 if _is_vars_VERSION(@_);
  50     return 1 if _is_package_VERSION(@_);
  51     return 1 if _is_readonly_VERSION(@_);
  52     return 0;
  53 }
  54
  55 #-----------------------------------------------------------------------------
  56
  57 sub _is_our_VERSION {
  58     my (undef, $elem) = @_;
  59     $elem->isa('PPI::Statement::Variable') || return 0;
  60     $elem->type() eq 'our' || return 0;
  61     return any { $_ eq '$VERSION' } $elem->variables(); ## no critic
  62 }
  63
  64 #-----------------------------------------------------------------------------
  65
  66 sub _is_vars_VERSION {
  67     my (undef, $elem) = @_;
  68     $elem->isa('PPI::Statement::Include') || return 0;
  69     $elem->pragma() eq 'vars' || return 0;
  70     return $elem =~ m{ \$VERSION }mx; #Crude, but usually works
  71 }
  72
  73 #-----------------------------------------------------------------------------
  74
  75 sub _is_package_VERSION {
  76     my (undef, $elem) = @_;
  77     $elem->isa('PPI::Token::Symbol') || return 0;
  78     return $elem =~ m{ \A \$ \S+ ::VERSION \z }mx;
  79     #TODO: ensure that it is in _this_ package!
  80 }
  81
  82 #-----------------------------------------------------------------------------
  83
  84 sub _is_readonly_VERSION {
  85
  86     #---------------------------------------------------------------
  87     # Readonly VERSION statements usually come in one of two forms:
  88     #
  89     #   Readonly our $VERSION = 1.0;
  90     #   Readonly::Scalar our $VERSION = 1.0;
  91     #---------------------------------------------------------------
  92
  93     my (undef, $elem) = @_;
  94     $elem->isa('PPI::Token::Symbol') || return 0;
  95     return 0 if $elem !~ m{ \A \$VERSION \z }mx;
  96
  97     my $psib = $elem->sprevious_sibling() || return 0;
  98     return 0 if $psib ne 'our';
  99
 100     my $ppsib = $psib->sprevious_sibling() || return 0;
 101     return $ppsib eq 'Readonly' || $ppsib eq 'Readonly::Scalar';
 102 }
 103
 104 1;
 105
 106 __END__
 107
 108 #-----------------------------------------------------------------------------
 109
 110 =pod
 111
 112 =head1 NAME
 113
 114 Perl::Critic::Policy::Modules::RequireVersionVar - Give every module a C<$VERSION> number.
 115
 116 =head1 AFFILIATION
 117
 118 This Policy is part of the core L<Perl::Critic> distribution.
 119
 120
 121 =head1 DESCRIPTION
 122
 123 Every Perl file (modules, libraries, and programs) should have a
 124 C<$VERSION> variable.  The C<$VERSION> allows clients to insist on a
 125 particular revision of your file like this:
 126
 127   use SomeModule 2.4;  #Only loads version 2.4
 128
 129 This Policy scans your file for any package variable named
 130 C<$VERSION>.  I'm assuming that you are using C<strict>, so you'll
 131 have to declare it like one of these:
 132
 133   our $VERSION = 1.0611;
 134   $MyPackage::VERSION = 1.061;
 135   use vars qw($VERSION);
 136
 137 A common practice is to use the C<$Revision: 2489 $> keyword to automatically
 138 define the C<$VERSION> variable like this:
 139
 140   our ($VERSION) = '$Revision: 2489 $' =~ m{ \$Revision: \s+ (\S+) }x;
 141
 142
 143 =head1 CONFIGURATION
 144
 145 This Policy is not configurable except for the standard options.
 146
 147
 148 =head1 NOTES
 149
 150 Conway recommends using the C<version> pragma instead of raw numbers
 151 or 'v-strings.'  However, this Policy only insists that the
 152 C<$VERSION> be defined somehow.  I may try to extend this in the
 153 future.
 154
 155 =head1 AUTHOR
 156
 157 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 158
 159 =head1 COPYRIGHT
 160
 161 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 162
 163 This program is free software; you can redistribute it and/or modify
 164 it under the same terms as Perl itself.  The full text of this license
 165 can be found in the LICENSE file included with this module.
 166
 167 =cut
 168
 169 # Local Variables:
 170 #   mode: cperl
 171 #   cperl-indent-level: 4
 172 #   fill-column: 78
 173 #   indent-tabs-mode: nil
 174 #   c-indentation-style: bsd
 175 # End:
 176 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :