File Coverage

blib/lib/Perl/Critic/Policy/Objects/ProhibitIndirectSyntax.pm
Criterion Covered Total %
statement 36 36 100.0
branch 8 12 66.6
condition 8 12 66.6
subroutine 13 13 100.0
pod 4 5 80.0
total 69 78 88.4


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Objects::ProhibitIndirectSyntax;
2              
3 40     40   27196 use 5.010001;
  40         178  
4 40     40   250 use strict;
  40         117  
  40         903  
5 40     40   226 use warnings;
  40         105  
  40         1100  
6              
7 40     40   277 use Carp;
  40         117  
  40         2867  
8 40     40   319 use English qw(-no_match_vars);
  40         136  
  40         308  
9 40     40   15823 use Perl::Critic::Utils qw{ :severities :classification };
  40         151  
  40         1981  
10 40     40   13462 use Readonly;
  40         151  
  40         2375  
11              
12 40     40   307 use parent 'Perl::Critic::Policy';
  40         137  
  40         338  
13              
14             our $VERSION = '1.146';
15              
16             #-----------------------------------------------------------------------------
17              
18             Readonly::Hash my %COMMA => {
19             q<,> => 1,
20             q{=>} => 1,
21             };
22             Readonly::Scalar my $DOLLAR => q<$>;
23              
24             Readonly::Scalar my $DESC => 'Subroutine "%s" called using indirect syntax';
25             Readonly::Scalar my $EXPL => [ 349 ];
26              
27             #-----------------------------------------------------------------------------
28              
29             sub supported_parameters {
30             return (
31             {
32 94     94 0 2076 name => 'forbid',
33             description => 'Indirect method syntax is forbidden for these methods.',
34             behavior => 'string list',
35             list_always_present_values => [ qw{ new } ],
36             }
37             )
38             }
39              
40 84     84 1 364 sub default_severity { return $SEVERITY_HIGH }
41 86     86 1 409 sub default_themes { return qw( core pbp maintenance certrule ) }
42 36     36 1 124 sub applies_to { return 'PPI::Token::Word' }
43              
44             #-----------------------------------------------------------------------------
45              
46             sub violates {
47 382     382 1 700 my ( $self, $elem, $doc ) = @_;
48              
49             # We are only interested in the functions we have been told to check.
50             # Do this before calling is_function_call() because we want to weed
51             # out as many candidate tokens as possible before calling it.
52 382 100       786 return if not $self->{_forbid}->{$elem->content()};
53              
54             # Make sure it really is a function call.
55 15 100       76 return if not is_function_call($elem);
56              
57             # Per perlobj, it is only an indirect object call if the next sibling
58             # is a word, a scalar symbol, or a block.
59 10 50       24 my $object = $elem->snext_sibling() or return;
60             return if not (
61 10 50 66     207 $object->isa( 'PPI::Token::Word' )
      100        
      66        
62             or $object->isa( 'PPI::Token::Symbol' )
63             and $DOLLAR eq $object->raw_type()
64             or $object->isa( 'PPI::Structure::Block' )
65             );
66              
67             # Per perlobj, it is not an indirect object call if the operator after
68             # the possible indirect object is a comma.
69 10 50       43 if ( my $operator = $object->snext_sibling() ) {
70             return if
71             $operator->isa( 'PPI::Token::Operator' )
72 10 50 33     183 and $COMMA{ $operator->content() };
73             }
74              
75 10         51 my $message = sprintf $DESC, $elem->content();
76              
77 10         76 return $self->violation( $message, $EXPL, $elem );
78             }
79              
80             1;
81              
82             __END__
83              
84             #-----------------------------------------------------------------------------
85              
86             =pod
87              
88             =head1 NAME
89              
90             Perl::Critic::Policy::Objects::ProhibitIndirectSyntax - Prohibit indirect object call syntax.
91              
92              
93             =head1 AFFILIATION
94              
95             This Policy is part of the core L<Perl::Critic|Perl::Critic>
96             distribution.
97              
98              
99             =head1 DESCRIPTION
100              
101             Indirect object syntax is commonly used in other object-oriented languages for
102             instantiating objects. Perl allows this, but to say that it supports it may be
103             going too far. Instead of writing
104              
105             my $foo = new Foo;
106              
107             it is preferable to write
108              
109             my $foo = Foo->new;
110              
111             The problem is that Perl needs to make a number of assumptions at compile time
112             to disambiguate the first form, so it tends to be fragile and to produce
113             hard-to-track-down bugs.
114              
115              
116             =head1 CONFIGURATION
117              
118             Indirect object syntax is also hard for Perl::Critic to disambiguate, so this
119             policy only checks certain subroutine calls. The names of the subroutines can
120             be configured using the C<forbid> configuration option:
121              
122             [Objects::ProhibitIndirectSyntax]
123             forbid = create destroy
124              
125             The C<new> subroutine is configured by default; any additional C<forbid>
126             values are in addition to C<new>.
127              
128              
129             =head1 CAVEATS
130              
131             The general situation can not be handled via static analysis.
132              
133              
134             =head1 SEE ALSO
135              
136             L<Perl::Critic::Policy::Dynamic::NoIndirect|Perl::Critic::Policy::Dynamic::NoIndirect>
137             and L<indirect|indirect> both do a better job with this, but they require that you
138             compile/execute your code.
139              
140              
141             =head1 AUTHOR
142              
143             Thomas R. Wyant, III F<wyant at cpan dot org>
144              
145              
146             =head1 COPYRIGHT
147              
148             Copyright (c) 2009-2011 Tom Wyant.
149              
150             This program is free software; you can redistribute it and/or modify
151             it under the same terms as Perl itself. The full text of this license
152             can be found in the LICENSE file included with this module.
153              
154             =cut
155              
156             # Local Variables:
157             # mode: cperl
158             # cperl-indent-level: 4
159             # fill-column: 78
160             # indent-tabs-mode: nil
161             # c-indentation-style: bsd
162             # End:
163             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
164