X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FEOL.pm;h=860e427fa47b12122a894a8e4195e502a36bdc69;hb=5a0bc53aa2c44509276facd97dc6bc98b277bae3;hp=3976a44e72f8924a511f11464b281a9a43272398;hpb=f17f4176809cf543fb1d04b24d83f9af10597b3b;p=catagits%2FTest-EOL.git diff --git a/lib/Test/EOL.pm b/lib/Test/EOL.pm index 3976a44..860e427 100644 --- a/lib/Test/EOL.pm +++ b/lib/Test/EOL.pm @@ -1,16 +1,15 @@ package Test::EOL; +# ABSTRACT: Check the correct line endings in your project use strict; use warnings; use Test::Builder; use File::Spec; -use FindBin qw($Bin); use File::Find; +use Cwd qw/ cwd /; -use vars qw( $VERSION $PERL $UNTAINT_PATTERN $PERL_PATTERN); - -$VERSION = '0.7'; +use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN); $PERL = $^X || 'perl'; $UNTAINT_PATTERN = qr|^([-+@\w./:\\]+)$|; @@ -25,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; @@ -34,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(@_); } @@ -43,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 ); @@ -64,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; @@ -77,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{} ); } @@ -89,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>) { @@ -116,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 } , $_ ) ); } } @@ -146,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; @@ -166,6 +174,7 @@ sub _module_to_path { } sub _make_plan { + return if $no_plan; unless ($Test->has_plan) { $Test->plan( 'no_plan' ); } @@ -178,17 +187,12 @@ sub _untaint { } 1; -__END__ - -=head1 NAME - -Test::EOL - Check the correct line endings in your project =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'); @@ -219,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, @@ -229,9 +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. -=head1 FUNCTIONS +=func all_perl_files_ok -=head2 all_perl_files_ok( [ \%options ], [ @directories ] ) + 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 @@ -239,34 +250,39 @@ 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> -If the test plan is defined: +Valid C<\%options> currently are: - use Test::EOL tests => 3; - all_perl_files_ok(); +=over -the total number of files tested must be specified. +=item * trailing_whitespace -=head2 eol_unix_ok( $file [, $text] [, \%options ] ) +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. -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. +=item * all_reasons -=head1 AUTHOR +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. -Tomas Doran (t0m) C<< >> +=back -=head1 BUGS +If the test plan is defined: -Testing for EOL styles other than unix (\n) currently unsupported. + use Test::EOL tests => 3; + all_perl_files_ok(); + +the total number of files tested must be specified. -The source code can be found on github, as listed in C< META.yml >, -patches are welcome. +=func eol_unix_ok -Otherwise please report any bugs or feature requests to -C, or through the web interface at -L. -I will be notified, and then you'll automatically be notified of progress on -your bug as I make changes. + 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. 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 @@ -277,12 +293,4 @@ Shamelessly ripped off from L. L, L. L, L, L, L. -=head1 COPYRIGHT & LICENSE - -Copyright 2009 Tomas Doran, some rights reserved. - -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - =cut -