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