git-fmt-merge-msg.perlon commit Git.pm: Introduce ident() and ident_person() methods (c7a30e5)
   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.
   7
   8use strict;
   9use Git;
  10use Error qw(:try);
  11
  12my $repo = Git->repository();
  13
  14my @src;
  15my %src;
  16sub andjoin {
  17        my ($label, $labels, $stuff) = @_;
  18        my $l = scalar @$stuff;
  19        my $m = '';
  20        if ($l == 0) {
  21                return ();
  22        }
  23        if ($l == 1) {
  24                $m = "$label$stuff->[0]";
  25        }
  26        else {
  27                $m = ("$labels" .
  28                      join (', ', @{$stuff}[0..$l-2]) .
  29                      " and $stuff->[-1]");
  30        }
  31        return ($m);
  32}
  33
  34sub 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;
  44                }
  45        };
  46        return $val;
  47}
  48
  49sub 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 = "";
  56        }
  57        return $bra;
  58}
  59
  60sub 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, $_;
  66        }
  67        return @result;
  68}
  69
  70my @origin = ();
  71while (<>) {
  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';
  84        }
  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,
  95                };
  96        }
  97        if (/^branch (.*)$/) {
  98                $origin = $1;
  99                push @{$src{$src}{BRANCH}}, $1;
 100                $src{$src}{HEAD_STATUS} |= 2;
 101        }
 102        elsif (/^tag (.*)$/) {
 103                $origin = $_;
 104                push @{$src{$src}{TAG}}, $1;
 105                $src{$src}{HEAD_STATUS} |= 2;
 106        }
 107        elsif (/^remote branch (.*)$/) {
 108                $origin = $1;
 109                push @{$src{$src}{R_BRANCH}}, $1;
 110                $src{$src}{HEAD_STATUS} |= 2;
 111        }
 112        elsif (/^HEAD$/) {
 113                $origin = $src;
 114                $src{$src}{HEAD_STATUS} |= 1;
 115        }
 116        else {
 117                push @{$src{$src}{GENERIC}}, $_;
 118                $src{$src}{HEAD_STATUS} |= 2;
 119                $origin = $src;
 120        }
 121        if ($src eq '.' || $src eq $origin) {
 122                $origin =~ s/^'(.*)'$/$1/;
 123                push @origin, [$sha1, "$origin"];
 124        }
 125        else {
 126                push @origin, [$sha1, "$origin of $src"];
 127        }
 128}
 129
 130my @msg;
 131for my $src (@src) {
 132        if ($src{$src}{HEAD_STATUS} == 1) {
 133                # Only HEAD is fetched, nothing else.
 134                push @msg, $src;
 135                next;
 136        }
 137        my @this;
 138        if ($src{$src}{HEAD_STATUS} == 3) {
 139                # HEAD is fetched among others.
 140                push @this, andjoin('', '', ['HEAD']);
 141        }
 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";
 153        }
 154        push @msg, $this;
 155}
 156
 157my $into = current_branch();
 158
 159print "Merge ", join("; ", @msg), $into, "\n";
 160
 161if (!repoconfig) {
 162        exit(0);
 163}
 164
 165# We limit the merge message to the latst 20 or so per each branch.
 166my $limit = 20;
 167
 168for (@origin) {
 169        my ($sha1, $name) = @$_;
 170        my @log = shortlog($sha1);
 171        if ($limit + 1 <= @log) {
 172                print "\n* $name: (" . scalar(@log) . " commits)\n";
 173        }
 174        else {
 175                print "\n* $name:\n";
 176        }
 177        my $cnt = 0;
 178        for my $log (@log) {
 179                if ($limit < ++$cnt) {
 180                        print "  ...\n";
 181                        last;
 182                }
 183                print "  $log\n";
 184        }
 185}