--- /dev/null
+blib*
+pm_to_blib*
+
+Makefile
+Makefile.old
+Build
+_build*
+
+*.tar.gz
+Perl-Critic-Policy-Dynamic-NoIndirect-*
+
+core.*
+*.[co]
+*.so
+*.bs
+*.out
+*.def
+*.exp
+
+cover_db
+*.gcda
+*.gcov
+*.gcno
+
+Debian_CPANTS.txt
--- /dev/null
+Revision history for Perl-Critic-Policy-Dynamic-NoIndirect
+
+0.01
+ First version.
+
--- /dev/null
+Changes
+META.yml
+Makefile.PL
+Makefile.old
+README
+lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm
+t/00-load.t
+t/91-pod.t
+t/92-pod-coverage.t
+t/95-portability-files.t
+t/99-kwalitee.t
--- /dev/null
+--- #YAML:1.0
+name: Perl-Critic-Policy-Dynamic-NoIndirect
+version: 0.01
+abstract: Perl::Critic policy against indirect method calls.
+author:
+ - Vincent Pit <perl@profvince.com>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+ Perl::Critic::TestUtils: 0
+ Test::More: 0
+requires:
+ base: 0
+ Carp: 0
+ indirect: 0.14
+ perl: 5.008
+ Perl::Critic::DynamicPolicy: 0
+ Perl::Critic::Utils: 0
+resources:
+ bugtracker: http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-Critic-Policy-Dynamic-NoIndirect
+ homepage: http://search.cpan.org/dist/Perl-Critic-Policy-Dynamic-NoIndirect/
+ license: http://dev.perl.org/licenses/
+ repository: http://git.profvince.com/?p=perl%2Fmodules%2FPerl-Critic-Policy-Dynamic-NoIndirect.git
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.52
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
--- /dev/null
+use 5.008;
+
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+my $dist = 'Perl-Critic-Policy-Dynamic-NoIndirect';
+
+my %META = (
+ configure_requires => {
+ 'ExtUtils::MakeMaker' => 0,
+ },
+ build_requires => {
+ 'ExtUtils::MakeMaker' => 0,
+ 'Perl::Critic::TestUtils' => 0,
+ 'Test::More' => 0,
+ },
+ resources => {
+ bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
+ homepage => "http://search.cpan.org/dist/$dist/",
+ license => 'http://dev.perl.org/licenses/',
+ repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
+ },
+);
+
+WriteMakefile(
+ NAME => 'Perl::Critic::Policy::Dynamic::NoIndirect',
+ AUTHOR => 'Vincent Pit <perl@profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm',
+ ABSTRACT_FROM => 'lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Carp' => 0,
+ 'Perl::Critic::Utils' => 0,
+ 'Perl::Critic::DynamicPolicy' => 0,
+ 'base' => 0,
+ 'indirect' => '0.14',
+ },
+ MIN_PERL_VERSION => 5.008,
+ META_MERGE => \%META,
+ dist => {
+ PREOP => 'pod2text lib/Perl/Critic/Policy/Dynamic/NoIndirect.pm > $(DISTVNAME)/README',
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => {
+ FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
+ },
+);
--- /dev/null
+NAME
+ Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against
+ indirect method calls.
+
+VERSION
+ Version 0.01
+
+DESCRIPTION
+ This Perl::Critic dynamic policy reports any use of indirect object
+ syntax with a 'stern' severity. It's listed under the 'dynamic' and
+ 'maintenance' themes.
+
+ Since it wraps around indirect, it needs to compile the audited code and
+ as such is implemented as a subclass of Perl::Critic::DynamicPolicy.
+
+DEPENDENCIES
+ perl 5.8, Carp.
+
+ Perl::Critic, Perl::Critic::Dynamic.
+
+ indirect.
+
+AUTHOR
+ Vincent Pit, "<perl at profvince.com>", <http://www.profvince.com>.
+
+ You can contact me by mail or on "irc.perl.org" (vincent).
+
+BUGS
+ Please report any bugs or feature requests to
+ "bug-perl-critic-policy-dynamic-noindirect at rt.cpan.org", or through
+ the web interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-Critic-Policy-Dynam
+ ic-NoIndirect>. I will be notified, and then you'll automatically be
+ notified of progress on your bug as I make changes.
+
+SUPPORT
+ You can find documentation for this module with the perldoc command.
+
+ perldoc Perl::Critic::Policy::Dynamic::NoIndirect
+
+COPYRIGHT & LICENSE
+ Copyright 2009 Vincent Pit, all rights reserved.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
--- /dev/null
+package Perl::Critic::Policy::Dynamic::NoIndirect;
+
+use 5.008;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Perl::Critic::Policy::Dynamic::NoIndirect - Perl::Critic policy against indirect method calls.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 DESCRIPTION
+
+This L<Perl::Critic> dynamic policy reports any use of indirect object syntax with a C<'stern'> severity.
+It's listed under the C<'dynamic'> and C<'maintenance'> themes.
+
+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>.
+
+=cut
+
+use base qw/Perl::Critic::DynamicPolicy/;
+
+use Perl::Critic::Utils qw/:severities/;
+
+sub default_severity { $SEVERITY_HIGH }
+sub default_themes { qw/dynamic maintenance/ }
+sub applies_to { 'PPI::Document' }
+
+sub violates_dynamic {
+ my ($self, undef, $doc) = @_;
+
+ my $src;
+
+ if ($doc->isa('PPI::Document::File')) {
+ my $file = $doc->filename;
+ open my $fh, '<', $file
+ or do { require Carp; Carp::confess("Can't open $file for reading: $!") };
+ $src = do { local $/; <$fh> };
+ } else {
+ $src = $doc->serialize;
+ }
+
+ my @errs;
+ my $offset = 6;
+ my $wrapper = <<" WRAPPER";
+ {
+ return;
+ package main;
+ no indirect hook => sub { push \@errs, [ \@_ ] };
+ {
+ ;
+ $src
+ }
+ }
+ WRAPPER
+
+ {
+ local ($@, *_);
+ eval $wrapper; ## no critic
+ if ($@) {
+ require Carp;
+ Carp::confess("Couldn't compile the source wrapper: $@");
+ }
+ }
+
+ my @violations;
+
+ if (@errs) {
+ my ($err, $obj, $meth, $line);
+
+ $doc->find(sub {
+ unless ($err) {
+ return 1 unless @errs;
+ $err = shift @errs;
+ ($obj, $meth, $line) = @$err[0, 1, 3];
+ $line -= $offset;
+ }
+
+ my $elt = $_[1];
+ my $pos = $elt->location;
+
+ if ($pos and $pos->[0] == $line and $elt eq $meth
+ and $elt->snext_sibling eq $obj) {
+ push @violations, [ $obj, $meth, $elt ];
+ undef $err;
+ }
+
+ return 0;
+ });
+ }
+
+ return map {
+ my ($obj, $meth, $elt) = @$_;
+ $self->violation(
+ "Indirect call of method \"$meth\" on object \"$obj\"",
+ "You really wanted $obj\->$meth",
+ $elt,
+ );
+ } @violations;
+}
+
+=head1 DEPENDENCIES
+
+L<perl> 5.8, L<Carp>.
+
+L<Perl::Critic>, L<Perl::Critic::Dynamic>.
+
+L<indirect>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+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>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Perl::Critic::Policy::Dynamic::NoIndirect
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of Perl::Critic::Policy::Dynamic::NoIndirect
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Perl::Critic::Policy::Dynamic::NoIndirect' );
+}
+
+diag( "Testing Perl::Critic::Policy::Dynamic::NoIndirect $Perl::Critic::Policy::Dynamic::NoIndirect::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+my $subtests;
+BEGIN { $subtests = 3 }
+
+use Test::More tests => $subtests * 14;
+
+use Perl::Critic::TestUtils qw/pcritique_with_violations/;
+
+Perl::Critic::TestUtils::block_perlcriticrc();
+
+my $policy = 'Dynamic::NoIndirect';
+
+{
+ local $/ = "####";
+
+ my $id = 1;
+
+ while (<DATA>) {
+ s/^\s+//s;
+
+ my ($code, $expected) = split /^-+$/m, $_, 2;
+ my @expected = eval $expected;
+
+ my @violations = eval { pcritique_with_violations($policy, \$code) };
+
+ if ($@) {
+ diag "Compilation $id failed: $@";
+ next;
+ }
+
+ for my $v (@violations) {
+ my $exp = shift @expected;
+
+ unless ($exp) {
+ fail "Unexpected violation for chunk $id: " . $v->description;
+ next;
+ }
+
+ my $pos = $v->location;
+ my ($meth, $obj, $line, $col) = @$exp;
+
+ like $v->description,
+ qr/^Indirect call of method \"\Q$meth\E\" on object \"\Q$obj\E\"/,
+ "description $id";
+ is $pos->[0], $line, "line $id";
+ is $pos->[1], $col, "column $id";
+ }
+
+ ++$id;
+ }
+}
+
+__DATA__
+my $x = new X;
+----
+[ 'new', 'X', 1, 9 ]
+####
+my $x = new X; $x = new X;
+----
+[ 'new', 'X', 1, 9 ], [ 'new', 'X', 1, 21 ]
+####
+my $x = new X new X;
+----
+[ 'new', 'X', 1, 9 ], [ 'new', 'X', 1, 18 ]
+####
+my $x = new X;
+my $y = new X;
+----
+[ 'new', 'X', 1, 9 ], [ 'new', 'X', 2, 9 ]
+####
+our $obj;
+my $x = new $obj;
+----
+[ 'new', '$obj', 2, 9 ]
+####
+our $obj;
+my $x = new $obj; $x = new $obj;
+----
+[ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 2, 24 ]
+####
+our $obj;
+my $x = new $obj new $obj;
+----
+[ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 2, 21 ]
+####
+our $obj;
+my $x = new $obj;
+my $y = new $obj;
+----
+[ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 3, 9 ]
+
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
+
+all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::CountParents' });
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Portability::Files";
+plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
+run_tests();
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
projects / perl / modules / Perl-Critic-Policy-Dynamic-NoIndirect.git / commitdiff