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