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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Modules/ProhibitAutomaticExportation.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::ProhibitAutomaticExportation;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities };
  16 use List::MoreUtils qw(any);
  17 use base 'Perl::Critic::Policy';
  18
  19 our $VERSION = '1.088';
  20
  21 #-----------------------------------------------------------------------------
  22
  23 Readonly::Scalar my $DESC => q{Symbols are exported by default};
  24 Readonly::Scalar my $EXPL => q{Use '@EXPORT_OK' or '%EXPORT_TAGS' instead};  ## no critic
  25
  26 #-----------------------------------------------------------------------------
  27
  28 sub supported_parameters { return ()              }
  29 sub default_severity     { return $SEVERITY_HIGH  }
  30 sub default_themes       { return qw( core bugs ) }
  31 sub applies_to           { return 'PPI::Document' }
  32
  33 #-----------------------------------------------------------------------------
  34
  35 sub violates {
  36     my ( $self, $elem, $doc ) = @_;
  37
  38     if ( _uses_exporter($doc) ) {
  39         if ( my $exp = _has_exports($doc) ) {
  40             return $self->violation( $DESC, $EXPL, $exp );
  41         }
  42     }
  43     return; #ok
  44 }
  45
  46 #-----------------------------------------------------------------------------
  47
  48 sub _uses_exporter {
  49     my ($doc) = @_;
  50     my $includes_ref = $doc->find('PPI::Statement::Include');
  51     return if !$includes_ref;
  52     #This covers both C<use Exporter;> and C<use base 'Exporter';>
  53     return scalar grep { m/ \b Exporter \b/mx }  @{ $includes_ref };
  54 }
  55
  56 #------------------
  57
  58 sub _has_exports {
  59     my ($doc) = @_;
  60     my $wanted = sub {_our_EXPORT(@_) || _vars_EXPORT(@_) || _package_EXPORT(@_)};
  61     return $doc->find_first( $wanted );
  62 }
  63
  64 #------------------
  65
  66 sub _our_EXPORT {
  67     my (undef, $elem) = @_;
  68     $elem->isa('PPI::Statement::Variable') || return 0;
  69     $elem->type() eq 'our' || return 0;
  70     return any { $_ eq '@EXPORT' } $elem->variables(); ## no critic(RequireInterpolationOfMetachars)
  71 }
  72
  73 #------------------
  74
  75 sub _vars_EXPORT {
  76     my (undef, $elem) = @_;
  77     $elem->isa('PPI::Statement::Include') || return 0;
  78     $elem->pragma() eq 'vars' || return 0;
  79     return $elem =~ m{ \@EXPORT \b }mx; #Crude, but usually works
  80 }
  81
  82 #------------------
  83
  84 sub _package_EXPORT {
  85     my (undef, $elem) = @_;
  86     $elem->isa('PPI::Token::Symbol') || return 0;
  87     return $elem =~ m{ \A \@ \S+ ::EXPORT \z }mx;
  88     #TODO: ensure that it is in _this_ package!
  89 }
  90
  91 1;
  92
  93 __END__
  94
  95 #-----------------------------------------------------------------------------
  96
  97 =pod
  98
  99 =head1 NAME
 100
 101 Perl::Critic::Policy::Modules::ProhibitAutomaticExportation - Export symbols via C<@EXPORT_OK> or C<%EXPORT_TAGS> instead of C<@EXPORT>.
 102
 103 =head1 AFFILIATION
 104
 105 This Policy is part of the core L<Perl::Critic> distribution.
 106
 107
 108 =head1 DESCRIPTION
 109
 110 When using L<Exporter>, symbols placed in the C<@EXPORT> variable are
 111 automatically exported into the caller's namespace.  Although
 112 convenient, this practice is not polite, and may cause serious
 113 problems if the caller declares the same symbols.  The best practice
 114 is to place your symbols in C<@EXPORT_OK> or C<%EXPORT_TAGS> and let
 115 the caller choose exactly which symbols to export.
 116
 117   package Foo;
 118
 119   use base qw(Exporter);
 120   our @EXPORT      = qw(&foo &bar);                  # not ok
 121   our @EXPORT_OK   = qw(&foo &bar);                  # ok
 122   our %EXPORT_TAGS = ( all => [ qw(&foo &bar) ] );   # ok
 123
 124
 125 =head1 CONFIGURATION
 126
 127 This Policy is not configurable except for the standard options.
 128
 129
 130 =head1 AUTHOR
 131
 132 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 133
 134 =head1 COPYRIGHT
 135
 136 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 137
 138 This program is free software; you can redistribute it and/or modify
 139 it under the same terms as Perl itself.  The full text of this license
 140 can be found in the LICENSE file included with this module.
 141
 142 =cut
 143
 144 # Local Variables:
 145 #   mode: cperl
 146 #   cperl-indent-level: 4
 147 #   fill-column: 78
 148 #   indent-tabs-mode: nil
 149 #   c-indentation-style: bsd
 150 # End:
 151 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :