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