vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireInterpolationOfMetachars.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::ValuesAndExpressions::RequireInterpolationOfMetachars;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities };
  16 use base 'Perl::Critic::Policy';
  17
  18 #-----------------------------------------------------------------------------
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Scalar my $DESC => q{String *may* require interpolation};
  25 Readonly::Scalar my $EXPL => [ 51 ];
  26
  27 #-----------------------------------------------------------------------------
  28
  29 sub supported_parameters { return ()                    }
  30 sub default_severity     { return $SEVERITY_LOWEST      }
  31 sub default_themes       { return qw(core pbp cosmetic) }
  32 sub applies_to           { return qw(PPI::Token::Quote::Single
  33                                      PPI::Token::Quote::Literal) }
  34
  35 #-----------------------------------------------------------------------------
  36
  37 sub violates {
  38     my ( $self, $elem, undef ) = @_;
  39     # The string() method strips off the quotes
  40     return if not _needs_interpolation( $elem->string() );
  41     return if _looks_like_email_address( $elem->string() );
  42     return $self->violation( $DESC, $EXPL, $elem );
  43 }
  44
  45 #-----------------------------------------------------------------------------
  46
  47 sub _needs_interpolation {
  48     my $string = shift;
  49     return $string =~ m{ [\$\@] \S+ }mxo             #Contains a $ or @
  50         || $string =~ m{ \\[tnrfae0xcNLuLUEQ] }mxo;  #Contains metachars
  51 }
  52
  53 #-----------------------------------------------------------------------------
  54
  55 sub _looks_like_email_address {
  56     my $string = shift;
  57     return $string =~ m{\A [^\@\s]+ \@ [\w\-.]+ \z}mxo;
  58 }
  59
  60 1;
  61
  62 __END__
  63
  64 #-----------------------------------------------------------------------------
  65
  66 =pod
  67
  68 =head1 NAME
  69
  70 Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars - Warns that you might have used single quotes when you really wanted double-quotes.
  71
  72 =head1 AFFILIATION
  73
  74 This Policy is part of the core L<Perl::Critic> distribution.
  75
  76
  77 =head1 DESCRIPTION
  78
  79 This policy warns you if you use single-quotes or C<q//> with a string
  80 that has unescaped metacharacters that may need interpolation. Its hard
  81 to know for sure if a string really should be interpolated without
  82 looking into the symbol table.  This policy just makes an educated
  83 guess by looking for metacharacters and sigils which usually indicate that
  84 the string should be interpolated.
  85
  86
  87 =head1 CONFIGURATION
  88
  89 This Policy is not configurable except for the standard options.
  90
  91
  92 =head1 NOTES
  93
  94 Perl's own C<warnings> pragma also warns you about this.
  95
  96 =head1 SEE ALSO
  97
  98 L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals>
  99
 100 =head1 AUTHOR
 101
 102 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 103
 104 =head1 COPYRIGHT
 105
 106 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 107
 108 This program is free software; you can redistribute it and/or modify
 109 it under the same terms as Perl itself.  The full text of this license
 110 can be found in the LICENSE file included with this module.
 111
 112 =cut
 113
 114 # Local Variables:
 115 #   mode: cperl
 116 #   cperl-indent-level: 4
 117 #   fill-column: 78
 118 #   indent-tabs-mode: nil
 119 #   c-indentation-style: bsd
 120 # End:
 121 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :