1 package Perl::Critic::Policy::Dynamic::NoIndirect;
10 Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against indirect method calls.
18 our $VERSION = '0.03';
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 L<perl> 5.8, L<Carp>.
122 L<Perl::Critic>, L<Perl::Critic::Dynamic>.
128 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
130 You can contact me by mail or on C<irc.perl.org> (vincent).
134 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>.
135 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
139 You can find documentation for this module with the perldoc command.
141 perldoc Perl::Critic::Policy::Dynamic::NoIndirect
143 =head1 COPYRIGHT & LICENSE
145 Copyright 2009 Vincent Pit, all rights reserved.
147 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
151 1; # End of Perl::Critic::Policy::Dynamic::NoIndirect