Commit | Line | Data |
---|---|---|
6092c506 | 1 | #!/usr/bin/perl |
18be95c2 MBT |
2 | |
3 | use 5.18.2; | |
4 | use warnings; | |
5 | ||
b3aab7a5 | 6 | our $VERSION = "0.03"; |
18be95c2 MBT |
7 | |
8 | sub 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 | ||
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, | |
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 |
35 | my $pat = shift // "."; |
36 | $pat = qr{$pat}; | |
37 | ||
ca5f6937 | 38 | my %exempt = map {( s/[\s\n].*\z//rs => 1 )} <DATA>; |
18be95c2 MBT |
39 | my %m; |
40 | ||
d8dafc80 MBT |
41 | foreach 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 |
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 | ||
18be95c2 MBT |
73 | $opt_d //= ""; |
74 | ||
75 | say " # Git Dist Perl Diff Unit"; | |
76 | say "=== ========= ====== ========= ====== ========= ====== ======================"; | |
77 | my $i = 1; | |
d8dafc80 | 78 | foreach 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 | |
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 = ( | |
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__ | |
139 | package.U Will never be equal due to conflicting needs |