cook

   1 #!/usr/bin/perl -w
   2 # Maintain "what's cooking" messages
   3
   4 my $MASTER = 'master'; # for now
   5
   6 use strict;
   7
   8 my %reverts = ('next' => {
   9         map { $_ => 1 } qw(
  10             ) });
  11
  12 %reverts = ();
  13
  14 sub phrase_these {
  15         my %uniq = ();
  16         my (@u) = grep { $uniq{$_}++ == 0 } sort @_;
  17         my @d = ();
  18         for (my $i = 0; $i < @u; $i++) {
  19                 push @d, $u[$i];
  20                 if ($i == @u - 2) {
  21                         push @d, " and ";
  22                 } elsif ($i < @u - 2) {
  23                         push @d, ", ";
  24                 }
  25         }
  26         return join('', @d);
  27 }
  28
  29 sub describe_relation {
  30         my ($topic_info) = @_;
  31         my @desc;
  32
  33         if (exists $topic_info->{'used'}) {
  34                 push @desc, ("is used by " .
  35                              phrase_these(@{$topic_info->{'used'}}));
  36         }
  37
  38         if (exists $topic_info->{'uses'}) {
  39                 push @desc, ("uses " .
  40                              phrase_these(@{$topic_info->{'uses'}}));
  41         }
  42
  43         if (0 && exists $topic_info->{'shares'}) {
  44                 push @desc, ("shares commits with " .
  45                              phrase_these(@{$topic_info->{'shares'}}));
  46         }
  47
  48         if (!@desc) {
  49                 return "";
  50         }
  51
  52         return "(this branch " . join("; ", @desc) . ".)";
  53 }
  54
  55 sub forks_from {
  56         my ($topic, $fork, $forkee, @overlap) = @_;
  57         my %ovl = map { $_ => 1 } (@overlap, @{$topic->{$forkee}{'log'}});
  58
  59         push @{$topic->{$fork}{'uses'}}, $forkee;
  60         push @{$topic->{$forkee}{'used'}}, $fork;
  61         @{$topic->{$fork}{'log'}} = (grep { !exists $ovl{$_} }
  62                                      @{$topic->{$fork}{'log'}});
  63 }
  64
  65 sub topic_relation {
  66         my ($topic, $one, $two) = @_;
  67
  68         my $fh;
  69         open($fh, '-|',
  70              qw(git log --abbrev), "--format=%m %h",
  71              "$one...$two", "^$MASTER")
  72             or die "$!: open log --left-right";
  73         my (@left, @right);
  74         while (<$fh>) {
  75                 my ($sign, $sha1) = /^(.) (.*)/;
  76                 if ($sign eq '<') {
  77                         push @left, $sha1;
  78                 } elsif ($sign eq '>') {
  79                         push @right, $sha1;
  80                 }
  81         }
  82         close($fh) or die "$!: close log --left-right";
  83
  84         if (!@left) {
  85                 if (@right) {
  86                         forks_from($topic, $two, $one);
  87                 }
  88         } elsif (!@right) {
  89                 forks_from($topic, $one, $two);
  90         } else {
  91                 push @{$topic->{$one}{'shares'}}, $two;
  92                 push @{$topic->{$two}{'shares'}}, $one;
  93         }
  94 }
  95
  96 sub get_message_parent {
  97         my ($mid) = @_;
  98         my @line = ();
  99         my %irt = ();
 100
 101         open(my $fh, "-|", qw(curl -s),
 102              "https://lore.kernel.org/git/" . "$mid" . "/raw");
 103         while (<$fh>) {
 104                 last if (/^$/);
 105                 chomp;
 106                 if (/^\s/) {
 107                         $line[-1] .= $_;
 108                 } else {
 109                         push @line, $_;
 110                 }
 111         }
 112         while (<$fh>) { # slurp
 113         }
 114         close($fh);
 115         for (@line) {
 116                 if (s/^in-reply-to:\s*//i) {
 117                         while (/\s*<([^<]*)>\s*(.*)/) {
 118                                 $irt{$1} = $1;
 119                                 $_ = $2;
 120                         }
 121                 }
 122         }
 123         keys %irt;
 124 }
 125
 126 sub get_source {
 127         my ($branch) = @_;
 128         my @id = ();
 129         my %msgs = ();
 130         my @msgs = ();
 131         my %source = ();
 132         my %skip_me = ();
 133
 134         open(my $fh, "-|",
 135              qw(git log --notes=amlog --first-parent --format=%N ^master),
 136              $branch);
 137         while (<$fh>) {
 138                 if (s/^message-id:\s*<(.*)>\s*$/$1/i) {
 139                         my $msg = $_;
 140                         $msgs{$msg} = [get_message_parent($msg)];
 141                         push @msgs, $msg;
 142                 }
 143         }
 144         close($fh);
 145
 146         # Collect parent messages that are not in the series,
 147         # as they are likely to be the cover letters.
 148         for my $msg (@msgs) {
 149                 for my $parent (@{$msgs{$msg}}) {
 150                         if (!exists $msgs{$parent}) {
 151                                 $source{$parent}++;
 152                         }
 153                 }
 154         }
 155
 156         reduce_sources(\@msgs, \%msgs, \%source);
 157
 158         map {
 159                 " source: <$_>";
 160         }
 161         (sort keys %source);
 162 }
 163
 164 sub reduce_sources {
 165         # Message-source specific hack
 166         my ($msgs_array, $msgs_map, $src_map) = @_;
 167
 168         # messages without parent, or a singleton patch
 169         if ((! %$src_map && @{$msgs_array}) || (@{$msgs_array} == 1)) {
 170                 %{$src_map} = ($msgs_array->[0] => 1);
 171                 return;
 172         }
 173
 174         # Is it from GGG?
 175         my @ggg_source = ();
 176         for my $msg (keys %$src_map) {
 177                 if ($msg =~ /^pull\.[^@]*\.gitgitgadget\@/) {
 178                         push @ggg_source, $msg;
 179                 }
 180         }
 181         if (@ggg_source == 1) {
 182                 %{$src_map} = ($ggg_source[0] => 1);
 183                 return;
 184         }
 185
 186 }
 187
 188 =head1
 189 Inspect the current set of topics
 190
 191 Returns a hash:
 192
 193     $topic = {
 194         $branchname => {
 195             'tipdate' => date of the tip commit,
 196             'desc' => description string,
 197             'log' => [ $commit,... ],
 198         },
 199     }
 200
 201 =cut
 202
 203 sub get_commit {
 204         my (@base) = ($MASTER, 'next', 'seen');
 205         my $fh;
 206         open($fh, '-|',
 207              qw(git for-each-ref),
 208              "--format=%(refname:short) %(committerdate:iso8601)",
 209              "refs/heads/??/*")
 210             or die "$!: open for-each-ref";
 211         my @topic;
 212         my %topic;
 213
 214         while (<$fh>) {
 215                 chomp;
 216                 my ($branch, $date) = /^(\S+) (.*)$/;
 217
 218                 next if ($branch =~ m|^../wip-|);
 219                 push @topic, $branch;
 220                 $date =~ s/ .*//;
 221                 $topic{$branch} = +{
 222                         log => [],
 223                         tipdate => $date,
 224                 };
 225         }
 226         close($fh) or die "$!: close for-each-ref";
 227
 228         my %base = map { $_ => undef } @base;
 229         my %commit;
 230         my $show_branch_batch = 20;
 231
 232         while (@topic) {
 233                 my @t = (@base, splice(@topic, 0, $show_branch_batch));
 234                 my $header_delim = '-' x scalar(@t);
 235                 my $contain_pat = '.' x scalar(@t);
 236                 open($fh, '-|', qw(git show-branch --sparse --sha1-name),
 237                      map { "refs/heads/$_" } @t)
 238                     or die "$!: open show-branch";
 239                 while (<$fh>) {
 240                         chomp;
 241                         if ($header_delim) {
 242                                 if (/^$header_delim$/) {
 243                                         $header_delim = undef;
 244                                 }
 245                                 next;
 246                         }
 247                         my ($contain, $sha1, $log) =
 248                             ($_ =~ /^($contain_pat) \[([0-9a-f]+)\] (.*)$/);
 249
 250                         for (my $i = 0; $i < @t; $i++) {
 251                                 my $branch = $t[$i];
 252                                 my $sign = substr($contain, $i, 1);
 253                                 next if ($sign eq ' ');
 254                                 next if (substr($contain, 0, 1) ne ' ');
 255
 256                                 if (!exists $commit{$sha1}) {
 257                                         $commit{$sha1} = +{
 258                                                 branch => {},
 259                                                 log => $log,
 260                                         };
 261                                 }
 262                                 my $co = $commit{$sha1};
 263                                 if (!exists $reverts{$branch}{$sha1}) {
 264                                         $co->{'branch'}{$branch} = 1;
 265                                 }
 266                                 next if (exists $base{$branch});
 267                                 push @{$topic{$branch}{'log'}}, $sha1;
 268                         }
 269                 }
 270                 close($fh) or die "$!: close show-branch";
 271         }
 272
 273         my %shared;
 274         for my $sha1 (keys %commit) {
 275                 my $sign;
 276                 my $co = $commit{$sha1};
 277                 if (exists $co->{'branch'}{'next'}) {
 278                         $sign = '+';
 279                 } elsif (exists $co->{'branch'}{'seen'}) {
 280                         $sign = '-';
 281                 } else {
 282                         $sign = '.';
 283                 }
 284                 $co->{'log'} = $sign . ' ' . $co->{'log'};
 285                 my @t = (sort grep { !exists $base{$_} }
 286                          keys %{$co->{'branch'}});
 287                 next if (@t < 2);
 288                 my $t = "@t";
 289                 $shared{$t} = 1;
 290         }
 291
 292         for my $combo (keys %shared) {
 293                 my @combo = split(' ', $combo);
 294                 for (my $i = 0; $i < @combo - 1; $i++) {
 295                         for (my $j = $i + 1; $j < @combo; $j++) {
 296                                 topic_relation(\%topic, $combo[$i], $combo[$j]);
 297                         }
 298                 }
 299         }
 300
 301         open($fh, '-|',
 302              qw(git log --first-parent --abbrev),
 303              "--format=%ci %h %p :%s", "$MASTER..next")
 304             or die "$!: open log $MASTER..next";
 305         while (<$fh>) {
 306                 my ($date, $commit, $parent, $tips);
 307                 unless (($date, $commit, $parent, $tips) =
 308                         /^([-0-9]+) ..:..:.. .\d{4} (\S+) (\S+) ([^:]*):/) {
 309                         die "Oops: $_";
 310                 }
 311                 for my $tip (split(' ', $tips)) {
 312                         my $co = $commit{$tip};
 313                         next unless ($co->{'branch'}{'next'});
 314                         $co->{'merged'} = " (merged to 'next' on $date at $commit)";
 315                 }
 316         }
 317         close($fh) or die "$!: close log $MASTER..next";
 318
 319         for my $branch (keys %topic) {
 320                 my @log = ();
 321                 my $n = scalar(@{$topic{$branch}{'log'}});
 322                 if (!$n) {
 323                         delete $topic{$branch};
 324                         next;
 325                 } elsif ($n == 1) {
 326                         $n = "1 commit";
 327                 } else {
 328                         $n = "$n commits";
 329                 }
 330                 my $d = $topic{$branch}{'tipdate'};
 331                 my $head = "* $branch ($d) $n\n";
 332                 my @desc;
 333                 for (@{$topic{$branch}{'log'}}) {
 334                         my $co = $commit{$_};
 335                         if (exists $co->{'merged'}) {
 336                                 push @desc, $co->{'merged'};
 337                         }
 338                         push @desc, $commit{$_}->{'log'};
 339                 }
 340
 341                 if (100 < @desc) {
 342                         @desc = @desc[0..99];
 343                         push @desc, "- ...";
 344                 }
 345
 346                 my $list = join("\n", map { " " . $_ } @desc);
 347
 348                 # NEEDSWORK:
 349                 # This is done a bit too early. We grabbed all
 350                 # under refs/heads/??/* without caring if they are
 351                 # merged to 'seen' yet, and it is correct because
 352                 # we want to describe a topic that is in the old
 353                 # edition that is tentatively kicked out of 'seen'.
 354                 # However, we do not want to say a topic is used
 355                 # by a new topic that is not yet in 'seen'!
 356                 my $relation = describe_relation($topic{$branch});
 357                 $topic{$branch}{'desc'} = $head . $list;
 358                 if ($relation) {
 359                         $topic{$branch}{'desc'} .= "\n $relation";
 360                 }
 361         }
 362
 363         return \%topic;
 364 }
 365
 366 sub blurb_text {
 367         my ($mon, $year, $issue, $dow, $date,
 368             $master_at, $next_at, $text) = @_;
 369
 370         my $now_string = localtime;
 371         my ($current_dow, $current_mon, $current_date, $current_year) =
 372             ($now_string =~ /^(\w+) (\w+) (\d+) [\d:]+ (\d+)$/);
 373
 374         $mon ||= $current_mon;
 375         $year ||= $current_year;
 376         $issue ||= "01";
 377         $dow ||= $current_dow;
 378         $date ||= $current_date;
 379         $master_at ||= '0' x 40;
 380         $next_at ||= '0' x 40;
 381         $text ||= <<'EOF';
 382 Here are the topics that have been cooking in my tree.  Commits
 383 prefixed with '+' are in 'next' (being in 'next' is a sign that a
 384 topic is stable enough to be used and are candidate to be in a future
 385 release).  Commits prefixed with '-' are only in 'seen', and aren't
 386 considered "accepted" at all and may be annotated with an URL to a
 387 message that raises issues but they are no means exhaustive.  A
 388 topic without enough support may be discarded after a long period of
 389 no activity.
 390
 391 Copies of the source code to Git live in many repositories, and the
 392 following is a list of the ones I push into or their mirrors.  Some
 393 repositories have only a subset of branches.
 394
 395 With maint, master, next, seen, todo:
 396
 397         git://git.kernel.org/pub/scm/git/git.git/
 398         git://repo.or.cz/alt-git.git/
 399         https://kernel.googlesource.com/pub/scm/git/git/
 400         https://github.com/git/git/
 401         https://gitlab.com/git-scm/git/
 402
 403 With all the integration branches and topics broken out:
 404
 405         https://github.com/gitster/git/
 406
 407 Even though the preformatted documentation in HTML and man format
 408 are not sources, they are published in these repositories for
 409 convenience (replace "htmldocs" with "manpages" for the manual
 410 pages):
 411
 412         git://git.kernel.org/pub/scm/git/git-htmldocs.git/
 413         https://github.com/gitster/git-htmldocs.git/
 414
 415 Release tarballs are available at:
 416
 417         https://www.kernel.org/pub/software/scm/git/
 418 EOF
 419
 420         $text = <<EOF;
 421 To: git\@vger.kernel.org
 422 Subject: What's cooking in git.git ($mon $year, #$issue; $dow, $date)
 423 X-$MASTER-at: $master_at
 424 X-next-at: $next_at
 425 Bcc: lwn\@lwn.net, gitster\@pobox.com
 426
 427 What's cooking in git.git ($mon $year, #$issue; $dow, $date)
 428 --------------------------------------------------
 429
 430 $text
 431 EOF
 432         $text =~ s/\n+\Z/\n/;
 433         return $text;
 434 }
 435
 436 my $blurb_match = <<'EOF';
 437 (?:(?i:\s*[a-z]+: .*|\s.*)\n)*Subject: What's cooking in \S+ \((\w+) (\d+), #(\d+); (\w+), (\d+)\)
 438 X-[a-z]*-at: ([0-9a-f]{40})
 439 X-next-at: ([0-9a-f]{40})(?:\n(?i:\s*[a-z]+: .*|\s.*))*
 440
 441 What's cooking in \S+ \(\1 \2, #\3; \4, \5\)
 442 -{30,}
 443 \n*
 444 EOF
 445
 446 my $blurb = "b..l..u..r..b";
 447 sub read_previous {
 448         my ($fn) = @_;
 449         my $fh;
 450         my $section = undef;
 451         my $serial = 1;
 452         my $branch = $blurb;
 453         my $last_empty = undef;
 454         my (@section, %section, @branch, %branch, %description, @leader);
 455         my $in_unedited_olde = 0;
 456
 457         if (!-r $fn) {
 458                 return +{
 459                         'section_list' => [],
 460                         'section_data' => {},
 461                         'topic_description' => {
 462                                 $blurb => {
 463                                         desc => undef,
 464                                         text => blurb_text(),
 465                                 },
 466                         },
 467                 };
 468         }
 469
 470         open ($fh, '<', $fn) or die "$!: open $fn";
 471         while (<$fh>) {
 472                 chomp;
 473                 s/\s+$//;
 474                 if ($in_unedited_olde) {
 475                         if (/^>>$/) {
 476                                 $in_unedited_olde = 0;
 477                                 $_ = " | $_";
 478                         }
 479                 } elsif (/^<<$/) {
 480                         $in_unedited_olde = 1;
 481                 }
 482
 483                 if ($in_unedited_olde) {
 484                         $_ = " | $_";
 485                 }
 486
 487                 if (defined $section && /^-{20,}$/) {
 488                         $_ = "";
 489                 }
 490                 if (/^$/) {
 491                         $last_empty = 1;
 492                         next;
 493                 }
 494                 if (/^\[(.*)\]\s*$/) {
 495                         $section = $1;
 496                         $branch = undef;
 497                         if (!exists $section{$section}) {
 498                                 push @section, $section;
 499                                 $section{$section} = [];
 500                         }
 501                         next;
 502                 }
 503                 if (defined $section && /^\* (\S+) /) {
 504                         $branch = $1;
 505                         $last_empty = 0;
 506                         if (!exists $branch{$branch}) {
 507                                 push @branch, [$branch, $section];
 508                                 $branch{$branch} = 1;
 509                         }
 510                         push @{$section{$section}}, $branch;
 511                 }
 512                 if (defined $branch) {
 513                         my $was_last_empty = $last_empty;
 514                         $last_empty = 0;
 515                         if (!exists $description{$branch}) {
 516                                 $description{$branch} = [];
 517                         }
 518                         if ($was_last_empty) {
 519                                 push @{$description{$branch}}, "";
 520                         }
 521                         push @{$description{$branch}}, $_;
 522                 }
 523         }
 524         close($fh);
 525
 526         my $lead = " ";
 527         for my $branch (keys %description) {
 528                 my $ary = $description{$branch};
 529                 if ($branch eq $blurb) {
 530                         while (@{$ary} && $ary->[-1] =~ /^-{30,}$/) {
 531                                 pop @{$ary};
 532                         }
 533                         $description{$branch} = +{
 534                                 desc => undef,
 535                                 text => join("\n", @{$ary}),
 536                         };
 537                 } else {
 538                         my (@desc, @src, @txt) = ();
 539
 540                         while (@{$ary}) {
 541                                 my $elem = shift @{$ary};
 542                                 last if ($elem eq '');
 543                                 push @desc, $elem;
 544                         }
 545                         for (@{$ary}) {
 546                                 s/^\s+//;
 547                                 $_ = "$lead$_";
 548                                 s/\s+$//;
 549                                 if (/^${lead}source:/) {
 550                                         push @src, $_;
 551                                 } else {
 552                                         push @txt, $_;
 553                                 }
 554                         }
 555
 556                         $description{$branch} = +{
 557                                 desc => join("\n", @desc),
 558                                 text => join("\n", @txt),
 559                                 src => join("\n", @src),
 560                         };
 561                 }
 562         }
 563
 564         return +{
 565                 section_list => \@section,
 566                 section_data => \%section,
 567                 topic_description => \%description,
 568         };
 569 }
 570
 571 sub write_cooking {
 572         my ($fn, $cooking) = @_;
 573         my $fh;
 574
 575         open($fh, '>', $fn) or die "$!: open $fn";
 576         print $fh $cooking->{'topic_description'}{$blurb}{'text'};
 577
 578         for my $section_name (@{$cooking->{'section_list'}}) {
 579                 my $topic_list = $cooking->{'section_data'}{$section_name};
 580                 next if (!@{$topic_list});
 581
 582                 print $fh "\n";
 583                 print $fh '-' x 50, "\n";
 584                 print $fh "[$section_name]\n";
 585                 my $lead = "\n";
 586                 for my $topic (@{$topic_list}) {
 587                         my $d = $cooking->{'topic_description'}{$topic};
 588
 589                         print $fh $lead, $d->{'desc'}, "\n";
 590                         if ($d->{'text'}) {
 591                                 # Final clean-up.  No leading or trailing
 592                                 # blank lines, no multi-line gaps.
 593                                 for ($d->{'text'}) {
 594                                         s/^\n+//s;
 595                                         s/\n{3,}/\n\n/s;
 596                                         s/\n+$//s;
 597                                 }
 598                                 print $fh "\n", $d->{'text'}, "\n";
 599                         }
 600                         if ($d->{'src'}) {
 601                                 if (!$d->{'text'}) {
 602                                         print $fh "\n";
 603                                 }
 604                                 print $fh $d->{'src'}, "\n";
 605                         }
 606                         $lead = "\n\n";
 607                 }
 608         }
 609         close($fh);
 610 }
 611
 612 my $graduated = "Graduated to '$MASTER'";
 613 my $new_topics = 'New Topics';
 614 my $discarded = 'Discarded';
 615 my $cooking_topics = 'Cooking';
 616
 617 sub update_issue {
 618         my ($cooking) = @_;
 619         my ($fh, $master_at, $next_at, $incremental);
 620
 621         open($fh, '-|',
 622              qw(git for-each-ref),
 623              "--format=%(refname:short) %(objectname)",
 624              "refs/heads/$MASTER",
 625              "refs/heads/next") or die "$!: open for-each-ref";
 626         while (<$fh>) {
 627                 my ($branch, $at) = /^(\S+) (\S+)$/;
 628                 if ($branch eq $MASTER) { $master_at = $at; }
 629                 if ($branch eq 'next') { $next_at = $at; }
 630         }
 631         close($fh) or die "$!: close for-each-ref";
 632
 633         $incremental = ((-r "Meta/whats-cooking.txt") &&
 634                         system("cd Meta && " .
 635                                "git diff --quiet --no-ext-diff HEAD -- " .
 636                                "whats-cooking.txt"));
 637
 638         my $now_string = localtime;
 639         my ($current_dow, $current_mon, $current_date, $current_year) =
 640             ($now_string =~ /^(\w+) (\w+) +(\d+) [\d:]+ (\d+)$/);
 641
 642         my $btext = $cooking->{'topic_description'}{$blurb}{'text'};
 643         if ($btext !~ s/\A$blurb_match//) {
 644                 die "match pattern broken?";
 645         }
 646         my ($mon, $year, $issue, $dow, $date) = ($1, $2, $3, $4, $5);
 647
 648         if ($current_mon ne $mon || $current_year ne $year) {
 649                 $issue = "01";
 650         } elsif (!$incremental) {
 651                 $issue =~ s/^0*//;
 652                 $issue = sprintf "%02d", ($issue + 1);
 653         }
 654         $mon = $current_mon;
 655         $year = $current_year;
 656         $dow = $current_dow;
 657         $date = $current_date;
 658
 659         $cooking->{'topic_description'}{$blurb}{'text'} =
 660             blurb_text($mon, $year, $issue, $dow, $date,
 661                        $master_at, $next_at, $btext);
 662
 663         # If starting a new issue, move what used to be in
 664         # new topics to cooking topics.
 665         if (!$incremental) {
 666                 my $sd = $cooking->{'section_data'};
 667                 my $sl = $cooking->{'section_list'};
 668
 669                 if (exists $sd->{$new_topics}) {
 670                         if (!exists $sd->{$cooking_topics}) {
 671                                 $sd->{$cooking_topics} = [];
 672                                 unshift @{$sl}, $cooking_topics;
 673                         }
 674                         unshift @{$sd->{$cooking_topics}}, @{$sd->{$new_topics}};
 675                 }
 676                 $sd->{$new_topics} = [];
 677         }
 678
 679         return $incremental;
 680 }
 681
 682 sub topic_in_seen {
 683         my ($topic_desc) = @_;
 684         for my $line (split(/\n/, $topic_desc)) {
 685                 if ($line =~ /^ [+-] /) {
 686                         return 1;
 687                 }
 688         }
 689         return 0;
 690 }
 691
 692 my $mergetomaster;
 693
 694 sub tweak_willdo {
 695         my ($td) = @_;
 696         my $desc = $td->{'desc'};
 697         my $text = $td->{'text'};
 698
 699         if (!defined $mergetomaster) {
 700                 my $master = `git describe $MASTER`;
 701                 if ($master =~ /-rc(\d+)(-\d+-g[0-9a-f]+)?$/ && $1 != 0) {
 702                         $mergetomaster = "Will cook in 'next'.";
 703                 } else {
 704                         $mergetomaster = "Will merge to '$MASTER'.";
 705                 }
 706         }
 707
 708         # If updated description (i.e. the list of patches with
 709         # merge trail to 'next') has 'merged to next', then
 710         # tweak the topic to be slated to 'master'.
 711         # NEEDSWORK: does this work correctly for a half-merged topic?
 712         $desc =~ s/\n<<\n.*//s;
 713         if ($desc =~ /^  \(merged to 'next'/m) {
 714                 $text =~ s/^ Will merge (back )?to 'next'\.$/ $mergetomaster/m;
 715                 $text =~ s/^ Will merge to and (then )?cook in 'next'\.$/ Will cook in 'next'./m;
 716                 $text =~ s/^ Will merge to 'next' and (then )?to '$MASTER'\.$/ Will merge to '$MASTER'./m;
 717         }
 718         $td->{'text'} = $text;
 719 }
 720
 721 sub tweak_graduated {
 722         my ($td) = @_;
 723
 724         # Remove the "Will merge" marker from topics that have graduated.
 725         for ($td->{'text'}) {
 726                 s/\n Will merge to '$MASTER'\.(\n|$)//s;
 727         }
 728 }
 729
 730 sub merge_cooking {
 731         my ($cooking, $current) = @_;
 732
 733         # A hash to find <desc, text> with a branch name or $blurb
 734         my $td = $cooking->{'topic_description'};
 735
 736         # A hash to find a list of $td element given a section name
 737         my $sd = $cooking->{'section_data'};
 738
 739         # A list of section names
 740         my $sl = $cooking->{'section_list'};
 741
 742         my (@new_topic, @gone_topic);
 743
 744         # Make sure "New Topics" and "Graduated" exists
 745         if (!exists $sd->{$new_topics}) {
 746                 $sd->{$new_topics} = [];
 747                 unshift @{$sl}, $new_topics;
 748         }
 749
 750         if (!exists $sd->{$graduated}) {
 751                 $sd->{$graduated} = [];
 752                 unshift @{$sl}, $graduated;
 753         }
 754
 755         my $incremental = update_issue($cooking);
 756
 757         for my $topic (sort keys %{$current}) {
 758                 if (!exists $td->{$topic}) {
 759                         # Ignore new topics without anything merged
 760                         if (topic_in_seen($current->{$topic}{'desc'})) {
 761                                 push @new_topic, $topic;
 762                                 # lazily find the source for a new topic.
 763                                 $current->{$topic}{'src'} = join("\n", get_source($topic));
 764                         }
 765                         next;
 766                 }
 767
 768                 # Annotate if the contents of the topic changed
 769                 my $topic_changed = 0;
 770                 my $n = $current->{$topic}{'desc'};
 771                 my $o = $td->{$topic}{'desc'};
 772                 if ($n ne $o) {
 773                         $topic_changed = 1;
 774                         $td->{$topic}{'desc'} = $n . "\n<<\n" . $o ."\n>>";
 775                         tweak_willdo($td->{$topic});
 776                 }
 777
 778                 # Keep the original source for unchanged topic
 779                 if ($topic_changed) {
 780                         # lazily find out the source for the latest round.
 781                         $current->{$topic}{'src'} = join("\n", get_source($topic));
 782
 783                         $n = $current->{$topic}{'src'};
 784                         $o = $td->{$topic}{'src'};
 785                         if ($n ne $o) {
 786                                 $o = join("\n",
 787                                           map { s/^\s*//; "-$_"; }
 788                                           split(/\n/, $o));
 789                                 $n = join("\n",
 790                                           map { s/^\s*//; "+$_"; }
 791                                           split(/\n/, $n));
 792                                 $td->{$topic}{'src'} = join("\n", "<<", $o, $n, ">>");
 793                         }
 794                 }
 795         }
 796
 797         for my $topic (sort keys %{$td}) {
 798                 next if ($topic eq $blurb);
 799                 next if (!$incremental &&
 800                          grep { $topic eq $_ } @{$sd->{$graduated}});
 801                 next if (grep { $topic eq $_ } @{$sd->{$discarded}});
 802                 if (!exists $current->{$topic}) {
 803                         push @gone_topic, $topic;
 804                 }
 805         }
 806
 807         for (@new_topic) {
 808                 push @{$sd->{$new_topics}}, $_;
 809                 $td->{$_}{'desc'} = $current->{$_}{'desc'};
 810                 $td->{$_}{'src'} = $current->{$_}{'src'};
 811         }
 812
 813         if (!$incremental) {
 814                 $sd->{$graduated} = [];
 815         }
 816
 817         if (@gone_topic) {
 818                 for my $topic (@gone_topic) {
 819                         for my $section (@{$sl}) {
 820                                 my $pre = scalar(@{$sd->{$section}});
 821                                 @{$sd->{$section}} = (grep { $_ ne $topic }
 822                                                       @{$sd->{$section}});
 823                                 my $post = scalar(@{$sd->{$section}});
 824                                 next if ($pre == $post);
 825                         }
 826                 }
 827                 for (@gone_topic) {
 828                         push @{$sd->{$graduated}}, $_;
 829                         tweak_graduated($td->{$_});
 830                 }
 831         }
 832 }
 833
 834 ################################################################
 835 # WilDo
 836 sub wildo_queue {
 837         my ($what, $action, $topic) = @_;
 838         if (!exists $what->{$action}) {
 839                 $what->{$action} = [];
 840         }
 841         push @{$what->{$action}}, $topic;
 842 }
 843
 844 sub section_action {
 845         my ($section) = @_;
 846         if ($section) {
 847                 for ($section) {
 848                         return if (/^Graduated to/ || /^Discarded$/);
 849                         return $_ if (/^Stalled$/);
 850                 }
 851         }
 852         return "Undecided";
 853 }
 854
 855 sub wildo_flush_topic {
 856         my ($in_section, $what, $topic) = @_;
 857         if (defined $topic) {
 858                 my $action = section_action($in_section);
 859                 if ($action) {
 860                         wildo_queue($what, $action, $topic);
 861                 }
 862         }
 863 }
 864
 865 sub wildo_match {
 866         # NEEDSWORK: unify with Reintegrate::annotate_merge
 867         if (/^Will (?:\S+ ){0,2}(fast-track|hold|keep|merge|drop|discard|cook|kick|defer|eject|be re-?rolled|wait)[,. ]/ ||
 868             /^Not urgent/ || /^Not ready/ || /^Waiting for / || /^Under discussion/ ||
 869             /^Can wait in / || /^Still / || /^Stuck / || /^On hold/ || /^Breaks / ||
 870             /^Needs? / || /^Expecting / || /^May want to / || /^Under review/) {
 871                 return 1;
 872         }
 873         if (/^I think this is ready for /) {
 874                 return 1;
 875         }
 876         return 0;
 877 }
 878
 879 sub wildo {
 880         my $fd = shift;
 881         my (%what, $topic, $last_merge_to_next, $in_section, $in_desc);
 882         my $too_recent = '9999-99-99';
 883         while (<$fd>) {
 884                 chomp;
 885
 886                 if (/^\[(.*)\]$/) {
 887                         my $old_section = $in_section;
 888                         $in_section = $1;
 889                         wildo_flush_topic($old_section, \%what, $topic);
 890                         $topic = $in_desc = undef;
 891                         next;
 892                 }
 893
 894                 if (/^\* (\S+) \(([-0-9]+)\) (\d+) commits?$/) {
 895                         wildo_flush_topic($in_section, \%what, $topic);
 896
 897                         # tip-date, next-date, topic, count, seen-count
 898                         $topic = [$2, $too_recent, $1, $3, 0];
 899                         $in_desc = undef;
 900                         next;
 901                 }
 902
 903                 if (defined $topic &&
 904                     ($topic->[1] eq $too_recent) &&
 905                     ($topic->[4] == 0) &&
 906                     (/^  \(merged to 'next' on ([-0-9]+)/)) {
 907                         $topic->[1] = $1;
 908                 }
 909                 if (defined $topic && /^ - /) {
 910                         $topic->[4]++;
 911                 }
 912
 913                 if (defined $topic && /^$/) {
 914                         $in_desc = 1;
 915                         next;
 916                 }
 917
 918                 next unless defined $topic && $in_desc;
 919
 920                 s/^\s+//;
 921                 if (wildo_match($_)) {
 922                         wildo_queue(\%what, $_, $topic);
 923                         $topic = $in_desc = undef;
 924                 }
 925
 926                 if (/Originally merged to 'next' on ([-0-9]+)/) {
 927                         $topic->[1] = $1;
 928                 }
 929         }
 930         wildo_flush_topic($in_section, \%what, $topic);
 931
 932         my $ipbl = "";
 933         for my $what (sort keys %what) {
 934                 print "$ipbl$what\n";
 935                 for $topic (sort { (($a->[1] cmp $b->[1]) ||
 936                                     ($a->[0] cmp $b->[0])) }
 937                             @{$what{$what}}) {
 938                         my ($tip, $next, $name, $count, $seen) = @$topic;
 939                         my ($sign);
 940                         $tip =~ s/^\d{4}-//;
 941                         if (($next eq $too_recent) || (0 < $seen)) {
 942                                 $sign = "-";
 943                                 $next = " " x 6;
 944                         } else {
 945                                 $sign = "+";
 946                                 $next =~ s|^\d{4}-|/|;
 947                         }
 948                         $count = "#$count";
 949                         printf " %s %-60s %s%s %5s\n", $sign, $name, $tip, $next, $count;
 950                 }
 951                 $ipbl = "\n";
 952         }
 953 }
 954
 955 ################################################################
 956 # HavDone
 957 sub havedone_show {
 958         my $topic = shift;
 959         my $str = shift;
 960         my $prefix = " * ";
 961         $str =~ s/\A\n+//;
 962         $str =~ s/\n+\Z//;
 963
 964         print "($topic)\n";
 965         for $str (split(/\n/, $str)) {
 966                 print "$prefix$str\n";
 967                 $prefix = "   ";
 968         }
 969 }
 970
 971 sub havedone_count {
 972         my @range = @_;
 973         my $cnt = `git rev-list --count @range`;
 974         chomp $cnt;
 975         return $cnt;
 976 }
 977
 978 sub havedone {
 979         my $fh;
 980         my %topic = ();
 981         my @topic = ();
 982         my ($topic, $to_maint, %to_maint, %merged, $in_desc);
 983         if (!@ARGV) {
 984                 open($fh, '-|',
 985                      qw(git rev-list --first-parent -1), $MASTER,
 986                      qw(-- Documentation/RelNotes RelNotes))
 987                     or die "$!: open rev-list";
 988                 my ($rev) = <$fh>;
 989                 close($fh) or die "$!: close rev-list";
 990                 chomp $rev;
 991                 @ARGV = ("$rev..$MASTER");
 992         }
 993         open($fh, '-|',
 994              qw(git log --first-parent --oneline --reverse), @ARGV)
 995             or die "$!: open log --first-parent";
 996         while (<$fh>) {
 997                 my ($sha1, $branch) = /^([0-9a-f]+) Merge branch '(.*)'$/;
 998                 next unless $branch;
 999                 $topic{$branch} = "";
1000                 $merged{$branch} = $sha1;
1001                 push @topic, $branch;
1002         }
1003         close($fh) or die "$!: close log --first-parent";
1004         open($fh, "<", "Meta/whats-cooking.txt")
1005             or die "$!: open whats-cooking";
1006         while (<$fh>) {
1007                 chomp;
1008                 if (/^\[(.*)\]$/) {
1009                         # section header
1010                         $in_desc = $topic = undef;
1011                         next;
1012                 }
1013                 if (/^\* (\S+) \([-0-9]+\) \d+ commits?$/) {
1014                         if (exists $topic{$1}) {
1015                                 $topic = $1;
1016                                 $to_maint = 0;
1017                         } else {
1018                                 $in_desc = $topic = undef;
1019                         }
1020                         next;
1021                 }
1022                 if (defined $topic && /^$/) {
1023                         $in_desc = 1;
1024                         next;
1025                 }
1026
1027                 next unless defined $topic && $in_desc;
1028
1029                 s/^\s+//;
1030                 if (wildo_match($_)) {
1031                         next;
1032                 }
1033                 $topic{$topic} .= "$_\n";
1034         }
1035         close($fh) or die "$!: close whats-cooking";
1036
1037         for $topic (@topic) {
1038                 my $merged = $merged{$topic};
1039                 my $in_master = havedone_count("$merged^1..$merged^2");
1040                 my $not_in_maint = havedone_count("maint..$merged^2");
1041                 if ($in_master == $not_in_maint) {
1042                         $to_maint{$topic} = 1;
1043                 }
1044         }
1045
1046         my $shown = 0;
1047         for $topic (@topic) {
1048                 next if (exists $to_maint{$topic});
1049                 havedone_show($topic, $topic{$topic});
1050                 print "\n";
1051                 $shown++;
1052         }
1053
1054         if ($shown) {
1055                 print "-" x 64, "\n";
1056         }
1057
1058         for $topic (@topic) {
1059                 next unless (exists $to_maint{$topic});
1060                 havedone_show($topic, $topic{$topic});
1061                 my $sha1 = `git rev-parse --short $topic`;
1062                 chomp $sha1;
1063                 print "   (merge $sha1 $topic later to maint).\n";
1064                 print "\n";
1065         }
1066 }
1067
1068 ################################################################
1069 # WhatsCooking
1070
1071 sub doit {
1072         my $cooking = read_previous('Meta/whats-cooking.txt');
1073         my $topic = get_commit($cooking);
1074         merge_cooking($cooking, $topic);
1075         write_cooking('Meta/whats-cooking.txt', $cooking);
1076 }
1077
1078 ################################################################
1079 # Main
1080
1081 use Getopt::Long;
1082
1083 my ($wildo, $havedone);
1084 if (!GetOptions("wildo" => \$wildo,
1085                 "havedone" => \$havedone)) {
1086         print STDERR "$0 [--wildo|--havedone]\n";
1087         exit 1;
1088 }
1089
1090 if ($wildo) {
1091         my $fd;
1092         if (!@ARGV) {
1093                 open($fd, "<", "Meta/whats-cooking.txt");
1094         } elsif (@ARGV != 1) {
1095                 print STDERR "$0 --wildo [filename|HEAD|-]\n";
1096                 exit 1;
1097         } elsif ($ARGV[0] eq '-') {
1098                 $fd = \*STDIN;
1099         } elsif ($ARGV[0] =~ /^HEAD/) {
1100                 open($fd, "-|",
1101                      qw(git --git-dir=Meta/.git cat-file -p),
1102                      "$ARGV[0]:whats-cooking.txt");
1103         } elsif ($ARGV[0] eq ":") {
1104                 open($fd, "-|",
1105                      qw(git --git-dir=Meta/.git cat-file -p),
1106                      ":whats-cooking.txt");
1107         } else {
1108                 open($fd, "<", $ARGV[0]);
1109         }
1110         wildo($fd);
1111 } elsif ($havedone) {
1112         havedone();
1113 } elsif (@ARGV) {
1114         print STDERR "$0 does not take extra args: @ARGV\n";
1115         exit 1;
1116 } else {
1117         doit();
1118 }