This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix Porting/cmpVERSION.pl to work on Win32
[perl5.git] / Porting / cmpVERSION.pl
CommitLineData
f1c5bace
JH
1#!/usr/bin/perl -w
2
3#
42e700c9
MJ
4# cmpVERSION - compare the current Perl source tree and a given tag
5# for modules that have identical version numbers but different contents.
f1c5bace 6#
2fb8ff88
DM
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)
4c7053ad 10# With this option, one of the directories must be '.'.
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;
19use File::Find;
20use File::Spec::Functions qw(rel2abs abs2rel catfile catdir curdir);
2547c837
DM
21use Getopt::Std;
22
2fb8ff88
DM
23use lib 'Porting';
24use Maintainers;
25
2547c837 26sub usage {
dc47dc11 27die <<"EOF";
42e700c9 28usage: $0 [ -d -x ] source_dir tag_to_compare
2547c837
DM
29EOF
30}
f1c5bace 31
2547c837 32my %opts;
2fb8ff88 33getopts('dx', \%opts) or usage;
2547c837 34@ARGV == 2 or usage;
0c429c78 35
42e700c9
MJ
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
68d2af03
SH
42my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
43
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
2fb8ff88
DM
50my %dual_files;
51if ($opts{x}) {
42e700c9
MJ
52 die "With -x, the directory must be '.'\n"
53 unless $source_dir eq '.';
2fb8ff88
DM
54 for my $m (grep $Maintainers::Modules{$_}{CPAN},
55 keys %Maintainers::Modules)
56 {
57
42e700c9 58 $dual_files{$_} = 1 for Maintainers::get_module_files($m);
2fb8ff88
DM
59 }
60}
61
42e700c9 62chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n";
f1c5bace 63
88830c88
JH
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;
477acd91 67@skip{
42e700c9
MJ
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',
477acd91 72} = ();
42e700c9
MJ
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)) &&
515cd855 83 !exists $skip{$_} &&
42e700c9
MJ
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)};
300da4a1
DG
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;
42e700c9
MJ
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) = @_;
68d2af03 112 open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
42e700c9
MJ
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;
68d2af03 122 my $file_content = `git --no-pager show $tag:$file 2>$null`;
42e700c9
MJ
123 return $file_content;
124}
125
126for (sort @output_files) {
2547c837
DM
127 print "$_\n";
128}
42e700c9 129
2547c837 130exit unless $opts{d};
42e700c9
MJ
131
132for (sort @output_diffs) {
2547c837 133 print "\n";
42e700c9 134 system "git --no-pager diff $tag_to_compare '$_'";
2547c837 135}
f1c5bace 136