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