UWC

   1 #!/usr/bin/perl -w
   2 #
   3 # Update an older edition of What's Cooking with the latest data.
   4 #
   5 # Usage: UWC [ old [ new ] ]
   6 #
   7 # Giving no parameter is the same as giving a single "-" to the command.
   8 #
   9 # The command reads the old edition of (annotated) "What's Cooking"
  10 # message from "old", and "new".  If "old" is "-", it is read from
  11 # the standard input.  If "new" is not specified, WC script is run
  12 # and its output is used.
  13 #
  14 # An annotated "What's Cooking" message can have group header (a line
  15 # that has the group name enclosed in "[" and "]"), and annotatation
  16 # paragraphs after each topic's commit list, in addition to the bare
  17 # "WC" output.
  18 #
  19 # The group headers, topics in each group and their order in the group,
  20 # and annotation to topics are preserved from the "old" message.  The
  21 # list of commits in each topic is replaced with the one taken from the
  22 # "new" message.  Any topic in "new" that did not exist in "old" appear
  23 # in "New Topics" group.  Also, topics that do not appear in the "new"
  24 # message are marked with <<deleted>>, topics whose commit list are
  25 # different from "old" are marked with <<updated from...>>>.
  26 #
  27 # Typically the maintainer would place the What's Cooking message
  28 # previously sent in a buffer in Emacs, and filter the buffer contents
  29 # with this script, to prepare an up-to-date message.
  30
  31 sub parse_whats_cooking {
  32         my ($fh) = @_;
  33         my $head = undef;
  34         my $group = undef;
  35         my %wc = ("group list" => [], "topic hash" => {});
  36         my $topic;
  37         my $skipping_comment = 0;
  38
  39         while (<$fh>) {
  40                 if (/^-{40,}$/) {
  41                         # Group separator
  42                         next;
  43                 }
  44
  45                 if (!defined $head) {
  46                         if (/^Here are the topics that have been/) {
  47                                 $head = $_;
  48                         }
  49                         next;
  50                 }
  51
  52                 if (/^<<.*>>$/) {
  53                         next;
  54                 }
  55
  56                 if ($skipping_comment) {
  57                         if (/^>>$/) {
  58                                 $skipping_comment = 0;
  59                         }
  60                         next;
  61                 }
  62
  63                 if (!$skipping_comment && /^<</) {
  64                         $skipping_comment = 1;
  65                         next;
  66                 }
  67
  68                 if (/^\[(.*)\]$/) {
  69                         $group = $1;
  70                         push @{$wc{"group list"}}, $group;
  71                         $wc{" $group"} = [];
  72                         $topic = undef;
  73                         next;
  74                 }
  75
  76                 if (!defined $group) {
  77                         if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
  78                                 # raw output
  79                                 $group = "Misc";
  80                                 push @{$wc{"group list"}}, $group;
  81                                 $wc{" $group"} = [];
  82                         } else {
  83                                 $head .= $_;
  84                                 next;
  85                         }
  86                 }
  87
  88                 if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
  89                         $topic = +{
  90                                 topic => $1,
  91                                 head => $_,
  92                                 names => "",
  93                                 text => "",
  94                         };
  95                         $wc{"topic hash"}{$topic->{"topic"}} = $topic;
  96                         push @{$wc{" $group"}}, $topic;
  97                         next;
  98                 }
  99
 100                 if (/^ [-+.?*] / || /^   \S/) {
 101                         $topic->{"names"} .= $_;
 102                         next;
 103                 }
 104                 $topic->{"text"} .= $_;
 105         }
 106
 107         for ($head) {
 108                 s/\A\s+//s;
 109                 s/\s+\Z//s;
 110         }
 111         $wc{"head text"} = $head;
 112         for $topic (values %{$wc{"topic hash"}}) {
 113                 for ($topic->{"text"}) {
 114                         s/\A\s+//s;
 115                         s/\s+\Z//s;
 116                 }
 117         }
 118         return \%wc;
 119 }
 120
 121 sub print_whats_cooking {
 122         my ($wc) = @_;
 123
 124         print $wc->{"head text"}, "\n";
 125
 126         for my $group (@{$wc->{"group list"}}) {
 127                 print "\n", "-" x 64, "\n";
 128                 print "[$group]\n";
 129                 for my $topic (@{$wc->{" $group"}}) {
 130                         print "\n", $topic->{"head"};
 131                         print $topic->{"names"};
 132                         if ($topic->{"text"} ne '') {
 133                                 print "\n", $topic->{"text"}, "\n";
 134                         }
 135                 }
 136         }
 137 }
 138
 139 sub delete_topic {
 140         my ($wc, $topic) = @_;
 141         $topic->{"status"} = "deleted";
 142 }
 143
 144 sub merge_whats_cooking {
 145         my ($old_wc, $new_wc) = @_;
 146         my $group;
 147
 148         for $group (@{$old_wc->{"group list"}}) {
 149                 for my $topic (@{$old_wc->{" $group"}}) {
 150                         my $name = $topic->{"topic"};
 151                         my $newtopic = delete $new_wc->{"topic hash"}{$name};
 152
 153                         if (!defined $newtopic) {
 154                                 $topic->{"text"} = ("<<deleted\n" .
 155                                                     $topic->{"head"} .
 156                                                     $topic->{"names"} .
 157                                                     ">>\n\n" .
 158                                                     $topic->{"text"});
 159                                 $topic->{"names"} = "";
 160                                 next;
 161                         }
 162                         if (($newtopic->{"names"} ne $topic->{"names"}) ||
 163                             ($newtopic->{"head"} ne $topic->{"head"})) {
 164                                 my $text = ("<<updated from\n" .
 165                                             $topic->{"head"} .
 166                                             $topic->{"names"} . ">>");
 167
 168                                 if ($topic->{"text"} ne '') {
 169                                         $text .= "\n\n" . $topic->{"text"};
 170                                 }
 171                                 for ($text) {
 172                                         s/\A\s+//s;
 173                                         s/\s+\Z//s;
 174                                 }
 175                                 $topic->{"text"} = $text;
 176                                 $topic->{"names"} = $newtopic->{"names"};
 177                                 $topic->{"head"} = $newtopic->{"head"};
 178                         }
 179                 }
 180         }
 181
 182         if (%{$new_wc->{"topic hash"}}) {
 183                 $group = "New Topics";
 184                 if (!exists $old_wc->{" $group"}) {
 185                         unshift @{$old_wc->{"group list"}}, $group;
 186                         $old_wc->{" $group"} = [];
 187                 }
 188                 for my $topic (values %{$new_wc->{"topic hash"}}) {
 189                         my $name = $topic->{"topic"};
 190                         $old_wc->{"topic hash"}{$name} = $topic;
 191                         push @{$old_wc->{" $group"}}, $topic;
 192                         $topic->{"text"} = $topic->{"text"};
 193                 }
 194         }
 195 }
 196
 197 if (@ARGV == 0) {
 198         @ARGV = ('-');
 199 }
 200 if (@ARGV != 2 && @ARGV != 1) {
 201         die "Usage: $0 old [new]\n";
 202 }
 203
 204 my ($old_wc, $new_wc);
 205
 206 if ($ARGV[0] eq '-') {
 207         *FH = *STDIN;
 208 } else {
 209         open FH, "$ARGV[0]";
 210 }
 211 $old_wc = parse_whats_cooking(\*FH);
 212 close FH;
 213
 214 if (@ARGV > 1) {
 215         open FH, "$ARGV[1]";
 216 } else {
 217         open FH, "Meta/WC |";
 218 }
 219 $new_wc = parse_whats_cooking(\*FH);
 220 close FH;
 221
 222 merge_whats_cooking($old_wc, $new_wc);
 223 print_whats_cooking($old_wc);