1 ##############################################################################
2 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Subroutines/ProtectPrivateSubs.pm $
3 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
6 ##############################################################################
8 package Perl::Critic::Policy::Subroutines::ProtectPrivateSubs;
15 use Perl::Critic::Utils qw{ :severities };
16 use base 'Perl::Critic::Policy';
18 our $VERSION = '1.088';
20 #-----------------------------------------------------------------------------
22 Readonly::Scalar my $DESC => q{Private subroutine/method used};
23 Readonly::Scalar my $EXPL => q{Use published APIs};
25 #-----------------------------------------------------------------------------
27 sub supported_parameters { return () }
28 sub default_severity { return $SEVERITY_MEDIUM }
29 sub default_themes { return qw( core maintenance ) }
30 sub applies_to { return 'PPI::Token::Word' }
32 #-----------------------------------------------------------------------------
35 my ( $self, $elem, undef ) = @_;
37 my $psib = $elem->sprevious_sibling;
38 my $psib_name = eval { $psib->content };
39 no warnings 'uninitialized'; ## no critic ProhibitNoWarnings
40 if ( $psib_name ne 'package'
41 && $psib_name ne 'require'
42 && $psib_name ne 'use'
43 && ( $self->_is_other_pkg_private_function($elem)
44 || $self->_is_other_pkg_private_method($elem) )
47 return $self->violation( $DESC, $EXPL, $elem );
52 sub _is_other_pkg_private_function {
53 my ( $self, $elem ) = @_;
54 return $elem =~ m{ (\w+)::_\w+ \z }xms
55 && $elem !~ m{ \A SUPER::_\w+ \z }xms;
58 sub _is_other_pkg_private_method {
59 my ( $self, $elem ) = @_;
61 # look for structures like "Some::Package->_foo()"
62 $elem =~ m{ \A _\w+ \z }xms || return;
63 my $op = $elem->sprevious_sibling() || return;
64 $op eq q{->} || return;
65 my $pkg = $op->sprevious_sibling() || return;
66 $pkg->isa('PPI::Token::Word') || return;
74 #-----------------------------------------------------------------------------
80 Perl::Critic::Policy::Subroutines::ProtectPrivateSubs - Prevent access to private subs in other packages.
84 This Policy is part of the core L<Perl::Critic> distribution.
89 By convention Perl authors (like authors in many other languages)
90 indicate private methods and variables by inserting a leading
91 underscore before the identifier. This policy catches attempts to
92 access private variables from outside the package itself.
97 This Policy is not configurable except for the standard options.
102 This policy is inspired by a similar test in L<B::Lint>
106 L<Perl::Critic::Policy::Subroutines::ProtectPrivateSubs>
110 Chris Dolan <cdolan@cpan.org>
114 Copyright (c) 2006-2008 Chris Dolan. All rights reserved.
116 This program is free software; you can redistribute it and/or modify
117 it under the same terms as Perl itself. The full text of this license
118 can be found in the LICENSE file included with this module.
124 # cperl-indent-level: 4
126 # indent-tabs-mode: nil
127 # c-indentation-style: bsd
129 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :