Meta/cook -w: catch a bit more standard judgement phrases
[alt-git.git] / cook
blob51fb601764ddcbd0f5193d0bb199c7e437f7e327
1 #!/usr/bin/perl -w
2 # Maintain "what's cooking" messages
4 use strict;
6 my %reverts = ('next' => {
7 map { $_ => 1 } qw(
8 ) });
10 %reverts = ();
12 sub phrase_these {
13 my %uniq = ();
14 my (@u) = grep { $uniq{$_}++ == 0 } sort @_;
15 my @d = ();
16 for (my $i = 0; $i < @u; $i++) {
17 push @d, $u[$i];
18 if ($i == @u - 2) {
19 push @d, " and ";
20 } elsif ($i < @u - 2) {
21 push @d, ", ";
24 return join('', @d);
27 sub describe_relation {
28 my ($topic_info) = @_;
29 my @desc;
31 if (exists $topic_info->{'used'}) {
32 push @desc, ("is used by " .
33 phrase_these(@{$topic_info->{'used'}}));
36 if (exists $topic_info->{'uses'}) {
37 push @desc, ("uses " .
38 phrase_these(@{$topic_info->{'uses'}}));
41 if (exists $topic_info->{'shares'}) {
42 push @desc, ("is tangled with " .
43 phrase_these(@{$topic_info->{'shares'}}));
46 if (!@desc) {
47 return "";
50 return "(this branch " . join("; ", @desc) . ".)";
53 sub forks_from {
54 my ($topic, $fork, $forkee, @overlap) = @_;
55 my %ovl = map { $_ => 1 } (@overlap, @{$topic->{$forkee}{'log'}});
57 push @{$topic->{$fork}{'uses'}}, $forkee;
58 push @{$topic->{$forkee}{'used'}}, $fork;
59 @{$topic->{$fork}{'log'}} = (grep { !exists $ovl{$_} }
60 @{$topic->{$fork}{'log'}});
63 sub topic_relation {
64 my ($topic, $one, $two) = @_;
66 my $fh;
67 open($fh, '-|',
68 qw(git log --abbrev=7), "--format=%m %h",
69 "$one...$two", "^master")
70 or die "$!: open log --left-right";
71 my (@left, @right);
72 while (<$fh>) {
73 my ($sign, $sha1) = /^(.) (.*)/;
74 if ($sign eq '<') {
75 push @left, $sha1;
76 } elsif ($sign eq '>') {
77 push @right, $sha1;
80 close($fh) or die "$!: close log --left-right";
82 if (!@left) {
83 if (@right) {
84 forks_from($topic, $two, $one);
86 } elsif (!@right) {
87 forks_from($topic, $one, $two);
88 } else {
89 push @{$topic->{$one}{'shares'}}, $two;
90 push @{$topic->{$two}{'shares'}}, $one;
94 =head1
95 Inspect the current set of topics
97 Returns a hash:
99 $topic = {
100 $branchname => {
101 'tipdate' => date of the tip commit,
102 'desc' => description string,
103 'log' => [ $commit,... ],
107 =cut
109 sub get_commit {
110 my (@base) = qw(master next pu);
111 my $fh;
112 open($fh, '-|',
113 qw(git for-each-ref),
114 "--format=%(refname:short) %(committerdate:iso8601)",
115 "refs/heads/??/*")
116 or die "$!: open for-each-ref";
117 my @topic;
118 my %topic;
120 while (<$fh>) {
121 chomp;
122 my ($branch, $date) = /^(\S+) (.*)$/;
123 push @topic, $branch;
124 $date =~ s/ .*//;
125 $topic{$branch} = +{
126 log => [],
127 tipdate => $date,
130 close($fh) or die "$!: close for-each-ref";
132 my %base = map { $_ => undef } @base;
133 my %commit;
134 my $show_branch_batch = 20;
136 while (@topic) {
137 my @t = (@base, splice(@topic, 0, $show_branch_batch));
138 my $header_delim = '-' x scalar(@t);
139 my $contain_pat = '.' x scalar(@t);
140 open($fh, '-|', qw(git show-branch --sparse --sha1-name),
141 map { "refs/heads/$_" } @t)
142 or die "$!: open show-branch";
143 while (<$fh>) {
144 chomp;
145 if ($header_delim) {
146 if (/^$header_delim$/) {
147 $header_delim = undef;
149 next;
151 my ($contain, $sha1, $log) =
152 ($_ =~ /^($contain_pat) \[([0-9a-f]+)\] (.*)$/);
154 for (my $i = 0; $i < @t; $i++) {
155 my $branch = $t[$i];
156 my $sign = substr($contain, $i, 1);
157 next if ($sign eq ' ');
158 next if (substr($contain, 0, 1) ne ' ');
160 if (!exists $commit{$sha1}) {
161 $commit{$sha1} = +{
162 branch => {},
163 log => $log,
166 my $co = $commit{$sha1};
167 if (!exists $reverts{$branch}{$sha1}) {
168 $co->{'branch'}{$branch} = 1;
170 next if (exists $base{$branch});
171 push @{$topic{$branch}{'log'}}, $sha1;
174 close($fh) or die "$!: close show-branch";
177 my %shared;
178 for my $sha1 (keys %commit) {
179 my $sign;
180 my $co = $commit{$sha1};
181 if (exists $co->{'branch'}{'next'}) {
182 $sign = '+';
183 } elsif (exists $co->{'branch'}{'pu'}) {
184 $sign = '-';
185 } else {
186 $sign = '.';
188 $co->{'log'} = $sign . ' ' . $co->{'log'};
189 my @t = (sort grep { !exists $base{$_} }
190 keys %{$co->{'branch'}});
191 next if (@t < 2);
192 my $t = "@t";
193 $shared{$t} = 1;
196 for my $combo (keys %shared) {
197 my @combo = split(' ', $combo);
198 for (my $i = 0; $i < @combo - 1; $i++) {
199 for (my $j = $i + 1; $j < @combo; $j++) {
200 topic_relation(\%topic, $combo[$i], $combo[$j]);
205 open($fh, '-|',
206 qw(git log --first-parent --abbrev=7),
207 "--format=%ci %h %p :%s", "master..next")
208 or die "$!: open log master..next";
209 while (<$fh>) {
210 my ($date, $commit, $parent, $tips);
211 unless (($date, $commit, $parent, $tips) =
212 /^([-0-9]+) ..:..:.. .\d{4} (\S+) (\S+) ([^:]*):/) {
213 die "Oops: $_";
215 for my $tip (split(' ', $tips)) {
216 my $co = $commit{$tip};
217 next unless ($co->{'branch'}{'next'});
218 $co->{'merged'} = " (merged to 'next' on $date at $commit)";
221 close($fh) or die "$!: close log master..next";
223 for my $branch (keys %topic) {
224 my @log = ();
225 my $n = scalar(@{$topic{$branch}{'log'}});
226 if (!$n) {
227 delete $topic{$branch};
228 next;
229 } elsif ($n == 1) {
230 $n = "1 commit";
231 } else {
232 $n = "$n commits";
234 my $d = $topic{$branch}{'tipdate'};
235 my $head = "* $branch ($d) $n\n";
236 my @desc;
237 for (@{$topic{$branch}{'log'}}) {
238 my $co = $commit{$_};
239 if (exists $co->{'merged'}) {
240 push @desc, $co->{'merged'};
242 push @desc, $commit{$_}->{'log'};
244 my $list = join("\n", map { " " . $_ } @desc);
245 my $relation = describe_relation($topic{$branch});
246 $topic{$branch}{'desc'} = $head . $list;
247 if ($relation) {
248 $topic{$branch}{'desc'} .= "\n $relation";
252 return \%topic;
255 sub blurb_text {
256 my ($mon, $year, $issue, $dow, $date,
257 $master_at, $next_at, $text) = @_;
259 my $now_string = localtime;
260 my ($current_dow, $current_mon, $current_date, $current_year) =
261 ($now_string =~ /^(\w+) (\w+) (\d+) [\d:]+ (\d+)$/);
263 $mon ||= $current_mon;
264 $year ||= $current_year;
265 $issue ||= "01";
266 $dow ||= $current_dow;
267 $date ||= $current_date;
268 $master_at ||= '0' x 40;
269 $next_at ||= '0' x 40;
270 $text ||= <<'EOF';
271 Here are the topics that have been cooking. Commits prefixed with '-' are
272 only in 'pu' (proposed updates) while commits prefixed with '+' are in 'next'.
273 The ones marked with '.' do not appear in any of the integration branches,
274 but I am still holding onto them.
276 Here are the repositories that have my integration branches:
278 With maint, master, next, pu, and todo:
280 git://git.kernel.org/pub/scm/git/git.git
281 git://repo.or.cz/alt-git.git
282 https://code.google.com/p/git-core/
283 https://github.com/git/git
285 With only maint and master:
287 git://git.sourceforge.jp/gitroot/git-core/git.git
288 git://git-core.git.sourceforge.net/gitroot/git-core/git-core
290 With all the topics and integration branches but not todo, html or man:
292 https://github.com/gitster/git
294 For convenience, preformatted documentation in html and manpage format
295 are found in their own separate repositories:
297 git://git.kernel.org/pub/scm/git/git-{htmldocs,manpages}.git/
298 git://repo.or.cz/git-{htmldocs,manpages}.git/
299 https://code.google.com/p/git-{htmldocs,manpages}.git/
300 https://github.com/gitster/git-{htmldocs,manpages}.git/
303 $text = <<EOF;
304 To: git\@vger.kernel.org
305 Subject: What's cooking in git.git ($mon $year, #$issue; $dow, $date)
306 X-master-at: $master_at
307 X-next-at: $next_at
309 What's cooking in git.git ($mon $year, #$issue; $dow, $date)
310 --------------------------------------------------
312 $text
314 $text =~ s/\n+\Z/\n/;
315 return $text;
318 my $blurb_match = <<'EOF';
319 To: .*
320 Subject: What's cooking in \S+ \((\w+) (\d+), #(\d+); (\w+), (\d+)\)
321 X-master-at: ([0-9a-f]{40})
322 X-next-at: ([0-9a-f]{40})
324 What's cooking in \S+ \(\1 \2, #\3; \4, \5\)
325 -{30,}
329 my $blurb = "b..l..u..r..b";
330 sub read_previous {
331 my ($fn) = @_;
332 my $fh;
333 my $section = undef;
334 my $serial = 1;
335 my $branch = $blurb;
336 my $last_empty = undef;
337 my (@section, %section, @branch, %branch, %description, @leader);
338 my $in_unedited_olde = 0;
340 if (!-r $fn) {
341 return +{
342 'section_list' => [],
343 'section_data' => {},
344 'topic_description' => {
345 $blurb => {
346 desc => undef,
347 text => blurb_text(),
353 open ($fh, '<', $fn) or die "$!: open $fn";
354 while (<$fh>) {
355 chomp;
356 if ($in_unedited_olde) {
357 if (/^>>$/) {
358 $in_unedited_olde = 0;
359 $_ = " | $_";
361 } elsif (/^<<$/) {
362 $in_unedited_olde = 1;
365 if ($in_unedited_olde) {
366 $_ = " | $_";
369 if (defined $section && /^-{20,}$/) {
370 $_ = "";
372 if (/^$/) {
373 $last_empty = 1;
374 next;
376 if (/^\[(.*)\]\s*$/) {
377 $section = $1;
378 $branch = undef;
379 if (!exists $section{$section}) {
380 push @section, $section;
381 $section{$section} = [];
383 next;
385 if (defined $section && /^\* (\S+) /) {
386 $branch = $1;
387 $last_empty = 0;
388 if (!exists $branch{$branch}) {
389 push @branch, [$branch, $section];
390 $branch{$branch} = 1;
392 push @{$section{$section}}, $branch;
394 if (defined $branch) {
395 my $was_last_empty = $last_empty;
396 $last_empty = 0;
397 if (!exists $description{$branch}) {
398 $description{$branch} = [];
400 if ($was_last_empty) {
401 push @{$description{$branch}}, "";
403 push @{$description{$branch}}, $_;
406 close($fh);
408 for my $branch (keys %description) {
409 my $ary = $description{$branch};
410 if ($branch eq $blurb) {
411 while (@{$ary} && $ary->[-1] =~ /^-{30,}$/) {
412 pop @{$ary};
414 $description{$branch} = +{
415 desc => undef,
416 text => join("\n", @{$ary}),
418 } else {
419 my @desc = ();
420 while (@{$ary}) {
421 my $elem = shift @{$ary};
422 last if ($elem eq '');
423 push @desc, $elem;
425 $description{$branch} = +{
426 desc => join("\n", @desc),
427 text => join("\n", @{$ary}),
432 return +{
433 section_list => \@section,
434 section_data => \%section,
435 topic_description => \%description,
439 sub write_cooking {
440 my ($fn, $cooking) = @_;
441 my $fh;
443 open($fh, '>', $fn) or die "$!: open $fn";
444 print $fh $cooking->{'topic_description'}{$blurb}{'text'};
446 for my $section_name (@{$cooking->{'section_list'}}) {
447 my $topic_list = $cooking->{'section_data'}{$section_name};
448 next if (!@{$topic_list});
450 print $fh "\n";
451 print $fh '-' x 50, "\n";
452 print $fh "[$section_name]\n";
453 for my $topic (@{$topic_list}) {
454 my $d = $cooking->{'topic_description'}{$topic};
456 print $fh "\n", $d->{'desc'}, "\n";
457 if ($d->{'text'}) {
458 print $fh "\n", $d->{'text'}, "\n";
462 close($fh);
465 my $graduated = 'Graduated to "master"';
466 my $new_topics = 'New Topics';
467 my $discarded = 'Discarded';
468 my $old_new_topics = 'Old New Topics';
470 sub update_issue {
471 my ($cooking) = @_;
472 my ($fh, $master_at, $next_at, $incremental);
474 open($fh, '-|',
475 qw(git for-each-ref),
476 "--format=%(refname:short) %(objectname)",
477 "refs/heads/master",
478 "refs/heads/next") or die "$!: open for-each-ref";
479 while (<$fh>) {
480 my ($branch, $at) = /^(\S+) (\S+)$/;
481 if ($branch eq 'master') { $master_at = $at; }
482 if ($branch eq 'next') { $next_at = $at; }
484 close($fh) or die "$!: close for-each-ref";
486 $incremental = ((-r "Meta/whats-cooking.txt") &&
487 system("cd Meta && " .
488 "git diff --quiet --no-ext-diff HEAD -- " .
489 "whats-cooking.txt"));
491 my $now_string = localtime;
492 my ($current_dow, $current_mon, $current_date, $current_year) =
493 ($now_string =~ /^(\w+) (\w+) +(\d+) [\d:]+ (\d+)$/);
495 my $btext = $cooking->{'topic_description'}{$blurb}{'text'};
496 if ($btext !~ s/\A$blurb_match//) {
497 die "match pattern broken?";
499 my ($mon, $year, $issue, $dow, $date) = ($1, $2, $3, $4, $5);
501 if ($current_mon ne $mon || $current_year ne $year) {
502 $issue = "01";
503 } elsif (!$incremental) {
504 $issue =~ s/^0*//;
505 $issue = sprintf "%02d", ($issue + 1);
507 $mon = $current_mon;
508 $year = $current_year;
509 $dow = $current_dow;
510 $date = $current_date;
512 $cooking->{'topic_description'}{$blurb}{'text'} =
513 blurb_text($mon, $year, $issue, $dow, $date,
514 $master_at, $next_at, $btext);
516 if (!$incremental) {
517 my $sd = $cooking->{'section_data'};
518 my $sl = $cooking->{'section_list'};
519 # Rename "New" to "Old New" and insert "New".
520 # Move "New" to "Old New"
521 my $i;
522 my $doneso;
523 for ($i = 0; $i < @{$sl}; $i++) {
524 if ($sl->[$i] eq $new_topics) {
525 $sl->[$i] = $old_new_topics;
526 unshift @{$sl}, $new_topics;
527 $doneso = 1;
528 last;
531 if ($doneso) {
532 $sd->{$old_new_topics} = $sd->{$new_topics};
534 $sd->{$new_topics} = [];
537 return $incremental;
540 sub topic_in_pu {
541 my ($topic_desc) = @_;
542 for my $line (split(/\n/, $topic_desc)) {
543 if ($line =~ /^ [+-] /) {
544 return 1;
547 return 0;
550 sub merge_cooking {
551 my ($cooking, $current) = @_;
552 my $td = $cooking->{'topic_description'};
553 my $sd = $cooking->{'section_data'};
554 my $sl = $cooking->{'section_list'};
555 my (@new_topic, @gone_topic);
557 # Make sure "New Topics" and "Graduated" exists
558 if (!exists $sd->{$new_topics}) {
559 $sd->{$new_topics} = [];
560 unshift @{$sl}, $new_topics;
563 if (!exists $sd->{$graduated}) {
564 $sd->{$graduated} = [];
565 unshift @{$sl}, $graduated;
568 my $incremental = update_issue($cooking);
570 for my $topic (sort keys %{$current}) {
571 if (!exists $td->{$topic}) {
572 # Ignore new topics without anything merged
573 if (topic_in_pu($current->{$topic}{'desc'})) {
574 push @new_topic, $topic;
576 next;
578 # Annotate if the contents of the topic changed
579 my $n = $current->{$topic}{'desc'};
580 my $o = $td->{$topic}{'desc'};
581 if ($n ne $o) {
582 $td->{$topic}{'desc'} = $n . "\n<<\n" . $o ."\n>>";
586 for my $topic (sort keys %{$td}) {
587 next if ($topic eq $blurb);
588 next if (!$incremental &&
589 grep { $topic eq $_ } @{$sd->{$graduated}});
590 next if (grep { $topic eq $_ } @{$sd->{$discarded}});
591 if (!exists $current->{$topic}) {
592 push @gone_topic, $topic;
596 for (@new_topic) {
597 push @{$sd->{$new_topics}}, $_;
598 $td->{$_}{'desc'} = $current->{$_}{'desc'};
601 if (!$incremental) {
602 $sd->{$graduated} = [];
605 if (@gone_topic) {
606 for my $topic (@gone_topic) {
607 for my $section (@{$sl}) {
608 my $pre = scalar(@{$sd->{$section}});
609 @{$sd->{$section}} = (grep { $_ ne $topic }
610 @{$sd->{$section}});
611 my $post = scalar(@{$sd->{$section}});
612 next if ($pre == $post);
615 for (@gone_topic) {
616 push @{$sd->{$graduated}}, $_;
621 ################################################################
622 # WilDo
623 sub wildo_queue {
624 my ($what, $action, $topic) = @_;
625 if (!exists $what->{$action}) {
626 $what->{$action} = [];
628 push @{$what->{$action}}, $topic;
631 sub wildo {
632 my (%what, $topic, $last_merge_to_next);
633 my $too_recent = '9999-99-99';
634 while (<>) {
635 chomp;
637 next if (/^\[Graduated to/../^-{20,}$/);
638 next if (/^\[Stalled\]/../^-{20,}$/);
639 next if (/^\[Discarded\]/../^-{20,}$/);
641 if (/^\* (\S+) \(([-0-9]+)\) (\d+) commits?$/) {
642 if (defined $topic) {
643 wildo_queue(\%what, "Undecided", $topic);
645 # tip-date, next-date, topic, count, pu-count
646 $topic = [$2, $too_recent, $1, $3, 0];
647 next;
649 if (defined $topic &&
650 ($topic->[1] eq $too_recent) &&
651 ($topic->[4] == 0) &&
652 (/^ \(merged to 'next' on ([-0-9]+)/)) {
653 $topic->[1] = $1;
655 if (defined $topic && /^ - /) {
656 $topic->[4]++;
658 next if (/^ /);
659 next unless defined $topic;
660 if (/^Will (?:\S+ ){0,2}(keep|merge|drop|discard|cook|kick)[,. ]/ ||
661 /^Not urgent/ || /^Not ready/ || /^Waiting for / ||
662 /^Needs? /) {
663 wildo_queue(\%what, $_, $topic);
664 $topic = undef;
666 if (/^Not urgent;/) {
667 wildo_queue(\%what, $_, $topic);
668 $topic = undef;
670 if (/Originally merged to 'next' on ([-0-9]+)/) {
671 $topic->[1] = $1;
674 if (defined $topic) {
675 wildo_queue(\%what, "Undecided", $topic);
677 my $ipbl = "";
678 for my $what (sort keys %what) {
679 print "$ipbl$what\n";
680 for $topic (sort { (($a->[1] cmp $b->[1]) ||
681 ($a->[0] cmp $b->[0])) }
682 @{$what{$what}}) {
683 my ($tip, $next, $name, $count, $pu) = @$topic;
684 my ($sign);
685 $tip =~ s/^\d{4}-//;
686 if (($next eq $too_recent) || (0 < $pu)) {
687 $sign = "-";
688 $next = " " x 6;
689 } else {
690 $sign = "+";
691 $next =~ s|^\d{4}-|/|;
693 $count = "#$count";
694 printf " %s %-60s %s%s %5s\n", $sign, $name, $tip, $next, $count;
696 $ipbl = "\n";
700 ################################################################
701 # WhatsCooking
703 sub doit {
704 my $topic = get_commit();
705 my $cooking = read_previous('Meta/whats-cooking.txt');
706 merge_cooking($cooking, $topic);
707 write_cooking('Meta/whats-cooking.txt', $cooking);
710 ################################################################
711 # Main
713 use Getopt::Long;
715 my $wildo;
716 if (!GetOptions("wildo" => \$wildo)) {
717 print STDERR "$0 [--wildo]";
718 exit 1;
721 if ($wildo) {
722 if (!@ARGV) {
723 push @ARGV, "Meta/whats-cooking.txt";
725 wildo();
726 } else {
727 doit();