What's cooking
[git/dscho.git] / UWC
blob7a513af2ee3a21793b02bf402130c61318427274
1 #!/usr/bin/perl -w
3 # Update an older edition of What's Cooking with the latest data.
5 # Usage: UWC [--keep-master] [ old [ new ] ]
7 # Giving no parameter is the same as giving a single "-" to the command.
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.
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.
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...>>>.
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.
31 my $keep_master = 1;
33 sub parse_whats_cooking {
34 my ($fh) = @_;
35 my $head = undef;
36 my $group = undef;
37 my %wc = ("group list" => [], "topic hash" => {});
38 my $topic;
39 my $skipping_comment = 0;
41 while (<$fh>) {
42 if (/^-{40,}$/) {
43 # Group separator
44 next;
47 if (!defined $head) {
48 if (/^Here are the topics that have been/) {
49 $head = $_;
51 next;
54 if (/^<<.*>>$/) {
55 next;
58 if ($skipping_comment) {
59 if (/^>>$/) {
60 $skipping_comment = 0;
62 next;
65 if (!$skipping_comment && /^<</) {
66 $skipping_comment = 1;
67 next;
70 if (/^\[(.*)\]$/) {
71 $group = $1;
72 push @{$wc{"group list"}}, $group;
73 $wc{" $group"} = [];
74 $topic = undef;
75 next;
78 if (!defined $group) {
79 if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
80 # raw output
81 $group = "Misc";
82 push @{$wc{"group list"}}, $group;
83 $wc{" $group"} = [];
84 } else {
85 $head .= $_;
86 next;
90 if (/^\* (\S+) (\(.*\) \d+ commits?)$/) {
91 $topic = +{
92 topic => $1,
93 head => $_,
94 names => "",
95 text => "",
97 $wc{"topic hash"}{$topic->{"topic"}} = $topic;
98 push @{$wc{" $group"}}, $topic;
99 next;
102 if (/^ [-+.?*] / || /^ \S/) {
103 $topic->{"names"} .= $_;
104 next;
106 $topic->{"text"} .= $_;
109 for ($head) {
110 s/\A\s+//s;
111 s/\s+\Z//s;
113 $wc{"head text"} = $head;
114 for $topic (values %{$wc{"topic hash"}}) {
115 for ($topic->{"text"}) {
116 s/\A\s+//s;
117 s/\s+\Z//s;
120 return \%wc;
123 sub print_whats_cooking {
124 my ($wc) = @_;
126 print $wc->{"head text"}, "\n";
128 for my $group (@{$wc->{"group list"}}) {
129 print "\n", "-" x 64, "\n";
130 print "[$group]\n";
131 for my $topic (@{$wc->{" $group"}}) {
132 next if ($topic->{"head"} eq '');
133 print "\n", $topic->{"head"};
134 print $topic->{"names"};
135 if ($topic->{"text"} ne '') {
136 print "\n", $topic->{"text"}, "\n";
142 sub delete_topic {
143 my ($wc, $topic) = @_;
144 $topic->{"status"} = "deleted";
147 sub merge_whats_cooking {
148 my ($old_wc, $new_wc) = @_;
149 my $group;
150 my @gone = ();
152 for $group (@{$old_wc->{"group list"}}) {
153 for my $topic (@{$old_wc->{" $group"}}) {
154 my $name = $topic->{"topic"};
155 my $newtopic = delete $new_wc->{"topic hash"}{$name};
157 if (!defined $newtopic) {
158 push @gone, +{ @{[ %$topic ]} };
159 $topic->{"text"} = "";
160 $topic->{"names"} = "";
161 $topic->{"head"} = "";
162 next;
164 if (($newtopic->{"names"} ne $topic->{"names"}) ||
165 ($newtopic->{"head"} ne $topic->{"head"})) {
166 my $text = ("<<updated from\n" .
167 $topic->{"head"} .
168 $topic->{"names"} . ">>");
170 if ($topic->{"text"} ne '') {
171 $text .= "\n\n" . $topic->{"text"};
173 for ($text) {
174 s/\A\s+//s;
175 s/\s+\Z//s;
177 $topic->{"text"} = $text;
178 $topic->{"names"} = $newtopic->{"names"};
179 $topic->{"head"} = $newtopic->{"head"};
185 $group = 'Graduated to "master"';
186 if (!$keep_master) {
187 print STDERR "Not Keeping Master\n";
188 my $o = delete $old_wc->{" $group"};
189 for (@$o) {
190 print STDERR " Dropping: ", $_->{'topic'}, "\n";
192 print STDERR "Gone are\n";
193 for (@gone) {
194 print STDERR " Gone: ", $_->{'topic'}, "\n";
197 if (@gone) {
198 if (!exists $old_wc->{" $group"}) {
199 unshift @{$old_wc->{"group list"}}, $group;
200 $old_wc->{" $group"} = [];
202 push @{$old_wc->{" $group"}}, @gone;
204 if (%{$new_wc->{"topic hash"}}) {
205 $group = "New Topics";
206 if (!exists $old_wc->{" $group"}) {
207 unshift @{$old_wc->{"group list"}}, $group;
208 $old_wc->{" $group"} = [];
210 for my $topic (values %{$new_wc->{"topic hash"}}) {
211 my $name = $topic->{"topic"};
212 $old_wc->{"topic hash"}{$name} = $topic;
213 push @{$old_wc->{" $group"}}, $topic;
214 $topic->{"text"} = $topic->{"text"};
219 if (@ARGV == 0) {
220 @ARGV = ('-');
221 } elsif ($ARGV[0] eq '--keep-master') {
222 $keep_master = 1;
223 shift;
225 if (@ARGV != 2 && @ARGV != 1) {
226 die "Usage: $0 old [new]\n";
229 my ($old_wc, $new_wc);
231 if ($ARGV[0] eq '-') {
232 *FH = *STDIN;
233 } else {
234 open FH, "$ARGV[0]";
236 $old_wc = parse_whats_cooking(\*FH);
237 close FH;
239 if (@ARGV > 1) {
240 open FH, "$ARGV[1]";
241 } else {
242 open FH, "Meta/WC generate |";
244 $new_wc = parse_whats_cooking(\*FH);
245 close FH;
247 merge_whats_cooking($old_wc, $new_wc);
248 print_whats_cooking($old_wc);