Meta/Dothem: no need to retest if only documentation changed
[alt-git.git] / compare-cooking.perl
blob018268a92a43638dd458626bd5370b2707d7b84f
1 #!/usr/bin/perl -w
3 $SIG{'PIPE'} = 'IGNORE';
5 my ($old, $new);
7 if (@ARGV == 7) {
8 # called as GIT_EXTERNAL_DIFF script
9 $old = parse_cooking($ARGV[1]);
10 $new = parse_cooking($ARGV[4]);
11 } else {
12 # called with old and new
13 $old = parse_cooking($ARGV[0]);
14 $new = parse_cooking($ARGV[1]);
16 compare_cooking($old, $new);
18 ################################################################
20 use File::Temp qw(tempfile);
22 sub compare_them {
23 local($_);
24 my ($a, $b, $force, $soft) = @_;
26 if ($soft) {
27 $plus = $minus = ' ';
28 } else {
29 $plus = '+';
30 $minus = '-';
33 if (!defined $a->[0]) {
34 return map { "$plus$_\n" } map { split(/\n/) } @{$b};
35 } elsif (!defined $b->[0]) {
36 return map { "$minus$_\n" } map { split(/\n/) } @{$a};
37 } elsif (join('', @$a) eq join('', @$b)) {
38 if ($force) {
39 return map { " $_\n" } map { split(/\n/) } @{$a};
40 } else {
41 return ();
44 my ($ah, $aname) = tempfile();
45 my ($bh, $bname) = tempfile();
46 my $cnt = 0;
47 my @result = ();
48 for (@$a) {
49 print $ah $_;
50 $cnt += tr/\n/\n/;
52 for (@$b) {
53 print $bh $_;
54 $cnt += tr/\n/\n/;
56 close $ah;
57 close $bh;
58 open(my $fh, "-|", 'diff', "-U$cnt", $aname, $bname);
59 $cnt = 0;
60 while (<$fh>) {
61 next if ($cnt++ < 3);
62 push @result, $_;
64 close $fh;
65 unlink ($aname, $bname);
66 return @result;
69 sub flush_topic {
70 my ($cooking, $name, $desc) = @_;
71 my $section = $cooking->{SECTIONS}[-1];
73 return if (!defined $name);
75 $desc =~ s/\s+\Z/\n/s;
76 $desc =~ s/\A\s+//s;
77 my $topic = +{
78 IN_SECTION => $section,
79 NAME => $name,
80 DESC => $desc,
82 $cooking->{TOPICS}{$name} = $topic;
83 push @{$cooking->{TOPIC_ORDER}}, $name;
86 sub parse_section {
87 my ($cooking, @line) = @_;
89 while (@line && $line[-1] =~ /^\s*$/) {
90 pop @line;
92 return if (!@line);
94 if (!exists $cooking->{SECTIONS}) {
95 $cooking->{SECTIONS} = [];
96 $cooking->{TOPICS} = {};
97 $cooking->{TOPIC_ORDER} = [];
99 if (!exists $cooking->{HEADER}) {
100 my $line = join('', @line);
101 $line =~ s/\A.*?\n\n//s;
102 $cooking->{HEADER} = $line;
103 return;
105 if (!exists $cooking->{GREETING}) {
106 $cooking->{GREETING} = join('', @line);
107 return;
110 my ($section_name, $topic_name, $topic_desc);
111 for (@line) {
112 if (!defined $section_name && /^\[(.*)\]$/) {
113 $section_name = $1;
114 push @{$cooking->{SECTIONS}}, $section_name;
115 next;
117 if (/^\* (\S+) /) {
118 my $next_name = $1;
119 flush_topic($cooking, $topic_name, $topic_desc);
120 $topic_name = $next_name;
121 $topic_desc = '';
123 $topic_desc .= $_;
125 flush_topic($cooking, $topic_name, $topic_desc);
128 sub dump_cooking {
129 my ($cooking) = @_;
130 print $cooking->{HEADER};
131 print "-" x 50, "\n";
132 print $cooking->{GREETING};
133 for my $section_name (@{$cooking->{SECTIONS}}) {
134 print "\n", "-" x 50, "\n";
135 print "[$section_name]\n";
136 for my $topic_name (@{$cooking->{TOPIC_ORDER}}) {
137 $topic = $cooking->{TOPICS}{$topic_name};
138 next if ($topic->{IN_SECTION} ne $section_name);
139 print "\n", $topic->{DESC};
144 sub parse_cooking {
145 my ($filename) = @_;
146 my (%cooking, @current, $fh);
147 open $fh, "<", $filename
148 or die "cannot open $filename: $!";
149 while (<$fh>) {
150 if (/^-{30,}$/) {
151 parse_section(\%cooking, @current);
152 @current = ();
153 next;
155 push @current, $_;
157 close $fh;
158 parse_section(\%cooking, @current);
160 return \%cooking;
163 sub compare_topics {
164 my ($a, $b) = @_;
165 if (!@$a || !@$b) {
166 print compare_them($a, $b, 1, 1);
167 return;
170 # otherwise they both have title.
171 $a = [map { "$_\n" } split(/\n/, join('', @$a))];
172 $b = [map { "$_\n" } split(/\n/, join('', @$b))];
173 my $atitle = shift @$a;
174 my $btitle = shift @$b;
175 print compare_them([$atitle], [$btitle], 1);
177 my (@atail, @btail);
178 while (@$a && $a->[-1] !~ /^\s/) {
179 unshift @atail, pop @$a;
181 while (@$b && $b->[-1] !~ /^\s/) {
182 unshift @btail, pop @$b;
184 print compare_them($a, $b);
185 print compare_them(\@atail, \@btail);
188 sub compare_class {
189 my ($fromto, $names, $topics) = @_;
191 my (@where, %where);
192 for my $name (@$names) {
193 my $t = $topics->{$name};
194 my ($a, $b, $in, $force);
195 if ($t->{OLD} && $t->{NEW}) {
196 $a = [$t->{OLD}{DESC}];
197 $b = [$t->{NEW}{DESC}];
198 if ($t->{OLD}{IN_SECTION} ne $t->{NEW}{IN_SECTION}) {
199 $force = 1;
200 $in = '';
201 } else {
202 $in = "[$t->{NEW}{IN_SECTION}]";
204 } elsif ($t->{OLD}) {
205 $a = [$t->{OLD}{DESC}];
206 $b = [];
207 $in = "Was in [$t->{OLD}{IN_SECTION}]";
208 } else {
209 $a = [];
210 $b = [$t->{NEW}{DESC}];
211 $in = "[$t->{NEW}{IN_SECTION}]";
213 next if (defined $a->[0] &&
214 defined $b->[0] &&
215 $a->[0] eq $b->[0] && !$force);
217 if (!exists $where{$in}) {
218 push @where, $in;
219 $where{$in} = [];
221 push @{$where{$in}}, [$a, $b];
224 return if (!@where);
225 for my $in (@where) {
226 my @bag = @{$where{$in}};
227 if (defined $fromto && $fromto ne '') {
228 print "\n", '-' x 50, "\n$fromto\n";
229 $fromto = undef;
231 print "\n$in\n" if ($in ne '');
232 for (@bag) {
233 my ($a, $b) = @{$_};
234 print "\n";
235 compare_topics($a, $b);
240 sub compare_cooking {
241 my ($old, $new) = @_;
243 print compare_them([$old->{HEADER}], [$new->{HEADER}]);
244 print compare_them([$old->{GREETING}], [$new->{GREETING}]);
246 my (@sections, %sections, @topics, %topics, @fromto, %fromto);
248 for my $section_name (@{$old->{SECTIONS}}, @{$new->{SECTIONS}}) {
249 next if (exists $sections{$section_name});
250 $sections{$section_name} = scalar @sections;
251 push @sections, $section_name;
254 my $gone_class = "Gone topics";
255 my $born_class = "Born topics";
256 my $stay_class = "Other topics";
258 push @fromto, $born_class;
259 for my $topic_name (@{$old->{TOPIC_ORDER}}, @{$new->{TOPIC_ORDER}}) {
260 next if (exists $topics{$topic_name});
261 push @topics, $topic_name;
263 my $oldtopic = $old->{TOPICS}{$topic_name};
264 my $newtopic = $new->{TOPICS}{$topic_name};
265 $topics{$topic_name} = +{
266 OLD => $oldtopic,
267 NEW => $newtopic,
269 my $oldsec = $oldtopic->{IN_SECTION};
270 my $newsec = $newtopic->{IN_SECTION};
271 if (defined $oldsec && defined $newsec) {
272 if ($oldsec ne $newsec) {
273 my $fromto =
274 "Moved from [$oldsec] to [$newsec]";
275 if (!exists $fromto{$fromto}) {
276 $fromto{$fromto} = [];
277 push @fromto, $fromto;
279 push @{$fromto{$fromto}}, $topic_name;
280 } else {
281 push @{$fromto{$stay_class}}, $topic_name;
283 } elsif (defined $oldsec) {
284 push @{$fromto{$gone_class}}, $topic_name;
285 } else {
286 push @{$fromto{$born_class}}, $topic_name;
289 push @fromto, $stay_class;
290 push @fromto, $gone_class;
292 for my $fromto (@fromto) {
293 compare_class($fromto, $fromto{$fromto}, \%topics);