lib/Test/NoTabs.pm

   1 package Test::NoTabs;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::Builder;
   7 use File::Spec;
   8 use FindBin qw($Bin);
   9 use File::Find;
  10
  11 use vars qw( $VERSION $PERL $UNTAINT_PATTERN $PERL_PATTERN);
  12
  13 $VERSION = '1.0';
  14
  15 $PERL    = $^X || 'perl';
  16 $UNTAINT_PATTERN  = qr|^([-+@\w./:\\]+)$|;
  17 $PERL_PATTERN     = qr/^#!.*perl/;
  18
  19 my %file_find_arg = ($] <= 5.006) ? () : (
  20     untaint => 1,
  21     untaint_pattern => $UNTAINT_PATTERN,
  22     untaint_skip => 1,
  23 );
  24
  25 my $Test  = Test::Builder->new;
  26 my $updir = File::Spec->updir();
  27
  28 sub import {
  29     my $self   = shift;
  30     my $caller = caller;
  31     {
  32         no strict 'refs';
  33         *{$caller.'::notabs_ok'} = \&notabs_ok;
  34         *{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
  35     }
  36     $Test->exported_to($caller);
  37     $Test->plan(@_);
  38 }
  39
  40 sub _all_perl_files {
  41     my @all_files = _all_files(@_);
  42     return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
  43 }
  44
  45 sub _all_files {
  46     my @base_dirs = @_ ? @_ : File::Spec->catdir($Bin, $updir);
  47     my @found;
  48     my $want_sub = sub {
  49         return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?.svn[\\/]!); # Filter out cvs or subversion dirs/
  50         return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
  51         return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
  52         return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script
  53         return unless (-f $File::Find::name && -r _);
  54         push @found, File::Spec->no_upwards( $File::Find::name );
  55     };
  56     my $find_arg = {
  57         %file_find_arg,
  58         wanted   => $want_sub,
  59         no_chdir => 1,
  60     };
  61     find( $find_arg, @base_dirs);
  62     return @found;
  63 }
  64
  65 sub notabs_ok {
  66     my $file = shift;
  67     my $test_txt = shift || "No tabs in '$file'";
  68     $file = _module_to_path($file);
  69     open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
  70     my $line = 0;
  71     while (<$fh>) {
  72         $line++;
  73         next if (/^\s*#/);
  74         next if (/^\s*=.+/ .. (/^\s*=(cut|back|end)/ || eof($fh)));
  75         last if (/^\s*(__END__|__DATA__)/);
  76         if ( /\t/ ) {
  77           $Test->ok(0, $test_txt . " on line $line");
  78           return 0;
  79         }
  80     }
  81     $Test->ok(1, $test_txt);
  82     return 1;
  83 }
  84
  85 sub all_perl_files_ok {
  86     my @files = _all_perl_files( @_ );
  87     _make_plan();
  88     foreach my $file ( sort @files ) {
  89       notabs_ok($file, "no tabs in $file");
  90     }
  91 }
  92
  93 sub _is_perl_module {
  94     $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
  95 }
  96
  97 sub _is_perl_script {
  98     my $file = shift;
  99     return 1 if $file =~ /\.pl$/i;
 100     return 1 if $file =~ /\.t$/;
 101     open (my $fh, $file) or return;
 102     my $first = <$fh>;
 103     return 1 if defined $first && ($first =~ $PERL_PATTERN);
 104     return;
 105 }
 106
 107 sub _module_to_path {
 108     my $file = shift;
 109     return $file unless ($file =~ /::/);
 110     my @parts = split /::/, $file;
 111     my $module = File::Spec->catfile(@parts) . '.pm';
 112     foreach my $dir (@INC) {
 113         my $candidate = File::Spec->catfile($dir, $module);
 114         next unless (-e $candidate && -f _ && -r _);
 115         return $candidate;
 116     }
 117     return $file;
 118 }
 119
 120 sub _make_plan {
 121     unless ($Test->has_plan) {
 122         $Test->plan( 'no_plan' );
 123     }
 124     $Test->expected_tests;
 125 }
 126
 127 sub _untaint {
 128     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
 129     return wantarray ? @untainted : $untainted[0];
 130 }
 131
 132 1;
 133 __END__
 134
 135 =head1 NAME
 136
 137 Test::NoTabs - Check the presence of tabs in your project
 138
 139 =head1 SYNOPSIS
 140
 141 C<Test::NoTabs> lets you check the presence of tabs in your perl code. It
 142 report its results in standard C<Test::Simple> fashion:
 143
 144   use Test::NoTabs tests => 1;
 145   notabs_ok( 'lib/Module.pm', 'Module is tab free');
 146
 147 Module authors can include the following in a t/notabs.t and have C<Test::NoTabs>
 148 automatically find and check all perl files in a module distribution:
 149
 150   use Test::NoTabs;
 151   all_perl_files_ok();
 152
 153 or
 154
 155   use Test::NoTabs;
 156   all_perl_files_ok( @mydirs );
 157
 158 =head1 DESCRIPTION
 159
 160 This module scans your project/distribution for any perl files (scripts,
 161 modules, etc) for the presence of tabs.
 162
 163 =head1 EXPORT
 164
 165 A list of functions that can be exported.  You can delete this section
 166 if you don't export anything, such as for a purely object-oriented module.
 167
 168 =head1 FUNCTIONS
 169
 170 =head2 all_perl_files_ok( [ @directories ] )
 171
 172 Applies C<notabs_ok()> to all perl files found in C<@directories> (and sub
 173 directories). If no <@directories> is given, the starting point is one level
 174 above the current running script, that should cover all the files of a typical
 175 CPAN distribution. A perl file is *.pl or *.pm or *.t or a file starting
 176 with C<#!...perl>
 177
 178 If the test plan is defined:
 179
 180   use Test::NoTabs tests => 3;
 181   all_perl_files_ok();
 182
 183 the total number of files tested must be specified.
 184
 185 =head2 notabs_ok( $file [, $text] )
 186
 187 Run a tab check on C<$file>. For a module, the path (lib/My/Module.pm) or the
 188 name (My::Module) can be both used.
 189
 190 =head1 AUTHOR
 191
 192 Nick Gerakines, C<< <nick at socklabs.com> >>
 193
 194 =head1 BUGS
 195
 196 Please report any bugs or feature requests to
 197 C<bug-test-notabs at rt.cpan.org>, or through the web interface at
 198 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-NoTabs>.
 199 I will be notified, and then you'll automatically be notified of progress on
 200 your bug as I make changes.
 201
 202 =head1 SUPPORT
 203
 204 You can find documentation for this module with the perldoc command.
 205
 206     perldoc Test::NoTabs
 207
 208 You can also look for information at:
 209
 210 =over 4
 211
 212 =item * AnnoCPAN: Annotated CPAN documentation
 213
 214 L<http://annocpan.org/dist/Test-NoTabs>
 215
 216 =item * CPAN Ratings
 217
 218 L<http://cpanratings.perl.org/d/Test-NoTabs>
 219
 220 =item * RT: CPAN's request tracker
 221
 222 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-NoTabs>
 223
 224 =item * Search CPAN
 225
 226 L<http://search.cpan.org/dist/Test-NoTabs>
 227
 228 =back
 229
 230 =head1 ACKNOWLEDGEMENTS
 231
 232 Inspired by some code written by Paul Lindner.
 233
 234 L<Test::Strict> was used as an example when creating this module and
 235 distribution.
 236
 237 Rick Myers and Emanuele Zeppieri also provided valuable feedback.
 238
 239 Patch to fix warnings provided by Florian Ragwitz (rafl)
 240
 241 Currently maintained by Tomas Doran (t0m) C<bobtfish@bobtfish.net>
 242
 243 =head1 SEE ALSO
 244
 245 L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>
 246
 247 =head1 COPYRIGHT & LICENSE
 248
 249 Copyright 2006 Nick Gerakines, all rights reserved.
 250
 251 This program is free software; you can redistribute it and/or modify it
 252 under the same terms as Perl itself.
 253
 254 =cut