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