Commit | Line | Data |
---|---|---|
dad3338c RGS |
1 | #!perl |
2 | # Reports, in a perl source tree, which dual-lived core modules have not the | |
3 | # same version than the corresponding module on CPAN. | |
b78893c9 | 4 | # with -t option, can compare multiple source trees in tabular form. |
dad3338c RGS |
5 | |
6 | use 5.9.0; | |
7 | use strict; | |
8 | use Getopt::Std; | |
9 | use ExtUtils::MM_Unix; | |
10 | use lib 'Porting'; | |
392c9d37 | 11 | use Maintainers qw(get_module_files reload_manifest %Modules); |
b78893c9 DM |
12 | use Cwd; |
13 | ||
14 | use List::Util qw(max); | |
dad3338c RGS |
15 | |
16 | our $packagefile = '02packages.details.txt'; | |
17 | ||
18 | sub usage () { | |
19 | die <<USAGE; | |
b78893c9 DM |
20 | $0 |
21 | $0 -t home1[:label] home2[:label] ... | |
22 | ||
23 | Report which core modules are outdated. | |
dad3338c | 24 | To be run at the root of a perl source tree. |
b78893c9 | 25 | |
dad3338c RGS |
26 | Options : |
27 | -h : help | |
28 | -v : verbose (print all versions of all files, not only those which differ) | |
29 | -f : force download of $packagefile from CPAN | |
30 | (it's expected to be found in the current directory) | |
b78893c9 | 31 | -t : display in tabular form CPAN vs one or more perl source trees |
dad3338c RGS |
32 | USAGE |
33 | } | |
34 | ||
35 | sub get_package_details () { | |
36 | my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz'; | |
37 | unlink $packagefile; | |
38 | system("wget $url && gunzip $packagefile.gz") == 0 | |
39 | or die "Failed to get package details\n"; | |
40 | } | |
41 | ||
b78893c9 | 42 | getopts('fhvt'); |
dad3338c | 43 | our $opt_h and usage; |
b78893c9 DM |
44 | our $opt_t; |
45 | ||
46 | my @sources = @ARGV ? @ARGV : '.'; | |
47e01c32 | 47 | die "Too many directories specified without -t option\n" |
b78893c9 DM |
48 | if @sources != 1 and ! $opt_t; |
49 | ||
50 | @sources = map { | |
51 | # handle /home/user/perl:bleed style labels | |
52 | my ($dir,$label) = split /:/; | |
53 | $label = $dir unless defined $label; | |
54 | [ $dir, $label ]; | |
55 | } @sources; | |
56 | ||
c16639b5 | 57 | our $opt_f || !-f $packagefile and get_package_details; |
dad3338c RGS |
58 | |
59 | # Load the package details. All of them. | |
60 | my %cpanversions; | |
1ae6ead9 | 61 | open my $fh, '<', $packagefile or die $!; |
dad3338c RGS |
62 | while (<$fh>) { |
63 | my ($p, $v) = split ' '; | |
b78893c9 | 64 | next if 1../^\s*$/; # skip header |
dad3338c RGS |
65 | $cpanversions{$p} = $v; |
66 | } | |
67 | close $fh; | |
68 | ||
b78893c9 DM |
69 | my %results; |
70 | ||
71 | # scan source tree(s) and CPAN module list, and put results in %results | |
72 | ||
73 | foreach my $source (@sources) { | |
74 | my ($srcdir, $label) = @$source; | |
75 | my $olddir = getcwd(); | |
76 | chdir $srcdir or die "chdir $srcdir: $!\n"; | |
77 | ||
392c9d37 DM |
78 | # load the MANIFEST file in the new directory |
79 | reload_manifest; | |
80 | ||
b78893c9 DM |
81 | for my $dist (sort keys %Modules) { |
82 | next unless $Modules{$dist}{CPAN}; | |
83 | for my $file (get_module_files($dist)) { | |
19e87f22 DM |
84 | next if $file !~ /(\.pm|_pm.PL)\z/ |
85 | or $file =~ m{^t/} or $file =~ m{/t/}; | |
b78893c9 DM |
86 | my $vcore = '!EXIST'; |
87 | $vcore = MM->parse_version($file) // 'undef' if -f $file; | |
19e87f22 DM |
88 | |
89 | # get module name from filename to lookup CPAN version | |
b78893c9 | 90 | my $module = $file; |
19e87f22 | 91 | $module =~ s/\_pm.PL\z//; |
b78893c9 DM |
92 | $module =~ s/\.pm\z//; |
93 | # some heuristics to figure out the module name from the file name | |
36512bd8 JV |
94 | $module =~ s{^(lib|ext|dist|cpan)/}{} |
95 | and $1 =~ /(?:ext|dist|cpan)/ | |
f6e59a58 DM |
96 | and ( |
97 | # ext/Foo-Bar/Bar.pm | |
98 | $module =~ s{^(\w+)-(\w+)/\2$}{$1/lib/$1/$2}, | |
99 | # ext/Encode/Foo/Foo.pm | |
100 | $module =~ s{^(Encode)/(\w+)/\2$}{$1/lib/$1/$2}, | |
101 | $module =~ s{^[^/]+/}{}, | |
102 | $module =~ s{^lib/}{}, | |
b78893c9 DM |
103 | ); |
104 | $module =~ s{/}{::}g; | |
105 | my $vcpan = $cpanversions{$module} // 'undef'; | |
106 | $results{$dist}{$file}{$label} = $vcore; | |
107 | $results{$dist}{$file}{CPAN} = $vcpan; | |
108 | } | |
109 | } | |
110 | ||
111 | chdir $olddir or die "chdir $olddir: $!\n"; | |
112 | } | |
113 | ||
114 | # output %results in the requested format | |
115 | ||
116 | my @labels = ((map $_->[1], @sources), 'CPAN' ); | |
117 | ||
118 | if ($opt_t) { | |
119 | my %changed; | |
120 | my @fields; | |
2061eafe | 121 | for my $dist (sort { lc $a cmp lc $b } keys %results) { |
b78893c9 DM |
122 | for my $file (sort keys %{$results{$dist}}) { |
123 | my @versions = @{$results{$dist}{$file}}{@labels}; | |
124 | for (0..$#versions) { | |
125 | $fields[$_] = max($fields[$_], | |
126 | length $versions[$_], | |
127 | length $labels[$_], | |
128 | length '!EXIST' | |
129 | ); | |
130 | } | |
131 | if (our $opt_v or grep $_ ne $versions[0], @versions) { | |
132 | $changed{$dist} = 1; | |
133 | } | |
134 | } | |
135 | } | |
136 | printf "%*s ", $fields[$_], $labels[$_] for 0..$#labels; | |
137 | print "\n"; | |
138 | printf "%*s ", $fields[$_], '-' x length $labels[$_] for 0..$#labels; | |
139 | print "\n"; | |
140 | ||
141 | my $field_total; | |
142 | $field_total += $_ + 1 for @fields; | |
143 | ||
2061eafe | 144 | for my $dist (sort { lc $a cmp lc $b } keys %results) { |
b78893c9 DM |
145 | next unless $changed{$dist}; |
146 | print " " x $field_total, " $dist\n"; | |
147 | for my $file (sort keys %{$results{$dist}}) { | |
148 | my @versions = @{$results{$dist}{$file}}{@labels}; | |
149 | for (0..$#versions) { | |
150 | printf "%*s ", $fields[$_], $versions[$_]//'!EXIST' | |
151 | } | |
152 | print " $file\n"; | |
153 | } | |
154 | } | |
155 | } | |
156 | else { | |
2061eafe | 157 | for my $dist (sort { lc $a cmp lc $b } keys %results) { |
d13df5d7 | 158 | my $distname_printed = 0; |
b78893c9 | 159 | for my $file (sort keys %{$results{$dist}}) { |
2d373db1 | 160 | my ($vcore, $vcpan) = @{$results{$dist}{$file}}{@labels}; |
b78893c9 | 161 | if (our $opt_v or $vcore ne $vcpan) { |
33649910 | 162 | print "\n$dist ($Modules{$dist}{MAINTAINER}):\n" unless ($distname_printed++); |
d13df5d7 | 163 | print "\t$file: core=$vcore, cpan=$vcpan\n"; |
b78893c9 | 164 | } |
dad3338c RGS |
165 | } |
166 | } | |
167 | } |