Commit | Line | Data |
---|---|---|
e1eaa4ae | 1 | use strict; |
2 | use warnings; | |
3 | ||
4 | BEGIN { | |
ba8c183b | 5 | use lib 't/lib'; |
6 | use Test::More; | |
7 | use File::Find; | |
8 | use File::Basename; | |
e1eaa4ae | 9 | |
ba8c183b | 10 | plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; |
e1eaa4ae | 11 | |
ba8c183b | 12 | eval 'use Test::Strict'; |
13 | plan skip_all => 'Test::Strict not installed' if $@; | |
14 | plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; | |
e1eaa4ae | 15 | }; |
16 | ||
17 | ## I hope this can go away if Test::Strict or File::Find::Rule | |
18 | ## finally run under -T. Until then, I'm on my own here. ;-) | |
19 | my @files; | |
20 | my %trusted = ( | |
ba8c183b | 21 | 'NotReallyAClass.pm' => 1 |
e1eaa4ae | 22 | ); |
23 | ||
ba8c183b | 24 | find({ |
25 | wanted => \&wanted, | |
26 | untaint => 1, | |
27 | untaint_pattern => qr|^([-+@\w./]+)$|, | |
28 | untaint_skip => 1, | |
29 | no_chdir => 1 | |
e1eaa4ae | 30 | }, qw(lib t)); |
31 | ||
32 | sub wanted { | |
ba8c183b | 33 | my $name = $File::Find::name; |
34 | my $file = fileparse($name); | |
e1eaa4ae | 35 | |
ba8c183b | 36 | return if $name =~ /TestApp/; |
e1eaa4ae | 37 | |
ba8c183b | 38 | if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { |
39 | push @files, $name; | |
40 | }; | |
e1eaa4ae | 41 | }; |
42 | ||
43 | if (scalar @files) { | |
ba8c183b | 44 | plan tests => scalar @files; |
e1eaa4ae | 45 | } else { |
ba8c183b | 46 | plan tests => 1; |
47 | fail 'No perl files found for Test::Strict checks!'; | |
e1eaa4ae | 48 | }; |
49 | ||
50 | foreach (@files) { | |
ba8c183b | 51 | strict_ok($_); |
e1eaa4ae | 52 | }; |