package Test::EOL;
+# ABSTRACT: Check the correct line endings in your project
use strict;
use warnings;
use FindBin qw($Bin);
use File::Find;
-use vars qw( $VERSION $PERL $UNTAINT_PATTERN $PERL_PATTERN);
-
-$VERSION = '0.3';
+use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN);
$PERL = $^X || 'perl';
$UNTAINT_PATTERN = qr|^([-+@\w./:\\]+)$|;
return @found;
}
+# Formats various human invisible symbols
+# to similar visible ones.
+# Perhaps ^M or something like that
+# would be more appropriate?
+
+sub _show_whitespace {
+ my $string = shift;
+ $string =~ s/\r/[\\r]/g;
+ $string =~ s/\t/[\\t]/g;
+ $string =~ s/ /[\\s]/g;
+ return $string;
+}
+
+# Format a line record for diagnostics.
+
+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{}
+ );
+}
+
sub eol_unix_ok {
my $file = shift;
- my $test_txt = shift || "No windows line endings in '$file'";
+ my $test_txt;
+ $test_txt = shift if !ref $_[0];
+ $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' );
my $line = 0;
+ my @fails;
while (<$fh>) {
$line++;
- if ( /\r$/ ) {
- $Test->ok(0, $test_txt . " on line $line");
- return 0;
+ if ( !$options->{trailing_whitespace} && /(\r+)$/ ) {
+ my $match = $1;
+ push @fails, [ _show_whitespace( $match ) , $line , $_ ];
+ }
+ if ( $options->{trailing_whitespace} && /([ \t]*\r+|[ \t]+)$/ ) {
+ my $match = $1;
+ push @fails, [ _show_whitespace($match), $line , $_ ];
}
+ # Minor short-circuit for people who don't need the whole file scanned
+ # once there's an err.
+ last if( @fails > 0 && !$options->{all_reasons} );
+ }
+ 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 ){
+ $Test->diag(_debug_line({ show_lines => 1 } , $_ ) );
+ }
+ }
+ return 0;
}
$Test->ok(1, $test_txt);
return 1;
}
-
sub all_perl_files_ok {
+ my $options = shift if ref $_[0] eq 'HASH';
my @files = _all_perl_files( @_ );
_make_plan();
foreach my $file ( @files ) {
- eol_unix_ok($file);
+ eol_unix_ok($file, $options);
}
}
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;
}
1;
-__END__
-
-=head1 NAME
-
-Test::EOL - Check the correct line endings in your project
=head1 SYNOPSIS
use Test::EOL tests => 1;
eol_unix_ok( 'lib/Module.pm', 'Module is ^M free');
+and to add checks for trailing whitespace:
+
+ use Test::EOL tests => 1;
+ eol_unix_ok( 'lib/Module.pm', 'Module is ^M and trailing whitespace free', { trailing_whitespace => 1 });
+
Module authors can include the following in a t/eol.t and have C<Test::EOL>
automatically find and check all perl files in a module distribution:
use Test::EOL;
all_perl_files_ok( @mydirs );
+and if authors would like to check for trailing whitespace:
+
+ use Test::EOL;
+ all_perl_files_ok({ trailing_whitespace => 1 });
+
+or
+
+ use Test::EOL;
+ all_perl_files_ok({ trailing_whitespace => 1 }, @mydirs );
+
=head1 DESCRIPTION
This module scans your project/distribution for any perl files (scripts,
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
-
-=head2 all_perl_files_ok( [ @directories ] )
+=func all_perl_files_ok( [ \%options ], [ @directories ] )
Applies C<eol_unix_ok()> to all perl files found in C<@directories> (and sub
directories). If no <@directories> is given, the starting point is one level
the total number of files tested must be specified.
-=head2 eol_unix_ok( $file [, $text] )
+=func 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.
-=head1 AUTHOR
-
-Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
-
-=head1 BUGS
-
-Testing for EOL styles other than unix (\n) currently unsupported.
-
-The source code can be found on github, as listed in C< META.yml >,
-patches are welcome.
-
-Otherwise please report any bugs or feature requests to
-C<bug-test-eol at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-EOL>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
=head1 ACKNOWLEDGEMENTS
Shamelessly ripped off from L<Test::NoTabs>.
L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>,
L<Test::NoTabs>, L<Module::Install::AuthorTests>.
-=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
-
projects / catagits/Test-EOL.git / blobdiff