git/git-topic.perl

#!/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;
}