]>
Commit | Line | Data |
---|---|---|
5a3846f6 JH |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | # Update an older edition of What's Cooking with the latest data. | |
4 | # | |
55dd4b0b | 5 | # Usage: UWC [--keep-master] [ old [ new ] ] |
5a3846f6 JH |
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 | ||
55dd4b0b JH |
31 | my $keep_master = 1; |
32 | ||
5a3846f6 JH |
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; | |
40 | ||
41 | while (<$fh>) { | |
42 | if (/^-{40,}$/) { | |
43 | # Group separator | |
44 | next; | |
45 | } | |
46 | ||
47 | if (!defined $head) { | |
e50c6fa8 | 48 | if (/^Here are the topics that have been/) { |
5a3846f6 JH |
49 | $head = $_; |
50 | } | |
51 | next; | |
52 | } | |
53 | ||
54 | if (/^<<.*>>$/) { | |
55 | next; | |
56 | } | |
57 | ||
58 | if ($skipping_comment) { | |
59 | if (/^>>$/) { | |
60 | $skipping_comment = 0; | |
61 | } | |
62 | next; | |
63 | } | |
64 | ||
65 | if (!$skipping_comment && /^<</) { | |
66 | $skipping_comment = 1; | |
67 | next; | |
68 | } | |
69 | ||
70 | if (/^\[(.*)\]$/) { | |
71 | $group = $1; | |
72 | push @{$wc{"group list"}}, $group; | |
73 | $wc{" $group"} = []; | |
74 | $topic = undef; | |
75 | next; | |
76 | } | |
77 | ||
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; | |
87 | } | |
88 | } | |
89 | ||
90 | if (/^\* (\S+) (\(.*\) \d+ commits?)$/) { | |
91 | $topic = +{ | |
92 | topic => $1, | |
93 | head => $_, | |
94 | names => "", | |
95 | text => "", | |
96 | }; | |
97 | $wc{"topic hash"}{$topic->{"topic"}} = $topic; | |
98 | push @{$wc{" $group"}}, $topic; | |
99 | next; | |
100 | } | |
101 | ||
d3cd72a0 | 102 | if (/^ [-+.?*] / || /^ \S/) { |
5a3846f6 JH |
103 | $topic->{"names"} .= $_; |
104 | next; | |
105 | } | |
106 | $topic->{"text"} .= $_; | |
107 | } | |
108 | ||
109 | for ($head) { | |
110 | s/\A\s+//s; | |
111 | s/\s+\Z//s; | |
112 | } | |
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; | |
118 | } | |
119 | } | |
120 | return \%wc; | |
121 | } | |
122 | ||
123 | sub print_whats_cooking { | |
124 | my ($wc) = @_; | |
125 | ||
126 | print $wc->{"head text"}, "\n"; | |
127 | ||
128 | for my $group (@{$wc->{"group list"}}) { | |
129 | print "\n", "-" x 64, "\n"; | |
130 | print "[$group]\n"; | |
131 | for my $topic (@{$wc->{" $group"}}) { | |
56210413 | 132 | next if ($topic->{"head"} eq ''); |
5a3846f6 JH |
133 | print "\n", $topic->{"head"}; |
134 | print $topic->{"names"}; | |
135 | if ($topic->{"text"} ne '') { | |
136 | print "\n", $topic->{"text"}, "\n"; | |
137 | } | |
138 | } | |
139 | } | |
140 | } | |
141 | ||
142 | sub delete_topic { | |
143 | my ($wc, $topic) = @_; | |
144 | $topic->{"status"} = "deleted"; | |
145 | } | |
146 | ||
147 | sub merge_whats_cooking { | |
148 | my ($old_wc, $new_wc) = @_; | |
149 | my $group; | |
56210413 | 150 | my @gone = (); |
5a3846f6 JH |
151 | |
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}; | |
156 | ||
157 | if (!defined $newtopic) { | |
56210413 JH |
158 | push @gone, +{ @{[ %$topic ]} }; |
159 | $topic->{"text"} = ""; | |
5a3846f6 | 160 | $topic->{"names"} = ""; |
56210413 | 161 | $topic->{"head"} = ""; |
5a3846f6 JH |
162 | next; |
163 | } | |
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"} . ">>"); | |
169 | ||
170 | if ($topic->{"text"} ne '') { | |
171 | $text .= "\n\n" . $topic->{"text"}; | |
172 | } | |
173 | for ($text) { | |
174 | s/\A\s+//s; | |
175 | s/\s+\Z//s; | |
176 | } | |
177 | $topic->{"text"} = $text; | |
178 | $topic->{"names"} = $newtopic->{"names"}; | |
179 | $topic->{"head"} = $newtopic->{"head"}; | |
180 | } | |
181 | } | |
182 | } | |
183 | ||
55dd4b0b JH |
184 | |
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"; | |
191 | } | |
192 | print STDERR "Gone are\n"; | |
193 | for (@gone) { | |
194 | print STDERR " Gone: ", $_->{'topic'}, "\n"; | |
195 | } | |
196 | } | |
197 | if (@gone) { | |
198 | if (!exists $old_wc->{" $group"}) { | |
199 | unshift @{$old_wc->{"group list"}}, $group; | |
200 | $old_wc->{" $group"} = []; | |
56210413 | 201 | } |
55dd4b0b JH |
202 | push @{$old_wc->{" $group"}}, @gone; |
203 | } | |
204 | if (%{$new_wc->{"topic hash"}}) { | |
5a3846f6 JH |
205 | $group = "New Topics"; |
206 | if (!exists $old_wc->{" $group"}) { | |
207 | unshift @{$old_wc->{"group list"}}, $group; | |
208 | $old_wc->{" $group"} = []; | |
209 | } | |
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"}; | |
215 | } | |
216 | } | |
217 | } | |
218 | ||
219 | if (@ARGV == 0) { | |
220 | @ARGV = ('-'); | |
55dd4b0b JH |
221 | } elsif ($ARGV[0] eq '--keep-master') { |
222 | $keep_master = 1; | |
223 | shift; | |
5a3846f6 JH |
224 | } |
225 | if (@ARGV != 2 && @ARGV != 1) { | |
226 | die "Usage: $0 old [new]\n"; | |
227 | } | |
228 | ||
229 | my ($old_wc, $new_wc); | |
230 | ||
231 | if ($ARGV[0] eq '-') { | |
232 | *FH = *STDIN; | |
233 | } else { | |
234 | open FH, "$ARGV[0]"; | |
235 | } | |
236 | $old_wc = parse_whats_cooking(\*FH); | |
237 | close FH; | |
238 | ||
239 | if (@ARGV > 1) { | |
240 | open FH, "$ARGV[1]"; | |
241 | } else { | |
67d7e9cf | 242 | open FH, "Meta/WC generate |"; |
5a3846f6 JH |
243 | } |
244 | $new_wc = parse_whats_cooking(\*FH); | |
245 | close FH; | |
246 | ||
247 | merge_whats_cooking($old_wc, $new_wc); | |
248 | print_whats_cooking($old_wc); |