Point MAN_BASE_URL to git-htmldocs/ for now
[alt-git.git] / cook
blob4369ac73ffec68301d1123e141e4cb7dafec6282
1 #!/usr/bin/perl -w
2 # Maintain "what's cooking" messages
4 use strict;
6 my %reverts = ('next' => {
7 map { $_ => 1 } qw(
8 ) });
10 %reverts = ();
12 sub phrase_these {
13 my %uniq = ();
14 my (@u) = grep { $uniq{$_}++ == 0 } sort @_;
15 my @d = ();
16 for (my $i = 0; $i < @u; $i++) {
17 push @d, $u[$i];
18 if ($i == @u - 2) {
19 push @d, " and ";
20 } elsif ($i < @u - 2) {
21 push @d, ", ";
24 return join('', @d);
27 sub describe_relation {
28 my ($topic_info) = @_;
29 my @desc;
31 if (exists $topic_info->{'used'}) {
32 push @desc, ("is used by " .
33 phrase_these(@{$topic_info->{'used'}}));
36 if (exists $topic_info->{'uses'}) {
37 push @desc, ("uses " .
38 phrase_these(@{$topic_info->{'uses'}}));
41 if (exists $topic_info->{'shares'}) {
42 push @desc, ("is tangled with " .
43 phrase_these(@{$topic_info->{'shares'}}));
46 if (!@desc) {
47 return "";
50 return "(this branch " . join("; ", @desc) . ".)";
53 sub forks_from {
54 my ($topic, $fork, $forkee, @overlap) = @_;
55 my %ovl = map { $_ => 1 } (@overlap, @{$topic->{$forkee}{'log'}});
57 push @{$topic->{$fork}{'uses'}}, $forkee;
58 push @{$topic->{$forkee}{'used'}}, $fork;
59 @{$topic->{$fork}{'log'}} = (grep { !exists $ovl{$_} }
60 @{$topic->{$fork}{'log'}});
63 sub topic_relation {
64 my ($topic, $one, $two) = @_;
66 my $fh;
67 open($fh, '-|',
68 qw(git log --abbrev=7), "--format=%m %h",
69 "$one...$two", "^master")
70 or die "$!: open log --left-right";
71 my (@left, @right);
72 while (<$fh>) {
73 my ($sign, $sha1) = /^(.) (.*)/;
74 if ($sign eq '<') {
75 push @left, $sha1;
76 } elsif ($sign eq '>') {
77 push @right, $sha1;
80 close($fh) or die "$!: close log --left-right";
82 if (!@left) {
83 if (@right) {
84 forks_from($topic, $two, $one);
86 } elsif (!@right) {
87 forks_from($topic, $one, $two);
88 } else {
89 push @{$topic->{$one}{'shares'}}, $two;
90 push @{$topic->{$two}{'shares'}}, $one;
94 =head1
95 Inspect the current set of topics
97 Returns a hash:
99 $topic = {
100 $branchname => {
101 'tipdate' => date of the tip commit,
102 'desc' => description string,
103 'log' => [ $commit,... ],
107 =cut
109 sub get_commit {
110 my (@base) = qw(master next pu);
111 my $fh;
112 open($fh, '-|',
113 qw(git for-each-ref),
114 "--format=%(refname:short) %(committerdate:iso8601)",
115 "refs/heads/??/*")
116 or die "$!: open for-each-ref";
117 my @topic;
118 my %topic;
120 while (<$fh>) {
121 chomp;
122 my ($branch, $date) = /^(\S+) (.*)$/;
123 push @topic, $branch;
124 $date =~ s/ .*//;
125 $topic{$branch} = +{
126 log => [],
127 tipdate => $date,
130 close($fh) or die "$!: close for-each-ref";
132 my %base = map { $_ => undef } @base;
133 my %commit;
134 my $show_branch_batch = 20;
136 while (@topic) {
137 my @t = (@base, splice(@topic, 0, $show_branch_batch));
138 my $header_delim = '-' x scalar(@t);
139 my $contain_pat = '.' x scalar(@t);
140 open($fh, '-|', qw(git show-branch --sparse --sha1-name),
141 map { "refs/heads/$_" } @t)
142 or die "$!: open show-branch";
143 while (<$fh>) {
144 chomp;
145 if ($header_delim) {
146 if (/^$header_delim$/) {
147 $header_delim = undef;
149 next;
151 my ($contain, $sha1, $log) =
152 ($_ =~ /^($contain_pat) \[([0-9a-f]+)\] (.*)$/);
154 for (my $i = 0; $i < @t; $i++) {
155 my $branch = $t[$i];
156 my $sign = substr($contain, $i, 1);
157 next if ($sign eq ' ');
158 next if (substr($contain, 0, 1) ne ' ');
160 if (!exists $commit{$sha1}) {
161 $commit{$sha1} = +{
162 branch => {},
163 log => $log,
166 my $co = $commit{$sha1};
167 if (!exists $reverts{$branch}{$sha1}) {
168 $co->{'branch'}{$branch} = 1;
170 next if (exists $base{$branch});
171 push @{$topic{$branch}{'log'}}, $sha1;
174 close($fh) or die "$!: close show-branch";
177 my %shared;
178 for my $sha1 (keys %commit) {
179 my $sign;
180 my $co = $commit{$sha1};
181 if (exists $co->{'branch'}{'next'}) {
182 $sign = '+';
183 } elsif (exists $co->{'branch'}{'pu'}) {
184 $sign = '-';
185 } else {
186 $sign = '.';
188 $co->{'log'} = $sign . ' ' . $co->{'log'};
189 my @t = (sort grep { !exists $base{$_} }
190 keys %{$co->{'branch'}});
191 next if (@t < 2);
192 my $t = "@t";
193 $shared{$t} = 1;
196 for my $combo (keys %shared) {
197 my @combo = split(' ', $combo);
198 for (my $i = 0; $i < @combo - 1; $i++) {
199 for (my $j = $i + 1; $j < @combo; $j++) {
200 topic_relation(\%topic, $combo[$i], $combo[$j]);
205 open($fh, '-|',
206 qw(git log --first-parent --abbrev=7),
207 "--format=%ci %h %p :%s", "master..next")
208 or die "$!: open log master..next";
209 while (<$fh>) {
210 my ($date, $commit, $parent, $tips);
211 unless (($date, $commit, $parent, $tips) =
212 /^([-0-9]+) ..:..:.. .\d{4} (\S+) (\S+) ([^:]*):/) {
213 die "Oops: $_";
215 for my $tip (split(' ', $tips)) {
216 my $co = $commit{$tip};
217 next unless ($co->{'branch'}{'next'});
218 $co->{'merged'} = " (merged to 'next' on $date at $commit)";
221 close($fh) or die "$!: close log master..next";
223 for my $branch (keys %topic) {
224 my @log = ();
225 my $n = scalar(@{$topic{$branch}{'log'}});
226 if (!$n) {
227 delete $topic{$branch};
228 next;
229 } elsif ($n == 1) {
230 $n = "1 commit";
231 } else {
232 $n = "$n commits";
234 my $d = $topic{$branch}{'tipdate'};
235 my $head = "* $branch ($d) $n\n";
236 my @desc;
237 for (@{$topic{$branch}{'log'}}) {
238 my $co = $commit{$_};
239 if (exists $co->{'merged'}) {
240 push @desc, $co->{'merged'};
242 push @desc, $commit{$_}->{'log'};
245 if (80 < @desc) {
246 @desc = @desc[0..4];
247 push @desc, "- ...";
250 my $list = join("\n", map { " " . $_ } @desc);
251 my $relation = describe_relation($topic{$branch});
252 $topic{$branch}{'desc'} = $head . $list;
253 if ($relation) {
254 $topic{$branch}{'desc'} .= "\n $relation";
258 return \%topic;
261 sub blurb_text {
262 my ($mon, $year, $issue, $dow, $date,
263 $master_at, $next_at, $text) = @_;
265 my $now_string = localtime;
266 my ($current_dow, $current_mon, $current_date, $current_year) =
267 ($now_string =~ /^(\w+) (\w+) (\d+) [\d:]+ (\d+)$/);
269 $mon ||= $current_mon;
270 $year ||= $current_year;
271 $issue ||= "01";
272 $dow ||= $current_dow;
273 $date ||= $current_date;
274 $master_at ||= '0' x 40;
275 $next_at ||= '0' x 40;
276 $text ||= <<'EOF';
277 Here are the topics that have been cooking. Commits prefixed with '-' are
278 only in 'pu' (proposed updates) while commits prefixed with '+' are in 'next'.
279 The ones marked with '.' do not appear in any of the integration branches,
280 but I am still holding onto them.
282 You can find the changes described here in the integration branches of the
283 repositories listed at
285 http://git-blame.blogspot.com/p/git-public-repositories.html
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
294 What's cooking in git.git ($mon $year, #$issue; $dow, $date)
295 --------------------------------------------------
297 $text
299 $text =~ s/\n+\Z/\n/;
300 return $text;
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})
309 What's cooking in \S+ \(\1 \2, #\3; \4, \5\)
310 -{30,}
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;
325 if (!-r $fn) {
326 return +{
327 'section_list' => [],
328 'section_data' => {},
329 'topic_description' => {
330 $blurb => {
331 desc => undef,
332 text => blurb_text(),
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 $_ = " | $_";
346 } elsif (/^<<$/) {
347 $in_unedited_olde = 1;
350 if ($in_unedited_olde) {
351 $_ = " | $_";
354 if (defined $section && /^-{20,}$/) {
355 $_ = "";
357 if (/^$/) {
358 $last_empty = 1;
359 next;
361 if (/^\[(.*)\]\s*$/) {
362 $section = $1;
363 $branch = undef;
364 if (!exists $section{$section}) {
365 push @section, $section;
366 $section{$section} = [];
368 next;
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;
377 push @{$section{$section}}, $branch;
379 if (defined $branch) {
380 my $was_last_empty = $last_empty;
381 $last_empty = 0;
382 if (!exists $description{$branch}) {
383 $description{$branch} = [];
385 if ($was_last_empty) {
386 push @{$description{$branch}}, "";
388 push @{$description{$branch}}, $_;
391 close($fh);
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};
399 $description{$branch} = +{
400 desc => undef,
401 text => join("\n", @{$ary}),
403 } else {
404 my @desc = ();
405 while (@{$ary}) {
406 my $elem = shift @{$ary};
407 last if ($elem eq '');
408 push @desc, $elem;
410 $description{$branch} = +{
411 desc => join("\n", @desc),
412 text => join("\n", @{$ary}),
417 return +{
418 section_list => \@section,
419 section_data => \%section,
420 topic_description => \%description,
424 sub write_cooking {
425 my ($fn, $cooking) = @_;
426 my $fh;
428 open($fh, '>', $fn) or die "$!: open $fn";
429 print $fh $cooking->{'topic_description'}{$blurb}{'text'};
431 for my $section_name (@{$cooking->{'section_list'}}) {
432 my $topic_list = $cooking->{'section_data'}{$section_name};
433 next if (!@{$topic_list});
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};
441 print $fh "\n", $d->{'desc'}, "\n";
442 if ($d->{'text'}) {
443 print $fh "\n", $d->{'text'}, "\n";
447 close($fh);
450 my $graduated = 'Graduated to "master"';
451 my $new_topics = 'New Topics';
452 my $discarded = 'Discarded';
453 my $old_new_topics = 'Old New Topics';
455 sub update_issue {
456 my ($cooking) = @_;
457 my ($fh, $master_at, $next_at, $incremental);
459 open($fh, '-|',
460 qw(git for-each-ref),
461 "--format=%(refname:short) %(objectname)",
462 "refs/heads/master",
463 "refs/heads/next") or die "$!: open for-each-ref";
464 while (<$fh>) {
465 my ($branch, $at) = /^(\S+) (\S+)$/;
466 if ($branch eq 'master') { $master_at = $at; }
467 if ($branch eq 'next') { $next_at = $at; }
469 close($fh) or die "$!: close for-each-ref";
471 $incremental = ((-r "Meta/whats-cooking.txt") &&
472 system("cd Meta && " .
473 "git diff --quiet --no-ext-diff HEAD -- " .
474 "whats-cooking.txt"));
476 my $now_string = localtime;
477 my ($current_dow, $current_mon, $current_date, $current_year) =
478 ($now_string =~ /^(\w+) (\w+) +(\d+) [\d:]+ (\d+)$/);
480 my $btext = $cooking->{'topic_description'}{$blurb}{'text'};
481 if ($btext !~ s/\A$blurb_match//) {
482 die "match pattern broken?";
484 my ($mon, $year, $issue, $dow, $date) = ($1, $2, $3, $4, $5);
486 if ($current_mon ne $mon || $current_year ne $year) {
487 $issue = "01";
488 } elsif (!$incremental) {
489 $issue =~ s/^0*//;
490 $issue = sprintf "%02d", ($issue + 1);
492 $mon = $current_mon;
493 $year = $current_year;
494 $dow = $current_dow;
495 $date = $current_date;
497 $cooking->{'topic_description'}{$blurb}{'text'} =
498 blurb_text($mon, $year, $issue, $dow, $date,
499 $master_at, $next_at, $btext);
501 if (!$incremental) {
502 my $sd = $cooking->{'section_data'};
503 my $sl = $cooking->{'section_list'};
504 # Rename "New" to "Old New" and insert "New".
505 # Move "New" to "Old New"
506 my $i;
507 my $doneso;
508 for ($i = 0; $i < @{$sl}; $i++) {
509 if ($sl->[$i] eq $new_topics) {
510 $sl->[$i] = $old_new_topics;
511 unshift @{$sl}, $new_topics;
512 $doneso = 1;
513 last;
516 if ($doneso) {
517 $sd->{$old_new_topics} = $sd->{$new_topics};
519 $sd->{$new_topics} = [];
522 return $incremental;
525 sub topic_in_pu {
526 my ($topic_desc) = @_;
527 for my $line (split(/\n/, $topic_desc)) {
528 if ($line =~ /^ [+-] /) {
529 return 1;
532 return 0;
535 sub merge_cooking {
536 my ($cooking, $current) = @_;
537 my $td = $cooking->{'topic_description'};
538 my $sd = $cooking->{'section_data'};
539 my $sl = $cooking->{'section_list'};
540 my (@new_topic, @gone_topic);
542 # Make sure "New Topics" and "Graduated" exists
543 if (!exists $sd->{$new_topics}) {
544 $sd->{$new_topics} = [];
545 unshift @{$sl}, $new_topics;
548 if (!exists $sd->{$graduated}) {
549 $sd->{$graduated} = [];
550 unshift @{$sl}, $graduated;
553 my $incremental = update_issue($cooking);
555 for my $topic (sort keys %{$current}) {
556 if (!exists $td->{$topic}) {
557 # Ignore new topics without anything merged
558 if (topic_in_pu($current->{$topic}{'desc'})) {
559 push @new_topic, $topic;
561 next;
563 # Annotate if the contents of the topic changed
564 my $n = $current->{$topic}{'desc'};
565 my $o = $td->{$topic}{'desc'};
566 if ($n ne $o) {
567 $td->{$topic}{'desc'} = $n . "\n<<\n" . $o ."\n>>";
571 for my $topic (sort keys %{$td}) {
572 next if ($topic eq $blurb);
573 next if (!$incremental &&
574 grep { $topic eq $_ } @{$sd->{$graduated}});
575 next if (grep { $topic eq $_ } @{$sd->{$discarded}});
576 if (!exists $current->{$topic}) {
577 push @gone_topic, $topic;
581 for (@new_topic) {
582 push @{$sd->{$new_topics}}, $_;
583 $td->{$_}{'desc'} = $current->{$_}{'desc'};
586 if (!$incremental) {
587 $sd->{$graduated} = [];
590 if (@gone_topic) {
591 for my $topic (@gone_topic) {
592 for my $section (@{$sl}) {
593 my $pre = scalar(@{$sd->{$section}});
594 @{$sd->{$section}} = (grep { $_ ne $topic }
595 @{$sd->{$section}});
596 my $post = scalar(@{$sd->{$section}});
597 next if ($pre == $post);
600 for (@gone_topic) {
601 push @{$sd->{$graduated}}, $_;
606 ################################################################
607 # WilDo
608 sub wildo_queue {
609 my ($what, $action, $topic) = @_;
610 if (!exists $what->{$action}) {
611 $what->{$action} = [];
613 push @{$what->{$action}}, $topic;
616 sub section_action {
617 my ($section) = @_;
618 if ($section) {
619 for ($section) {
620 return if (/^Graduated to/ || /^Discarded$/);
621 return $_ if (/^Stalled$/);
624 return "Undecided";
627 sub wildo_flush_topic {
628 my ($in_section, $what, $topic) = @_;
629 if (defined $topic) {
630 my $action = section_action($in_section);
631 if ($action) {
632 wildo_queue($what, $action, $topic);
637 sub wildo {
638 my (%what, $topic, $last_merge_to_next, $in_section);
639 my $too_recent = '9999-99-99';
640 while (<>) {
641 chomp;
643 if (/^\[(.*)\]$/) {
644 my $old_section = $in_section;
645 $in_section = $1;
646 wildo_flush_topic($old_section, \%what, $topic);
647 $topic = undef;
648 next;
651 if (/^\* (\S+) \(([-0-9]+)\) (\d+) commits?$/) {
652 wildo_flush_topic($in_section, \%what, $topic);
654 # tip-date, next-date, topic, count, pu-count
655 $topic = [$2, $too_recent, $1, $3, 0];
656 next;
659 if (defined $topic &&
660 ($topic->[1] eq $too_recent) &&
661 ($topic->[4] == 0) &&
662 (/^ \(merged to 'next' on ([-0-9]+)/)) {
663 $topic->[1] = $1;
665 if (defined $topic && /^ - /) {
666 $topic->[4]++;
668 next if (/^ /);
669 next unless defined $topic;
671 if (/^Will (?:\S+ ){0,2}(keep|merge|drop|discard|cook|kick|defer)[,. ]/ ||
672 /^Not urgent/ || /^Not ready/ || /^Waiting for / ||
673 /^Needs? / || /^Expecting / || /^May want to /) {
674 wildo_queue(\%what, $_, $topic);
675 $topic = undef;
677 if (/^Not urgent;/) {
678 wildo_queue(\%what, $_, $topic);
679 $topic = undef;
681 if (/Originally merged to 'next' on ([-0-9]+)/) {
682 $topic->[1] = $1;
685 wildo_flush_topic($in_section, \%what, $topic);
687 my $ipbl = "";
688 for my $what (sort keys %what) {
689 print "$ipbl$what\n";
690 for $topic (sort { (($a->[1] cmp $b->[1]) ||
691 ($a->[0] cmp $b->[0])) }
692 @{$what{$what}}) {
693 my ($tip, $next, $name, $count, $pu) = @$topic;
694 my ($sign);
695 $tip =~ s/^\d{4}-//;
696 if (($next eq $too_recent) || (0 < $pu)) {
697 $sign = "-";
698 $next = " " x 6;
699 } else {
700 $sign = "+";
701 $next =~ s|^\d{4}-|/|;
703 $count = "#$count";
704 printf " %s %-60s %s%s %5s\n", $sign, $name, $tip, $next, $count;
706 $ipbl = "\n";
710 ################################################################
711 # WhatsCooking
713 sub doit {
714 my $topic = get_commit();
715 my $cooking = read_previous('Meta/whats-cooking.txt');
716 merge_cooking($cooking, $topic);
717 write_cooking('Meta/whats-cooking.txt', $cooking);
720 ################################################################
721 # Main
723 use Getopt::Long;
725 my $wildo;
726 if (!GetOptions("wildo" => \$wildo)) {
727 print STDERR "$0 [--wildo]";
728 exit 1;
731 if ($wildo) {
732 if (!@ARGV) {
733 push @ARGV, "Meta/whats-cooking.txt";
735 wildo();
736 } else {
737 doit();