lib/Test/EOL.pm

   1 package Test::EOL;
   2 # ABSTRACT: Check the correct line endings in your project
   3
   4 use strict;
   5 use warnings;
   6
   7 use Test::Builder;
   8 use File::Spec;
   9 use File::Find;
  10 use Cwd qw/ cwd /;
  11
  12 use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN);
  13
  14 $PERL    = $^X || 'perl';
  15 $UNTAINT_PATTERN  = qr|^([-+@\w./:\\]+)$|;
  16 $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 my $no_plan;
  28
  29 sub import {
  30     my $self   = shift;
  31     my $caller = caller;
  32     {
  33         no strict 'refs';
  34         *{$caller.'::eol_unix_ok'} = \&eol_unix_ok;
  35         *{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
  36     }
  37     $Test->exported_to($caller);
  38
  39     if ($_[0] && $_[0] eq 'no_plan') {
  40         shift;
  41         $no_plan = 1;
  42     }
  43     $Test->plan(@_);
  44 }
  45
  46 sub _all_perl_files {
  47     my @all_files = _all_files(@_);
  48     return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
  49 }
  50
  51 sub _all_files {
  52     my @base_dirs = @_ ? @_ : cwd();
  53     my $options = pop(@base_dirs) if ref $base_dirs[-1] eq 'HASH';
  54     my @found;
  55     my $want_sub = sub {
  56         return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?\.svn[\\/]!); # Filter out cvs or subversion dirs/
  57         return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
  58         return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
  59         return if ($File::Find::dir =~ m![\\/]?inc!); # Filter out Module::Install stuff
  60         return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script
  61         return unless (-f $File::Find::name && -r _);
  62         push @found, File::Spec->no_upwards( $File::Find::name );
  63     };
  64     my $find_arg = {
  65         %file_find_arg,
  66         wanted   => $want_sub,
  67         no_chdir => 1,
  68     };
  69     find( $find_arg, @base_dirs);
  70     return @found;
  71 }
  72
  73 # Formats various human invisible symbols
  74 # to similar visible ones.
  75 # Perhaps ^M or something like that
  76 # would be more appropriate?
  77
  78 sub _show_whitespace {
  79     my $string = shift;
  80     $string =~ s/\r/[\\r]/g;
  81     $string =~ s/\t/[\\t]/g;
  82     $string =~ s/ /[\\s]/g;
  83     return $string;
  84 }
  85
  86 # Format a line record for diagnostics.
  87
  88 sub _debug_line {
  89     my ( $options, $line ) = @_;
  90     $line->[2] =~ s/\n\z//g;
  91     return "line $line->[1]: $line->[0] " . (
  92       $options->{show_lines} ? qq{: } . _show_whitespace( $line->[2] )  : q{}
  93     );
  94 }
  95
  96 sub eol_unix_ok {
  97     my $file = shift;
  98     my $test_txt;
  99     $test_txt   = shift if !ref $_[0];
 100     $test_txt ||= "No incorrect line endings in '$file'";
 101     my $options = shift if ref $_[0] eq 'HASH';
 102     $options ||= {
 103         trailing_whitespace => 0,
 104         all_reasons => 0,
 105     };
 106     $file = _module_to_path($file);
 107
 108     open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
 109     # Windows-- , default is :crlf, which hides \r\n  -_-
 110     binmode( $fh, ':raw' );
 111     my $line = 0;
 112     my @fails;
 113     while (<$fh>) {
 114         $line++;
 115         if ( !$options->{trailing_whitespace} && /(\r+)$/ ) {
 116           my $match = $1;
 117           push @fails, [ _show_whitespace( $match ) , $line , $_ ];
 118         }
 119         if (  $options->{trailing_whitespace} && /([ \t]*\r+|[ \t]+)$/ ) {
 120           my $match = $1;
 121           push @fails, [ _show_whitespace($match), $line , $_ ];
 122         }
 123         # Minor short-circuit for people who don't need the whole file scanned
 124         # once there's an err.
 125         last if( @fails > 0 && !$options->{all_reasons} );
 126     }
 127     if( @fails ){
 128        $Test->ok( 0, $test_txt . " on "  . _debug_line({ show_lines => 0 } , $fails[0]  )  );
 129        if ( $options->{all_reasons} || 1 ){
 130           $Test->diag( "  Problem Lines: ");
 131           for ( @fails ){
 132             $Test->diag(_debug_line({ show_lines => 1 } , $_ ) );
 133           }
 134        }
 135        return 0;
 136     }
 137     $Test->ok(1, $test_txt);
 138     return 1;
 139 }
 140 sub all_perl_files_ok {
 141     my $options = shift if ref $_[0] eq 'HASH';
 142     my @files = _all_perl_files( @_ );
 143     _make_plan();
 144     foreach my $file ( @files ) {
 145       eol_unix_ok($file, $options);
 146     }
 147 }
 148
 149 sub _is_perl_module {
 150     $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
 151 }
 152
 153 sub _is_perl_script {
 154     my $file = shift;
 155     return 1 if $file =~ /\.pl$/i;
 156     return 1 if $file =~ /\.t$/;
 157     open (my $fh, $file) or return;
 158     my $first = <$fh>;
 159     return 1 if defined $first && ($first =~ $PERL_PATTERN);
 160     return;
 161 }
 162
 163 sub _module_to_path {
 164     my $file = shift;
 165     return $file unless ($file =~ /::/);
 166     my @parts = split /::/, $file;
 167     my $module = File::Spec->catfile(@parts) . '.pm';
 168     foreach my $dir (@INC) {
 169         my $candidate = File::Spec->catfile($dir, $module);
 170         next unless (-e $candidate && -f _ && -r _);
 171         return $candidate;
 172     }
 173     return $file;
 174 }
 175
 176 sub _make_plan {
 177     return if $no_plan;
 178     unless ($Test->has_plan) {
 179         $Test->plan( 'no_plan' );
 180     }
 181     $Test->expected_tests;
 182 }
 183
 184 sub _untaint {
 185     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
 186     return wantarray ? @untainted : $untainted[0];
 187 }
 188
 189 1;
 190
 191 =head1 SYNOPSIS
 192
 193 C<Test::EOL> lets you check for the presence of trailing whitespace and/or
 194 windows line endings in your perl code. It reports its results in standard
 195 C<Test::Simple> fashion:
 196
 197   use Test::EOL tests => 1;
 198   eol_unix_ok( 'lib/Module.pm', 'Module is ^M free');
 199
 200 and to add checks for trailing whitespace:
 201
 202   use Test::EOL tests => 1;
 203   eol_unix_ok( 'lib/Module.pm', 'Module is ^M and trailing whitespace free', { trailing_whitespace => 1 });
 204
 205 Module authors can include the following in a t/eol.t and have C<Test::EOL>
 206 automatically find and check all perl files in a module distribution:
 207
 208   use Test::EOL;
 209   all_perl_files_ok();
 210
 211 or
 212
 213   use Test::EOL;
 214   all_perl_files_ok( @mydirs );
 215
 216 and if authors would like to check for trailing whitespace:
 217
 218   use Test::EOL;
 219   all_perl_files_ok({ trailing_whitespace => 1 });
 220
 221 or
 222
 223   use Test::EOL;
 224   all_perl_files_ok({ trailing_whitespace => 1 }, @mydirs );
 225
 226 or
 227
 228   use Test::More;
 229   use Test::EOL 'no_test';
 230   all_perl_files_ok();
 231   done_testing;
 232
 233 =head1 DESCRIPTION
 234
 235 This module scans your project/distribution for any perl files (scripts,
 236 modules, etc) for the presence of windows line endings.
 237
 238 =head1 EXPORT
 239
 240 A list of functions that can be exported.  You can delete this section
 241 if you don't export anything, such as for a purely object-oriented module.
 242
 243 =func all_perl_files_ok
 244
 245   all_perl_files_ok( [ \%options ], [ @directories ] )
 246
 247 Applies C<eol_unix_ok()> to all perl files found in C<@directories> (and sub
 248 directories). If no <@directories> is given, the starting point is one level
 249 above the current running script, that should cover all the files of a typical
 250 CPAN distribution. A perl file is *.pl or *.pm or *.t or a file starting
 251 with C<#!...perl>
 252
 253 Valid C<\%options> currently are:
 254
 255 =over
 256
 257 =item * trailing_whitespace
 258
 259 By default Test::EOL only looks for Windows (CR/LF) line-endings. Set this
 260 to true to raise errors if any kind of trailing whitespace is present in
 261 the file.
 262
 263 =item * all_reasons
 264
 265 Normally Test::EOL reports only the first error in every file (given that
 266 a text file originated on Windows will fail every single line). Set this
 267 a true value to register a test failure for every line with an error.
 268
 269 =back
 270
 271 If the test plan is defined:
 272
 273   use Test::EOL tests => 3;
 274   all_perl_files_ok();
 275
 276 the total number of files tested must be specified.
 277
 278 =func eol_unix_ok
 279
 280   eol_unix_ok ( $file [, $text] [, \%options ] )
 281
 282 Run a unix EOL check on C<$file>. For a module, the path (lib/My/Module.pm) or the
 283 name (My::Module) can be both used. C<$text> is the diagnostic label emited after
 284 the C<ok>/C<not ok> TAP output. C<\%options> takes the same values as described in
 285 L</all_perl_files_ok>.
 286
 287 =head1 ACKNOWLEDGEMENTS
 288
 289 Shamelessly ripped off from L<Test::NoTabs>.
 290
 291 =head1 SEE ALSO
 292
 293 L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>,
 294 L<Test::NoTabs>, L<Module::Install::AuthorTests>.
 295
 296 =cut