| 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 | |