Code

Git.pm: tentative fix to test the freshly built Git.pm
[git.git] / git-fmt-merge-msg.perl
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2005 Junio C Hamano
4 #
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 ();
23         }
24         if ($l == 1) {
25                 $m = "$label$stuff->[0]";
26         }
27         else {
28                 $m = ("$labels" .
29                       join (', ', @{$stuff}[0..$l-2]) .
30                       " and $stuff->[-1]");
31         }
32         return ($m);
33 }
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;
45                 }
46         };
47         return $val;
48 }
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 = "";
57         }
58         return $bra;
59 }
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, $_;
67         }
68         return @result;
69 }
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';
85         }
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,
96                 };
97         }
98         if (/^branch (.*)$/) {
99                 $origin = $1;
100                 push @{$src{$src}{BRANCH}}, $1;
101                 $src{$src}{HEAD_STATUS} |= 2;
102         }
103         elsif (/^tag (.*)$/) {
104                 $origin = $_;
105                 push @{$src{$src}{TAG}}, $1;
106                 $src{$src}{HEAD_STATUS} |= 2;
107         }
108         elsif (/^remote branch (.*)$/) {
109                 $origin = $1;
110                 push @{$src{$src}{R_BRANCH}}, $1;
111                 $src{$src}{HEAD_STATUS} |= 2;
112         }
113         elsif (/^HEAD$/) {
114                 $origin = $src;
115                 $src{$src}{HEAD_STATUS} |= 1;
116         }
117         else {
118                 push @{$src{$src}{GENERIC}}, $_;
119                 $src{$src}{HEAD_STATUS} |= 2;
120                 $origin = $src;
121         }
122         if ($src eq '.' || $src eq $origin) {
123                 $origin =~ s/^'(.*)'$/$1/;
124                 push @origin, [$sha1, "$origin"];
125         }
126         else {
127                 push @origin, [$sha1, "$origin of $src"];
128         }
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;
137         }
138         my @this;
139         if ($src{$src}{HEAD_STATUS} == 3) {
140                 # HEAD is fetched among others.
141                 push @this, andjoin('', '', ['HEAD']);
142         }
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";
154         }
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";
174         }
175         else {
176                 print "\n* $name:\n";
177         }
178         my $cnt = 0;
179         for my $log (@log) {
180                 if ($limit < ++$cnt) {
181                         print "  ...\n";
182                         last;
183                 }
184                 print "  $log\n";
185         }