Add Configure probe for strtold_l

[metaconfig.git] / ls-diff.pl

diff --git a/ls-diff.pl b/ls-diff.pl
old mode 100644 (file)
new mode 100755 (executable)
index 4cb8f9e..2bbef26
--- a/ls-diff.pl
+++ b/ls-diff.pl
@@ -1,13 +1,17 @@
-#!/pro/bin/perl
+#!/usr/bin/perl
 
 use 5.18.2;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = "0.03";
 
 sub usage {
     my $err = shift and select STDERR;
-    say "usage: $0 [--list] [--diff]";
+    say "usage: $0 [--list] [--diff[=gd|dp|gp]] [--diff-flags=--whatever] [--pat=pattern]";
+    say "  diff (size) between git / dist / perl";
+    say "  where git  (g) is the version from the git repo of meta/dist";
+    say "  where dist (d) is the unmodified installed version from dist";
+    say "  where perl (p) is the *modified* version for use with perl";
     exit $err;
     } # usage
 
@@ -20,16 +24,23 @@ GetOptions (
 
     "l|list!"  => \my $opt_l,
     "d|diff=s" => \my $opt_d,
+    "D|diff-flags=s"   => \my $opt_D,
+    "c|copy"   => \my $opt_c,
+
+    "p|pat=s"  => \my $opt_p,
     ) or usage (1);
 
+$opt_D //= "-w";
+
 my $pat = shift // ".";
 $pat = qr{$pat};
 
+my %exempt = map {( s/[\s\n].*\z//rs => 1 )} <DATA>;
 my %m;
 
-foreach my $u ( [ "d", "dist/U"          ],
-               [ "m", "U"               ],
-               [ "g", "dist-git/mcon/U" ],
+foreach my $u ( [ "g", "dist-git/mcon/U" ],
+               [ "d", "dist/U"          ],
+               [ "p", "U"               ],
                ) {
     my ($t, $dir) = @$u;
     find (sub {
@@ -37,29 +48,92 @@ foreach my $u ( [ "d", "dist/U"          ],
        m/\.U$/ or  return;
        m{$pat} or  return;
 
+       $exempt{$_} and return;
+
        my $u = do { local (@ARGV, $/) = $_; <> };
-       $m{$_}{$t} = [ $File::Find::dir, $u, length ($u), ($u =~ tr/\n/\n/) ];
+       $m{$_}{$t} = {
+           dir   => $File::Find::dir,
+           unit  => $u,
+           size  => length ($u),
+           lines => ($u =~ tr/\n/\n/),
+           };
        }, $dir);
     }
 
+foreach my $u (keys %m) {
+    my $g = $m{$u}{g};
+    my $d = $m{$u}{d};
+    my $p = $m{$u}{p};
+
+    $m{$u}{gd} = $g && $d ? length diff (\$g->{unit}, \$d->{unit}) : 0;
+    $m{$u}{dp} = $d && $p ? length diff (\$d->{unit}, \$p->{unit}) : 0;
+    $m{$u}{gp} = $g && $p ? length diff (\$g->{unit}, \$p->{unit}) : 0;
+    }
+
 $opt_d //= "";
 
 say "  #     Git             Dist              Perl    Diff Unit";
 say "=== ========= ====== ========= ====== ========= ====== ======================";
 my $i = 1;
-foreach my $u (sort keys %m) {
+foreach my $u (sort { $m{$b}{gd} <=> $m{$a}{gd} || $m{$b}{dp} <=> $m{$a}{dp} } keys %m) {
     my $d = $m{$u}{d} or next;
-    my $m = $m{$u}{m} or next;
+    my $p = $m{$u}{p} or next;
     my $g = $m{$u}{g} or next;
 
+    my $gd = $m{$u}{gd};
+    my $dp = $m{$u}{dp};
+    my $gp = $m{$u}{gp};
+
+    #$gd == 0 || $gd > 1000 and next;
+
+    if ($opt_p) {
+       $d->{unit} =~ $opt_p ||
+       $p->{unit} =~ $opt_p ||
+       $g->{unit} =~ $opt_p or next;
+       }
+
+    my $su = $u;
+    $gd || $dp || $gp or $su .= "\t** NO CHANGES LEFT **";
     printf "%3d %5d/%3d %6d %5d/%3d %6d %5d/%3d %6d %s\n", $i++,
-       $g->[2], $g->[3], length (diff (\$g->[1], \$d->[1])),
-       $d->[2], $d->[3], length (diff (\$d->[1], \$m->[1])),
-       $m->[2], $m->[3], length (diff (\$g->[1], \$m->[1])),
-       $u;
-    $opt_l and say "    $m{$u}{$_}[0]/$u" for qw( g d m );
-
-    $opt_d eq "dm" and system "diff", "-w", "$d->[0]/$u", "$m->[0]/$u";
-    $opt_d eq "dg" and system "diff", "-w", "$d->[0]/$u", "$g->[0]/$u";
-    $opt_d eq "gm" and system "diff", "-w", "$g->[0]/$u", "$m->[0]/$u";
+       $g->{size}, $g->{lines}, $gd,
+       $d->{size}, $d->{lines}, $dp,
+       $p->{size}, $p->{lines}, $gp,
+       $su;
+    $opt_l and say "    $_ $m{$u}{$_}{dir}/$u" for qw( g d p );
+
+    extdiff ($u, sort split // => $opt_d);
     }
+
+sub extdiff {
+    my ($u, $from, $to) = (@_, "", "");
+
+    my $f = $m{$u}{$from} or return;
+    my $t = $m{$u}{$to}   or return;
+
+    my %tag = (
+       g => "git",
+       d => "dst",
+       p => "prl",
+       );
+    my $F = $tag{$from};
+    my $T = $tag{$to};
+
+    my $ff = "$f->{dir}/$u";
+    my $tf = "$t->{dir}/$u";
+
+    if ($opt_c) {
+       unlink $ff;
+       system "cp", "-fp", $tf, $ff;
+       }
+
+    open my $fh, "-|", "diff $opt_D $ff $tf";
+    while (<$fh>) {
+       s/^</$F </;
+       s/^>/$T >/;
+       print;
+       }
+    close $fh;
+    } # extdiff
+
+__END__
+package.U      Will never be equal due to conflicting needs