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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!perl -T
use strict;
use warnings;
use Cwd qw(getcwd);
use File::Find;
use Test::More;
$ENV{AUTHOR_TESTING}
or plan( skip_all => 'Author test. Set $ENV{AUTHOR_TESTING} to a true value to run.' );
my $UNTAINT_FILENAME_PATTERN = qr{\A (
(?:
(?: [A-Z] : )
| //
)?
[0-9A-Z_\-/\. ]+
) \z}xmsi;
my ($PATH) = getcwd() =~ $UNTAINT_FILENAME_PATTERN;
$PATH =~ s{\\}{/}xmsg;
my @list;
find(
{
untaint_pattern => $UNTAINT_FILENAME_PATTERN,
untaint => 1,
wanted => sub {
-d and return;
$File::Find::name =~ m{
/ \.svn /
| / \.git /
| / \.gitignore \z
}xms and return;
$File::Find::name =~ m{
(
(?: /lib/ | /example/ | /t/ )
| /Build\.PL \z
| /Changes \z
| /README \z
| /MANIFEST\.SKIP \z
)
}xms or return;
push @list, $File::Find::name;
},
},
$PATH,
);
plan( tests => 6 * scalar @list );
my @ignore_non_ascii = (
);
for my $file_name (sort @list) {
my @lines;
{
open my $file, '< :raw', $file_name
or die "Cannnot open file $file_name";
local $/ = ();
my $text = <$file>;
# repair last line without \n
ok(
! ( $text =~ s{([^\x0D\x0A]) \z}{$1\x0D\x0A}xms ),
"$file_name has newline at EOF",
);
@lines = split m{\x0A}, $text;
}
my $find_line_numbers = sub {
my ($test_description, $test_reason, $regex, $regex_negation) = @_;
my $line_number = 0;
my @line_numbers = map {
++$line_number;
($regex_negation xor $_ =~ $regex)
? $line_number
: ();
} @lines;
ok(! @line_numbers, $test_description);
if (@line_numbers) {
if (@line_numbers > 10) {
$#line_numbers = 10;
$line_numbers[10] = '...';
}
my $line_numbers = join q{, }, @line_numbers;
diag("Check line $line_numbers in file $file_name for $test_reason.");
}
return;
};
$find_line_numbers->(
"$file_name has network line endings (LFCR)",
'line endings',
qr{\x0D \z}xms,
1,
);
$find_line_numbers->(
"$file_name has no TABs",
'TABs',
qr{\x09}xms,
);
$find_line_numbers->(
"$file_name has no control chars",
'control chars',
qr{[\x00-\x08\x0B\x0C\x0E-\x1F\x7F]}xms,
);
NON_ASCII: {
for my $regex (@ignore_non_ascii) {
if ( $file_name =~ $regex ) {
ok(1, 'dummy');
next NON_ASCII;
}
}
$find_line_numbers->(
"$file_name has no nonASCII chars",
'nonASCII chars',
qr{[\x80-\xA6\xA8-\xFF]}xms, # A7 is
);
}
$find_line_numbers->(
"$file_name has no trailing space",
'trailing space',
qr{[ ] (?: \x0D? \x0A | \z )}xms,
);
}
|
