What's in/cooking updates
[git] / 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                         next if ($topic->{"head"} eq '');
131                         print "\n", $topic->{"head"};
132                         print $topic->{"names"};
133                         if ($topic->{"text"} ne '') {
134                                 print "\n", $topic->{"text"}, "\n";
135                         }
136                 }
137         }
138 }
139
140 sub delete_topic {
141         my ($wc, $topic) = @_;
142         $topic->{"status"} = "deleted";
143 }
144
145 sub merge_whats_cooking {
146         my ($old_wc, $new_wc) = @_;
147         my $group;
148         my @gone = ();
149
150         for $group (@{$old_wc->{"group list"}}) {
151                 for my $topic (@{$old_wc->{" $group"}}) {
152                         my $name = $topic->{"topic"};
153                         my $newtopic = delete $new_wc->{"topic hash"}{$name};
154
155                         if (!defined $newtopic) {
156                                 push @gone, +{ @{[ %$topic ]} };
157                                 $topic->{"text"} = "";
158                                 $topic->{"names"} = "";
159                                 $topic->{"head"} = "";
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                 if (@gone) {
184                         $group = 'Graduated to "master"';
185                         if (!exists $old_wc->{" $group"}) {
186                                 unshift @{$old_wc->{"group list"}}, $group;
187                                 $old_wc->{" $group"} = [];
188                         }
189                         push @{$old_wc->{" $group"}}, @gone;
190                 }
191                 $group = "New Topics";
192                 if (!exists $old_wc->{" $group"}) {
193                         unshift @{$old_wc->{"group list"}}, $group;
194                         $old_wc->{" $group"} = [];
195                 }
196                 for my $topic (values %{$new_wc->{"topic hash"}}) {
197                         my $name = $topic->{"topic"};
198                         $old_wc->{"topic hash"}{$name} = $topic;
199                         push @{$old_wc->{" $group"}}, $topic;
200                         $topic->{"text"} = $topic->{"text"};
201                 }
202         }
203 }
204
205 if (@ARGV == 0) {
206         @ARGV = ('-');
207 }
208 if (@ARGV != 2 && @ARGV != 1) {
209         die "Usage: $0 old [new]\n";
210 }
211
212 my ($old_wc, $new_wc);
213
214 if ($ARGV[0] eq '-') {
215         *FH = *STDIN;
216 } else {
217         open FH, "$ARGV[0]";
218 }
219 $old_wc = parse_whats_cooking(\*FH);
220 close FH;
221
222 if (@ARGV > 1) {
223         open FH, "$ARGV[1]";
224 } else {
225         open FH, "Meta/WC generate |";
226 }
227 $new_wc = parse_whats_cooking(\*FH);
228 close FH;
229
230 merge_whats_cooking($old_wc, $new_wc);
231 print_whats_cooking($old_wc);