cook

   1 #!/usr/bin/perl -w
   2 # Maintain "what's cooking" messages
   3
   4 use strict;
   5
   6 my %reverts = ('next' => {
   7         map { $_ => 1 } qw(
   8             ) });
   9
  10 %reverts = ();
  11
  12 sub phrase_these {
  13         my (@u) = sort @_;
  14         my @d = ();
  15         for (my $i = 0; $i < @u; $i++) {
  16                 push @d, $u[$i];
  17                 if ($i == @u - 2) {
  18                         push @d, " and ";
  19                 } elsif ($i < @u - 2) {
  20                         push @d, ", ";
  21                 }
  22         }
  23         return join('', @d);
  24 }
  25
  26 sub describe_relation {
  27         my ($topic_info) = @_;
  28         my @desc;
  29
  30         if (exists $topic_info->{'used'}) {
  31                 push @desc, ("is used by " .
  32                              phrase_these(@{$topic_info->{'used'}}));
  33         }
  34
  35         if (exists $topic_info->{'uses'}) {
  36                 push @desc, ("uses " .
  37                              phrase_these(@{$topic_info->{'uses'}}));
  38         }
  39
  40         if (exists $topic_info->{'shares'}) {
  41                 push @desc, ("is tangled with " .
  42                              phrase_these(@{$topic_info->{'shares'}}));
  43         }
  44
  45         if (!@desc) {
  46                 return "";
  47         }
  48
  49         return "(this branch " . join("; ", @desc) . ".)";
  50 }
  51
  52 sub forks_from {
  53         my ($topic, $fork, $forkee, @overlap) = @_;
  54         my %ovl = map { $_ => 1 } (@overlap, @{$topic->{$forkee}{'log'}});
  55
  56         push @{$topic->{$fork}{'uses'}}, $forkee;
  57         push @{$topic->{$forkee}{'used'}}, $fork;
  58         @{$topic->{$fork}{'log'}} = (grep { !exists $ovl{$_} }
  59                                      @{$topic->{$fork}{'log'}});
  60 }
  61
  62 sub topic_relation {
  63         my ($topic, $one, $two) = @_;
  64
  65         my $fh;
  66         open($fh, '-|',
  67              qw(git log --abbrev=7), "--format=%m %h",
  68              "$one...$two", "^master")
  69             or die "$!: open log --left-right";
  70         my (@left, @right);
  71         while (<$fh>) {
  72                 my ($sign, $sha1) = /^(.) (.*)/;
  73                 if ($sign eq '<') {
  74                         push @left, $sha1;
  75                 } elsif ($sign eq '>') {
  76                         push @right, $sha1;
  77                 }
  78         }
  79         close($fh) or die "$!: close log --left-right";
  80
  81         if (!@left) {
  82                 if (@right) {
  83                         forks_from($topic, $two, $one);
  84                 }
  85         } elsif (!@right) {
  86                 forks_from($topic, $one, $two);
  87         } else {
  88                 push @{$topic->{$one}{'shares'}}, $two;
  89                 push @{$topic->{$two}{'shares'}}, $one;
  90         }
  91 }
  92
  93 =head1
  94 Inspect the current set of topics
  95
  96 Returns a hash:
  97
  98     $topic = {
  99         $branchname => {
 100             'tipdate' => date of the tip commit,
 101             'desc' => description string,
 102             'log' => [ $commit,... ],
 103         },
 104     }
 105
 106 =cut
 107
 108 sub get_commit {
 109         my (@base) = qw(master next pu);
 110         my $fh;
 111         open($fh, '-|',
 112              qw(git for-each-ref),
 113              "--format=%(refname:short) %(committerdate:iso8601)",
 114              "refs/heads/??/*")
 115             or die "$!: open for-each-ref";
 116         my @topic;
 117         my %topic;
 118
 119         while (<$fh>) {
 120                 chomp;
 121                 my ($branch, $date) = /^(\S+) (.*)$/;
 122                 push @topic, $branch;
 123                 $date =~ s/ .*//;
 124                 $topic{$branch} = +{
 125                         log => [],
 126                         tipdate => $date,
 127                 };
 128         }
 129         close($fh) or die "$!: close for-each-ref";
 130
 131         my %base = map { $_ => undef } @base;
 132         my %commit;
 133         my $show_branch_batch = 20;
 134
 135         while (@topic) {
 136                 my @t = (@base, splice(@topic, 0, $show_branch_batch));
 137                 my $header_delim = '-' x scalar(@t);
 138                 my $contain_pat = '.' x scalar(@t);
 139                 open($fh, '-|', qw(git show-branch --sparse --sha1-name),
 140                      map { "refs/heads/$_" } @t)
 141                     or die "$!: open show-branch";
 142                 while (<$fh>) {
 143                         chomp;
 144                         if ($header_delim) {
 145                                 if (/^$header_delim$/) {
 146                                         $header_delim = undef;
 147                                 }
 148                                 next;
 149                         }
 150                         my ($contain, $sha1, $log) =
 151                             ($_ =~ /^($contain_pat) \[([0-9a-f]+)\] (.*)$/);
 152
 153                         for (my $i = 0; $i < @t; $i++) {
 154                                 my $branch = $t[$i];
 155                                 my $sign = substr($contain, $i, 1);
 156                                 next if ($sign eq ' ');
 157                                 next if (substr($contain, 0, 1) ne ' ');
 158
 159                                 if (!exists $commit{$sha1}) {
 160                                         $commit{$sha1} = +{
 161                                                 branch => {},
 162                                                 log => $log,
 163                                         };
 164                                 }
 165                                 my $co = $commit{$sha1};
 166                                 if (!exists $reverts{$branch}{$sha1}) {
 167                                         $co->{'branch'}{$branch} = 1;
 168                                 }
 169                                 next if (exists $base{$branch});
 170                                 push @{$topic{$branch}{'log'}}, $sha1;
 171                         }
 172                 }
 173                 close($fh) or die "$!: close show-branch";
 174         }
 175
 176         my %shared;
 177         for my $sha1 (keys %commit) {
 178                 my $sign;
 179                 my $co = $commit{$sha1};
 180                 if (exists $co->{'branch'}{'next'}) {
 181                         $sign = '+';
 182                 } elsif (exists $co->{'branch'}{'pu'}) {
 183                         $sign = '-';
 184                 } else {
 185                         $sign = '.';
 186                 }
 187                 $co->{'log'} = $sign . ' ' . $co->{'log'};
 188                 my @t = (sort grep { !exists $base{$_} }
 189                          keys %{$co->{'branch'}});
 190                 next if (@t < 2);
 191                 my $t = "@t";
 192                 $shared{$t} = 1;
 193         }
 194
 195         for my $combo (keys %shared) {
 196                 my @combo = split(' ', $combo);
 197                 for (my $i = 0; $i < @combo - 1; $i++) {
 198                         for (my $j = $i + 1; $j < @combo; $j++) {
 199                                 topic_relation(\%topic, $combo[$i], $combo[$j]);
 200                         }
 201                 }
 202         }
 203
 204         open($fh, '-|',
 205              qw(git log --first-parent --abbrev=7),
 206              "--format=%ci %h %p :%s", "master..next")
 207             or die "$!: open log master..next";
 208         while (<$fh>) {
 209                 my ($date, $commit, $parent, $tips);
 210                 unless (($date, $commit, $parent, $tips) =
 211                         /^([-0-9]+) ..:..:.. .\d{4} (\S+) (\S+) ([^:]*):/) {
 212                         die "Oops: $_";
 213                 }
 214                 for my $tip (split(' ', $tips)) {
 215                         my $co = $commit{$tip};
 216                         next unless ($co->{'branch'}{'next'});
 217                         $co->{'merged'} = " (merged to 'next' on $date at $commit)";
 218                 }
 219         }
 220         close($fh) or die "$!: close log master..next";
 221
 222         for my $branch (keys %topic) {
 223                 my @log = ();
 224                 my $n = scalar(@{$topic{$branch}{'log'}});
 225                 if (!$n) {
 226                         delete $topic{$branch};
 227                         next;
 228                 } elsif ($n == 1) {
 229                         $n = "1 commit";
 230                 } else {
 231                         $n = "$n commits";
 232                 }
 233                 my $d = $topic{$branch}{'tipdate'};
 234                 my $head = "* $branch ($d) $n\n";
 235                 my @desc;
 236                 for (@{$topic{$branch}{'log'}}) {
 237                         my $co = $commit{$_};
 238                         if (exists $co->{'merged'}) {
 239                                 push @desc, $co->{'merged'};
 240                         }
 241                         push @desc, $commit{$_}->{'log'};
 242                 }
 243                 my $list = join("\n", map { " " . $_ } @desc);
 244                 my $relation = describe_relation($topic{$branch});
 245                 $topic{$branch}{'desc'} = $head . $list;
 246                 if ($relation) {
 247                         $topic{$branch}{'desc'} .= "\n $relation";
 248                 }
 249         }
 250
 251         return \%topic;
 252 }
 253
 254 sub blurb_text {
 255         my ($mon, $year, $issue, $dow, $date,
 256             $master_at, $next_at, $text) = @_;
 257
 258         my $now_string = localtime;
 259         my ($current_dow, $current_mon, $current_date, $current_year) =
 260             ($now_string =~ /^(\w+) (\w+) (\d+) [\d:]+ (\d+)$/);
 261
 262         $mon ||= $current_mon;
 263         $year ||= $current_year;
 264         $issue ||= "01";
 265         $dow ||= $current_dow;
 266         $date ||= $current_date;
 267         $master_at ||= '0' x 40;
 268         $next_at ||= '0' x 40;
 269         $text ||= <<'EOF';
 270 Here are the topics that have been cooking.  Commits prefixed with '-' are
 271 only in 'pu' while commits prefixed with '+' are in 'next'.  The ones
 272 marked with '.' do not appear in any of the integration branches, but I am
 273 still holding onto them.
 274 EOF
 275
 276         $text = <<EOF;
 277 To: git\@vger.kernel.org
 278 Subject: What's cooking in git.git ($mon $year, #$issue; $dow, $date)
 279 X-master-at: $master_at
 280 X-next-at: $next_at
 281
 282 What's cooking in git.git ($mon $year, #$issue; $dow, $date)
 283 --------------------------------------------------
 284
 285 $text
 286 EOF
 287         $text =~ s/\n+\Z/\n/;
 288         return $text;
 289 }
 290
 291 my $blurb_match = <<'EOF';
 292 To: .*
 293 Subject: What's cooking in \S+ \((\w+) (\d+), #(\d+); (\w+), (\d+)\)
 294 X-master-at: ([0-9a-f]{40})
 295 X-next-at: ([0-9a-f]{40})
 296
 297 What's cooking in \S+ \(\1 \2, #\3; \4, \5\)
 298 -{30,}
 299 \n*
 300 EOF
 301
 302 my $blurb = "b..l..u..r..b";
 303 sub read_previous {
 304         my ($fn) = @_;
 305         my $fh;
 306         my $section = undef;
 307         my $serial = 1;
 308         my $branch = $blurb;
 309         my $last_empty = undef;
 310         my (@section, %section, @branch, %branch, %description, @leader);
 311         my $in_unedited_olde = 0;
 312
 313         if (!-r $fn) {
 314                 return +{
 315                         'section_list' => [],
 316                         'section_data' => {},
 317                         'topic_description' => {
 318                                 $blurb => {
 319                                         desc => undef,
 320                                         text => blurb_text(),
 321                                 },
 322                         },
 323                 };
 324         }
 325
 326         open ($fh, '<', $fn) or die "$!: open $fn";
 327         while (<$fh>) {
 328                 chomp;
 329                 if ($in_unedited_olde) {
 330                         if (/^>>$/) {
 331                                 $in_unedited_olde = 0;
 332                                 $_ = " | $_";
 333                         }
 334                 } elsif (/^<<$/) {
 335                         $in_unedited_olde = 1;
 336                 }
 337
 338                 if ($in_unedited_olde) {
 339                         $_ = " | $_";
 340                 }
 341
 342                 if (defined $section && /^-{20,}$/) {
 343                         $_ = "";
 344                 }
 345                 if (/^$/) {
 346                         $last_empty = 1;
 347                         next;
 348                 }
 349                 if (/^\[(.*)\]\s*$/) {
 350                         $section = $1;
 351                         $branch = undef;
 352                         if (!exists $section{$section}) {
 353                                 push @section, $section;
 354                                 $section{$section} = [];
 355                         }
 356                         next;
 357                 }
 358                 if (defined $section && /^\* (\S+) /) {
 359                         $branch = $1;
 360                         $last_empty = 0;
 361                         if (!exists $branch{$branch}) {
 362                                 push @branch, [$branch, $section];
 363                                 $branch{$branch} = 1;
 364                         }
 365                         push @{$section{$section}}, $branch;
 366                 }
 367                 if (defined $branch) {
 368                         my $was_last_empty = $last_empty;
 369                         $last_empty = 0;
 370                         if (!exists $description{$branch}) {
 371                                 $description{$branch} = [];
 372                         }
 373                         if ($was_last_empty) {
 374                                 push @{$description{$branch}}, "";
 375                         }
 376                         push @{$description{$branch}}, $_;
 377                 }
 378         }
 379         close($fh);
 380
 381         for my $branch (keys %description) {
 382                 my $ary = $description{$branch};
 383                 if ($branch eq $blurb) {
 384                         while (@{$ary} && $ary->[-1] =~ /^-{30,}$/) {
 385                                 pop @{$ary};
 386                         }
 387                         $description{$branch} = +{
 388                                 desc => undef,
 389                                 text => join("\n", @{$ary}),
 390                         };
 391                 } else {
 392                         my @desc = ();
 393                         while (@{$ary}) {
 394                                 my $elem = shift @{$ary};
 395                                 last if ($elem eq '');
 396                                 push @desc, $elem;
 397                         }
 398                         $description{$branch} = +{
 399                                 desc => join("\n", @desc),
 400                                 text => join("\n", @{$ary}),
 401                         };
 402                 }
 403         }
 404
 405         return +{
 406                 section_list => \@section,
 407                 section_data => \%section,
 408                 topic_description => \%description,
 409         };
 410 }
 411
 412 sub write_cooking {
 413         my ($fn, $cooking) = @_;
 414         my $fh;
 415
 416         open($fh, '>', $fn) or die "$!: open $fn";
 417         print $fh $cooking->{'topic_description'}{$blurb}{'text'};
 418
 419         for my $section_name (@{$cooking->{'section_list'}}) {
 420                 my $topic_list = $cooking->{'section_data'}{$section_name};
 421                 next if (!@{$topic_list});
 422
 423                 print $fh "\n";
 424                 print $fh '-' x 50, "\n";
 425                 print $fh "[$section_name]\n";
 426                 for my $topic (@{$topic_list}) {
 427                         my $d = $cooking->{'topic_description'}{$topic};
 428
 429                         print $fh "\n", $d->{'desc'}, "\n";
 430                         if ($d->{'text'}) {
 431                                 print $fh "\n", $d->{'text'}, "\n";
 432                         }
 433                 }
 434         }
 435         close($fh);
 436 }
 437
 438 my $graduated = 'Graduated to "master"';
 439 my $new_topics = 'New Topics';
 440 my $old_new_topics = 'Old New Topics';
 441
 442 sub update_issue {
 443         my ($cooking) = @_;
 444         my ($fh, $master_at, $next_at, $incremental);
 445
 446         open($fh, '-|',
 447              qw(git for-each-ref),
 448              "--format=%(refname:short) %(objectname)",
 449              "refs/heads/master",
 450              "refs/heads/next") or die "$!: open for-each-ref";
 451         while (<$fh>) {
 452                 my ($branch, $at) = /^(\S+) (\S+)$/;
 453                 if ($branch eq 'master') { $master_at = $at; }
 454                 if ($branch eq 'next') { $next_at = $at; }
 455         }
 456         close($fh) or die "$!: close for-each-ref";
 457
 458         $incremental = ((-r "Meta/whats-cooking.txt") &&
 459                         system("cd Meta && " .
 460                                "git diff --quiet --no-ext-diff HEAD -- " .
 461                                "whats-cooking.txt"));
 462
 463         my $now_string = localtime;
 464         my ($current_dow, $current_mon, $current_date, $current_year) =
 465             ($now_string =~ /^(\w+) (\w+) +(\d+) [\d:]+ (\d+)$/);
 466
 467         my $btext = $cooking->{'topic_description'}{$blurb}{'text'};
 468         if ($btext !~ s/\A$blurb_match//) {
 469                 die "match pattern broken?";
 470         }
 471         my ($mon, $year, $issue, $dow, $date) = ($1, $2, $3, $4, $5);
 472
 473         if ($current_mon ne $mon || $current_year ne $year) {
 474                 $issue = "01";
 475         } elsif (!$incremental) {
 476                 $issue =~ s/^0*//;
 477                 $issue = sprintf "%02d", ($issue + 1);
 478         }
 479         $mon = $current_mon;
 480         $year = $current_year;
 481         $dow = $current_dow;
 482         $date = $current_date;
 483
 484         $cooking->{'topic_description'}{$blurb}{'text'} =
 485             blurb_text($mon, $year, $issue, $dow, $date,
 486                        $master_at, $next_at, $btext);
 487
 488         if (!$incremental) {
 489                 my $sd = $cooking->{'section_data'};
 490                 my $sl = $cooking->{'section_list'};
 491                 # Rename "New" to "Old New" and insert "New".
 492                 # Move "New" to "Old New"
 493                 my $i;
 494                 my $doneso;
 495                 for ($i = 0; $i < @{$sl}; $i++) {
 496                         if ($sl->[$i] eq $new_topics) {
 497                                 $sl->[$i] = $old_new_topics;
 498                                 unshift @{$sl}, $new_topics;
 499                                 $doneso = 1;
 500                                 last;
 501                         }
 502                 }
 503                 if ($doneso) {
 504                         $sd->{$old_new_topics} = $sd->{$new_topics};
 505                 }
 506                 $sd->{$new_topics} = [];
 507         }
 508
 509         return $incremental;
 510 }
 511
 512 sub topic_in_pu {
 513         my ($topic_desc) = @_;
 514         for my $line (split(/\n/, $topic_desc)) {
 515                 if ($line =~ /^ [+-] /) {
 516                         return 1;
 517                 }
 518         }
 519         return 0;
 520 }
 521
 522 sub merge_cooking {
 523         my ($cooking, $current) = @_;
 524         my $td = $cooking->{'topic_description'};
 525         my $sd = $cooking->{'section_data'};
 526         my $sl = $cooking->{'section_list'};
 527         my (@new_topic, @gone_topic);
 528
 529         # Make sure "New Topics" and "Graduated" exists
 530         if (!exists $sd->{$new_topics}) {
 531                 $sd->{$new_topics} = [];
 532                 unshift @{$sl}, $new_topics;
 533         }
 534
 535         if (!exists $sd->{$graduated}) {
 536                 $sd->{$graduated} = [];
 537                 unshift @{$sl}, $graduated;
 538         }
 539
 540         my $incremental = update_issue($cooking);
 541
 542         for my $topic (sort keys %{$current}) {
 543                 if (!exists $td->{$topic}) {
 544                         # Ignore new topics without anything merged
 545                         if (topic_in_pu($current->{$topic}{'desc'})) {
 546                                 push @new_topic, $topic;
 547                         }
 548                         next;
 549                 }
 550                 my $n = $current->{$topic}{'desc'};
 551                 my $o = $td->{$topic}{'desc'};
 552                 if ($n ne $o) {
 553                         $td->{$topic}{'desc'} = $n . "\n<<\n" . $o ."\n>>";
 554                 }
 555         }
 556
 557         for my $topic (sort keys %{$td}) {
 558                 next if ($topic eq $blurb);
 559                 next if (!$incremental &&
 560                          grep { $topic eq $_ } @{$sd->{$graduated}});
 561                 if (!exists $current->{$topic}) {
 562                         push @gone_topic, $topic;
 563                 }
 564         }
 565
 566         for (@new_topic) {
 567                 push @{$sd->{$new_topics}}, $_;
 568                 $td->{$_}{'desc'} = $current->{$_}{'desc'};
 569         }
 570
 571         if (!$incremental) {
 572                 $sd->{$graduated} = [];
 573         }
 574
 575         if (@gone_topic) {
 576                 for my $topic (@gone_topic) {
 577                         for my $section (@{$sl}) {
 578                                 my $pre = scalar(@{$sd->{$section}});
 579                                 @{$sd->{$section}} = (grep { $_ ne $topic }
 580                                                       @{$sd->{$section}});
 581                                 my $post = scalar(@{$sd->{$section}});
 582                                 next if ($pre == $post);
 583                         }
 584                 }
 585                 for (@gone_topic) {
 586                         push @{$sd->{$graduated}}, $_;
 587                 }
 588         }
 589 }
 590
 591 ################################################################
 592 # WilDo
 593 sub wildo_queue {
 594         my ($what, $action, $topic) = @_;
 595         if (!exists $what->{$action}) {
 596                 $what->{$action} = [];
 597         }
 598         push @{$what->{$action}}, $topic;
 599 }
 600
 601 sub wildo {
 602         my (%what, $topic, $last_merge_to_next);
 603         my $too_recent = '9999-99-99';
 604         while (<>) {
 605                 chomp;
 606
 607                 next if (/^\[Graduated to/../^-{20,}$/);
 608                 next if (/^\[Stalled\]/../^-{20,}$/);
 609                 next if (/^\[Discarded\]/../^-{20,}$/);
 610
 611                 if (/^\* (\S+) \(([-0-9]+)\) (\d+) commits?$/) {
 612                         if (defined $topic) {
 613                                 wildo_queue(\%what, "Undecided", $topic);
 614                         }
 615                         # tip-date, next-date, topic, count, pu-count
 616                         $topic = [$2, $too_recent, $1, $3, 0];
 617                         next;
 618                 }
 619                 if (defined $topic &&
 620                     ($topic->[1] eq $too_recent) &&
 621                     ($topic->[4] == 0) &&
 622                     (/^  \(merged to 'next' on ([-0-9]+)/)) {
 623                         $topic->[1] = $1;
 624                 }
 625                 if (defined $topic && /^ - /) {
 626                         $topic->[4]++;
 627                 }
 628                 next if (/^ /);
 629                 if (defined $topic &&
 630                     /Will (?:\S+ )?(merge|drop|discard|cook)[. ]/i) {
 631                         wildo_queue(\%what, $_, $topic);
 632                         $topic = undef;
 633                 }
 634         }
 635         if (defined $topic) {
 636                 wildo_queue(\%what, "Undecided", $topic);
 637         }
 638         my $ipbl = "";
 639         for my $what (sort keys %what) {
 640                 print "$ipbl$what\n";
 641                 for $topic (sort { (($a->[1] cmp $b->[1]) ||
 642                                     ($a->[0] cmp $b->[0])) }
 643                             @{$what{$what}}) {
 644                         my ($tip, $next, $name, $count, $pu) = @$topic;
 645                         my ($sign);
 646                         $tip =~ s/^\d{4}-//;
 647                         if (($next eq $too_recent) || (0 < $pu)) {
 648                                 $sign = "-";
 649                                 $next = " " x 6;
 650                         } else {
 651                                 $sign = "+";
 652                                 $next =~ s|^\d{4}-|/|;
 653                         }
 654                         $count = "#$count";
 655                         printf " %s %-60s %s%s %5s\n", $sign, $name, $tip, $next, $count;
 656                 }
 657                 $ipbl = "\n";
 658         }
 659 }
 660
 661 ################################################################
 662 # WhatsCooking
 663
 664 sub doit {
 665         my $topic = get_commit();
 666         my $cooking = read_previous('Meta/whats-cooking.txt');
 667         merge_cooking($cooking, $topic);
 668         write_cooking('Meta/whats-cooking.txt', $cooking);
 669 }
 670
 671 ################################################################
 672 # Main
 673
 674 use Getopt::Long;
 675
 676 my $wildo;
 677 if (!GetOptions("wildo" => \$wildo)) {
 678         print STDERR "$0 [--wildo]";
 679         exit 1;
 680 }
 681
 682 if ($wildo) {
 683         if (!@ARGV) {
 684                 push @ARGV, "Meta/whats-cooking.txt";
 685         }
 686         wildo();
 687 } else {
 688         doit();
 689 }