1 package Perl::Critic::Policy::Dynamic::NoIndirect;
10 Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against indirect method calls.
18 our $VERSION = '0.02';
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: $@");
77 my ($err, $obj, $meth, $line);
81 return 1 unless @errs;
83 ($obj, $meth, $line) = @$err[0, 1, 3];
88 my $pos = $elt->location;
90 if ($pos and $pos->[0] == $line and $elt eq $meth
91 and $elt->snext_sibling eq $obj) {
92 push @violations, [ $obj, $meth, $elt ];
101 my ($obj, $meth, $elt) = @$_;
103 "Indirect call of method \"$meth\" on object \"$obj\"",
104 "You really wanted $obj\->$meth",
112 L<perl> 5.8, L<Carp>.
114 L<Perl::Critic>, L<Perl::Critic::Dynamic>.
120 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
122 You can contact me by mail or on C<irc.perl.org> (vincent).
126 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>.
127 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
131 You can find documentation for this module with the perldoc command.
133 perldoc Perl::Critic::Policy::Dynamic::NoIndirect
135 =head1 COPYRIGHT & LICENSE
137 Copyright 2009 Vincent Pit, all rights reserved.
139 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
143 1; # End of Perl::Critic::Policy::Dynamic::NoIndirect