File Coverage

inc/Test/Perl/Critic.pm
Criterion Covered Total %
statement 59 70 84.2
branch 7 16 43.7
condition 1 3 33.3
subroutine 13 14 92.8
pod 3 3 100.0
total 83 106 78.3


line stmt bran cond sub pod time code
1             #line 1
2             #######################################################################
3             # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-1.01/lib/Test/Perl/Critic.pm $
4             # $Date: 2007-01-24 22:22:10 -0800 (Wed, 24 Jan 2007) $
5             # $Author: thaljef $
6             # $Revision: 1183 $
7             ########################################################################
8              
9             package Test::Perl::Critic;
10 1     1   625  
  1         2  
  1         28  
11 1     1   5 use strict;
  1         2  
  1         32  
12 1     1   11 use warnings;
  1         1  
  1         64  
13 1     1   1177 use Carp qw(croak);
  1         2134  
  1         487  
14 1     1   404 use English qw(-no_match_vars);
  1         2  
  1         13  
15 1     1   2484 use Test::Builder qw();
  1         1784048  
  1         27  
16 1     1   11 use Perl::Critic qw();
  1         3  
  1         19  
17 1     1   6 use Perl::Critic::Violation qw();
  1         1  
  1         16  
18             use Perl::Critic::Utils;
19              
20              
21             #---------------------------------------------------------------------------
22              
23             our $VERSION = 1.01;
24              
25             #---------------------------------------------------------------------------
26              
27             my $TEST = Test::Builder->new();
28             my %CRITIC_ARGS = ();
29              
30             #---------------------------------------------------------------------------
31              
32             sub import {
33 1     1   10  
34 1         3 my ( $self, %args ) = @_;
35             my $caller = caller;
36 1     1   1030  
  1         4  
  1         596  
37 1         2 no strict 'refs'; ## no critic
  1         6  
38 1         3 *{ $caller . '::critic_ok' } = \&critic_ok;
  1         4  
39             *{ $caller . '::all_critic_ok' } = \&all_critic_ok;
40 1         7  
41             $TEST->exported_to($caller);
42              
43 1 50       14 # -format is supported for backward compatibility
  0         0  
44 1         3 if( exists $args{-format} ){ $args{-verbose} = $args{-format}; }
45             %CRITIC_ARGS = %args;
46 1         13  
47             return 1;
48             }
49              
50             #---------------------------------------------------------------------------
51              
52             sub critic_ok {
53 1     1 1 3  
54 1 50       7 my ( $file, $test_name ) = @_;
55 1 50       22 croak q{no file specified} if not defined $file;
56 1   33     8 croak qq{"$file" does not exist} if not -f $file;
57             $test_name ||= qq{Test::Perl::Critic for "$file"};
58 1         2  
59 1         2 my $critic = undef;
60 1         1 my @violations = ();
61             my $ok = 0;
62              
63 1         3 # Run Perl::Critic
64             eval {
65 1         9 # TODO: Should $critic be a global singleton?
66 1         484970 $critic = Perl::Critic->new( %CRITIC_ARGS );
67 1         197252 @violations = $critic->critique( $file );
68             $ok = not scalar @violations;
69             };
70              
71 1         14 # Evaluate results
72             $TEST->ok( $ok, $test_name );
73              
74 1 50       382  
    50          
75 0         0 if ($EVAL_ERROR) { # Trap exceptions from P::C
76 0         0 $TEST->diag( "\n" ); # Just to get on a new line.
77 0         0 $TEST->diag( qq{Perl::Critic had errors in "$file":} );
78             $TEST->diag( qq{\t$EVAL_ERROR} );
79             }
80 0         0 elsif ( not $ok ) { # Report Policy violations
81 0         0 $TEST->diag( "\n" ); # Just to get on a new line.
82             $TEST->diag( qq{Perl::Critic found these violations in "$file":} );
83 0         0  
84 0         0 my $verbose = $critic->config->verbose();
85 0         0 Perl::Critic::Violation::set_format( $verbose );
  0         0  
86             for my $viol (@violations) { $TEST->diag("$viol") }
87             }
88 1         580  
89             return $ok;
90             }
91              
92             #---------------------------------------------------------------------------
93              
94             sub all_critic_ok {
95 1 50   1 1 10  
96 1         3 my @dirs = @_ ? @_ : _starting_points();
97 1         501 my @files = all_code_files( @dirs );
98             $TEST->plan( tests => scalar @files );
99 1         589  
  1         4  
100 1         119 my $okays = grep { critic_ok($_) } @files;
101             return $okays == @files;
102             }
103              
104             #---------------------------------------------------------------------------
105              
106 1 50   1 1 3 sub all_code_files {
107 1         5 my @dirs = @_ ? @_ : _starting_points();
108             return Perl::Critic::Utils::all_perl_files(@dirs);
109             }
110              
111             #---------------------------------------------------------------------------
112              
113 0 0   0     sub _starting_points {
114             return -e 'blib' ? 'blib' : 'lib';
115             }
116              
117             #---------------------------------------------------------------------------
118              
119             1;
120              
121              
122             __END__
123              
124             #line 412