Meta/RelBuild: force specific subkey to be used to sign tarballs for kup
[alt-git.git] / git-topic.perl
blob7c241e54d9d53cf52b5543951eb03ce349ba6870
1 #!/usr/bin/perl -w
3 # Copyright (c) 2006 Junio C Hamano
6 use strict;
7 use Getopt::Long;
9 my $topic_pattern = '??*/*';
10 my $base = 'next';
11 my @stage = qw(next pu);
12 my @mark = ('.', '?', '-', '+');
13 my $all = 0;
14 my $merges = 0;
15 my $tests = 0;
17 my @custom_stage;
18 my @custom_mark;
19 GetOptions("topic=s" => \$topic_pattern,
20 "base=s" => \$base,
21 "stage=s" => \@custom_stage,
22 "mark=s" => \@custom_mark,
23 "merges!" => \$merges,
24 "tests!" => \$tests,
25 "all!" => \$all)
26 or die;
28 if (@custom_stage) { @stage = @custom_stage; }
29 if (@custom_mark) { @mark = @custom_mark; }
30 my @nomerges = $merges ? qw(--no-merges) : ();
32 sub read_revs_short {
33 my (@args) = @_;
34 my @revs;
35 open(REVS, '-|', qw(git rev-list), @nomerges, @args)
36 or die;
37 while (<REVS>) {
38 chomp;
39 push @revs, $_;
41 close(REVS);
42 return @revs;
45 sub read_revs {
46 my ($bottom, $top, $mask) = @_;
47 my @revs;
48 open(REVS, '-|', qw(git rev-list --pretty=oneline), @nomerges,
49 "$bottom..$top")
50 or die;
51 while (<REVS>) {
52 chomp;
53 my ($sha1, $topic) = /^([0-9a-f]{40}) (.*)$/;
54 push @revs, [$sha1, $topic, $mask];
56 close(REVS);
57 return @revs;
60 sub rebase_marker {
61 my ($topic, $stage, $in_next) = @_;
62 my @not_in_topic = read_revs_short('^master', "^$topic", "$stage");
64 # @$in_next is what is in $stage but not in $base.
65 # @not_in_topic excludes what came from $topic from @$in_next.
66 # $topic can be rebased if these two set matches, because
67 # no commits in $topic has been merged to $stage yet.
68 if (@not_in_topic != @$in_next) {
69 # we cannot rebase it anymore
70 return ' ';
72 if (read_revs_short('master', "^$topic")) {
73 # there is something that is in master but not in topic.
74 return '^';
76 # topic is up to date.
77 return '*';
80 my %atlog_next = ();
81 my %atlog_test = ();
83 sub next_marker {
84 my ($topic) = @_;
85 return '' if (!$tests);
86 return '??' if (!exists $atlog_next{$topic});
87 for ($atlog_next{$topic}) {
88 my ($merge, $test) = ('*', '*');
89 if (/rerere ok/) {
90 $merge = 'R';
91 } elsif (/conflict (\d+)/) {
92 if ($1 < 10) {
93 $merge = $1;
94 } else {
95 $merge = 'X';
98 $test = 'X' if (/test error/);
99 return "$merge$test";
103 sub test_marker {
104 my ($commit) = @_;
105 return '' if (!$tests);
106 my $tree = `git rev-parse "$commit^{tree}"`;
107 chomp($tree);
108 return "?" if (!exists $atlog_test{$tree});
109 for ($atlog_test{$tree}) {
110 if (/build error/) {
111 return 'B';
112 } elsif (/test error/) {
113 return 'X';
114 } else {
115 return ' ';
120 sub describe_topic {
121 my ($topic) = @_;
123 open(CONF, '-|', qw(git repo-config --get),
124 "branch.$topic.description")
125 or die;
126 my $it = join('',<CONF>);
127 close(CONF);
128 chomp($it);
129 if ($it) {
130 wrap_print(" $it");
134 my @in_next = read_revs_short('^master', $stage[0]);
135 my @topic = ();
137 my @topic_pattern = map { "refs/heads/$_" } (@ARGV ? @ARGV : $topic_pattern);
139 open(TOPIC, '-|', qw(git for-each-ref),
140 '--sort=-authordate',
141 '--format=%(objectname) %(authordate) %(refname)',
142 @topic_pattern)
143 or die;
145 while (<TOPIC>) {
146 chomp;
147 my ($sha1, $date, $topic) = m|^([0-9a-f]{40})\s(.*?)\srefs/heads/(.+)$|
148 or next;
149 push @topic, [$sha1, $date, $topic];
151 close(TOPIC);
153 if (open(AT, "Meta/AT.log")) {
154 my $next = `git rev-parse --verify refs/heads/next`;
155 chomp $next;
156 while (<AT>) {
157 if (/^N (.{40}) (.{40}) (.*)$/ && $1 eq $next) {
158 $atlog_next{$2} = $3;
159 next;
161 if (/^A (.{40}) (.*)/) {
162 $atlog_test{$1} = $2;
163 next;
166 close(AT);
169 my @last_merge_to_next = ();
171 for (@topic) {
172 my ($sha1, $date, $topic) = @$_;
173 my @revs = read_revs($base, $sha1, (1<<@stage)-1);
174 next unless (@revs || $all);
176 my %revs = map { $_->[0] => $_ } @revs; # fast index
177 for (my $i = 0; $i < @stage; $i++) {
178 for my $item (read_revs_short("^$stage[$i]", $sha1)) {
179 if (exists $revs{$item}) {
180 $revs{$item}[2] &= ~(1 << $i);
185 print '*' .
186 next_marker($sha1) .
187 rebase_marker($sha1, $stage[0], \@in_next);
188 my $count = "";
189 if (1 < @revs) {
190 $count = " " . (scalar @revs) . " commits";
192 elsif (@revs) {
193 $count = " 1 commit";
195 print " $topic ($date)$count\n";
196 describe_topic($topic);
197 for my $item (@revs) {
198 my $mark = $item->[2];
199 if ($mark < @mark) {
200 $mark = $mark[$mark];
202 if ($tests) {
203 $mark = test_marker($item->[0]) . $mark;
205 wrap_print("$mark $item->[1]");
209 sub wrap_print {
210 my ($string) = @_;
211 format STDOUT =
212 ~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
213 $string
214 ~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
215 $string
217 write;