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
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
DM
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)
4c7053ad 9# With this option, one of the directories must be '.'.
2547c837 10#
42e700c9 11# Original by slaven@rezic.de, modified by jhi and matt.w.johnson@gmail.com.
f1c5bace
JH
12#
13
14use strict;
15
16use ExtUtils::MakeMaker;
17use File::Compare;
2385f340 18use File::Spec::Functions qw(catfile catdir devnull);
2547c837
DM
19use Getopt::Std;
20
21sub usage {
dc47dc11 22die <<"EOF";
42e700c9 23usage: $0 [ -d -x ] source_dir tag_to_compare
2547c837
DM
24EOF
25}
f1c5bace 26
2547c837 27my %opts;
2fb8ff88 28getopts('dx', \%opts) or usage;
2547c837 29@ARGV == 2 or usage;
0c429c78 30
42e700c9
MJ
31my ($source_dir, $tag_to_compare) = @ARGV[0,1];
32die "$0: '$source_dir' does not look like a Perl directory\n"
33 unless -f catfile($source_dir, "perl.h") && -d catdir($source_dir, "Porting");
34die "$0: '$source_dir' is a Perl directory but does not look like Git working directory\n"
35 unless -d catdir($source_dir, ".git");
36
2385f340 37my $null = devnull();
68d2af03
SH
38
39my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`;
42e700c9
MJ
40chomp $tag_exists;
41
42die "$0: '$tag_to_compare' is not a known Git tag\n"
43 unless $tag_exists eq $tag_to_compare;
f1c5bace 44
2fb8ff88
DM
45my %dual_files;
46if ($opts{x}) {
42e700c9
MJ
47 die "With -x, the directory must be '.'\n"
48 unless $source_dir eq '.';
2fb8ff88 49
3a06b4ed
NC
50 unshift @INC, 'Porting';
51 require Maintainers;
52
53 for my $m (grep $Maintainers::Modules{$_}{CPAN},
54 keys %Maintainers::Modules) {
42e700c9 55 $dual_files{$_} = 1 for Maintainers::get_module_files($m);
2fb8ff88 56 }
3a06b4ed
NC
57} else {
58 chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n";
2fb8ff88
DM
59}
60
88830c88
JH
61# Files to skip from the check for one reason or another,
62# usually because they pull in their version from some other file.
63my %skip;
477acd91 64@skip{
42e700c9
MJ
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',
477acd91 69} = ();
42e700c9
MJ
70my $skip_dirs = qr|^t/lib|;
71
72my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`;
73chomp @all_diffs;
74
75my @module_diffs = grep {
76 my $this_dir;
77 $this_dir = $1 if m/^(.*)\//;
78 /\.pm$/ &&
79 (!defined($this_dir) || ($this_dir !~ $skip_dirs)) &&
515cd855 80 !exists $skip{$_} &&
42e700c9
MJ
81 !exists $dual_files{$_}
82} @all_diffs;
83
84my (@output_files, @output_diffs);
85
86foreach 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)};
300da4a1
DG
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;
42e700c9
MJ
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
107sub compare_git_file {
108 my ($file, $tag) = @_;
68d2af03 109 open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null");
42e700c9
MJ
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
116sub get_file_from_git {
117 my ($file, $tag) = @_;
118 local $/ = undef;
68d2af03 119 my $file_content = `git --no-pager show $tag:$file 2>$null`;
42e700c9
MJ
120 return $file_content;
121}
122
123for (sort @output_files) {
2547c837
DM
124 print "$_\n";
125}
42e700c9 126
2547c837 127exit unless $opts{d};
42e700c9
MJ
128
129for (sort @output_diffs) {
2547c837 130 print "\n";
42e700c9 131 system "git --no-pager diff $tag_to_compare '$_'";
2547c837 132}
f1c5bace 133