Commit | Line | Data |
a83ae797 |
1 | package Test::EOL; |
94bc2901 |
2 | # ABSTRACT: Check the correct line endings in your project |
a83ae797 |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Test::Builder; |
8 | use File::Spec; |
a83ae797 |
9 | use File::Find; |
856d7baf |
10 | use Cwd qw/ cwd /; |
a83ae797 |
11 | |
94bc2901 |
12 | use vars qw( $PERL $UNTAINT_PATTERN $PERL_PATTERN); |
a83ae797 |
13 | |
14 | $PERL = $^X || 'perl'; |
15 | $UNTAINT_PATTERN = qr|^([-+@\w./:\\]+)$|; |
16 | $PERL_PATTERN = qr/^#!.*perl/; |
17 | |
18 | my %file_find_arg = ($] <= 5.006) ? () : ( |
19 | untaint => 1, |
20 | untaint_pattern => $UNTAINT_PATTERN, |
21 | untaint_skip => 1, |
22 | ); |
23 | |
24 | my $Test = Test::Builder->new; |
a83ae797 |
25 | |
5a0bc53a |
26 | my $no_plan; |
27 | |
a83ae797 |
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); |
5a0bc53a |
37 | |
38 | if ($_[0] && $_[0] eq 'no_plan') { |
39 | shift; |
40 | $no_plan = 1; |
41 | } |
a83ae797 |
42 | $Test->plan(@_); |
43 | } |
44 | |
45 | sub _all_perl_files { |
46 | my @all_files = _all_files(@_); |
b303ce9f |
47 | return grep { _is_perl_module($_) || _is_perl_script($_) || _is_pod_file($_) } @all_files; |
a83ae797 |
48 | } |
49 | |
50 | sub _all_files { |
856d7baf |
51 | my @base_dirs = @_ ? @_ : cwd(); |
52 | my $options = pop(@base_dirs) if ref $base_dirs[-1] eq 'HASH'; |
a83ae797 |
53 | my @found; |
54 | my $want_sub = sub { |
e52debaf |
55 | return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?\.svn[\\/]!); # Filter out cvs or subversion dirs/ |
a83ae797 |
56 | return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist |
57 | return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist |
27c70d46 |
58 | return if ($File::Find::dir =~ m![\\/]?inc!); # Filter out Module::Install stuff |
a83ae797 |
59 | return if ($File::Find::name =~ m!Build$!i); # Filter out autogenerated Build script |
60 | return unless (-f $File::Find::name && -r _); |
61 | push @found, File::Spec->no_upwards( $File::Find::name ); |
62 | }; |
63 | my $find_arg = { |
64 | %file_find_arg, |
65 | wanted => $want_sub, |
66 | no_chdir => 1, |
67 | }; |
68 | find( $find_arg, @base_dirs); |
69 | return @found; |
70 | } |
71 | |
f17f4176 |
72 | # Formats various human invisible symbols |
73 | # to similar visible ones. |
fe02d07d |
74 | # Perhaps ^M or something like that |
f17f4176 |
75 | # would be more appropriate? |
76 | |
fe02d07d |
77 | sub _show_whitespace { |
f17f4176 |
78 | my $string = shift; |
79 | $string =~ s/\r/[\\r]/g; |
80 | $string =~ s/\t/[\\t]/g; |
81 | $string =~ s/ /[\\s]/g; |
82 | return $string; |
83 | } |
84 | |
85 | # Format a line record for diagnostics. |
86 | |
fe02d07d |
87 | sub _debug_line { |
f17f4176 |
88 | my ( $options, $line ) = @_; |
131289da |
89 | $line->[2] =~ s/\n\z//g if defined $line->[2]; |
d3afcf90 |
90 | return "line $line->[1]: $line->[0]" . ( |
131289da |
91 | $options->{show_lines} && defined $line->[2] |
92 | ? qq{: } . _show_whitespace( $line->[2] ) |
93 | : q{} |
f17f4176 |
94 | ); |
95 | } |
96 | |
a83ae797 |
97 | sub eol_unix_ok { |
98 | my $file = shift; |
91613276 |
99 | my $test_txt; |
100 | $test_txt = shift if !ref $_[0]; |
939ef613 |
101 | $test_txt ||= "No incorrect line endings in '$file'"; |
91613276 |
102 | my $options = shift if ref $_[0] eq 'HASH'; |
103 | $options ||= { |
104 | trailing_whitespace => 0, |
131289da |
105 | trailing_newline => 0, |
f17f4176 |
106 | all_reasons => 0, |
91613276 |
107 | }; |
a83ae797 |
108 | $file = _module_to_path($file); |
fe02d07d |
109 | |
a83ae797 |
110 | open my $fh, $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; }; |
f17f4176 |
111 | # Windows-- , default is :crlf, which hides \r\n -_- |
a2bfe7c3 |
112 | binmode( $fh, ':raw' ); |
a83ae797 |
113 | my $line = 0; |
131289da |
114 | my $blank_lines = 0; |
115 | my (@fails, %fails); |
a83ae797 |
116 | while (<$fh>) { |
117 | $line++; |
131289da |
118 | if ( /(\r+)$/ ) { |
f17f4176 |
119 | my $match = $1; |
131289da |
120 | push @fails, [ _show_whitespace($match) , $line , $_ ] |
121 | if !$fails{eol}++ or $options->{all_reasons}; |
a83ae797 |
122 | } |
131289da |
123 | if ( $options->{trailing_whitespace} && /([ \t]+)\r*$/ ) { |
f17f4176 |
124 | my $match = $1; |
131289da |
125 | push @fails, [ _show_whitespace($match), $line , $_ ] |
126 | if !$fails{tws}++ or $options->{all_reasons}; |
127 | } |
128 | if ( /\A\s*\z/ ) { |
129 | $blank_lines++; |
130 | } |
131 | else { |
132 | $blank_lines = 0; |
133 | } |
134 | if ( $options->{trailing_newline} && eof ) { |
135 | push @fails, [ sprintf('%d blank line%s at end of file', |
136 | $blank_lines, $blank_lines > 1 ? 's' : ''), |
137 | $line, undef ] |
138 | if $blank_lines; |
139 | push @fails, [ 'Missing "\n" at end of file', $line, undef ] |
140 | unless /\n\z/; |
f17f4176 |
141 | } |
142 | # Minor short-circuit for people who don't need the whole file scanned |
143 | # once there's an err. |
144 | last if( @fails > 0 && !$options->{all_reasons} ); |
145 | } |
fe02d07d |
146 | if( @fails ){ |
f17f4176 |
147 | $Test->ok( 0, $test_txt . " on " . _debug_line({ show_lines => 0 } , $fails[0] ) ); |
148 | if ( $options->{all_reasons} || 1 ){ |
149 | $Test->diag( " Problem Lines: "); |
fe02d07d |
150 | for ( @fails ){ |
f17f4176 |
151 | $Test->diag(_debug_line({ show_lines => 1 } , $_ ) ); |
152 | } |
153 | } |
154 | return 0; |
a83ae797 |
155 | } |
156 | $Test->ok(1, $test_txt); |
157 | return 1; |
158 | } |
a83ae797 |
159 | sub all_perl_files_ok { |
91613276 |
160 | my $options = shift if ref $_[0] eq 'HASH'; |
a83ae797 |
161 | my @files = _all_perl_files( @_ ); |
162 | _make_plan(); |
163 | foreach my $file ( @files ) { |
91613276 |
164 | eol_unix_ok($file, $options); |
a83ae797 |
165 | } |
166 | } |
167 | |
168 | sub _is_perl_module { |
169 | $_[0] =~ /\.pm$/i || $_[0] =~ /::/; |
170 | } |
171 | |
b303ce9f |
172 | sub _is_pod_file { |
173 | $_[0] =~ /\.pod$/i; |
174 | } |
175 | |
a83ae797 |
176 | sub _is_perl_script { |
177 | my $file = shift; |
178 | return 1 if $file =~ /\.pl$/i; |
179 | return 1 if $file =~ /\.t$/; |
7ebe98c1 |
180 | open (my $fh, $file) or return; |
a83ae797 |
181 | my $first = <$fh>; |
182 | return 1 if defined $first && ($first =~ $PERL_PATTERN); |
183 | return; |
184 | } |
185 | |
186 | sub _module_to_path { |
187 | my $file = shift; |
188 | return $file unless ($file =~ /::/); |
189 | my @parts = split /::/, $file; |
190 | my $module = File::Spec->catfile(@parts) . '.pm'; |
191 | foreach my $dir (@INC) { |
192 | my $candidate = File::Spec->catfile($dir, $module); |
193 | next unless (-e $candidate && -f _ && -r _); |
194 | return $candidate; |
195 | } |
196 | return $file; |
197 | } |
198 | |
199 | sub _make_plan { |
5a0bc53a |
200 | return if $no_plan; |
a83ae797 |
201 | unless ($Test->has_plan) { |
202 | $Test->plan( 'no_plan' ); |
203 | } |
204 | $Test->expected_tests; |
205 | } |
206 | |
207 | sub _untaint { |
208 | my @untainted = map { ($_ =~ $UNTAINT_PATTERN) } @_; |
209 | return wantarray ? @untainted : $untainted[0]; |
210 | } |
211 | |
212 | 1; |
a83ae797 |
213 | |
214 | =head1 SYNOPSIS |
215 | |
936fb8fb |
216 | C<Test::EOL> lets you check for the presence of trailing whitespace and/or |
217 | windows line endings in your perl code. It reports its results in standard |
218 | C<Test::Simple> fashion: |
a83ae797 |
219 | |
220 | use Test::EOL tests => 1; |
29330dd1 |
221 | eol_unix_ok( 'lib/Module.pm', 'Module is ^M free'); |
a83ae797 |
222 | |
91613276 |
223 | and to add checks for trailing whitespace: |
224 | |
225 | use Test::EOL tests => 1; |
226 | eol_unix_ok( 'lib/Module.pm', 'Module is ^M and trailing whitespace free', { trailing_whitespace => 1 }); |
227 | |
a83ae797 |
228 | Module authors can include the following in a t/eol.t and have C<Test::EOL> |
229 | automatically find and check all perl files in a module distribution: |
230 | |
231 | use Test::EOL; |
232 | all_perl_files_ok(); |
233 | |
234 | or |
235 | |
236 | use Test::EOL; |
237 | all_perl_files_ok( @mydirs ); |
238 | |
91613276 |
239 | and if authors would like to check for trailing whitespace: |
240 | |
241 | use Test::EOL; |
242 | all_perl_files_ok({ trailing_whitespace => 1 }); |
243 | |
244 | or |
245 | |
246 | use Test::EOL; |
247 | all_perl_files_ok({ trailing_whitespace => 1 }, @mydirs ); |
248 | |
5a0bc53a |
249 | or |
250 | |
251 | use Test::More; |
252 | use Test::EOL 'no_test'; |
253 | all_perl_files_ok(); |
254 | done_testing; |
255 | |
131289da |
256 | and if authors would like to check that there's a single newline and no |
257 | blank lines at the end of each file: |
258 | |
259 | use Test::EOL; |
260 | all_perl_files_ok({ trailing_newline => 1 }); |
261 | |
262 | or |
263 | |
264 | use Test::EOL; |
265 | all_perl_files_ok({ trailing_newline => 1 }, @mydirs ); |
266 | |
a83ae797 |
267 | =head1 DESCRIPTION |
268 | |
269 | This module scans your project/distribution for any perl files (scripts, |
29330dd1 |
270 | modules, etc) for the presence of windows line endings. |
a83ae797 |
271 | |
272 | =head1 EXPORT |
273 | |
274 | A list of functions that can be exported. You can delete this section |
275 | if you don't export anything, such as for a purely object-oriented module. |
276 | |
936fb8fb |
277 | =func all_perl_files_ok |
278 | |
279 | all_perl_files_ok( [ \%options ], [ @directories ] ) |
a83ae797 |
280 | |
281 | Applies C<eol_unix_ok()> to all perl files found in C<@directories> (and sub |
7713e104 |
282 | directories). If no <@directories> is given, the starting point is the current |
283 | working directory, as tests are usually run from the top directory in a typical |
b303ce9f |
284 | CPAN distribution. A perl file is *.pl or *.pm or *.pod or *.t or a file starting |
a83ae797 |
285 | with C<#!...perl> |
286 | |
936fb8fb |
287 | Valid C<\%options> currently are: |
288 | |
289 | =over |
290 | |
291 | =item * trailing_whitespace |
292 | |
293 | By default Test::EOL only looks for Windows (CR/LF) line-endings. Set this |
294 | to true to raise errors if any kind of trailing whitespace is present in |
295 | the file. |
296 | |
131289da |
297 | =item * trailing_newline |
298 | |
299 | Set this to true to raise an error if the file doesn't end with exactly |
300 | one newline and no blank lines. |
301 | |
936fb8fb |
302 | =item * all_reasons |
303 | |
304 | Normally Test::EOL reports only the first error in every file (given that |
305 | a text file originated on Windows will fail every single line). Set this |
306 | a true value to register a test failure for every line with an error. |
307 | |
308 | =back |
309 | |
a83ae797 |
310 | If the test plan is defined: |
311 | |
312 | use Test::EOL tests => 3; |
313 | all_perl_files_ok(); |
314 | |
315 | the total number of files tested must be specified. |
316 | |
936fb8fb |
317 | =func eol_unix_ok |
318 | |
319 | eol_unix_ok ( $file [, $text] [, \%options ] ) |
a83ae797 |
320 | |
321 | Run a unix EOL check on C<$file>. For a module, the path (lib/My/Module.pm) or the |
936fb8fb |
322 | name (My::Module) can be both used. C<$text> is the diagnostic label emited after |
323 | the C<ok>/C<not ok> TAP output. C<\%options> takes the same values as described in |
324 | L</all_perl_files_ok>. |
a83ae797 |
325 | |
a83ae797 |
326 | =head1 ACKNOWLEDGEMENTS |
327 | |
328 | Shamelessly ripped off from L<Test::NoTabs>. |
329 | |
330 | =head1 SEE ALSO |
331 | |
332 | L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>, |
333 | L<Test::NoTabs>, L<Module::Install::AuthorTests>. |
334 | |
a83ae797 |
335 | =cut |