File Coverage

blib/lib/Test/NoTabs.pm
Criterion Covered Total %
statement 69 91 75.8
branch 20 44 45.4
condition 6 18 33.3
subroutine 16 18 88.8
pod 2 2 100.0
total 113 173 65.3


line stmt bran cond sub pod time code
1             package Test::NoTabs; # git description: 1.4-13-g68640dd
2             # ABSTRACT: Check the presence of tabs in your project
3              
4 1     1   470 use strict;
  1         1  
  1         24  
5 1     1   3 use warnings;
  1         1  
  1         30  
6              
7             our $VERSION = '2.00';
8              
9 1     1   569 use Test::Builder;
  1         8884  
  1         29  
10 1     1   7 use File::Spec;
  1         1  
  1         20  
11 1     1   496 use FindBin qw($Bin);
  1         838  
  1         130  
12 1     1   5 use File::Find ();
  1         2  
  1         174  
13              
14             our $PERL = $^X || 'perl';
15             our $UNTAINT_PATTERN = qr|^([-+@\w./:\\]+)$|;
16             our $PERL_PATTERN = qr/^#!.*perl/;
17              
18             my %file_find_arg = ("$]" <= 5.006) ? () : (
19             untaint => 1,
20             untaint_pattern => $UNTAINT_PATTERN,
21             untaint_skip => 1,
22             );
23              
24             my $Test = Test::Builder->new;
25             my $updir = File::Spec->updir();
26              
27             sub import {
28 1     1   4 my $self = shift;
29 1         2 my $caller = caller;
30             {
31 1     1   5 no strict 'refs';
  1         1  
  1         999  
  1         1  
32 1         1 *{$caller.'::notabs_ok'} = \¬abs_ok;
  1         4  
33 1         2 *{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
  1         3  
34             }
35 1         3 $Test->exported_to($caller);
36 1         6 $Test->plan(@_);
37             }
38              
39             sub _all_perl_files {
40 1     1   3 my @all_files = _all_files(@_);
41 1 50       2 return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
  1         4  
42             }
43              
44             sub _all_files {
45 1 50   1   4 my @base_dirs = @_ ? @_ : File::Spec->catdir($Bin, $updir);
46 1         1 my @found;
47             my $want_sub = sub {
48 3 50   3   49 return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?\.svn[\\/]!); # Filter out cvs or subversion dirs/
49 3 50       8 return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
50 3 50       6 return if ($File::Find::dir =~ m![\\/]?inc!); # Remove Module::Install
51 3 50       6 return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
52 3 50       6 return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script
53 3 100 66     233 return unless (-f $File::Find::name && -r _);
54 1         35 push @found, File::Spec->no_upwards( $File::Find::name );
55 1         4 };
56 1         7 my $find_arg = {
57             %file_find_arg,
58             wanted => $want_sub,
59             no_chdir => 1,
60             };
61 1         141 File::Find::find( $find_arg, @base_dirs);
62 1         6 return @found;
63             }
64              
65             sub notabs_ok {
66 5     5 1 1230 my $file = shift;
67 5   66     17 my $test_txt = shift || "No tabs in '$file'";
68 5         8 $file = _module_to_path($file);
69 5 50       149 open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
  0         0  
  0         0  
  0         0  
70 5         7 my $line = 0;
71 5         46 while (<$fh>) {
72 264         143 $line++;
73 264 100       337 next if (/^\s*#/);
74 259 100 66     404 next if (/^\s*=(head[1234]|over|item|begin|for|encoding)/ .. (/^\s*=(cut|back|end)/ || eof($fh)));
75 235 100       258 last if (/^\s*(__END__|__DATA__)/);
76 232 50       416 if ( /\t/ ) {
77 0         0 $Test->ok(0, $test_txt . " on line $line");
78 0         0 return 0;
79             }
80             }
81 5         18 $Test->ok(1, $test_txt);
82 5         1163 return 1;
83             }
84              
85             sub all_perl_files_ok {
86 1     1 1 11 my @files = _all_perl_files( @_ );
87 1         4 _make_plan();
88 1         26 foreach my $file ( sort @files ) {
89 1         6 notabs_ok($file, "No tabs in '$file'");
90             }
91             }
92              
93             sub _is_perl_module {
94 1 50   1   7 $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
95             }
96              
97             sub _is_perl_script {
98 0     0   0 my $file = shift;
99 0 0       0 return 1 if $file =~ /\.pl$/i;
100 0 0       0 return 1 if $file =~ /\.t$/;
101 0 0       0 open (my $fh, $file) or return;
102 0         0 my $first = <$fh>;
103 0 0 0     0 return 1 if defined $first && ($first =~ $PERL_PATTERN);
104 0         0 return;
105             }
106              
107             sub _module_to_path {
108 5     5   5 my $file = shift;
109 5 50       16 return $file unless ($file =~ /::/);
110 0         0 my @parts = split /::/, $file;
111 0         0 my $module = File::Spec->catfile(@parts) . '.pm';
112 0         0 foreach my $dir (@INC) {
113 0         0 my $candidate = File::Spec->catfile($dir, $module);
114 0 0 0     0 next unless (-e $candidate && -f _ && -r _);
      0        
115 0         0 return $candidate;
116             }
117 0         0 return $file;
118             }
119              
120             sub _make_plan {
121 1 50   1   18 unless ($Test->has_plan) {
122 1         32 $Test->plan( 'no_plan' );
123             }
124 1         20 $Test->expected_tests;
125             }
126              
127             sub _untaint {
128 0     0     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
  0            
129 0 0         return wantarray ? @untainted : $untainted[0];
130             }
131              
132             1;
133              
134             __END__