Porting/cmpVERSION.pl

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