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   696  
  1         3  
  1         33  
11 1     1   6 use strict;
  1         2  
  1         32  
12 1     1   6 use warnings;
  1         1  
  1         64  
13 1     1   1003 use Carp qw(croak);
  1         3149  
  1         6  
14 1     1   486 use English qw(-no_match_vars);
  1         2  
  1         16  
15 1     1   2266 use Test::Builder qw();
  1         1850357  
  1         26  
16 1     1   12 use Perl::Critic qw();
  1         3  
  1         24  
17 1     1   6 use Perl::Critic::Violation qw();
  1         2  
  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   9  
34 1         3 my ( $self, %args ) = @_;
35             my $caller = caller;
36 1     1   1051  
  1         14  
  1         583  
37 1         2 no strict 'refs'; ## no critic
  1         7  
38 1         2 *{ $caller . '::critic_ok' } = \&critic_ok;
  1         3  
39             *{ $caller . '::all_critic_ok' } = \&all_critic_ok;
40 1         7  
41             $TEST->exported_to($caller);
42              
43 1 50       13 # -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         12  
47             return 1;
48             }
49              
50             #---------------------------------------------------------------------------
51              
52             sub critic_ok {
53 1     1 1 2  
54 1 50       8 my ( $file, $test_name ) = @_;
55 1 50       20 croak q{no file specified} if not defined $file;
56 1   33     9 croak qq{"$file" does not exist} if not -f $file;
57             $test_name ||= qq{Test::Perl::Critic for "$file"};
58 1         1  
59 1         4 my $critic = undef;
60 1         2 my @violations = ();
61             my $ok = 0;
62              
63 1         2 # Run Perl::Critic
64             eval {
65 1         8 # TODO: Should $critic be a global singleton?
66 1         490093 $critic = Perl::Critic->new( %CRITIC_ARGS );
67 1         153331 @violations = $critic->critique( $file );
68             $ok = not scalar @violations;
69             };
70              
71 1         13 # Evaluate results
72             $TEST->ok( $ok, $test_name );
73              
74 1 50       805  
    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         420  
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         487 my @files = all_code_files( @dirs );
98             $TEST->plan( tests => scalar @files );
99 1         568  
  1         4  
100 1         134 my $okays = grep { critic_ok($_) } @files;
101             return $okays == @files;
102             }
103              
104             #---------------------------------------------------------------------------
105              
106 1 50   1 1 4 sub all_code_files {
107 1         6 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