lib/Test/EOL.pm

   1 package Test::EOL;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::Builder;
   7 use File::Spec;
   8 use FindBin qw($Bin);
   9 use File::Find;
  10
  11 use vars qw( $VERSION $PERL $UNTAINT_PATTERN $PERL_PATTERN);
  12
  13 $VERSION = '0.6';
  14
  15 $PERL    = $^X || 'perl';
  16 $UNTAINT_PATTERN  = qr|^([-+@\w./:\\]+)$|;
  17 $PERL_PATTERN     = qr/^#!.*perl/;
  18
  19 my %file_find_arg = ($] <= 5.006) ? () : (
  20     untaint => 1,
  21     untaint_pattern => $UNTAINT_PATTERN,
  22     untaint_skip => 1,
  23 );
  24
  25 my $Test  = Test::Builder->new;
  26 my $updir = File::Spec->updir();
  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     $Test->plan(@_);
  38 }
  39
  40 sub _all_perl_files {
  41     my @all_files = _all_files(@_);
  42     return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
  43 }
  44
  45 sub _all_files {
  46     my @base_dirs = @_ ? @_ : File::Spec->catdir($Bin, $updir);
  47     my @found;
  48     my $want_sub = sub {
  49         return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?.svn[\\/]!); # Filter out cvs or subversion dirs/
  50         return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
  51         return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
  52         return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script
  53         return unless (-f $File::Find::name && -r _);
  54         push @found, File::Spec->no_upwards( $File::Find::name );
  55     };
  56     my $find_arg = {
  57         %file_find_arg,
  58         wanted   => $want_sub,
  59         no_chdir => 1,
  60     };
  61     find( $find_arg, @base_dirs);
  62     return @found;
  63 }
  64
  65 sub eol_unix_ok {
  66     my $file = shift;
  67     my $test_txt;
  68     $test_txt   = shift if !ref $_[0];
  69     $test_txt ||= "No windows line endings in '$file'";
  70     my $options = shift if ref $_[0] eq 'HASH';
  71     $options ||= {
  72         trailing_whitespace => 0,
  73     };
  74     $file = _module_to_path($file);
  75     open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
  76     my $line = 0;
  77     while (<$fh>) {
  78         $line++;
  79         if (
  80            (!$options->{trailing_whitespace} && /\r$/) ||
  81            ( $options->{trailing_whitespace} && /(\r|[ \t]+)$/)
  82         ) {
  83           $Test->ok(0, $test_txt . " on line $line");
  84           return 0;
  85         }
  86     }
  87     $Test->ok(1, $test_txt);
  88     return 1;
  89 }
  90 sub all_perl_files_ok {
  91     my $options = shift if ref $_[0] eq 'HASH';
  92     my @files = _all_perl_files( @_ );
  93     _make_plan();
  94     foreach my $file ( @files ) {
  95       eol_unix_ok($file, $options);
  96     }
  97 }
  98
  99 sub _is_perl_module {
 100     $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
 101 }
 102
 103 sub _is_perl_script {
 104     my $file = shift;
 105     return 1 if $file =~ /\.pl$/i;
 106     return 1 if $file =~ /\.t$/;
 107     open my $fh, $file or return;
 108     my $first = <$fh>;
 109     return 1 if defined $first && ($first =~ $PERL_PATTERN);
 110     return;
 111 }
 112
 113 sub _module_to_path {
 114     my $file = shift;
 115     return $file unless ($file =~ /::/);
 116     my @parts = split /::/, $file;
 117     my $module = File::Spec->catfile(@parts) . '.pm';
 118     foreach my $dir (@INC) {
 119         my $candidate = File::Spec->catfile($dir, $module);
 120         next unless (-e $candidate && -f _ && -r _);
 121         return $candidate;
 122     }
 123     return $file;
 124 }
 125
 126 sub _make_plan {
 127     unless ($Test->has_plan) {
 128         $Test->plan( 'no_plan' );
 129     }
 130     $Test->expected_tests;
 131 }
 132
 133 sub _untaint {
 134     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
 135     return wantarray ? @untainted : $untainted[0];
 136 }
 137
 138 1;
 139 __END__
 140
 141 =head1 NAME
 142
 143 Test::EOL - Check the correct line endings in your project
 144
 145 =head1 SYNOPSIS
 146
 147 C<Test::EOL> lets you check the presence of windows line endings in your
 148 perl code. It
 149 report its results in standard C<Test::Simple> fashion:
 150
 151   use Test::EOL tests => 1;
 152   eol_unix_ok( 'lib/Module.pm', 'Module is ^M free');
 153
 154 and to add checks for trailing whitespace:
 155
 156   use Test::EOL tests => 1;
 157   eol_unix_ok( 'lib/Module.pm', 'Module is ^M and trailing whitespace free', { trailing_whitespace => 1 });
 158
 159 Module authors can include the following in a t/eol.t and have C<Test::EOL>
 160 automatically find and check all perl files in a module distribution:
 161
 162   use Test::EOL;
 163   all_perl_files_ok();
 164
 165 or
 166
 167   use Test::EOL;
 168   all_perl_files_ok( @mydirs );
 169
 170 and if authors would like to check for trailing whitespace:
 171
 172   use Test::EOL;
 173   all_perl_files_ok({ trailing_whitespace => 1 });
 174
 175 or
 176
 177   use Test::EOL;
 178   all_perl_files_ok({ trailing_whitespace => 1 }, @mydirs );
 179
 180 =head1 DESCRIPTION
 181
 182 This module scans your project/distribution for any perl files (scripts,
 183 modules, etc) for the presence of windows line endings.
 184
 185 =head1 EXPORT
 186
 187 A list of functions that can be exported.  You can delete this section
 188 if you don't export anything, such as for a purely object-oriented module.
 189
 190 =head1 FUNCTIONS
 191
 192 =head2 all_perl_files_ok( [ \%options ], [ @directories ] )
 193
 194 Applies C<eol_unix_ok()> to all perl files found in C<@directories> (and sub
 195 directories). If no <@directories> is given, the starting point is one level
 196 above the current running script, that should cover all the files of a typical
 197 CPAN distribution. A perl file is *.pl or *.pm or *.t or a file starting
 198 with C<#!...perl>
 199
 200 If the test plan is defined:
 201
 202   use Test::EOL tests => 3;
 203   all_perl_files_ok();
 204
 205 the total number of files tested must be specified.
 206
 207 =head2 eol_unix_ok( $file [, $text] [, \%options ]  )
 208
 209 Run a unix EOL check on C<$file>. For a module, the path (lib/My/Module.pm) or the
 210 name (My::Module) can be both used.
 211
 212 =head1 AUTHOR
 213
 214 Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
 215
 216 =head1 BUGS
 217
 218 Testing for EOL styles other than unix (\n) currently unsupported.
 219
 220 The source code can be found on github, as listed in C< META.yml >,
 221 patches are welcome.
 222
 223 Otherwise please report any bugs or feature requests to
 224 C<bug-test-eol at rt.cpan.org>, or through the web interface at
 225 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-EOL>.
 226 I will be notified, and then you'll automatically be notified of progress on
 227 your bug as I make changes.
 228
 229 =head1 ACKNOWLEDGEMENTS
 230
 231 Shamelessly ripped off from L<Test::NoTabs>.
 232
 233 =head1 SEE ALSO
 234
 235 L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>,
 236 L<Test::NoTabs>, L<Module::Install::AuthorTests>.
 237
 238 =head1 COPYRIGHT & LICENSE
 239
 240 Copyright 2009 Tomas Doran, some rights reserved.
 241
 242 This program is free software; you can redistribute it and/or modify it
 243 under the same terms as Perl itself.
 244
 245 =cut
 246