Commit | Line | Data |
---|---|---|
6092c506 | 1 | #!/usr/bin/perl |
f83b5b07 MB |
2 | |
3 | # dual.pl patch-file | |
4 | # | |
5 | # will show the e-mail addresses of those whose files are changed by this patch | |
6 | ||
7 | package Maintainers; | |
8 | ||
9 | use strict; | |
10 | use warnings; | |
11 | ||
12 | use Cwd; | |
13 | use File::Find; | |
a8ae8817 | 14 | use FindBin; |
f83b5b07 MB |
15 | |
16 | my $pdir = getcwd; | |
a8ae8817 | 17 | |
f4eff071 | 18 | my $p5_metaconfig_base = "$FindBin::Bin/../"; |
a8ae8817 DH |
19 | chdir "$p5_metaconfig_base/perl" || |
20 | die "perl/ directory missing in $p5_metaconfig_base\n"; | |
f83b5b07 MB |
21 | |
22 | use vars qw(%Modules %Maintainers); | |
23 | require "Porting/Maintainers.pl"; | |
24 | ||
25 | my %Files; | |
26 | foreach my $m (keys %Modules) { | |
27 | foreach my $f (split m/\s+/ => $Modules{$m}{FILES}) { | |
28 | my @f; | |
29 | if (-d $f) { | |
30 | find (sub { -f and push @f, $File::Find::name }, $f); | |
31 | } | |
32 | else { | |
33 | @f = ($f); | |
34 | } | |
35 | for (@f) { | |
36 | $Files{$_} = { | |
37 | Module => $m, | |
38 | Maintainer => $Modules{$m}{MAINTAINER}, | |
39 | }; | |
40 | } | |
41 | } | |
42 | } | |
43 | ||
44 | my ($pfx, $pwd, $pc) = ("", (getcwd) x 2); | |
45 | #$pwd =~ m/CPAN/ and ($pc, $pfx) = ("/pro/3gl/CPAN/perl-current", "perl/"); | |
46 | ||
47 | my %fqfn; | |
48 | find (sub { | |
49 | -f or return; # Only files | |
50 | my $f = $File::Find::name; | |
51 | $f =~ s{^$pc/}{$pfx}o; | |
52 | #print STDERR "$f\n"; | |
53 | $fqfn{$f} = $f; | |
54 | ||
55 | my $x = $f; | |
56 | while ($x =~ s{^[^/]+/}{}) { | |
57 | if (exists $fqfn{$x} && !ref $fqfn{$x}) { | |
58 | #warn "$f already in top-level. skipped\n"; | |
59 | next; | |
60 | } | |
61 | push @{$fqfn{$x}}, $f; | |
62 | } | |
63 | }, $pc); | |
64 | ||
65 | chdir $pdir; | |
66 | my @patched_files; | |
67 | while (<>) { | |
68 | m/^(?:\+\+\+|\*\*\*)\s+(\S+)/ or next; | |
69 | ||
70 | # now check if the file exists | |
71 | my $f = $1; | |
72 | $f =~ m/^\d+,\d+$/ and next; # Grr, diff not -u | |
73 | -f "perl/$f" and $f = "perl/$f"; | |
74 | ||
75 | unless (exists $fqfn{$f}) { | |
76 | #print STDERR "finding FQFN for $f ...\n"; | |
77 | while ($f =~ m{/} && !exists $fqfn{$f}) { | |
78 | $f =~ s{^[^/]*/}{}; | |
79 | } | |
80 | $f or die "No match for $f\n"; | |
81 | } | |
82 | ||
83 | my $x = $fqfn{$f}; | |
84 | if (ref $x) { | |
85 | my @f = @$x; | |
86 | @f == 0 and next; # Hmmm | |
87 | @f > 1 and die "$f matches (@f)\n"; | |
88 | $x = $f[0]; | |
89 | } | |
90 | push @patched_files, $x; | |
91 | } | |
92 | ||
93 | my (%mod, %mnt); | |
94 | foreach my $f (@patched_files) { | |
95 | exists $Files{$f} or next; # Not dual | |
96 | $mod{$Files{$f}{Module}}++; | |
97 | $mnt{$Files{$f}{Maintainer}}++; | |
98 | } | |
99 | ||
100 | if (my @mod = sort { lc $a cmp lc $b } keys %mod) { | |
101 | local $" = ", "; | |
102 | print "Affected modules: @mod\n"; | |
103 | print "Maintainers: @{[map { $Maintainers{$_} } keys %mnt]}\n"; | |
104 | } |