This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
cmpVERSION.pl: don't flag version 'undef'
[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
42my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>/dev/null`;
43chomp $tag_exists;
44
45die "$0: '$tag_to_compare' is not a known Git tag\n"
46 unless $tag_exists eq $tag_to_compare;
f1c5bace 47
2fb8ff88
DM
48my %dual_files;
49if ($opts{x}) {
42e700c9
MJ
50 die "With -x, the directory must be '.'\n"
51 unless $source_dir eq '.';
2fb8ff88
DM
52 for my $m (grep $Maintainers::Modules{$_}{CPAN},
53 keys %Maintainers::Modules)
54 {
55
42e700c9 56 $dual_files{$_} = 1 for Maintainers::get_module_files($m);
2fb8ff88
DM
57 }
58}
59
42e700c9 60chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n";
f1c5bace 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{$_} &&
42e700c9
MJ
82 !exists $dual_files{$_}
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) = @_;
110 open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>/dev/null");
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;
120 my $file_content = `git --no-pager show $tag:$file 2>/dev/null`;
121 return $file_content;
122}
123
124for (sort @output_files) {
2547c837
DM
125 print "$_\n";
126}
42e700c9 127
2547c837 128exit unless $opts{d};
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