1 package Perl::Critic::Policy::Dynamic::NoIndirect;
10 Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against indirect method calls.
18 our $VERSION = '0.04';
22 This L<Perl::Critic> dynamic policy reports any use of indirect object syntax with a C<'stern'> severity.
23 It's listed under the C<'dynamic'> and C<'maintenance'> themes.
25 Since it wraps around L<indirect>, it needs to compile the audited code and as such is implemented as a subclass of L<Perl::Critic::DynamicPolicy>.
29 use base qw/Perl::Critic::DynamicPolicy/;
31 use Perl::Critic::Utils qw/:severities/;
33 sub default_severity { $SEVERITY_HIGH }
34 sub default_themes { qw/dynamic maintenance/ }
35 sub applies_to { 'PPI::Document' }
39 $obj = '{' if $obj =~ /^\s*\{/;
43 sub violates_dynamic {
44 my ($self, undef, $doc) = @_;
48 if ($doc->isa('PPI::Document::File')) {
49 my $file = $doc->filename;
50 open my $fh, '<', $file
51 or do { require Carp; Carp::confess("Can't open $file for reading: $!") };
52 $src = do { local $/; <$fh> };
54 $src = $doc->serialize;
59 my $wrapper = <<" WRAPPER";
63 no indirect hook => sub { push \@errs, [ \@_ ] };
73 eval $wrapper; ## no critic
76 Carp::confess("Couldn't compile the source wrapper: $@");
85 my ($obj, $meth, $line) = @$_[0, 1, 3];
87 my $tag = join "\0", $line, $meth, $tag_obj->($obj);
88 push @{$errs_tags{$tag}}, [ $obj, $meth ];
93 my $pos = $elt->location;
96 my $tag = join "\0", $pos->[0], $elt, $tag_obj->($elt->snext_sibling);
97 if (my $errs = $errs_tags{$tag}) {
98 push @violations, do { my $e = pop @$errs; push @$e, $elt; $e };
99 delete $errs_tags{$tag} unless @$errs;
100 return 1 unless %errs_tags;
108 my ($obj, $meth, $elt) = @$_;
109 $obj = ($obj =~ /^\s*\{/) ? "a block" : "object \"$obj\"";
111 "Indirect call of method \"$meth\" on $obj",
112 "You really wanted $obj\->$meth",
120 The uses of the L<indirect> pragma inside the auditted code take precedence over this policy.
121 Hence no violations will be reported for indirect method calls that are located inside the lexical scope of C<use indirect> or C<< no indirect hook => ... >>.
122 Occurrences of C<no indirect> won't be a problem.
124 Since the reports generated by L<indirect> are remapped to the corresponding L<PPI::Element> objects, the order in which the violations are returned is different from the order given by L<indirect> : the former is the document order (top to bottom, left to right) while the latter is the optree order (arguments before function calls).
128 L<perl> 5.8, L<Carp>.
130 L<Perl::Critic>, L<Perl::Critic::Dynamic>.
136 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
138 You can contact me by mail or on C<irc.perl.org> (vincent).
142 Please report any bugs or feature requests to C<bug-perl-critic-policy-dynamic-noindirect at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-Critic-Policy-Dynamic-NoIndirect>.
143 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
147 You can find documentation for this module with the perldoc command.
149 perldoc Perl::Critic::Policy::Dynamic::NoIndirect
151 =head1 COPYRIGHT & LICENSE
153 Copyright 2009 Vincent Pit, all rights reserved.
155 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
159 1; # End of Perl::Critic::Policy::Dynamic::NoIndirect