What's cooking (2013/11 #05)

[alt-git.git] / 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);