blob: 7adc243e82c2e9ba3cda7804fa470ac7cb5dcc00 [file] [log] [blame]
#!/usr/bin/perl -w
#
# Copyright (c) 2006 Junio C Hamano
#
use strict;
use Getopt::Long;
my $topic_pattern = '??*/*';
my $base = 'next';
my @stage = qw(next seen);
my @mark = ('.', '?', '-', '+');
my $all = 0;
my $merges = 0;
my $tests = 0;
my @custom_stage;
my @custom_mark;
GetOptions("topic=s" => \$topic_pattern,
"base=s" => \$base,
"stage=s" => \@custom_stage,
"mark=s" => \@custom_mark,
"merges!" => \$merges,
"tests!" => \$tests,
"all!" => \$all)
or die;
if (@custom_stage) { @stage = @custom_stage; }
if (@custom_mark) { @mark = @custom_mark; }
my @nomerges = $merges ? qw(--no-merges) : ();
sub read_revs_short {
my (@args) = @_;
my @revs;
open(REVS, '-|', qw(git rev-list), @nomerges, @args)
or die;
while (<REVS>) {
chomp;
push @revs, $_;
}
close(REVS);
return @revs;
}
sub read_revs {
my ($bottom, $top, $mask) = @_;
my @revs;
open(REVS, '-|', qw(git rev-list --pretty=oneline), @nomerges,
"$bottom..$top")
or die;
while (<REVS>) {
chomp;
my ($sha1, $topic) = /^([0-9a-f]{40}) (.*)$/;
push @revs, [$sha1, $topic, $mask];
}
close(REVS);
return @revs;
}
sub rebase_marker {
my ($topic, $stage, $in_next) = @_;
my @not_in_topic = read_revs_short('^master', "^$topic", "$stage");
# @$in_next is what is in $stage but not in $base.
# @not_in_topic excludes what came from $topic from @$in_next.
# $topic can be rebased if these two set matches, because
# no commits in $topic has been merged to $stage yet.
if (@not_in_topic != @$in_next) {
# we cannot rebase it anymore
return ' ';
}
if (read_revs_short('master', "^$topic")) {
# there is something that is in master but not in topic.
return '^';
}
# topic is up to date.
return '*';
}
my %atlog_next = ();
my %atlog_test = ();
sub next_marker {
my ($topic) = @_;
return '' if (!$tests);
return '??' if (!exists $atlog_next{$topic});
for ($atlog_next{$topic}) {
my ($merge, $test) = ('*', '*');
if (/rerere ok/) {
$merge = 'R';
} elsif (/conflict (\d+)/) {
if ($1 < 10) {
$merge = $1;
} else {
$merge = 'X';
}
}
$test = 'X' if (/test error/);
return "$merge$test";
}
}
sub test_marker {
my ($commit) = @_;
return '' if (!$tests);
my $tree = `git rev-parse "$commit^{tree}"`;
chomp($tree);
return "?" if (!exists $atlog_test{$tree});
for ($atlog_test{$tree}) {
if (/build error/) {
return 'B';
} elsif (/test error/) {
return 'X';
} else {
return ' ';
}
}
}
sub describe_topic {
my ($topic) = @_;
open(CONF, '-|', qw(git repo-config --get),
"branch.$topic.description")
or die;
my $it = join('',<CONF>);
close(CONF);
chomp($it);
if ($it) {
wrap_print(" $it");
}
}
my @in_next = read_revs_short('^master', $stage[0]);
my @topic = ();
my @topic_pattern = map { "refs/heads/$_" } (@ARGV ? @ARGV : $topic_pattern);
open(TOPIC, '-|', qw(git for-each-ref),
'--sort=-authordate',
'--format=%(objectname) %(authordate) %(refname)',
@topic_pattern)
or die;
while (<TOPIC>) {
chomp;
my ($sha1, $date, $topic) = m|^([0-9a-f]{40})\s(.*?)\srefs/heads/(.+)$|
or next;
push @topic, [$sha1, $date, $topic];
}
close(TOPIC);
if (open(AT, "Meta/AT.log")) {
my $next = `git rev-parse --verify refs/heads/next`;
chomp $next;
while (<AT>) {
if (/^N (.{40}) (.{40}) (.*)$/ && $1 eq $next) {
$atlog_next{$2} = $3;
next;
}
if (/^A (.{40}) (.*)/) {
$atlog_test{$1} = $2;
next;
}
}
close(AT);
}
my @last_merge_to_next = ();
for (@topic) {
my ($sha1, $date, $topic) = @$_;
my @revs = read_revs($base, $sha1, (1<<@stage)-1);
next unless (@revs || $all);
my %revs = map { $_->[0] => $_ } @revs; # fast index
for (my $i = 0; $i < @stage; $i++) {
for my $item (read_revs_short("^$stage[$i]", $sha1)) {
if (exists $revs{$item}) {
$revs{$item}[2] &= ~(1 << $i);
}
}
}
print '*' .
next_marker($sha1) .
rebase_marker($sha1, $stage[0], \@in_next);
my $count = "";
if (1 < @revs) {
$count = " " . (scalar @revs) . " commits";
}
elsif (@revs) {
$count = " 1 commit";
}
print " $topic ($date)$count\n";
describe_topic($topic);
for my $item (@revs) {
my $mark = $item->[2];
if ($mark < @mark) {
$mark = $mark[$mark];
}
if ($tests) {
$mark = test_marker($item->[0]) . $mark;
}
wrap_print("$mark $item->[1]");
}
}
sub wrap_print {
my ($string) = @_;
format STDOUT =
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$string
~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$string
.
write;
}