git/compare-cooking.perl

#!/usr/bin/perl -w

$SIG{'PIPE'} = 'IGNORE';

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);
	}
}