Git.pm: Support for perl/ being built by a different compiler
[git/debian.git] / git-fmt-merge-msg.perl
blobe8fad02e757506e423b05b4a37fe3df8dba87ab2
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 unshift @INC, '@@INSTLIBDIR@@';
9 use strict;
10 use Git;
11 use Error qw(:try);
13 my $repo = Git->repository();
15 my @src;
16 my %src;
17 sub andjoin {
18 my ($label, $labels, $stuff) = @_;
19 my $l = scalar @$stuff;
20 my $m = '';
21 if ($l == 0) {
22 return ();
24 if ($l == 1) {
25 $m = "$label$stuff->[0]";
27 else {
28 $m = ("$labels" .
29 join (', ', @{$stuff}[0..$l-2]) .
30 " and $stuff->[-1]");
32 return ($m);
35 sub repoconfig {
36 my $val;
37 try {
38 $val = $repo->command_oneline('repo-config', '--get', 'merge.summary');
39 } catch Git::Error::Command with {
40 my ($E) = shift;
41 if ($E->value() == 1) {
42 return undef;
43 } else {
44 throw $E;
47 return $val;
50 sub current_branch {
51 my ($bra) = $repo->command_oneline('symbolic-ref', 'HEAD');
52 $bra =~ s|^refs/heads/||;
53 if ($bra ne 'master') {
54 $bra = " into $bra";
55 } else {
56 $bra = "";
58 return $bra;
61 sub shortlog {
62 my ($tip) = @_;
63 my @result;
64 foreach ($repo->command('log', '--no-merges', '--topo-order', '--pretty=oneline', $tip, '^HEAD')) {
65 s/^[0-9a-f]{40}\s+//;
66 push @result, $_;
68 return @result;
71 my @origin = ();
72 while (<>) {
73 my ($bname, $tname, $gname, $src, $sha1, $origin);
74 chomp;
75 s/^([0-9a-f]*) //;
76 $sha1 = $1;
77 next if (/^not-for-merge/);
78 s/^ //;
79 if (s/ of (.*)$//) {
80 $src = $1;
81 } else {
82 # Pulling HEAD
83 $src = $_;
84 $_ = 'HEAD';
86 if (! exists $src{$src}) {
87 push @src, $src;
88 $src{$src} = {
89 BRANCH => [],
90 TAG => [],
91 R_BRANCH => [],
92 GENERIC => [],
93 # &1 == has HEAD.
94 # &2 == has others.
95 HEAD_STATUS => 0,
98 if (/^branch (.*)$/) {
99 $origin = $1;
100 push @{$src{$src}{BRANCH}}, $1;
101 $src{$src}{HEAD_STATUS} |= 2;
103 elsif (/^tag (.*)$/) {
104 $origin = $_;
105 push @{$src{$src}{TAG}}, $1;
106 $src{$src}{HEAD_STATUS} |= 2;
108 elsif (/^remote branch (.*)$/) {
109 $origin = $1;
110 push @{$src{$src}{R_BRANCH}}, $1;
111 $src{$src}{HEAD_STATUS} |= 2;
113 elsif (/^HEAD$/) {
114 $origin = $src;
115 $src{$src}{HEAD_STATUS} |= 1;
117 else {
118 push @{$src{$src}{GENERIC}}, $_;
119 $src{$src}{HEAD_STATUS} |= 2;
120 $origin = $src;
122 if ($src eq '.' || $src eq $origin) {
123 $origin =~ s/^'(.*)'$/$1/;
124 push @origin, [$sha1, "$origin"];
126 else {
127 push @origin, [$sha1, "$origin of $src"];
131 my @msg;
132 for my $src (@src) {
133 if ($src{$src}{HEAD_STATUS} == 1) {
134 # Only HEAD is fetched, nothing else.
135 push @msg, $src;
136 next;
138 my @this;
139 if ($src{$src}{HEAD_STATUS} == 3) {
140 # HEAD is fetched among others.
141 push @this, andjoin('', '', ['HEAD']);
143 push @this, andjoin("branch ", "branches ",
144 $src{$src}{BRANCH});
145 push @this, andjoin("remote branch ", "remote branches ",
146 $src{$src}{R_BRANCH});
147 push @this, andjoin("tag ", "tags ",
148 $src{$src}{TAG});
149 push @this, andjoin("commit ", "commits ",
150 $src{$src}{GENERIC});
151 my $this = join(', ', @this);
152 if ($src ne '.') {
153 $this .= " of $src";
155 push @msg, $this;
158 my $into = current_branch();
160 print "Merge ", join("; ", @msg), $into, "\n";
162 if (!repoconfig) {
163 exit(0);
166 # We limit the merge message to the latst 20 or so per each branch.
167 my $limit = 20;
169 for (@origin) {
170 my ($sha1, $name) = @$_;
171 my @log = shortlog($sha1);
172 if ($limit + 1 <= @log) {
173 print "\n* $name: (" . scalar(@log) . " commits)\n";
175 else {
176 print "\n* $name:\n";
178 my $cnt = 0;
179 for my $log (@log) {
180 if ($limit < ++$cnt) {
181 print " ...\n";
182 last;
184 print " $log\n";