path: root/UWC

#!/usr/bin/perl -w
#
# Update an older edition of What's Cooking with the latest data.
#
# Usage: UWC [--keep-master] [ old [ new ] ]
#
# Giving no parameter is the same as giving a single "-" to the command.
#
# The command reads the old edition of (annotated) "What's Cooking"
# message from "old", and "new".  If "old" is "-", it is read from
# the standard input.  If "new" is not specified, WC script is run
# and its output is used.
#
# An annotated "What's Cooking" message can have group header (a line
# that has the group name enclosed in "[" and "]"), and annotatation
# paragraphs after each topic's commit list, in addition to the bare
# "WC" output.
#
# The group headers, topics in each group and their order in the group,
# and annotation to topics are preserved from the "old" message.  The
# list of commits in each topic is replaced with the one taken from the
# "new" message.  Any topic in "new" that did not exist in "old" appear
# in "New Topics" group.  Also, topics that do not appear in the "new"
# message are marked with <<deleted>>, topics whose commit list are
# different from "old" are marked with <<updated from...>>>.
#
# Typically the maintainer would place the What's Cooking message
# previously sent in a buffer in Emacs, and filter the buffer contents
# with this script, to prepare an up-to-date message.

my $keep_master = 1;

sub parse_whats_cooking {
	my ($fh) = @_;
	my $head = undef;
	my $group = undef;
	my %wc = ("group list" => [], "topic hash" => {});
	my $topic;
	my $skipping_comment = 0;

	while (<$fh>) {
		if (/^-{40,}$/) {
			# Group separator
			next;
		}

		if (!defined $head) {
			if (/^Here are the topics that have been/) {
				$head = $_;
			}
			next;
		}

		if (/^<<.*>>$/) {
			next;
		}

		if ($skipping_comment) {
			if (/^>>$/) {
				$skipping_comment = 0;
			}
			next;
		}

		if (!$skipping_comment && /^<</) {
			$skipping_comment = 1;
			next;
		}

		if (/^\[(.*)\]$/) {
			$group = $1;
			push @{$wc{"group list"}}, $group;
			$wc{" $group"} = [];
			$topic = undef;
			next;
		}

		if (!defined $group) {
			if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
				# raw output
				$group = "Misc";
				push @{$wc{"group list"}}, $group;
				$wc{" $group"} = [];
			} else {
				$head .= $_;
				next;
			}
		}

		if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
			$topic = +{
				topic => $1,
				head => $_,
				names => "",
				text => "",
			};
			$wc{"topic hash"}{$topic->{"topic"}} = $topic;
			push @{$wc{" $group"}}, $topic;
			next;
		}

		if (/^ [-+.?*] / || /^   \S/) {
			$topic->{"names"} .= $_;
			next;
		}
		$topic->{"text"} .= $_;
	}

	for ($head) {
		s/\A\s+//s;
		s/\s+\Z//s;
	}
	$wc{"head text"} = $head;
	for $topic (values %{$wc{"topic hash"}}) {
		for ($topic->{"text"}) {
			s/\A\s+//s;
			s/\s+\Z//s;
		}
	}
	return \%wc;
}

sub print_whats_cooking {
	my ($wc) = @_;

	print $wc->{"head text"}, "\n";

	for my $group (@{$wc->{"group list"}}) {
		print "\n", "-" x 64, "\n";
		print "[$group]\n";
		for my $topic (@{$wc->{" $group"}}) {
			next if ($topic->{"head"} eq '');
			print "\n", $topic->{"head"};
			print $topic->{"names"};
			if ($topic->{"text"} ne '') {
				print "\n", $topic->{"text"}, "\n";
			}
		}
	}
}

sub delete_topic {
	my ($wc, $topic) = @_;
	$topic->{"status"} = "deleted";
}

sub merge_whats_cooking {
	my ($old_wc, $new_wc) = @_;
	my $group;
	my @gone = ();

	for $group (@{$old_wc->{"group list"}}) {
		for my $topic (@{$old_wc->{" $group"}}) {
			my $name = $topic->{"topic"};
			my $newtopic = delete $new_wc->{"topic hash"}{$name};

			if (!defined $newtopic) {
				push @gone, +{ @{[ %$topic ]} };
				$topic->{"text"} = "";
				$topic->{"names"} = "";
				$topic->{"head"} = "";
				next;
			}
			if (($newtopic->{"names"} ne $topic->{"names"}) ||
			    ($newtopic->{"head"} ne $topic->{"head"})) {
				my $text = ("<<updated from\n" .
					    $topic->{"head"} .
					    $topic->{"names"} . ">>");

				if ($topic->{"text"} ne '') {
					$text .= "\n\n" . $topic->{"text"};
				}
				for ($text) {
					s/\A\s+//s;
					s/\s+\Z//s;
				}
				$topic->{"text"} = $text;
				$topic->{"names"} = $newtopic->{"names"};
				$topic->{"head"} = $newtopic->{"head"};
			}
		}
	}


	$group = 'Graduated to "master"';
	if (!$keep_master) {
		print STDERR "Not Keeping Master\n";
		my $o = delete $old_wc->{" $group"};
		for (@$o) {
			print STDERR " Dropping: ", $_->{'topic'}, "\n";
		}
		print STDERR "Gone are\n";
		for (@gone) {
			print STDERR " Gone: ", $_->{'topic'}, "\n";
		}
	}
	if (@gone) {
		if (!exists $old_wc->{" $group"}) {
			unshift @{$old_wc->{"group list"}}, $group;
			$old_wc->{" $group"} = [];
		}
		push @{$old_wc->{" $group"}}, @gone;
	}
	if (%{$new_wc->{"topic hash"}}) {
		$group = "New Topics";
		if (!exists $old_wc->{" $group"}) {
			unshift @{$old_wc->{"group list"}}, $group;
			$old_wc->{" $group"} = [];
		}
		for my $topic (values %{$new_wc->{"topic hash"}}) {
			my $name = $topic->{"topic"};
			$old_wc->{"topic hash"}{$name} = $topic;
			push @{$old_wc->{" $group"}}, $topic;
			$topic->{"text"} = $topic->{"text"};
		}
	}
}

if (@ARGV == 0) {
	@ARGV = ('-');
} elsif ($ARGV[0] eq '--keep-master') {
	$keep_master = 1;
	shift;
}
if (@ARGV != 2 && @ARGV != 1) {
	die "Usage: $0 old [new]\n";
}

my ($old_wc, $new_wc);

if ($ARGV[0] eq '-') {
	*FH = *STDIN;
} else {
	open FH, "$ARGV[0]";
}
$old_wc = parse_whats_cooking(\*FH);
close FH;

if (@ARGV > 1) {
	open FH, "$ARGV[1]";
} else {
	open FH, "Meta/WC generate |";
}
$new_wc = parse_whats_cooking(\*FH);
close FH;

merge_whats_cooking($old_wc, $new_wc);
print_whats_cooking($old_wc);