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     }