ls-diff.pl

   1 #!/usr/bin/perl
   2
   3 use 5.18.2;
   4 use warnings;
   5
   6 our $VERSION = "0.03";
   7
   8 sub usage {
   9     my $err = shift and select STDERR;
  10     say "usage: $0 [--list] [--diff[=gd|dp|gp]] [--diff-flags=--whatever] [--pat=pattern]";
  11     say "  diff (size) between git / dist / perl";
  12     say "  where git  (g) is the version from the git repo of meta/dist";
  13     say "  where dist (d) is the unmodified installed version from dist";
  14     say "  where perl (p) is the *modified* version for use with perl";
  15     exit $err;
  16     } # usage
  17
  18 use File::Find;
  19 use Text::Diff;
  20 use Getopt::Long qw(:config bundling);
  21 GetOptions (
  22     "help|?"    => sub { usage (0); },
  23     "V|version" => sub { say $0 =~ s{.*/}{}r, " [$VERSION]"; exit 0; },
  24
  25     "l|list!"   => \my $opt_l,
  26     "d|diff=s"  => \my $opt_d,
  27     "D|diff-flags=s"    => \my $opt_D,
  28     "c|copy"    => \my $opt_c,
  29
  30     "p|pat=s"   => \my $opt_p,
  31     ) or usage (1);
  32
  33 $opt_D //= "-w";
  34
  35 my $pat = shift // ".";
  36 $pat = qr{$pat};
  37
  38 my %exempt = map {( s/[\s\n].*\z//rs => 1 )} <DATA>;
  39 my %m;
  40
  41 foreach my $u ( [ "g", "dist-git/mcon/U" ],
  42                 [ "d", "dist/U"          ],
  43                 [ "p", "U"               ],
  44                 ) {
  45     my ($t, $dir) = @$u;
  46     find (sub {
  47         -l $_   and return;
  48         m/\.U$/ or  return;
  49         m{$pat} or  return;
  50
  51         $exempt{$_} and return;
  52
  53         my $u = do { local (@ARGV, $/) = $_; <> };
  54         $m{$_}{$t} = {
  55             dir   => $File::Find::dir,
  56             unit  => $u,
  57             size  => length ($u),
  58             lines => ($u =~ tr/\n/\n/),
  59             };
  60         }, $dir);
  61     }
  62
  63 foreach my $u (keys %m) {
  64     my $g = $m{$u}{g};
  65     my $d = $m{$u}{d};
  66     my $p = $m{$u}{p};
  67
  68     $m{$u}{gd} = $g && $d ? length diff (\$g->{unit}, \$d->{unit}) : 0;
  69     $m{$u}{dp} = $d && $p ? length diff (\$d->{unit}, \$p->{unit}) : 0;
  70     $m{$u}{gp} = $g && $p ? length diff (\$g->{unit}, \$p->{unit}) : 0;
  71     }
  72
  73 $opt_d //= "";
  74
  75 say "  #     Git             Dist              Perl    Diff Unit";
  76 say "=== ========= ====== ========= ====== ========= ====== ======================";
  77 my $i = 1;
  78 foreach my $u (sort { $m{$b}{gd} <=> $m{$a}{gd} || $m{$b}{dp} <=> $m{$a}{dp} } keys %m) {
  79     my $d = $m{$u}{d} or next;
  80     my $p = $m{$u}{p} or next;
  81     my $g = $m{$u}{g} or next;
  82
  83     my $gd = $m{$u}{gd};
  84     my $dp = $m{$u}{dp};
  85     my $gp = $m{$u}{gp};
  86
  87     #$gd == 0 || $gd > 1000 and next;
  88
  89     if ($opt_p) {
  90         $d->{unit} =~ $opt_p ||
  91         $p->{unit} =~ $opt_p ||
  92         $g->{unit} =~ $opt_p or next;
  93         }
  94
  95     my $su = $u;
  96     $gd || $dp || $gp or $su .= "\t** NO CHANGES LEFT **";
  97     printf "%3d %5d/%3d %6d %5d/%3d %6d %5d/%3d %6d %s\n", $i++,
  98         $g->{size}, $g->{lines}, $gd,
  99         $d->{size}, $d->{lines}, $dp,
 100         $p->{size}, $p->{lines}, $gp,
 101         $su;
 102     $opt_l and say "    $_ $m{$u}{$_}{dir}/$u" for qw( g d p );
 103
 104     extdiff ($u, sort split // => $opt_d);
 105     }
 106
 107 sub extdiff {
 108     my ($u, $from, $to) = (@_, "", "");
 109
 110     my $f = $m{$u}{$from} or return;
 111     my $t = $m{$u}{$to}   or return;
 112
 113     my %tag = (
 114         g => "git",
 115         d => "dst",
 116         p => "prl",
 117         );
 118     my $F = $tag{$from};
 119     my $T = $tag{$to};
 120
 121     my $ff = "$f->{dir}/$u";
 122     my $tf = "$t->{dir}/$u";
 123
 124     if ($opt_c) {
 125         unlink $ff;
 126         system "cp", "-fp", $tf, $ff;
 127         }
 128
 129     open my $fh, "-|", "diff $opt_D $ff $tf";
 130     while (<$fh>) {
 131         s/^</$F </;
 132         s/^>/$T >/;
 133         print;
 134         }
 135     close $fh;
 136     } # extdiff
 137
 138 __END__
 139 package.U       Will never be equal due to conflicting needs