This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Trim the import list from File::Spec::Functions and don't use File::Find.
[perl5.git] / 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 #                 With this option, one of the directories must be '.'.
10 #
11 # Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com.
12 #
13
14 use strict;
15
16 use ExtUtils::MakeMaker;
17 use File::Compare;
18 use File::Spec::Functions qw(catfile catdir devnull);
19 use Getopt::Std;
20
21 sub usage {
22 die <<"EOF";
23 usage: $0 [ -d -x ] source_dir tag_to_compare
24 EOF
25 }
26
27 my %opts;
28 getopts('dx', \%opts) or usage;
29 @ARGV == 2 or usage;
30
31 my ($source_dir, $tag_to_compare) = @ARGV[0,1];
32 die "$0: '$source_dir' does not look like a Perl directory\n"
33     unless -f catfile($source_dir, "perl.h") && -d catdir($source_dir, "Porting");
34 die "$0: '$source_dir' is a Perl directory but does not look like Git working directory\n"
35     unless -d catdir($source_dir, ".git");
36
37 my $null = devnull();
38
39 my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
40 chomp $tag_exists;
41
42 die "$0: '$tag_to_compare' is not a known Git tag\n"
43     unless $tag_exists eq $tag_to_compare;
44
45 my %dual_files;
46 if ($opts{x}) {
47     die "With -x, the directory must be '.'\n"
48         unless $source_dir eq '.';
49
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 } else {
58     chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n";
59 }
60
61 # Files to skip from the check for one reason or another,
62 # usually because they pull in their version from some other file.
63 my %skip;
64 @skip{
65     'lib/Carp/Heavy.pm',
66     'lib/Config.pm',            # no version number but contents will vary
67     'lib/Exporter/Heavy.pm',
68     'win32/FindExt.pm',
69 } = ();
70 my $skip_dirs = qr|^t/lib|;
71
72 my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
73 chomp @all_diffs;
74
75 my @module_diffs = grep {
76     my $this_dir;
77     $this_dir = $1 if m/^(.*)\//;
78     /\.pm$/ &&
79     (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
80     !exists $skip{$_} &&
81     !exists $dual_files{$_}
82 } @all_diffs;
83
84 my (@output_files, @output_diffs);
85
86 foreach my $pm_file (@module_diffs) {
87     (my $xs_file = $pm_file) =~ s/\.pm$/.xs/;
88     my $pm_eq = compare_git_file($pm_file, $tag_to_compare);
89     next unless defined $pm_eq;
90     my $xs_eq = 1;
91     if (-e $xs_file) {
92         $xs_eq = compare_git_file($xs_file, $tag_to_compare);
93         next unless defined $xs_eq;
94     }
95     next if ($pm_eq && $xs_eq);
96     my $pm_version = eval {MM->parse_version($pm_file)};
97     my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare);
98     my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)};
99     next if ( ! defined $pm_version || ! defined $orig_pm_version );
100     next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh
101     next if $pm_version ne $orig_pm_version;
102     push @output_files, $pm_file;
103     push @output_diffs, $pm_file unless $pm_eq;
104     push @output_diffs, $xs_file unless $xs_eq;
105 }
106
107 sub compare_git_file {
108     my ($file, $tag) = @_;
109     open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
110     return undef if eof($orig_fh);
111     my $is_eq = compare($file, $orig_fh) == 0;
112     close($orig_fh);
113     return $is_eq;
114 }
115
116 sub get_file_from_git {
117     my ($file, $tag) = @_;
118     local $/ = undef;
119     my $file_content = `git --no-pager show $tag:$file 2>$null`;
120     return $file_content;
121 }
122
123 for (sort @output_files) {
124     print "$_\n";
125 }
126
127 exit unless $opts{d};
128
129 for (sort @output_diffs) {
130     print "\n";
131     system "git --no-pager diff $tag_to_compare '$_'";
132 }
133