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.3';
  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 = shift || "No windows line endings in '$file'";
  68     $file = _module_to_path($file);
  69     open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
  70     my $line = 0;
  71     while (<$fh>) {
  72         $line++;
  73         if ( /\r$/ ) {
  74           $Test->ok(0, $test_txt . " on line $line");
  75           return 0;
  76         }
  77     }
  78     $Test->ok(1, $test_txt);
  79     return 1;
  80 }
  81
  82 sub all_perl_files_ok {
  83     my @files = _all_perl_files( @_ );
  84     _make_plan();
  85     foreach my $file ( @files ) {
  86       eol_unix_ok($file);
  87     }
  88 }
  89
  90 sub _is_perl_module {
  91     $_[0] =~ /\.pm$/i || $_[0] =~ /::/;
  92 }
  93
  94 sub _is_perl_script {
  95     my $file = shift;
  96     return 1 if $file =~ /\.pl$/i;
  97     return 1 if $file =~ /\.t$/;
  98     open my $fh, $file or return;
  99     my $first = <$fh>;
 100     return 1 if defined $first && ($first =~ $PERL_PATTERN);
 101     return;
 102 }
 103
 104 sub _module_to_path {
 105     my $file = shift;
 106     return $file unless ($file =~ /::/);
 107     my @parts = split /::/, $file;
 108     my $module = File::Spec->catfile(@parts) . '.pm';
 109     foreach my $dir (@INC) {
 110         my $candidate = File::Spec->catfile($dir, $module);
 111         next unless (-e $candidate && -f _ && -r _);
 112         return $candidate;
 113     }
 114     return $file;
 115 }
 116
 117 sub _make_plan {
 118     unless ($Test->has_plan) {
 119         $Test->plan( 'no_plan' );
 120     }
 121     $Test->expected_tests;
 122 }
 123
 124 sub _untaint {
 125     my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_;
 126     return wantarray ? @untainted : $untainted[0];
 127 }
 128
 129 1;
 130 __END__
 131
 132 =head1 NAME
 133
 134 Test::EOL - Check the correct line endings in your project
 135
 136 =head1 SYNOPSIS
 137
 138 C<Test::EOL> lets you check the presence of windows line endings in your
 139 perl code. It
 140 report its results in standard C<Test::Simple> fashion:
 141
 142   use Test::EOL tests => 1;
 143   eol_unix_ok( 'lib/Module.pm', 'Module is ^M free');
 144
 145 Module authors can include the following in a t/eol.t and have C<Test::EOL>
 146 automatically find and check all perl files in a module distribution:
 147
 148   use Test::EOL;
 149   all_perl_files_ok();
 150
 151 or
 152
 153   use Test::EOL;
 154   all_perl_files_ok( @mydirs );
 155
 156 =head1 DESCRIPTION
 157
 158 This module scans your project/distribution for any perl files (scripts,
 159 modules, etc) for the presence of windows line endings.
 160
 161 =head1 EXPORT
 162
 163 A list of functions that can be exported.  You can delete this section
 164 if you don't export anything, such as for a purely object-oriented module.
 165
 166 =head1 FUNCTIONS
 167
 168 =head2 all_perl_files_ok( [ @directories ] )
 169
 170 Applies C<eol_unix_ok()> to all perl files found in C<@directories> (and sub
 171 directories). If no <@directories> is given, the starting point is one level
 172 above the current running script, that should cover all the files of a typical
 173 CPAN distribution. A perl file is *.pl or *.pm or *.t or a file starting
 174 with C<#!...perl>
 175
 176 If the test plan is defined:
 177
 178   use Test::EOL tests => 3;
 179   all_perl_files_ok();
 180
 181 the total number of files tested must be specified.
 182
 183 =head2 eol_unix_ok( $file [, $text] )
 184
 185 Run a unix EOL check on C<$file>. For a module, the path (lib/My/Module.pm) or the
 186 name (My::Module) can be both used.
 187
 188 =head1 AUTHOR
 189
 190 Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
 191
 192 =head1 BUGS
 193
 194 Testing for EOL styles other than unix (\n) currently unsupported.
 195
 196 The source code can be found on github, as listed in C< META.yml >,
 197 patches are welcome.
 198
 199 Otherwise please report any bugs or feature requests to
 200 C<bug-test-eol at rt.cpan.org>, or through the web interface at
 201 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-EOL>.
 202 I will be notified, and then you'll automatically be notified of progress on
 203 your bug as I make changes.
 204
 205 =head1 ACKNOWLEDGEMENTS
 206
 207 Shamelessly ripped off from L<Test::NoTabs>.
 208
 209 =head1 SEE ALSO
 210
 211 L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>,
 212 L<Test::NoTabs>, L<Module::Install::AuthorTests>.
 213
 214 =head1 COPYRIGHT & LICENSE
 215
 216 Copyright 2009 Tomas Doran, some rights reserved.
 217
 218 This program is free software; you can redistribute it and/or modify it
 219 under the same terms as Perl itself.
 220
 221 =cut
 222