This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix version for Locale-Maketext in Porting/Maintainers.pl
[perl5.git] / Porting / cmpVERSION.pl
... / ...
CommitLineData
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
15use strict;
16
17use ExtUtils::MakeMaker;
18use File::Compare;
19use File::Find;
20use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
21use Getopt::Std;
22
23use lib 'Porting';
24use Maintainers;
25
26sub usage {
27die <<"EOF";
28usage: $0 [ -d -x ] source_dir tag_to_compare
29EOF
30}
31
32my %opts;
33getopts('dx', \%opts) or usage;
34@ARGV == 2 or usage;
35
36my ($source_dir, $tag_to_compare) = @ARGV[0,1];
37die "$0: '$source_dir' does not look like a Perl directory\n"
38 unless -f catfile($source_dir, "perl.h") && -d catdir($source_dir, "Porting");
39die "$0: '$source_dir' is a Perl directory but does not look like Git working directory\n"
40 unless -d catdir($source_dir, ".git");
41
42my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
43
44my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
45chomp $tag_exists;
46
47die "$0: '$tag_to_compare' is not a known Git tag\n"
48 unless $tag_exists eq $tag_to_compare;
49
50my %dual_files;
51if ($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
62chdir $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.
66my %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} = ();
73my $skip_dirs = qr|^t/lib|;
74
75my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
76chomp @all_diffs;
77
78my @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
87my (@output_files, @output_diffs);
88
89foreach 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
110sub 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
119sub 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
126for (sort @output_files) {
127 print "$_\n";
128}
129
130exit unless $opts{d};
131
132for (sort @output_diffs) {
133 print "\n";
134 system "git --no-pager diff $tag_to_compare '$_'";
135}
136