Use $GITPERLLIB instead of $RUNNING_GIT_TESTS and centralize @INC munging
[git/vmiklos.git] / git-fmt-merge-msg.perl
blobf86231e14b0bf0d16ae3ac7978b824b3a994d359
1 #!/usr/bin/perl -w
3 # Copyright (c) 2005 Junio C Hamano
5 # Read .git/FETCH_HEAD and make a human readable merge message
6 # by grouping branches and tags together to form a single line.
8 use strict;
9 use Git;
10 use Error qw(:try);
12 my $repo = Git->repository();
14 my @src;
15 my %src;
16 sub andjoin {
17 my ($label, $labels, $stuff) = @_;
18 my $l = scalar @$stuff;
19 my $m = '';
20 if ($l == 0) {
21 return ();
23 if ($l == 1) {
24 $m = "$label$stuff->[0]";
26 else {
27 $m = ("$labels" .
28 join (', ', @{$stuff}[0..$l-2]) .
29 " and $stuff->[-1]");
31 return ($m);
34 sub repoconfig {
35 my $val;
36 try {
37 $val = $repo->command_oneline('repo-config', '--get', 'merge.summary');
38 } catch Git::Error::Command with {
39 my ($E) = shift;
40 if ($E->value() == 1) {
41 return undef;
42 } else {
43 throw $E;
46 return $val;
49 sub current_branch {
50 my ($bra) = $repo->command_oneline('symbolic-ref', 'HEAD');
51 $bra =~ s|^refs/heads/||;
52 if ($bra ne 'master') {
53 $bra = " into $bra";
54 } else {
55 $bra = "";
57 return $bra;
60 sub shortlog {
61 my ($tip) = @_;
62 my @result;
63 foreach ($repo->command('log', '--no-merges', '--topo-order', '--pretty=oneline', $tip, '^HEAD')) {
64 s/^[0-9a-f]{40}\s+//;
65 push @result, $_;
67 return @result;
70 my @origin = ();
71 while (<>) {
72 my ($bname, $tname, $gname, $src, $sha1, $origin);
73 chomp;
74 s/^([0-9a-f]*) //;
75 $sha1 = $1;
76 next if (/^not-for-merge/);
77 s/^ //;
78 if (s/ of (.*)$//) {
79 $src = $1;
80 } else {
81 # Pulling HEAD
82 $src = $_;
83 $_ = 'HEAD';
85 if (! exists $src{$src}) {
86 push @src, $src;
87 $src{$src} = {
88 BRANCH => [],
89 TAG => [],
90 R_BRANCH => [],
91 GENERIC => [],
92 # &1 == has HEAD.
93 # &2 == has others.
94 HEAD_STATUS => 0,
97 if (/^branch (.*)$/) {
98 $origin = $1;
99 push @{$src{$src}{BRANCH}}, $1;
100 $src{$src}{HEAD_STATUS} |= 2;
102 elsif (/^tag (.*)$/) {
103 $origin = $_;
104 push @{$src{$src}{TAG}}, $1;
105 $src{$src}{HEAD_STATUS} |= 2;
107 elsif (/^remote branch (.*)$/) {
108 $origin = $1;
109 push @{$src{$src}{R_BRANCH}}, $1;
110 $src{$src}{HEAD_STATUS} |= 2;
112 elsif (/^HEAD$/) {
113 $origin = $src;
114 $src{$src}{HEAD_STATUS} |= 1;
116 else {
117 push @{$src{$src}{GENERIC}}, $_;
118 $src{$src}{HEAD_STATUS} |= 2;
119 $origin = $src;
121 if ($src eq '.' || $src eq $origin) {
122 $origin =~ s/^'(.*)'$/$1/;
123 push @origin, [$sha1, "$origin"];
125 else {
126 push @origin, [$sha1, "$origin of $src"];
130 my @msg;
131 for my $src (@src) {
132 if ($src{$src}{HEAD_STATUS} == 1) {
133 # Only HEAD is fetched, nothing else.
134 push @msg, $src;
135 next;
137 my @this;
138 if ($src{$src}{HEAD_STATUS} == 3) {
139 # HEAD is fetched among others.
140 push @this, andjoin('', '', ['HEAD']);
142 push @this, andjoin("branch ", "branches ",
143 $src{$src}{BRANCH});
144 push @this, andjoin("remote branch ", "remote branches ",
145 $src{$src}{R_BRANCH});
146 push @this, andjoin("tag ", "tags ",
147 $src{$src}{TAG});
148 push @this, andjoin("commit ", "commits ",
149 $src{$src}{GENERIC});
150 my $this = join(', ', @this);
151 if ($src ne '.') {
152 $this .= " of $src";
154 push @msg, $this;
157 my $into = current_branch();
159 print "Merge ", join("; ", @msg), $into, "\n";
161 if (!repoconfig) {
162 exit(0);
165 # We limit the merge message to the latst 20 or so per each branch.
166 my $limit = 20;
168 for (@origin) {
169 my ($sha1, $name) = @$_;
170 my @log = shortlog($sha1);
171 if ($limit + 1 <= @log) {
172 print "\n* $name: (" . scalar(@log) . " commits)\n";
174 else {
175 print "\n* $name:\n";
177 my $cnt = 0;
178 for my $log (@log) {
179 if ($limit < ++$cnt) {
180 print " ...\n";
181 last;
183 print " $log\n";