bin/diff2unit.pl

   1 #!/pro/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Find;
   7
   8 print STDERR "Reading Units ...";
   9 my (%U, %P);
  10 local $/ = undef;
  11 find (sub {
  12     -f  && m/\.U$/ or return;
  13     -l and return;
  14     my $pri = 0;
  15     $File::Find::dir =~ m:^metaconfig/dist-3.0at70b: and $pri = 1;
  16     $File::Find::dir =~ m:^metaconfig/U:             and $pri = 2;
  17     exists $U{$_} && $pri < $P{$_} and return;
  18     open my $U, "< $_" or die "$_: $!";
  19     $P{$_} = $pri;
  20     $U{$_} = [ $File::Find::name, <$U> ];
  21     }, "metaconfig");
  22 my @U = sort keys %U;
  23 print STDERR "\b\b\b", scalar @U, "\n";
  24
  25 for (@ARGV) {
  26     s:^(\d\d)(\d+)$:gzcat perl-current-diffs/${1}000/$1$2.gz |:;
  27     }
  28
  29 my $patch_nr = 0;
  30 local $/ = "\n+++";
  31 while (<>) {
  32     if (m/^Change (\d+) by/) {
  33         $patch_nr = $1;
  34         next;
  35         }
  36     m:^ perl/Configure\b: or next;
  37     print STDERR "Patch accepted ...\n";
  38     s:End of Patch\b.*::;
  39
  40     my $part = 0;
  41     foreach my $patch (split m:\@\@[-\s\d,+]+\@\@\n:) {
  42         $patch =~ m:^ perl/Configure\b: and next;
  43         my $org = join "\n", grep s/^[- ]//, split m/\n/, $patch;
  44         print STDERR "Search for:\n--8<---\n$org\n-->8---\n";
  45         my @units;
  46         foreach my $U (@U) {
  47             index ($U{$U}[1], $org) >= 0 and push @units, $U{$U}[0];
  48             }
  49         printf "%5d/%03d %s\n", $patch_nr, ++$part, join ", ", @units;
  50         }
  51     }