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' }
37 sub violates_dynamic {
38 my ($self, undef, $doc) = @_;
42 if ($doc->isa('PPI::Document::File')) {
43 my $file = $doc->filename;
44 open my $fh, '<', $file
45 or do { require Carp; Carp::confess("Can't open $file for reading: $!") };
46 $src = do { local $/; <$fh> };
48 $src = $doc->serialize;
53 my $wrapper = <<" WRAPPER";
57 no indirect hook => sub { push \@errs, [ \@_ ] };
67 eval $wrapper; ## no critic
70 Carp::confess("Couldn't compile the source wrapper: $@");
79 my ($obj, $meth, $line) = @$_[0, 1, 3];
81 my $tag = join "\0", $line, $meth, $obj;
82 push @{$errs_tags{$tag}}, [ $obj, $meth ];
87 my $pos = $elt->location;
90 my $tag = join "\0", $pos->[0], $elt, $elt->snext_sibling;
91 if (my $errs = $errs_tags{$tag}) {
92 push @violations, do { my $e = pop @$errs; push @$e, $elt; $e };
93 delete $errs_tags{$tag} unless @$errs;
94 return 1 unless %errs_tags;
102 my ($obj, $meth, $elt) = @$_;
104 "Indirect call of method \"$meth\" on object \"$obj\"",
105 "You really wanted $obj\->$meth",
113 L<perl> 5.8, L<Carp>.
115 L<Perl::Critic>, L<Perl::Critic::Dynamic>.
121 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
123 You can contact me by mail or on C<irc.perl.org> (vincent).
127 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>.
128 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
132 You can find documentation for this module with the perldoc command.
134 perldoc Perl::Critic::Policy::Dynamic::NoIndirect
136 =head1 COPYRIGHT & LICENSE
138 Copyright 2009 Vincent Pit, all rights reserved.
140 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
144 1; # End of Perl::Critic::Policy::Dynamic::NoIndirect