Local helper utilities

diff --git a/bin/diff2unit.pl b/bin/diff2unit.pl
new file mode 100755 (executable)
index 0000000..a27ec8b
--- /dev/null
+++ b/bin/diff2unit.pl
@@ -0,0 +1,51 @@
+#!/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;
+       }
+    }

diff --git a/bin/dual.pl b/bin/dual.pl
new file mode 100755 (executable)
index 0000000..579dd8f
--- /dev/null
+++ b/bin/dual.pl
@@ -0,0 +1,101 @@
+#!/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";
+    }

diff --git a/bin/metagrep b/bin/metagrep
new file mode 100755 (executable)
index 0000000..f2698a8
--- /dev/null
+++ b/bin/metagrep
@@ -0,0 +1,35 @@
+#!/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");

diff --git a/bin/patch2p4 b/bin/patch2p4
new file mode 100755 (executable)
index 0000000..d26624e
--- /dev/null
+++ b/bin/patch2p4
@@ -0,0 +1,109 @@
+#!/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";
+    }