Commit | Line | Data |
---|---|---|
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 | ||
14 | use strict; | |
15 | ||
16 | use ExtUtils::MakeMaker; | |
17 | use File::Compare; | |
2385f340 | 18 | use File::Spec::Functions qw(catfile catdir devnull); |
00ad0422 | 19 | use Getopt::Long; |
2547c837 | 20 | |
00ad0422 NC |
21 | my ($diffs, $exclude_dual); |
22 | unless (GetOptions('diffs' => \$diffs, | |
23 | 'exclude|x' => \$exclude_dual, | |
24 | ) && @ARGV == 2) { | |
25 | die "usage: $0 [ -d -x ] source_dir tag_to_compare"; | |
2547c837 | 26 | } |
f1c5bace | 27 | |
42e700c9 MJ |
28 | my ($source_dir, $tag_to_compare) = @ARGV[0,1]; |
29 | die "$0: '$source_dir' does not look like a Perl directory\n" | |
30 | unless -f catfile($source_dir, "perl.h") && -d catdir($source_dir, "Porting"); | |
31 | die "$0: '$source_dir' is a Perl directory but does not look like Git working directory\n" | |
32 | unless -d catdir($source_dir, ".git"); | |
33 | ||
2385f340 | 34 | my $null = devnull(); |
68d2af03 SH |
35 | |
36 | my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>$null`; | |
42e700c9 MJ |
37 | chomp $tag_exists; |
38 | ||
39 | die "$0: '$tag_to_compare' is not a known Git tag\n" | |
40 | unless $tag_exists eq $tag_to_compare; | |
f1c5bace | 41 | |
2fb8ff88 | 42 | my %dual_files; |
00ad0422 | 43 | if ($exclude_dual) { |
42e700c9 MJ |
44 | die "With -x, the directory must be '.'\n" |
45 | unless $source_dir eq '.'; | |
2fb8ff88 | 46 | |
3a06b4ed NC |
47 | unshift @INC, 'Porting'; |
48 | require Maintainers; | |
49 | ||
50 | for my $m (grep $Maintainers::Modules{$_}{CPAN}, | |
51 | keys %Maintainers::Modules) { | |
42e700c9 | 52 | $dual_files{$_} = 1 for Maintainers::get_module_files($m); |
2fb8ff88 | 53 | } |
3a06b4ed NC |
54 | } else { |
55 | chdir $source_dir or die "$0: chdir '$source_dir' failed: $!\n"; | |
2fb8ff88 DM |
56 | } |
57 | ||
88830c88 JH |
58 | # Files to skip from the check for one reason or another, |
59 | # usually because they pull in their version from some other file. | |
60 | my %skip; | |
477acd91 | 61 | @skip{ |
42e700c9 MJ |
62 | 'lib/Carp/Heavy.pm', |
63 | 'lib/Config.pm', # no version number but contents will vary | |
64 | 'lib/Exporter/Heavy.pm', | |
65 | 'win32/FindExt.pm', | |
477acd91 | 66 | } = (); |
42e700c9 MJ |
67 | my $skip_dirs = qr|^t/lib|; |
68 | ||
69 | my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`; | |
70 | chomp @all_diffs; | |
71 | ||
72 | my @module_diffs = grep { | |
73 | my $this_dir; | |
74 | $this_dir = $1 if m/^(.*)\//; | |
75 | /\.pm$/ && | |
76 | (!defined($this_dir) || ($this_dir !~ $skip_dirs)) && | |
515cd855 | 77 | !exists $skip{$_} && |
42e700c9 MJ |
78 | !exists $dual_files{$_} |
79 | } @all_diffs; | |
80 | ||
81 | my (@output_files, @output_diffs); | |
82 | ||
83 | foreach my $pm_file (@module_diffs) { | |
84 | (my $xs_file = $pm_file) =~ s/\.pm$/.xs/; | |
85 | my $pm_eq = compare_git_file($pm_file, $tag_to_compare); | |
86 | next unless defined $pm_eq; | |
87 | my $xs_eq = 1; | |
88 | if (-e $xs_file) { | |
89 | $xs_eq = compare_git_file($xs_file, $tag_to_compare); | |
90 | next unless defined $xs_eq; | |
91 | } | |
92 | next if ($pm_eq && $xs_eq); | |
93 | my $pm_version = eval {MM->parse_version($pm_file)}; | |
94 | my $orig_pm_content = get_file_from_git($pm_file, $tag_to_compare); | |
95 | my $orig_pm_version = eval {MM->parse_version(\$orig_pm_content)}; | |
300da4a1 DG |
96 | next if ( ! defined $pm_version || ! defined $orig_pm_version ); |
97 | next if ( $pm_version eq 'undef' || $orig_pm_version eq 'undef' ); # sigh | |
98 | next if $pm_version ne $orig_pm_version; | |
42e700c9 MJ |
99 | push @output_files, $pm_file; |
100 | push @output_diffs, $pm_file unless $pm_eq; | |
101 | push @output_diffs, $xs_file unless $xs_eq; | |
102 | } | |
103 | ||
104 | sub compare_git_file { | |
105 | my ($file, $tag) = @_; | |
68d2af03 | 106 | open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>$null"); |
42e700c9 MJ |
107 | return undef if eof($orig_fh); |
108 | my $is_eq = compare($file, $orig_fh) == 0; | |
109 | close($orig_fh); | |
110 | return $is_eq; | |
111 | } | |
112 | ||
113 | sub get_file_from_git { | |
114 | my ($file, $tag) = @_; | |
115 | local $/ = undef; | |
68d2af03 | 116 | my $file_content = `git --no-pager show $tag:$file 2>$null`; |
42e700c9 MJ |
117 | return $file_content; |
118 | } | |
119 | ||
120 | for (sort @output_files) { | |
2547c837 DM |
121 | print "$_\n"; |
122 | } | |
42e700c9 | 123 | |
00ad0422 | 124 | exit unless $diffs; |
42e700c9 MJ |
125 | |
126 | for (sort @output_diffs) { | |
2547c837 | 127 | print "\n"; |
42e700c9 | 128 | system "git --no-pager diff $tag_to_compare '$_'"; |
2547c837 | 129 | } |
f1c5bace | 130 |