Commit | Line | Data |
a83ae797 |
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 | |
fb935bc1 |
13 | $VERSION = '0.7'; |
a83ae797 |
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 { |
5bcec1c9 |
49 | return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?.svn[\\/]!); # Filter out cvs or subversion dirs/ |
a83ae797 |
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; |
91613276 |
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 | }; |
a83ae797 |
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++; |
91613276 |
79 | if ( |
80 | (!$options->{trailing_whitespace} && /\r$/) || |
81 | ( $options->{trailing_whitespace} && /(\r|[ \t]+)$/) |
82 | ) { |
a83ae797 |
83 | $Test->ok(0, $test_txt . " on line $line"); |
84 | return 0; |
85 | } |
86 | } |
87 | $Test->ok(1, $test_txt); |
88 | return 1; |
89 | } |
a83ae797 |
90 | sub all_perl_files_ok { |
91613276 |
91 | my $options = shift if ref $_[0] eq 'HASH'; |
a83ae797 |
92 | my @files = _all_perl_files( @_ ); |
93 | _make_plan(); |
94 | foreach my $file ( @files ) { |
91613276 |
95 | eol_unix_ok($file, $options); |
a83ae797 |
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 | |
29330dd1 |
147 | C<Test::EOL> lets you check the presence of windows line endings in your |
148 | perl code. It |
a83ae797 |
149 | report its results in standard C<Test::Simple> fashion: |
150 | |
151 | use Test::EOL tests => 1; |
29330dd1 |
152 | eol_unix_ok( 'lib/Module.pm', 'Module is ^M free'); |
a83ae797 |
153 | |
91613276 |
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 | |
a83ae797 |
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 | |
91613276 |
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 | |
a83ae797 |
180 | =head1 DESCRIPTION |
181 | |
182 | This module scans your project/distribution for any perl files (scripts, |
29330dd1 |
183 | modules, etc) for the presence of windows line endings. |
a83ae797 |
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 | |
91613276 |
192 | =head2 all_perl_files_ok( [ \%options ], [ @directories ] ) |
a83ae797 |
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 | |
91613276 |
207 | =head2 eol_unix_ok( $file [, $text] [, \%options ] ) |
a83ae797 |
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 | |