Compare two issues of 'what's cooking'

diff --git a/compare-cooking.perl b/compare-cooking.perl
new file mode 100755 (executable)
index 0000000..2ec6c95
--- /dev/null
+++ b/compare-cooking.perl
@@ -0,0 +1,293 @@
+#!/usr/bin/perl -w
+
+my ($old, $new);
+
+if (@ARGV == 7) {
+       # called as GIT_EXTERNAL_DIFF script
+       $old = parse_cooking($ARGV[1]);
+       $new = parse_cooking($ARGV[4]);
+} else {
+       # called with old and new
+       $old = parse_cooking($ARGV[0]);
+       $new = parse_cooking($ARGV[1]);
+}
+compare_cooking($old, $new);
+
+################################################################
+
+use File::Temp qw(tempfile);
+
+sub compare_them {
+       local($_);
+       my ($a, $b, $force, $soft) = @_;
+
+       if ($soft) {
+               $plus = $minus = ' ';
+       } else {
+               $plus = '+';
+               $minus = '-';
+       }
+
+       if (!defined $a->[0]) {
+               return map { "$plus$_\n" } map { split(/\n/) } @{$b};
+       } elsif (!defined $b->[0]) {
+               return map { "$minus$_\n" } map { split(/\n/) } @{$a};
+       } elsif (join('', @$a) eq join('', @$b)) {
+               if ($force) {
+                       return map { " $_\n" } map { split(/\n/) } @{$a};
+               } else {
+                       return ();
+               }
+       }
+       my ($ah, $aname) = tempfile();
+       my ($bh, $bname) = tempfile();
+       my $cnt = 0;
+       my @result = ();
+       for (@$a) {
+               print $ah $_;
+               $cnt += tr/\n/\n/;
+       }
+       for (@$b) {
+               print $bh $_;
+               $cnt += tr/\n/\n/;
+       }
+       close $ah;
+       close $bh;
+       open(my $fh, "-|", 'diff', "-U$cnt", $aname, $bname);
+       $cnt = 0;
+       while (<$fh>) {
+               next if ($cnt++ < 3);
+               push @result, $_;
+       }
+       close $fh;
+       unlink ($aname, $bname);
+       return @result;
+}
+
+sub flush_topic {
+       my ($cooking, $name, $desc) = @_;
+       my $section = $cooking->{SECTIONS}[-1];
+
+       return if (!defined $name);
+
+       $desc =~ s/\s+\Z/\n/s;
+       $desc =~ s/\A\s+//s;
+       my $topic = +{
+               IN_SECTION => $section,
+               NAME => $name,
+               DESC => $desc,
+       };
+       $cooking->{TOPICS}{$name} = $topic;
+       push @{$cooking->{TOPIC_ORDER}}, $name;
+}
+
+sub parse_section {
+       my ($cooking, @line) = @_;
+
+       while (@line && $line[-1] =~ /^\s*$/) {
+               pop @line;
+       }
+       return if (!@line);
+
+       if (!exists $cooking->{SECTIONS}) {
+               $cooking->{SECTIONS} = [];
+               $cooking->{TOPICS} = {};
+               $cooking->{TOPIC_ORDER} = [];
+       }
+       if (!exists $cooking->{HEADER}) {
+               my $line = join('', @line);
+               $line =~ s/\A.*?\n\n//s;
+               $cooking->{HEADER} = $line;
+               return;
+       }
+       if (!exists $cooking->{GREETING}) {
+               $cooking->{GREETING} = join('', @line);
+               return;
+       }
+
+       my ($section_name, $topic_name, $topic_desc);
+       for (@line) {
+               if (!defined $section_name && /^\[(.*)\]$/) {
+                       $section_name = $1;
+                       push @{$cooking->{SECTIONS}}, $section_name;
+                       next;
+               }
+               if (/^\* (\S+) /) {
+                       my $next_name = $1;
+                       flush_topic($cooking, $topic_name, $topic_desc);
+                       $topic_name = $next_name;
+                       $topic_desc = '';
+               }
+               $topic_desc .= $_;
+       }
+       flush_topic($cooking, $topic_name, $topic_desc);
+}
+
+sub dump_cooking {
+       my ($cooking) = @_;
+       print $cooking->{HEADER};
+       print "-" x 50, "\n";
+       print $cooking->{GREETING};
+       for my $section_name (@{$cooking->{SECTIONS}}) {
+               print "\n", "-" x 50, "\n";
+               print "[$section_name]\n";
+               for my $topic_name (@{$cooking->{TOPIC_ORDER}}) {
+                       $topic = $cooking->{TOPICS}{$topic_name};
+                       next if ($topic->{IN_SECTION} ne $section_name);
+                       print "\n", $topic->{DESC};
+               }
+       }
+}
+
+sub parse_cooking {
+       my ($filename) = @_;
+       my (%cooking, @current, $fh);
+       open $fh, "<", $filename
+           or die "cannot open $filename: $!";
+       while (<$fh>) {
+               if (/^-{30,}$/) {
+                       parse_section(\%cooking, @current);
+                       @current = ();
+                       next;
+               }
+               push @current, $_;
+       }
+       close $fh;
+       parse_section(\%cooking, @current);
+
+       return \%cooking;
+}
+
+sub compare_topics {
+       my ($a, $b) = @_;
+       if (!@$a || !@$b) {
+               print compare_them($a, $b, 1, 1);
+               return;
+       }
+
+       # otherwise they both have title.
+       $a = [map { "$_\n" } split(/\n/, join('', @$a))];
+       $b = [map { "$_\n" } split(/\n/, join('', @$b))];
+       my $atitle = shift @$a;
+       my $btitle = shift @$b;
+       print compare_them([$atitle], [$btitle], 1);
+
+       my (@atail, @btail);
+       while (@$a && $a->[-1] !~ /^\s/) {
+               unshift @atail, pop @$a;
+       }
+       while (@$b && $b->[-1] !~ /^\s/) {
+               unshift @btail, pop @$b;
+       }
+       print compare_them($a, $b);
+       print compare_them(\@atail, \@btail);
+}
+
+sub compare_class {
+       my ($fromto, $names, $topics) = @_;
+
+       my (@where, %where);
+       for my $name (@$names) {
+               my $t = $topics->{$name};
+               my ($a, $b, $in, $force);
+               if ($t->{OLD} && $t->{NEW}) {
+                       $a = [$t->{OLD}{DESC}];
+                       $b = [$t->{NEW}{DESC}];
+                       if ($t->{OLD}{IN_SECTION} ne $t->{NEW}{IN_SECTION}) {
+                               $force = 1;
+                               $in = '';
+                       } else {
+                               $in = "[$t->{NEW}{IN_SECTION}]";
+                       }
+               } elsif ($t->{OLD}) {
+                       $a = [$t->{OLD}{DESC}];
+                       $b = [];
+                       $in = "Was in [$t->{OLD}{IN_SECTION}]";
+               } else {
+                       $a = [];
+                       $b = [$t->{NEW}{DESC}];
+                       $in = "[$t->{NEW}{IN_SECTION}]";
+               }
+               next if (defined $a->[0] &&
+                        defined $b->[0] &&
+                        $a->[0] eq $b->[0] && !$force);
+
+               if (!exists $where{$in}) {
+                       push @where, $in;
+                       $where{$in} = [];
+               }
+               push @{$where{$in}}, [$a, $b];
+       }
+
+       return if (!@where);
+       for my $in (@where) {
+               my @bag = @{$where{$in}};
+               if (defined $fromto && $fromto ne '') {
+                       print "\n", '-' x 50, "\n$fromto\n";
+                       $fromto = undef;
+               }
+               print "\n$in\n" if ($in ne '');
+               for (@bag) {
+                       my ($a, $b) = @{$_};
+                       print "\n";
+                       compare_topics($a, $b);
+               }
+       }
+}
+
+sub compare_cooking {
+       my ($old, $new) = @_;
+
+       print compare_them([$old->{HEADER}], [$new->{HEADER}]);
+       print compare_them([$old->{GREETING}], [$new->{GREETING}]);
+
+       my (@sections, %sections, @topics, %topics, @fromto, %fromto);
+
+       for my $section_name (@{$old->{SECTIONS}}, @{$new->{SECTIONS}}) {
+               next if (exists $sections{$section_name});
+               $sections{$section_name} = scalar @sections;
+               push @sections, $section_name;
+       }
+
+       my $gone_class = "Gone topics";
+       my $born_class = "Born topics";
+       my $stay_class = "Other topics";
+
+       push @fromto, $born_class;
+       for my $topic_name (@{$old->{TOPIC_ORDER}}, @{$new->{TOPIC_ORDER}}) {
+               next if (exists $topics{$topic_name});
+               push @topics, $topic_name;
+
+               my $oldtopic = $old->{TOPICS}{$topic_name};
+               my $newtopic = $new->{TOPICS}{$topic_name};
+               $topics{$topic_name} = +{
+                       OLD => $oldtopic,
+                       NEW => $newtopic,
+               };
+               my $oldsec = $oldtopic->{IN_SECTION};
+               my $newsec = $newtopic->{IN_SECTION};
+               if (defined $oldsec && defined $newsec) {
+                       if ($oldsec ne $newsec) {
+                               my $fromto =
+                                   "Moved from [$oldsec] to [$newsec]";
+                               if (!exists $fromto{$fromto}) {
+                                       $fromto{$fromto} = [];
+                                       push @fromto, $fromto;
+                               }
+                               push @{$fromto{$fromto}}, $topic_name;
+                       } else {
+                               push @{$fromto{$stay_class}}, $topic_name;
+                       }
+               } elsif (defined $oldsec) {
+                       push @{$fromto{$gone_class}}, $topic_name;
+               } else {
+                       push @{$fromto{$born_class}}, $topic_name;
+               }
+       }
+       push @fromto, $stay_class;
+       push @fromto, $gone_class;
+
+       for my $fromto (@fromto) {
+               compare_class($fromto, $fromto{$fromto}, \%topics);
+       }
+}