Test-Perl-Critic-Progressive-0.03/0000755000076500007650000000000011043177317015420 5ustar jeffjeffTest-Perl-Critic-Progressive-0.03/Build.PL0000444000076500007650000000505611043177317016720 0ustar jeffjeff####################################################################### # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-Progressive-0.03/Build.PL $ # $Date: 2008-07-27 16:01:56 -0700 (Sun, 27 Jul 2008) $ # $Author: thaljef $ # $Revision: 2620 $ ######################################################################## use 5.006001; use strict; use warnings; use Module::Build; my $class = Module::Build->subclass( code => <<'END_SUBCLASS' ); sub ACTION_test { my ($self) = @_; $self->depends_on('manifest'); return $self->SUPER::ACTION_test(); } sub ACTION_authortest { my ($self) = @_; $self->depends_on('build'); $self->depends_on('manifest'); $self->depends_on('distmeta'); $self->test_files( qw< t xt/author > ); $self->recursive_test_files(1); $self->depends_on('test'); return; } # end ACTION_authortest() sub ACTION_distdir { my ($self) = @_; $self->depends_on('authortest'); return $self->SUPER::ACTION_distdir; } # end ACTION_distdir END_SUBCLASS my $builder = $class->new( module_name => 'Test::Perl::Critic::Progressive', dist_author => 'Jeffrey Thalhammer ', dist_abstract => 'Encourage Perl::Critic conformance over time.', license => 'perl', dynamic_config => 1, create_readme => 1, create_packlist => 1, sign => 0, requires => { 'base' => 0, 'Carp' => 0, 'Data::Dumper' => 0, 'English' => 0, 'Exporter' => 0, 'File::Spec' => 0, 'FindBin' => 0, 'Perl::Critic' => 1.082, 'Perl::Critic::Utils' => 1.082, 'strict' => 0, 'Test::Builder' => 0, 'warnings' => 0, }, build_requires => { 'Test::More' => 0, }, add_to_cleanup => [ qw(MANIFEST MANIFEST.bak README) ], meta_merge => { resources => { homepage => 'http://perlcritic.com', license => 'http://dev.perl.org/licenses/', Repository => 'http://perlcritic.tigris.org/svn/perlcritic/trunk/Test-Perl-Critic-Progressive/', MailingList => 'http://perlcritic.tigris.org/servlets/SummarizeList?listName=users', } }, ); $builder->create_build_script(); Test-Perl-Critic-Progressive-0.03/Changes0000444000076500007650000000167611043177317016723 0ustar jeffjeff####################################################################### # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-Progressive-0.03/Changes $ # $Date: 2008-07-27 16:01:56 -0700 (Sun, 27 Jul 2008) $ # $Author: thaljef $ # $Revision: 2620 $ ######################################################################## [0.03] Released on 2008-07-27. "use 5.006001" in Makefile.PL and Build.PL. If 'blib' directory does not exist, then look for perl files in 'bin', 'script', and 'scripts' dirs, as well as the 'lib' dir. RT #33197. [0.02] Released on 2007-06-22 Added hooks for controling the decay rate for individual types of violations. See POD for details. All functions can now be exported upon request. Note that some of them have been renamed. Tweaked the test diagnostics messages a bit. Edited documentation. [0.01] Released on 2007-06-17 Initial release. Test-Perl-Critic-Progressive-0.03/INSTALL0000444000076500007650000000146711043177317016457 0ustar jeffjeff####################################################################### # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-Progressive-0.03/INSTALL $ # $Date: 2008-07-27 16:01:56 -0700 (Sun, 27 Jul 2008) $ # $Author: thaljef $ # $Revision: 2620 $ ######################################################################## INSTALLATION To install Test::Perl::Critic::Progressive with C, give the following commands at your favorite shell: tar -zxf Test-Perl-Critic-Progressive-0.03.tar.gz cd Test-Perl-Critic-Progressive-0.03 perl Makefile.PL make make test make install Or if you prefer C, try this: tar -zxf Test-Perl-Critic-Progressive-0.03.tar.gz cd Test-Perl-Critic-Progressive-0.03 perl Build.pl ./Build ./Build test ./Build install Test-Perl-Critic-Progressive-0.03/lib/0000755000076500007650000000000011043177317016166 5ustar jeffjeffTest-Perl-Critic-Progressive-0.03/lib/Test/0000755000076500007650000000000011043177317017105 5ustar jeffjeffTest-Perl-Critic-Progressive-0.03/lib/Test/Perl/0000755000076500007650000000000011043177317020007 5ustar jeffjeffTest-Perl-Critic-Progressive-0.03/lib/Test/Perl/Critic/0000755000076500007650000000000011043177317021224 5ustar jeffjeffTest-Perl-Critic-Progressive-0.03/lib/Test/Perl/Critic/Progressive.pm0000444000076500007650000003713611043177317024102 0ustar jeffjeff############################################################################## # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-Progressive-0.03/lib/Test/Perl/Critic/Progressive.pm $ # $Date: 2008-07-27 16:01:56 -0700 (Sun, 27 Jul 2008) $ # $Author: thaljef $ # $Revision: 2620 $ ############################################################################## package Test::Perl::Critic::Progressive; use 5.006001; use strict; use warnings; use Carp qw(croak confess); use Data::Dumper qw(Dumper); use English qw(-no_match_vars); use File::Spec qw(); use FindBin qw($Bin); use Perl::Critic qw(); use Perl::Critic::Utils qw(policy_short_name policy_long_name); use Test::Builder qw(); use base 'Exporter'; #--------------------------------------------------------------------------- our $VERSION = '0.03'; #--------------------------------------------------------------------------- our @EXPORT_OK = qw( get_critic_args get_history_file get_total_step_size get_step_size_per_policy progressive_critic_ok set_critic_args set_history_file set_total_step_size set_step_size_per_policy ); our %EXPORT_TAGS = ( all => \@EXPORT_OK ); #--------------------------------------------------------------------------- my $TOTAL_STEP_SIZE = undef; my $DEFAULT_STEP_SIZE = 0; my %STEP_SIZE_PER_POLICY = (); my $HISTORY_FILE = undef; my $DEFAULT_HISTORY_FILE = File::Spec->catfile($Bin, '.perlcritic-history'); my $CRITIC = undef; my %CRITIC_ARGS = (); my $TEST = Test::Builder->new(); #--------------------------------------------------------------------------- # Public functions sub progressive_critic_ok { my @dirs = @_; if (not @dirs) { @dirs = _starting_points(); } my @files = _all_code_files( @dirs ); croak qq{No perl files found\n} if not @files; my $caller = caller; $TEST->exported_to($caller); $TEST->plan( tests => 1 ); $CRITIC = Perl::Critic->new( get_critic_args() ); my @violations = map { $CRITIC->critique($_) } @files; my $ok = _evaluate_test( @violations ); $TEST->ok($ok, __PACKAGE__); return $ok; } #--------------------------------------------------------------------------- # Pulbic accessor functions sub get_history_file { return defined $HISTORY_FILE ? $HISTORY_FILE : $DEFAULT_HISTORY_FILE; } #--------------------------------------------------------------------------- sub set_history_file { $HISTORY_FILE = shift; return 1; } #--------------------------------------------------------------------------- sub get_critic_args { return %CRITIC_ARGS; } #--------------------------------------------------------------------------- sub set_critic_args { %CRITIC_ARGS = @_; return 1; } #--------------------------------------------------------------------------- sub get_total_step_size { return defined $TOTAL_STEP_SIZE ? $TOTAL_STEP_SIZE : $DEFAULT_STEP_SIZE; } #--------------------------------------------------------------------------- sub set_total_step_size { $TOTAL_STEP_SIZE = shift; return 1; } #--------------------------------------------------------------------------- sub get_step_size_per_policy { return %STEP_SIZE_PER_POLICY; } #--------------------------------------------------------------------------- sub set_step_size_per_policy { my %args = @_; my %step_sizes = (); for my $policy_name ( keys %args ) { $step_sizes{policy_long_name($policy_name)} = $args{$policy_name}; } %STEP_SIZE_PER_POLICY = %step_sizes; return 1; } #--------------------------------------------------------------------------- # Private functions sub _evaluate_test { my (@viols) = @_; my $ok = 1; my $results = {}; my $history_data = _read_history( get_history_file() ); my $last_critique = $history_data->[-1]; my $has_run_before = defined $last_critique; my $last_total_violations = 0; my $current_total_violations = 0; for my $policy ( $CRITIC->policies() ) { my $policy_name = ref $policy; my $policy_violations = grep {$_->policy() eq $policy_name} @viols; $results->{$policy_name} = $policy_violations; my $last_policy_violations = $last_critique->{$policy_name}; next if not defined $last_policy_violations; $last_total_violations += $last_policy_violations; $current_total_violations += $policy_violations; my $policy_step_size = defined $STEP_SIZE_PER_POLICY{$policy_name} ? $STEP_SIZE_PER_POLICY{$policy_name} : $DEFAULT_STEP_SIZE; my $target = $policy_step_size > $last_policy_violations ? 0 : $last_policy_violations - $policy_step_size; if ( $policy_violations > $target ) { my $short_name = policy_short_name($policy_name); my $diagf = '%s: Got %i violation(s). Expected no more than %i.'; $TEST->diag( sprintf $diagf, $short_name, $policy_violations, $target ); $ok = 0; # Failed the test! } } if ( $has_run_before ) { my $target = get_total_step_size() > $last_total_violations ? 0 : $last_total_violations - get_total_step_size(); if ( $current_total_violations > $target ) { my $got = $current_total_violations; $TEST->diag('Too many Perl::Critic violations...'); $TEST->diag("Got a total of $got. Expected no more than $target."); $ok = 0; } } if ( !$has_run_before || ($ok && $last_total_violations > 0) ) { push @{$history_data}, $results; _write_history_file( get_history_file(), $history_data); } return $ok; } #--------------------------------------------------------------------------- sub _all_code_files { my @dirs = @_; if (not @dirs) { @dirs = _starting_points(); } return Perl::Critic::Utils::all_perl_files(@dirs); } #--------------------------------------------------------------------------- sub _starting_points { return -e 'blib' ? 'blib' : grep { -e $_ } qw(lib bin script scripts); } #--------------------------------------------------------------------------- sub _read_history { my ($history_file) = @_; return [] if not -e $history_file; my $history_data = eval { do $history_file }; croak qq{Can't read history from "$history_file": $EVAL_ERROR} if $EVAL_ERROR; return $history_data; } #--------------------------------------------------------------------------- sub _open_history_file { my ($history_file) = @_; open my $history_fh, '>', $history_file or confess qq{Can't open "$history_file": $OS_ERROR}; return $history_fh; } #--------------------------------------------------------------------------- sub _write_history_file { my ($history_file, $history_data) = @_; my $history_fh = _open_history_file($history_file); print {$history_fh} Dumper($history_data) or confess qq{Can't write to "$history_file": $OS_ERROR}; close $history_fh or confess qq{Can't close "$history_file": $OS_ERROR}; return 1; } #--------------------------------------------------------------------------- 1; __END__ =pod =for stopwords AntHill CruiseControl =head1 NAME Test::Perl::Critic::Progressive - Gradually enforce coding standards. =head1 SYNOPSIS To test one or more files, and/or all files in one or more directories: use Test::Perl::Critic::Progressive qw( progressive_critic_ok ); progressive_critic_ok($file1, $file2, $dir1, $dir2); To test all Perl files in a distribution: use Test::Perl::Critic::Progressive qw( progressive_critic_ok ); progressive_critic_ok(); Recommended usage for public CPAN distributions: use strict; use warnings; use Test::More; eval { require Test::Perl::Critic::Progressive }; plan skip_all => 'T::P::C::Progressive required for this test' if $@; Test::Perl::Critic::Progressive::progressive_critic_ok(); =head1 DESCRIPTION Applying coding standards to large amounts of legacy code is a daunting task. Often times, legacy code is so non-compliant that it seems downright impossible. But, if you consistently chip away at the problem, you will eventually succeed! Test::Perl::Critic::Progressive uses the L engine to prevent further deterioration of your code and B steer it towards conforming with your chosen coding standards. The most effective way to use Test::Perl::Critic::Progressive is as a unit test that is run under a continuous-integration system like CruiseControl or AntHill. Each time a developer commits changes to the code, this test will fail and the build will break unless it has the same (or fewer) Perl::Critic violations than the last successful test. See the L<"NOTES"> for more details about how this test works. =head1 SUBROUTINES All of the following subroutines can be exported upon request. Or you can export all of them at once using the C<':all'> tag. =over =item C< progressive_critic_ok(@FILES [, @DIRECTORIES ]) > =item C< progressive_critic_ok() > Uses Perl::Critic to analyze each of the given @FILES, and/or all Perl files beneath the given list of C<@DIRECTORIES>. If no arguments are given, it analyzes all the Perl files in the F directory. If the F directory does not exist, then it tries the F, F, F