File Coverage

blib/lib/Test/Tabs.pm
Criterion Covered Total %
statement 107 123 86.9
branch 45 64 70.3
condition 7 18 38.8
subroutine 20 22 90.9
pod 2 2 100.0
total 181 229 79.0


line stmt bran cond sub pod time code
1             package Test::Tabs;
2              
3 2     2   85434 use 5.008;
  2         68  
  2         75  
4 2     2   10 use strict;
  2         3  
  2         63  
5 2     2   9 use warnings;
  2         7  
  2         107  
6              
7             BEGIN {
8 2     2   4 $Test::Tabs::AUTHORITY = 'cpan:TOBYINK';
9 2         58 $Test::Tabs::VERSION = '0.004';
10             }
11              
12 2     2   1137 use Test::Builder;
  2         12699  
  2         50  
13 2     2   11 use File::Spec;
  2         3  
  2         48  
14 2     2   1944 use FindBin qw($Bin);
  2         3263  
  2         561  
15 2     2   15 use File::Find;
  2         4  
  2         162  
16              
17 2     2   12 use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN );
  2         3  
  2         2437  
18              
19             $PERL = $^X || 'perl';
20             $UNTAINT_PATTERN = qr|^([-+@\w./:\\]+)$|;
21             $PERL_PATTERN = qr/^#!.*perl/;
22              
23             my %file_find_arg = ($] <= 5.006) ? () : (
24             untaint => 1,
25             untaint_pattern => $UNTAINT_PATTERN,
26             untaint_skip => 1,
27             );
28              
29             my $Test = Test::Builder->new;
30             my $updir = File::Spec->updir();
31              
32             sub import
33             {
34 2     2   18 my $self = shift;
35 2         5 my $caller = caller;
36             {
37 2     2   17 no strict 'refs';
  2         14  
  2         3464  
  2         4  
38 2         14 *{$caller.'::tabs_ok'} = \&tabs_ok;
  2         12  
39 2         4 *{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
  2         9  
40             }
41 2         11 $Test->exported_to($caller);
42 2         23 $Test->plan(@_);
43             }
44              
45             sub _all_perl_files
46             {
47 1     1   4 my @all_files = _all_files(@_);
48 1 100       3 return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
  32         56  
49             }
50              
51             sub _all_files
52             {
53 1 50   1   23 my @base_dirs = @_ ? @_ : File::Spec->catdir($Bin, $updir);
54 1         2 my @found;
55             my $want_sub = sub
56             {
57 56 50   56   685 return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?\.svn[\\/]!); # Filter out cvs or subversion dirs/
58 56 50       114 return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
59 56 50       101 return if ($File::Find::dir =~ m![\\/]?inc!); # Remove Module::Install
60 56 100       141 return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
61 54 50       112 return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script
62 54 100 66     2879 return unless (-f $File::Find::name && -r _);
63 32         848 push @found, File::Spec->no_upwards( $File::Find::name );
64 1         6 };
65 1         8 my $find_arg = {
66             %file_find_arg,
67             wanted => $want_sub,
68             no_chdir => 1,
69             };
70 1         127 find( $find_arg, @base_dirs);
71 1         14 return @found;
72             }
73            
74             sub tabs_ok
75             {
76 5     5 1 9 my $file = shift;
77 5         12 $file = _module_to_path($file);
78 5 50       278 open my $fh, $file or do {
79 0         0 $Test->ok(0, "whitespace for $file");
80 0         0 $Test->diag("Could not open $file: $!");
81 0         0 return;
82             };
83 5         10 my $line = 0;
84 5         6 my $last_indent = 0;
85 5         7 my $ignoring = 0;
86 5         6 my $ok = 1;
87 5         77 while (<$fh>)
88             {
89 546         484 $line++;
90            
91 546         755 my $ignore_line = /##\s*WS/i;
92 546 100       883 $ignoring = 1 if /#\s*no\s*Test::Tabs/;
93 546 100       856 $ignoring = 0 if /#\s*use\s*Test::Tabs/;
94            
95 546 50       932 if (/#\s*skip\s*Test::Tabs/)
96             {
97 0 0       0 $ok
98             ? $Test->skip($file)
99             : $Test->ok($ok, "$file contains skip comment, but problems already encountered");
100 0         0 return $ok;
101             }
102            
103 546 100       918 next if (/^\s*#/);
104 540 50 0     1076 next if (/^\s*=.+/ .. (/^\s*=(cut|back|end)/ || eof($fh)));
105 540 100       934 last if (/^\s*(__END__|__DATA__)/);
106 538 100 100     2309 next if $ignoring || $ignore_line;
107            
108 534         1653 my ($indent, $remaining) = (/^([\s\x20]*)(.*)/);
109 534 100       1095 next unless length $remaining;
110            
111 467 100       762 if ($indent =~ /\x20/)
112             {
113 27         112 $Test->diag("$file had space indent on line $line");
114 27         1970 $ok = 0;
115             }
116 467 100       823 if ($remaining =~ /\t/)
117             {
118 3         14 $Test->diag("$file had non-indenting tab on line $line");
119 3         204 $ok = 0;
120             }
121 467 100       897 if ($remaining =~ /\s$/)
122             {
123 3         11 $Test->diag("$file had trailing whitespace on line $line");
124 3         164 $ok = 0;
125             }
126 467 100       815 if (length($indent) - $last_indent > 1)
127             {
128 5         22 $Test->diag("$file had jumping indent on line $line");
129 5         324 $ok = 0;
130             }
131 467         1375 $last_indent = length $indent;
132             }
133 5         31 $Test->ok($ok, "whitespace for $file");
134 5         2188 return $ok;
135             }
136              
137             sub all_perl_files_ok
138             {
139 1     1 1 7 local $Test::Builder::Level = $Test::Builder::Level + 1;
140 1         4 my @files = _all_perl_files( @_ );
141 1         5 _make_plan();
142 1         12 foreach my $file ( sort @files )
143             {
144 5         21 tabs_ok($file, "OK tabs in '$file'");
145             }
146             }
147              
148             sub _is_perl_module
149             {
150 32 100   32   195 $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
151             }
152              
153             sub _is_perl_script
154             {
155 30     30   30 my $file = shift;
156 30 100       64 return 1 if $file =~ /\.pl$/i;
157 29 50       51 return 1 if $file =~ /\.psgi$/;
158 29 100       53 return 1 if $file =~ /\.t$/;
159 27 50       903 open (my $fh, $file) or return;
160 27         281 my $first = <$fh>;
161 27 50 66     149 return 1 if defined $first && ($first =~ $PERL_PATTERN);
162 27         328 return;
163             }
164              
165             sub _module_to_path
166             {
167 5     5   6 my $file = shift;
168 5 50       22 return $file unless ($file =~ /::/);
169 0         0 my @parts = split /::/, $file;
170 0         0 my $module = File::Spec->catfile(@parts) . '.pm';
171 0         0 foreach my $dir (@INC)
172             {
173 0         0 my $candidate = File::Spec->catfile($dir, $module);
174 0 0 0     0 next unless (-e $candidate && -f _ && -r _);
      0        
175 0         0 return $candidate;
176             }
177 0         0 return $file;
178             }
179              
180             sub _make_plan
181             {
182 1 50   1   8 unless ($Test->has_plan)
183             {
184 1         21 $Test->plan( 'no_plan' );
185             }
186 1         23 $Test->expected_tests;
187             }
188              
189             sub _untaint
190             {
191 0     0     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
  0            
192 0 0         return wantarray ? @untainted : $untainted[0];
193             }
194              
195             sub __silly {
196             # this is just for testing really.
197             print "$_\n"
198 0     0     for 1..3; ##WS
199             }
200              
201             ## no Test::Tabs
202             1;
203             ## use Test::Tabs
204              
205             __END__