This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
prctl needs unistd on Android
[metaconfig.git] / bin / dual.pl
1 #!/pro/bin/perl
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;
14
15 my $pdir = getcwd;
16 $< == 203 && -d "/pro/3gl/CPAN" and chdir "/pro/3gl/CPAN/perl";
17 -d "Porting" or die "You're not in the perl5 root folder\n";
18
19 use vars qw(%Modules %Maintainers);
20 require "Porting/Maintainers.pl";
21
22 my %Files;
23 foreach my $m (keys %Modules) {
24     foreach my $f (split m/\s+/ => $Modules{$m}{FILES}) {
25         my @f;
26         if (-d $f) {
27             find (sub { -f and push @f, $File::Find::name }, $f);
28             }
29         else {
30             @f = ($f);
31             }
32         for (@f) {
33             $Files{$_} = {
34                 Module     => $m,
35                 Maintainer => $Modules{$m}{MAINTAINER},
36                 };
37             }
38         }
39     }
40
41 my ($pfx, $pwd, $pc) = ("", (getcwd) x 2);
42 #$pwd =~ m/CPAN/ and ($pc, $pfx) = ("/pro/3gl/CPAN/perl-current", "perl/");
43
44 my %fqfn;
45 find (sub {
46     -f or return;       # Only files
47     my $f = $File::Find::name;
48     $f =~ s{^$pc/}{$pfx}o;
49     #print STDERR "$f\n";
50     $fqfn{$f} = $f;
51
52     my $x = $f;
53     while ($x =~ s{^[^/]+/}{}) {
54         if (exists $fqfn{$x} && !ref $fqfn{$x}) {
55             #warn "$f already in top-level. skipped\n";
56             next;
57             }
58         push @{$fqfn{$x}}, $f;
59         }
60     }, $pc);
61
62 chdir $pdir;
63 my @patched_files;
64 while (<>) {
65     m/^(?:\+\+\+|\*\*\*)\s+(\S+)/ or next;
66
67     # now check if the file exists
68     my $f = $1;
69     $f =~ m/^\d+,\d+$/ and next;        # Grr, diff not -u
70     -f "perl/$f" and $f = "perl/$f";
71
72     unless (exists $fqfn{$f}) {
73         #print STDERR "finding FQFN for $f ...\n";
74         while ($f =~ m{/} && !exists $fqfn{$f}) {
75             $f =~ s{^[^/]*/}{};
76             }
77         $f or die "No match for $f\n";
78         }
79
80     my $x = $fqfn{$f};
81     if (ref $x) {
82         my @f = @$x;
83         @f == 0 and next;       # Hmmm
84         @f > 1 and die "$f matches (@f)\n";
85         $x = $f[0];
86         }
87     push @patched_files, $x;
88     }
89
90 my (%mod, %mnt);
91 foreach my $f (@patched_files) {
92     exists $Files{$f} or next;  # Not dual
93     $mod{$Files{$f}{Module}}++;
94     $mnt{$Files{$f}{Maintainer}}++;
95     }
96
97 if (my @mod = sort { lc $a cmp lc $b } keys %mod) {
98     local $" = ", ";
99     print "Affected modules: @mod\n";
100     print "Maintainers: @{[map { $Maintainers{$_} } keys %mnt]}\n";
101     }