Porting/cmpVERSION.pl

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # cmpVERSION - compare the current Perl source tree and a given tag
   5 # for modules that have identical version numbers but different contents.
   6 #
   7 # with -d option, output the diffs too
   8 # with -x option, exclude dual-life modules (after all, there are tools
   9 #                 like core-cpan-diff that can already deal with them)
  10 #                 With this option, one of the directories must be '.'.
  11 #
  12 # Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com.
  13 #
  14
  15 use strict;
  16
  17 use ExtUtils::MakeMaker;
  18 use File::Compare;
  19 use File::Find;
  20 use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
  21 use Getopt::Std;
  22
  23 use lib 'Porting';
  24 use Maintainers;
  25
  26 sub usage {
  27 die <<"EOF";
  28 usage: $0 [ -d -x ] source_dir tag_to_compare
  29 EOF
  30 }
  31
  32 my %opts;
  33 getopts('dx', \%opts) or usage;
  34 @ARGV == 2 or usage;
  35
  36 my ($source_dir, $tag_to_compare) = @ARGV[0,1];
  37 die "$0: '$source_dir' does not look like a Perl directory\n"
  38     unless -f catfile($source_dir, "perl.h") && -d catdir($source_dir, "Porting");
  39 die "$0: '$source_dir' is a Perl directory but does not look like Git working directory\n"
  40     unless -d catdir($source_dir, ".git");
  41
  42 my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
  43
  44 my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
  45 chomp $tag_exists;
  46
  47 die "$0: '$tag_to_compare' is not a known Git tag\n"
  48     unless $tag_exists eq $tag_to_compare;
  49
  50 my %dual_files;
  51 if ($opts{x}) {
  52     die "With -x, the directory must be '.'\n"
  53         unless $source_dir eq '.';
  54     for my $m (grep $Maintainers::Modules{$_}{CPAN},
  55                                 keys %Maintainers::Modules)
  56     {
  57
  58         $dual_files{$_} = 1 for Maintainers::get_module_files($m);
  59     }
  60 }
  61
  62 chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n";
  63
  64 # Files to skip from the check for one reason or another,
  65 # usually because they pull in their version from some other file.
  66 my %skip;
  67 @skip{
  68     'lib/Carp/Heavy.pm',
  69     'lib/Config.pm',            # no version number but contents will vary
  70     'lib/Exporter/Heavy.pm',
  71     'win32/FindExt.pm',
  72 } = ();
  73 my $skip_dirs = qr|^t/lib|;
  74
  75 my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
  76 chomp @all_diffs;
  77
  78 my @module_diffs = grep {
  79     my $this_dir;
  80     $this_dir = $1 if m/^(.*)\//;
  81     /\.pm$/ &&
  82     (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
  83     !exists $skip{$_} &&
  84     !exists $dual_files{$_}
  85 } @all_diffs;
  86
  87 my (@output_files, @output_diffs);
  88
  89 foreach my $pm_file (@module_diffs) {
  90     (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
  91     my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
  92     next unless defined $pm_eq;
  93     my $xs_eq = 1;
  94     if (-e $xs_file) {
  95         $xs_eq = compare_git_file($xs_file, $tag_to_compare);
  96         next unless defined $xs_eq;
  97     }
  98     next if ($pm_eq && $xs_eq);
  99     my $pm_version = eval {MM->parse_version($pm_file)};
 100     my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
 101     my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
 102     next if ( ! defined $pm_version || ! defined $orig_pm_version );
 103     next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
 104     next if $pm_version ne $orig_pm_version;
 105     push @output_files, $pm_file;
 106     push @output_diffs, $pm_file unless $pm_eq;
 107     push @output_diffs, $xs_file unless $xs_eq;
 108 }
 109
 110 sub compare_git_file {
 111     my ($file, $tag) = @_;
 112     open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
 113     return undef if eof($orig_fh);
 114     my $is_eq = compare($file, $orig_fh) == 0;
 115     close($orig_fh);
 116     return $is_eq;
 117 }
 118
 119 sub get_file_from_git {
 120     my ($file, $tag) = @_;
 121     local $/ = undef;
 122     my $file_content = `git --no-pager show $tag:$file 2>$null`;
 123     return $file_content;
 124 }
 125
 126 for (sort @output_files) {
 127     print "$_\n";
 128 }
 129
 130 exit unless $opts{d};
 131
 132 for (sort @output_diffs) {
 133     print "\n";
 134     system "git --no-pager diff $tag_to_compare '$_'";
 135 }
 136