This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix ups for README
[metaconfig.git] / ls-diff.pl
CommitLineData
6092c506 1#!/usr/bin/perl
18be95c2
MBT
2
3use 5.18.2;
4use warnings;
5
b3aab7a5 6our $VERSION = "0.03";
18be95c2
MBT
7
8sub usage {
9 my $err = shift and select STDERR;
0aad8594 10 say "usage: $0 [--list] [--diff[=gd|dp|gp]] [--diff-flags=--whatever] [--pat=pattern]";
d8dafc80
MBT
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";
18be95c2
MBT
15 exit $err;
16 } # usage
17
18use File::Find;
19use Text::Diff;
20use Getopt::Long qw(:config bundling);
21GetOptions (
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,
0aad8594 27 "D|diff-flags=s" => \my $opt_D,
c6667804 28 "c|copy" => \my $opt_c,
b3aab7a5
MBT
29
30 "p|pat=s" => \my $opt_p,
18be95c2
MBT
31 ) or usage (1);
32
0aad8594
NT
33$opt_D //= "-w";
34
18be95c2
MBT
35my $pat = shift // ".";
36$pat = qr{$pat};
37
ca5f6937 38my %exempt = map {( s/[\s\n].*\z//rs => 1 )} <DATA>;
18be95c2
MBT
39my %m;
40
d8dafc80
MBT
41foreach my $u ( [ "g", "dist-git/mcon/U" ],
42 [ "d", "dist/U" ],
43 [ "p", "U" ],
18be95c2
MBT
44 ) {
45 my ($t, $dir) = @$u;
46 find (sub {
47 -l $_ and return;
48 m/\.U$/ or return;
49 m{$pat} or return;
50
ca5f6937
MBT
51 $exempt{$_} and return;
52
18be95c2 53 my $u = do { local (@ARGV, $/) = $_; <> };
c6667804
MBT
54 $m{$_}{$t} = {
55 dir => $File::Find::dir,
56 unit => $u,
57 size => length ($u),
58 lines => ($u =~ tr/\n/\n/),
59 };
18be95c2
MBT
60 }, $dir);
61 }
62
d8dafc80
MBT
63foreach 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
18be95c2
MBT
73$opt_d //= "";
74
75say " # Git Dist Perl Diff Unit";
76say "=== ========= ====== ========= ====== ========= ====== ======================";
77my $i = 1;
d8dafc80 78foreach my $u (sort { $m{$b}{gd} <=> $m{$a}{gd} || $m{$b}{dp} <=> $m{$a}{dp} } keys %m) {
18be95c2 79 my $d = $m{$u}{d} or next;
d8dafc80 80 my $p = $m{$u}{p} or next;
18be95c2
MBT
81 my $g = $m{$u}{g} or next;
82
d8dafc80
MBT
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;
c6667804 88
b3aab7a5
MBT
89 if ($opt_p) {
90 $d->{unit} =~ $opt_p ||
91 $p->{unit} =~ $opt_p ||
92 $g->{unit} =~ $opt_p or next;
93 }
94
87605c81
MBT
95 my $su = $u;
96 $gd || $dp || $gp or $su .= "\t** NO CHANGES LEFT **";
18be95c2 97 printf "%3d %5d/%3d %6d %5d/%3d %6d %5d/%3d %6d %s\n", $i++,
c6667804 98 $g->{size}, $g->{lines}, $gd,
d8dafc80
MBT
99 $d->{size}, $d->{lines}, $dp,
100 $p->{size}, $p->{lines}, $gp,
87605c81 101 $su;
d8dafc80 102 $opt_l and say " $_ $m{$u}{$_}{dir}/$u" for qw( g d p );
c6667804
MBT
103
104 extdiff ($u, sort split // => $opt_d);
18be95c2 105 }
c6667804
MBT
106
107sub 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 = (
c6667804 114 g => "git",
d8dafc80
MBT
115 d => "dst",
116 p => "prl",
c6667804
MBT
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
0aad8594 129 open my $fh, "-|", "diff $opt_D $ff $tf";
c6667804
MBT
130 while (<$fh>) {
131 s/^</$F </;
132 s/^>/$T >/;
133 print;
134 }
135 close $fh;
136 } # extdiff
ca5f6937
MBT
137
138__END__
139package.U Will never be equal due to conflicting needs