Commit | Line | Data |
---|---|---|
cfc6c78d CBW |
1 | #!./perl -w |
2 | ||
3 | # Test that CUSTOMIZED files in Maintainers.pl have not been overwritten. | |
4 | ||
5 | BEGIN { | |
6 | # This test script uses a slightly atypical invocation of the 'standard' | |
7 | # core testing setup stanza. | |
8 | # The existing porting tools which manage the Maintainers file all | |
9 | # expect to be run from the root | |
10 | # XXX that should be fixed | |
11 | ||
12 | chdir '..' unless -d 't'; | |
6944c18b CK |
13 | @INC = qw(lib Porting t); |
14 | require 'test.pl'; | |
ff23b6f8 | 15 | skip_all("pre-computed SHA1 won't match under EBCDIC") if $::IS_EBCDIC; |
cfc6c78d CBW |
16 | } |
17 | ||
18 | use strict; | |
19 | use warnings; | |
20 | use Digest; | |
21 | use File::Spec; | |
22 | use Maintainers qw[%Modules get_module_files get_module_pat]; | |
23 | ||
24 | sub filter_customized { | |
25 | my ($m, @files) = @_; | |
26 | ||
27 | return @files | |
28 | unless my $customized = $Modules{$m}{CUSTOMIZED}; | |
29 | ||
30 | my ($pat) = map { qr/$_/ } join '|' => map { | |
31 | ref $_ ? $_ : qr/\b\Q$_\E$/ | |
32 | } @{ $customized }; | |
33 | ||
34 | return grep { $_ =~ $pat } @files; | |
35 | } | |
36 | ||
37 | sub my_get_module_files { | |
38 | my $m = shift; | |
39 | return filter_customized $m => map { Maintainers::expand_glob($_) } get_module_pat($m); | |
40 | } | |
41 | ||
42 | my $TestCounter = 0; | |
43 | ||
44 | my $digest_type = 'SHA-1'; | |
45 | ||
46 | my $original_dir = File::Spec->rel2abs(File::Spec->curdir); | |
47 | my $data_dir = File::Spec->catdir('t', 'porting'); | |
48 | my $customised = File::Spec->catfile($data_dir, 'customized.dat'); | |
49 | ||
50 | my %customised; | |
51 | ||
52 | my $regen = 0; | |
53 | ||
54 | while (@ARGV && substr($ARGV[0], 0, 1) eq '-') { | |
55 | my $arg = shift @ARGV; | |
56 | ||
57 | $arg =~ s/^--/-/; # Treat '--' the same as a single '-' | |
58 | if ($arg eq '-regen') { | |
59 | $regen = 1; | |
60 | } | |
61 | else { | |
62 | die <<EOF; | |
63 | Unknown option '$arg' | |
64 | ||
65 | Usage: $0 [ --regen ]\n" | |
66 | --regen -> Regenerate the data file for $0 | |
67 | ||
68 | EOF | |
69 | } | |
70 | } | |
71 | ||
72 | my $data_fh; | |
73 | ||
74 | if ( $regen ) { | |
e88ca83c | 75 | open $data_fh, '>:raw', $customised or die "Can't open $customised"; |
cfc6c78d CBW |
76 | } |
77 | else { | |
e88ca83c | 78 | open $data_fh, '<:raw', $customised or die "Can't open $customised"; |
cfc6c78d CBW |
79 | while (<$data_fh>) { |
80 | chomp; | |
81 | my ($module,$file,$sha) = split ' '; | |
82 | $customised{ $module }->{ $file } = $sha; | |
83 | } | |
84 | close $data_fh; | |
85 | } | |
86 | ||
b39091a6 | 87 | foreach my $module ( sort keys %Modules ) { |
cfc6c78d | 88 | next unless my $files = $Modules{ $module }{CUSTOMIZED}; |
8b41fafa | 89 | next unless @{ $files }; |
cfc6c78d CBW |
90 | my @perl_files = my_get_module_files( $module ); |
91 | foreach my $file ( @perl_files ) { | |
92 | my $digest = Digest->new( $digest_type ); | |
93 | { | |
94 | open my $fh, '<', $file or die "Can't open $file"; | |
95 | binmode $fh; | |
96 | $digest->addfile( $fh ); | |
97 | close $fh; | |
98 | } | |
99 | my $id = $digest->hexdigest; | |
100 | if ( $regen ) { | |
101 | print $data_fh join(' ', $module, $file, $id), "\n"; | |
102 | next; | |
103 | } | |
104 | my $should_be = $customised{ $module }->{ $file }; | |
6944c18b | 105 | is( $id, $should_be, "SHA for $file matches stashed SHA" ); |
cfc6c78d CBW |
106 | } |
107 | } | |
108 | ||
109 | if ( $regen ) { | |
6944c18b | 110 | pass( "regenerated data file" ); |
cfc6c78d CBW |
111 | close $data_fh; |
112 | } | |
113 | ||
6944c18b | 114 | done_testing(); |
cfc6c78d CBW |
115 | |
116 | =pod | |
117 | ||
118 | =head1 NAME | |
119 | ||
120 | customized.t - Test that CUSTOMIZED files in Maintainers.pl have not been overwritten | |
121 | ||
122 | =head1 SYNOPSIS | |
123 | ||
124 | cd t | |
125 | ./perl -I../lib porting/customized.t --regen | |
126 | ||
127 | =head1 DESCRIPTION | |
128 | ||
129 | customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED> | |
5c25e937 | 130 | are not accidentally overwritten by CPAN module updates. |
cfc6c78d CBW |
131 | |
132 | =head1 OPTIONS | |
133 | ||
134 | =over | |
135 | ||
136 | =item C<--regen> | |
137 | ||
138 | Use this command line option to regenerate the C<customized.dat> file. | |
139 | ||
140 | =back | |
141 | ||
142 | =cut |