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