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