What's cooking (2021/06 #06)

[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;
}