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