customized.t 3.33 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
#!./perl -w

# Test that CUSTOMIZED files in Maintainers.pl have not been overwritten.

BEGIN {
        # This test script uses a slightly atypical invocation of the 'standard'
        # core testing setup stanza.
        # The existing porting tools which manage the Maintainers file all
        # expect to be run from the root
        # XXX that should be fixed

    chdir '..' unless -d 't';
13 14
    @INC = qw(lib Porting t);
    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 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
}

use strict;
use warnings;
use Digest;
use File::Spec;
use Maintainers qw[%Modules get_module_files get_module_pat];

sub filter_customized {
    my ($m, @files) = @_;

    return @files
        unless my $customized = $Modules{$m}{CUSTOMIZED};

    my ($pat) = map { qr/$_/ } join '|' => map {
        ref $_ ? $_ : qr/\b\Q$_\E$/
    } @{ $customized };

    return grep { $_ =~ $pat } @files;
}

sub my_get_module_files {
    my $m = shift;
    return filter_customized $m => map { Maintainers::expand_glob($_) } get_module_pat($m);
}

my $TestCounter = 0;

my $digest_type = 'SHA-1';

my $original_dir = File::Spec->rel2abs(File::Spec->curdir);
my $data_dir = File::Spec->catdir('t', 'porting');
my $customised = File::Spec->catfile($data_dir, 'customized.dat');

my %customised;

my $regen = 0;

while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
    my $arg = shift @ARGV;

    $arg =~ s/^--/-/; # Treat '--' the same as a single '-'
    if ($arg eq '-regen') {
        $regen = 1;
    }
    else {
        die <<EOF;
Unknown option '$arg'

Usage: $0 [ --regen ]\n"
    --regen    -> Regenerate the data file for $0

EOF
    }
}

my $data_fh;

if ( $regen ) {
76
  open $data_fh, '>:raw', $customised or die "Can't open $customised";
77 78
}
else {
79
  open $data_fh, '<:raw', $customised or die "Can't open $customised";
80 81 82 83 84 85 86 87
  while (<$data_fh>) {
    chomp;
    my ($module,$file,$sha) = split ' ';
    $customised{ $module }->{ $file } = $sha;
  }
  close $data_fh;
}

88
foreach my $module ( sort keys %Modules ) {
89
  next unless my $files = $Modules{ $module }{CUSTOMIZED};
90
  next unless @{ $files };
91 92 93 94 95 96 97 98 99 100 101 102 103 104
  my @perl_files = my_get_module_files( $module );
  foreach my $file ( @perl_files ) {
    my $digest = Digest->new( $digest_type );
    {
      open my $fh, '<', $file or die "Can't open $file";
      binmode $fh;
      $digest->addfile( $fh );
      close $fh;
    }
    my $id = $digest->hexdigest;
    if ( $regen ) {
      print $data_fh join(' ', $module, $file, $id), "\n";
      next;
    }
105 106
SKIP: {
    skip("$file modified for Debian", 1) if $file eq 'cpan/Encode/bin/enc2xs';
107
    my $should_be = $customised{ $module }->{ $file };
108
    is( $id, $should_be, "SHA for $file matches stashed SHA" );
109
}
110 111 112 113
  }
}

if ( $regen ) {
114
  pass( "regenerated data file" );
115 116 117
  close $data_fh;
}

118
done_testing();
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133

=pod

=head1 NAME

customized.t - Test that CUSTOMIZED files in Maintainers.pl have not been overwritten

=head1 SYNOPSIS

 cd t
 ./perl -I../lib porting/customized.t --regen

=head1 DESCRIPTION

customized.t checks that files listed in C<Maintainers.pl> that have been C<CUSTOMIZED>
134
are not accidentally overwritten by CPAN module updates.
135 136 137 138 139 140 141 142 143 144 145 146

=head1 OPTIONS

=over

=item C<--regen>

Use this command line option to regenerate the C<customized.dat> file.

=back

=cut