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 | ||
42 | my $tag_exists = `git --no-pager tag -l $tag_to_compare 2>/dev/null`; | |
43 | chomp $tag_exists; | |
44 | ||
45 | die "$0: '$tag_to_compare' is not a known Git tag\n" | |
46 | unless $tag_exists eq $tag_to_compare; | |
f1c5bace | 47 | |
2fb8ff88 DM |
48 | my %dual_files; |
49 | if ($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 | 60 | chdir $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. | |
64 | my %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 |
71 | my $skip_dirs = qr|^t/lib|; |
72 | ||
73 | my @all_diffs = `git --no-pager diff --name-only $tag_to_compare`; | |
74 | chomp @all_diffs; | |
75 | ||
76 | my @module_diffs = grep { | |
77 | my $this_dir; | |
78 | $this_dir = $1 if m/^(.*)\//; | |
79 | /\.pm$/ && | |
80 | (!defined($this_dir) || ($this_dir !~ $skip_dirs)) && | |
81 | !exists $skip{$_} && | |
82 | !exists $dual_files{$_} | |
83 | } @all_diffs; | |
84 | ||
85 | my (@output_files, @output_diffs); | |
86 | ||
87 | foreach 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)}; | |
100 | next unless | |
101 | defined $pm_version && | |
102 | defined $orig_pm_version && | |
103 | $pm_version eq $orig_pm_version; | |
104 | push @output_files, $pm_file; | |
105 | push @output_diffs, $pm_file unless $pm_eq; | |
106 | push @output_diffs, $xs_file unless $xs_eq; | |
107 | } | |
108 | ||
109 | sub compare_git_file { | |
110 | my ($file, $tag) = @_; | |
111 | open(my $orig_fh, "-|", "git --no-pager show $tag:$file 2>/dev/null"); | |
112 | return undef if eof($orig_fh); | |
113 | my $is_eq = compare($file, $orig_fh) == 0; | |
114 | close($orig_fh); | |
115 | return $is_eq; | |
116 | } | |
117 | ||
118 | sub get_file_from_git { | |
119 | my ($file, $tag) = @_; | |
120 | local $/ = undef; | |
121 | my $file_content = `git --no-pager show $tag:$file 2>/dev/null`; | |
122 | return $file_content; | |
123 | } | |
124 | ||
125 | for (sort @output_files) { | |
2547c837 DM |
126 | print "$_\n"; |
127 | } | |
42e700c9 | 128 | |
2547c837 | 129 | exit unless $opts{d}; |
42e700c9 MJ |
130 | |
131 | for (sort @output_diffs) { | |
2547c837 | 132 | print "\n"; |
42e700c9 | 133 | system "git --no-pager diff $tag_to_compare '$_'"; |
2547c837 | 134 | } |
f1c5bace | 135 |