X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FEOL.pm;h=860e427fa47b12122a894a8e4195e502a36bdc69;hb=5a0bc53aa2c44509276facd97dc6bc98b277bae3;hp=bd736bac24e4a1843a2fb735506b042dae6b444d;hpb=94bc2901714b2203fc2ae3013b3991007f61f8ab;p=catagits%2FTest-EOL.git diff --git a/lib/Test/EOL.pm b/lib/Test/EOL.pm index bd736ba..860e427 100644 --- a/lib/Test/EOL.pm +++ b/lib/Test/EOL.pm @@ -6,8 +6,8 @@ use warnings; use Test::Builder; use File::Spec; -use FindBin qw($Bin); use File::Find; +use Cwd qw/ cwd /; use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN); @@ -24,6 +24,8 @@ my %file_find_arg = ($] <= 5.006) ? () : ( my $Test = Test::Builder->new; my $updir = File::Spec->updir(); +my $no_plan; + sub import { my $self = shift; my $caller = caller; @@ -33,6 +35,11 @@ sub import { *{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok; } $Test->exported_to($caller); + + if ($_[0] && $_[0] eq 'no_plan') { + shift; + $no_plan = 1; + } $Test->plan(@_); } @@ -42,12 +49,14 @@ sub _all_perl_files { } sub _all_files { - my @base_dirs = @_ ? @_ : File::Spec->catdir($Bin, $updir); + my @base_dirs = @_ ? @_ : cwd(); + my $options = pop(@base_dirs) if ref $base_dirs[-1] eq 'HASH'; my @found; my $want_sub = sub { - return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?.svn[\\/]!); # Filter out cvs or subversion dirs/ + return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?\.svn[\\/]!); # Filter out cvs or subversion dirs/ return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist + return if ($File::Find::dir =~ m![\\/]?inc!); # Filter out Module::Install stuff return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script return unless (-f $File::Find::name && -r _); push @found, File::Spec->no_upwards( $File::Find::name ); @@ -63,10 +72,10 @@ sub _all_files { # Formats various human invisible symbols # to similar visible ones. -# Perhaps ^M or something like that +# Perhaps ^M or something like that # would be more appropriate? -sub _show_whitespace { +sub _show_whitespace { my $string = shift; $string =~ s/\r/[\\r]/g; $string =~ s/\t/[\\t]/g; @@ -76,11 +85,11 @@ sub _show_whitespace { # Format a line record for diagnostics. -sub _debug_line { +sub _debug_line { my ( $options, $line ) = @_; $line->[2] =~ s/\n\z//g; - return "line $line->[1] : $line->[0] " . ( - $options->{show_lines} ? qq{: } . _show_whitespace( $line->[2] ) : q{} + return "line $line->[1]: $line->[0] " . ( + $options->{show_lines} ? qq{: } . _show_whitespace( $line->[2] ) : q{} ); } @@ -88,17 +97,17 @@ sub eol_unix_ok { my $file = shift; my $test_txt; $test_txt = shift if !ref $_[0]; - $test_txt ||= "No windows line endings in '$file'"; + $test_txt ||= "No incorrect line endings in '$file'"; my $options = shift if ref $_[0] eq 'HASH'; $options ||= { trailing_whitespace => 0, all_reasons => 0, }; $file = _module_to_path($file); - + open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; }; # Windows-- , default is :crlf, which hides \r\n -_- - binmode( $fh, ':raw:utf8' ); + binmode( $fh, ':raw' ); my $line = 0; my @fails; while (<$fh>) { @@ -115,11 +124,11 @@ sub eol_unix_ok { # once there's an err. last if( @fails > 0 && !$options->{all_reasons} ); } - if( @fails ){ + if( @fails ){ $Test->ok( 0, $test_txt . " on " . _debug_line({ show_lines => 0 } , $fails[0] ) ); if ( $options->{all_reasons} || 1 ){ $Test->diag( " Problem Lines: "); - for ( @fails ){ + for ( @fails ){ $Test->diag(_debug_line({ show_lines => 1 } , $_ ) ); } } @@ -145,7 +154,7 @@ sub _is_perl_script { my $file = shift; return 1 if $file =~ /\.pl$/i; return 1 if $file =~ /\.t$/; - open my $fh, $file or return; + open (my $fh, $file) or return; my $first = <$fh>; return 1 if defined $first && ($first =~ $PERL_PATTERN); return; @@ -165,6 +174,7 @@ sub _module_to_path { } sub _make_plan { + return if $no_plan; unless ($Test->has_plan) { $Test->plan( 'no_plan' ); } @@ -180,9 +190,9 @@ sub _untaint { =head1 SYNOPSIS -C lets you check the presence of windows line endings in your -perl code. It -report its results in standard C fashion: +C lets you check for the presence of trailing whitespace and/or +windows line endings in your perl code. It reports its results in standard +C fashion: use Test::EOL tests => 1; eol_unix_ok( 'lib/Module.pm', 'Module is ^M free'); @@ -213,6 +223,13 @@ or use Test::EOL; all_perl_files_ok({ trailing_whitespace => 1 }, @mydirs ); +or + + use Test::More; + use Test::EOL 'no_test'; + all_perl_files_ok(); + done_testing; + =head1 DESCRIPTION This module scans your project/distribution for any perl files (scripts, @@ -223,7 +240,9 @@ modules, etc) for the presence of windows line endings. A list of functions that can be exported. You can delete this section if you don't export anything, such as for a purely object-oriented module. -=func all_perl_files_ok( [ \%options ], [ @directories ] ) +=func all_perl_files_ok + + all_perl_files_ok( [ \%options ], [ @directories ] ) Applies C to all perl files found in C<@directories> (and sub directories). If no <@directories> is given, the starting point is one level @@ -231,6 +250,24 @@ above the current running script, that should cover all the files of a typical CPAN distribution. A perl file is *.pl or *.pm or *.t or a file starting with C<#!...perl> +Valid C<\%options> currently are: + +=over + +=item * trailing_whitespace + +By default Test::EOL only looks for Windows (CR/LF) line-endings. Set this +to true to raise errors if any kind of trailing whitespace is present in +the file. + +=item * all_reasons + +Normally Test::EOL reports only the first error in every file (given that +a text file originated on Windows will fail every single line). Set this +a true value to register a test failure for every line with an error. + +=back + If the test plan is defined: use Test::EOL tests => 3; @@ -238,10 +275,14 @@ If the test plan is defined: the total number of files tested must be specified. -=func eol_unix_ok( $file [, $text] [, \%options ] ) +=func eol_unix_ok + + eol_unix_ok ( $file [, $text] [, \%options ] ) Run a unix EOL check on C<$file>. For a module, the path (lib/My/Module.pm) or the -name (My::Module) can be both used. +name (My::Module) can be both used. C<$text> is the diagnostic label emited after +the C/C TAP output. C<\%options> takes the same values as described in +L. =head1 ACKNOWLEDGEMENTS