--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+use File::Find;
+
+print STDERR "Reading Units ...";
+my (%U, %P);
+local $/ = undef;
+find (sub {
+ -f && m/\.U$/ or return;
+ -l and return;
+ my $pri = 0;
+ $File::Find::dir =~ m:^metaconfig/dist-3.0at70b: and $pri = 1;
+ $File::Find::dir =~ m:^metaconfig/U: and $pri = 2;
+ exists $U{$_} && $pri < $P{$_} and return;
+ open my $U, "< $_" or die "$_: $!";
+ $P{$_} = $pri;
+ $U{$_} = [ $File::Find::name, <$U> ];
+ }, "metaconfig");
+my @U = sort keys %U;
+print STDERR "\b\b\b", scalar @U, "\n";
+
+for (@ARGV) {
+ s:^(\d\d)(\d+)$:gzcat perl-current-diffs/${1}000/$1$2.gz |:;
+ }
+
+my $patch_nr = 0;
+local $/ = "\n+++";
+while (<>) {
+ if (m/^Change (\d+) by/) {
+ $patch_nr = $1;
+ next;
+ }
+ m:^ perl/Configure\b: or next;
+ print STDERR "Patch accepted ...\n";
+ s:End of Patch\b.*::;
+
+ my $part = 0;
+ foreach my $patch (split m:\@\@[-\s\d,+]+\@\@\n:) {
+ $patch =~ m:^ perl/Configure\b: and next;
+ my $org = join "\n", grep s/^[- ]//, split m/\n/, $patch;
+ print STDERR "Search for:\n--8<---\n$org\n-->8---\n";
+ my @units;
+ foreach my $U (@U) {
+ index ($U{$U}[1], $org) >= 0 and push @units, $U{$U}[0];
+ }
+ printf "%5d/%03d %s\n", $patch_nr, ++$part, join ", ", @units;
+ }
+ }
--- /dev/null
+#!/pro/bin/perl
+
+# dual.pl patch-file
+#
+# will show the e-mail addresses of those whose files are changed by this patch
+
+package Maintainers;
+
+use strict;
+use warnings;
+
+use Cwd;
+use File::Find;
+
+my $pdir = getcwd;
+$< == 203 && -d "/pro/3gl/CPAN" and chdir "/pro/3gl/CPAN/perl";
+-d "Porting" or die "You're not in the perl5 root folder\n";
+
+use vars qw(%Modules %Maintainers);
+require "Porting/Maintainers.pl";
+
+my %Files;
+foreach my $m (keys %Modules) {
+ foreach my $f (split m/\s+/ => $Modules{$m}{FILES}) {
+ my @f;
+ if (-d $f) {
+ find (sub { -f and push @f, $File::Find::name }, $f);
+ }
+ else {
+ @f = ($f);
+ }
+ for (@f) {
+ $Files{$_} = {
+ Module => $m,
+ Maintainer => $Modules{$m}{MAINTAINER},
+ };
+ }
+ }
+ }
+
+my ($pfx, $pwd, $pc) = ("", (getcwd) x 2);
+#$pwd =~ m/CPAN/ and ($pc, $pfx) = ("/pro/3gl/CPAN/perl-current", "perl/");
+
+my %fqfn;
+find (sub {
+ -f or return; # Only files
+ my $f = $File::Find::name;
+ $f =~ s{^$pc/}{$pfx}o;
+ #print STDERR "$f\n";
+ $fqfn{$f} = $f;
+
+ my $x = $f;
+ while ($x =~ s{^[^/]+/}{}) {
+ if (exists $fqfn{$x} && !ref $fqfn{$x}) {
+ #warn "$f already in top-level. skipped\n";
+ next;
+ }
+ push @{$fqfn{$x}}, $f;
+ }
+ }, $pc);
+
+chdir $pdir;
+my @patched_files;
+while (<>) {
+ m/^(?:\+\+\+|\*\*\*)\s+(\S+)/ or next;
+
+ # now check if the file exists
+ my $f = $1;
+ $f =~ m/^\d+,\d+$/ and next; # Grr, diff not -u
+ -f "perl/$f" and $f = "perl/$f";
+
+ unless (exists $fqfn{$f}) {
+ #print STDERR "finding FQFN for $f ...\n";
+ while ($f =~ m{/} && !exists $fqfn{$f}) {
+ $f =~ s{^[^/]*/}{};
+ }
+ $f or die "No match for $f\n";
+ }
+
+ my $x = $fqfn{$f};
+ if (ref $x) {
+ my @f = @$x;
+ @f == 0 and next; # Hmmm
+ @f > 1 and die "$f matches (@f)\n";
+ $x = $f[0];
+ }
+ push @patched_files, $x;
+ }
+
+my (%mod, %mnt);
+foreach my $f (@patched_files) {
+ exists $Files{$f} or next; # Not dual
+ $mod{$Files{$f}{Module}}++;
+ $mnt{$Files{$f}{Maintainer}}++;
+ }
+
+if (my @mod = sort { lc $a cmp lc $b } keys %mod) {
+ local $" = ", ";
+ print "Affected modules: @mod\n";
+ print "Maintainers: @{[map { $Maintainers{$_} } keys %mnt]}\n";
+ }
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Long qw(:config bundling nopermute passthrough);
+my $opt_w = 0;
+GetOptions (
+ "-w" => \$opt_w,
+ ) or die "usage: metagrep [-w] pattern\n";
+
+use File::Find;
+
+my $pat = shift or die "usage: metagrep pattern\n";
+$opt_w and $pat = "\\b$pat\\b";
+$pat = qr/$pat/i;
+
+my %dir; # I don't want a file for which any path component symlinks
+find (sub {
+ -l and return;
+ -d and $dir{$File::Find::name}++;
+ }, "metaconfig");
+
+print STDERR "<$pat>\n";
+find (sub {
+ -l and return;
+ -f or return;
+ m/\.U$/ or return;
+
+ exists $dir{$File::Find::dir} or return;
+ #print STDERR "$File::Find::dir - $_\n";
+
+ open my $f, "<$_" or die "$File::Find::name: $!\n";
+ print map { "$File::Find::name:$_" } grep /$pat/, <$f>;
+ }, "metaconfig");
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+use Cwd;
+use File::Find;
+
+my ($pfx, $pwd, $pc) = ("", (getcwd) x 2);
+$pwd =~ m/CPAN/ and ($pc, $pfx) = ("/pro/3gl/CPAN/perl-current", "perl/");
+
+use Getopt::Long;
+my $opt_v = 1; # Verbosity
+my $opt_r = 0; # Revert instead of edit
+my $opt_p = -1; # Stript ## elements from path in patch
+GetOptions (
+ "v:1" => \$opt_v,
+ "r" => \$opt_r,
+ "p:1" => \$opt_p,
+ ) or die "usage: patch2p4 [-r] patch [...]\n";
+
+my %fqfn = ( null => "/dev/null" );
+my $nfqfn = 0;
+find (sub {
+ -f or return; # Only files
+ my $f = $File::Find::name;
+ $f =~ s{^$pc/}{$pfx}o;
+ $opt_v > 4 and print STDERR "$f\n";
+ $fqfn{$f} = $f;
+
+ $nfqfn++;
+ my $x = $f;
+ while ($x =~ s{^[^/]+/}{}) {
+ if (exists $fqfn{$x} && !ref $fqfn{$x}) {
+ $opt_v > 2 and warn "$f already in top-level. skipped\n";
+ next;
+ }
+ push @{$fqfn{$x}}, $f;
+ }
+ }, $pc);
+$opt_v and print STDERR "Tagged $nfqfn files\n";
+
+my @p4f;
+my %chunk;
+my $old_file;
+while (<>) {
+ m/^diff\b/ and next;
+ m/$(=====================|Index: )/ and next;
+
+ if (s{^--- }{}) {
+ m{^(\S+).*1970\b.*00:00} and print STDERR "File $1 will be added!\n";
+ m{^/dev/null} and print STDERR "A new file will be added\n";
+ m{^([^/]\w\S+)} and $old_file = $1;
+ next;
+ }
+
+ unless (m/^(?:\+\+\+|\*\*\*)\s+(\S+)/) {
+ @p4f and push @{$chunk{$p4f[-1]}}, $_;
+ next;
+ }
+
+ $1 eq "/dev/null" and print "\n\e[33;41;1m*** File $old_file is planned to be removed ***\e[0m\n\n";
+
+ @p4f && $p4f[-1] eq "${pfx}MANIFEST" and
+ print STDERR +(grep m/^[-+]/, @{$chunk{$p4f[-1]}}), "\n";
+
+ # now check if the file exists
+ my $f = $1;
+ $f =~ m/^\d+,\d+$/ and next; # Grr, diff not -u
+
+ if ($opt_p < 0) {
+ my $ff = $f;
+ do {
+ $opt_p++;
+ -f "$pfx$ff" and $ff = "";
+ } while $ff =~ s{^[^/]+/}{};
+ $opt_v > 1 and print STDERR "\$opt_p set to $opt_p\n";
+ }
+
+ $f =~ s{^[^/]+/}{} for 1 .. $opt_p;
+ -f "$pfx$f" and $f = "$pfx$f";
+
+ unless (exists $fqfn{$f}) {
+ $opt_v and print STDERR "finding FQFN for $f ...\n";
+ while ($f =~ m{/} && !exists $fqfn{$f}) {
+ $f =~ s{^[^/]*/}{};
+ }
+ $f or die "No match for $f\n";
+ }
+
+ my $x = $fqfn{$f};
+ #print STDERR "FQFN for '$f' = '", $x//"--undef--", "'\n";
+ if (ref $x) {
+ my @f = @$x;
+ @f == 0 and next; # Hmmm
+ @f > 1 and die "$f matches (@f)\n";
+ $x = $f[0];
+ }
+ $x eq "${pfx}MANIFEST" and print "\n\e[33;41;1m*** MANIFEST will be changed ***\e[0m\n\n";
+ $x eq "${pfx}embed.fnc" and print "\n\e[33;41;1m*** regen needed ***\e[0m\n\n";
+ push @p4f, $x;
+ }
+
+if (@p4f) {
+ $" = " ";
+ my $action = $opt_r ? "revert" : "sedit";
+ s{^/dev/null$}{} for @p4f;
+ print "p4 $action @p4f\n";
+ }