#!/usr/bin/env perl
# git-changelog --- generate GNU ChangeLog-style log
# Author: Noah Friedman <friedman@splode.com>
# Created: 2019-06-22
# Public domain

# $Id: git-changelog,v 1.3 2019/08/22 02:35:16 friedman Exp $

# Commentary:

# Usage: git-changelog {-C dir} {revrange} {-- {files...}}
#        git {-C dir} changelog {revrange} {-- {files...}}
# optional arg: revision range, e.g. "@{yesterday}..@"
# Other standard log args (e.g. -n) also applicable

# Currently, if you enumerate specific files, the changelog won't list any
# other files that are part of the commit except the ones specified.
#
# To see the full filelog of those changes, you need instead to use `git
# rev-list' to get a list of commit ids, and then produce the log for those
# commits separately.  Since `git log' can only show one revrange at a
# time, it might be more efficient to use a single `git cat-file --batch'
# process and traverse treeish objects manually with a bidirectional pipe.
# The output for tree objects is binary, so they will require some unpacking.

# Code:

package ChangeLog;

use strict;
use warnings qw(all);

my %change_label =
  ( A => 'add',
    C => 'copy',
    D => 'del',
    M => 'edit',
    R => 'rename',
    T => 'type',
    U => 'unmerge',
    X => 'unknown',
    B => 'broken',
  );

my @git_cmd = ($ENV{GITPROG} || "git");

my $log_format = join ("%x00", qw( chash:%h   thash:%t     sref:%S
                                   aname:%aN  amail:%aE   adate:%aI
                                   cname:%cN  cmail:%cE   cdate:%cI
                                    desc:%B    note:%N  filelog:));

# n.b. you can use "--follow" to follow renames, but that only works for
# single files so it's not useful as a default option.
my @log_cmd = ( "log",
                "--single-worktree",
                "--pretty=format:$log_format%x00",
                "--name-status",
                "--no-merges",
                "--no-color",
                "-z", );

# This can be modified by parse_options, see below
my $template = q{%(adate)  %(aname)  <%(amail)>  %(chash):%(thash)

%(committedby)%n%n%(desc)%n%(note)%n%(filelog)%n%n};

# Like `` but avoids shell exec/reparsing.
sub __cmd_out
{
  my $pid = open (my $fh, "-|");
  die "fork: $!\n" unless defined $pid;
  local $/ = wantarray ? $/ : undef;
  return <$fh> if $pid;                           # parent
  exec ({ $_[0] } @_) or die "exec: $_[0]: $!\n"; # child
}

sub __git { return __cmd_out (@git_cmd, @_) }

sub __fold_text
{
  local $_ = shift;
  return unless defined $_;

  s/\r//g;
  s/\t/        /g;
  my @para = split (/\n\n+/, $_);

  foreach $_ (@para)
    {
      if (/^\s/)
        {
          s/^\s{1,8}/\t/gm;
          next;
        }
      next if /^\s*[*#\$]/;

      s/\s*\n\s*/ /g;
      s/(.{1,70})(?:\s+|$)/$1\n/g;
      s/\n$//s;
    }
  return join ("\n\n", @para);
}

sub __maxlen
{
  my @len = map { length $_ } @_;
  my $max = shift @len;
  while (@len)
    {
      $max = $len[0] if $len[0] > $max;
      shift @len;
    }
  return $max;
}

sub new
{
  my $type = shift;
  my $class = ref ($type) || $type;

  my $self = {};
  bless $self, $class;

  $self->get_log_data (@_);
  return $self;
}

sub get_log_data
{
  my $self = shift;
  $self->{data} = __git (@log_cmd, @_) . "\0";
}

sub next_log_entry
{
  my $self = shift;

  return unless $self->{data} =~ /\G(.*?)\0\0/gs;

  my %entry;
  my @field = split( /\0/, $1 );
  while (@field)
    {
      my ($key, $val) = split (/:/, shift @field, 2);
      if ($key eq 'filelog')
        {
          my %filelog;
          $field[0] =~ s/\n//g if @field;
          while (@field)
            {
              my $action = shift @field;
              my $file   = shift @field;

              if (substr ($action, 0, 1) eq 'R')
                {
                  my $newname = shift @field;
                  my $pct = int (substr ($action, 1));
                  push @{$filelog{R}}, [$file, $newname, $pct];
                }
              else
                {
                  push @{$filelog{$action}}, $file;
                }
            }
          $entry{$key} = \%filelog;
        }
      elsif ($val ne '')
        {
          $entry{$key} = $val;
        }
    }

  return \%entry;
}

sub log_entries
{
  my $self = shift;
  my @log;
  while (my $entry = $self->next_log_entry())
    {
      push @log, $entry;
    }
  return \@log;
}

sub _format_filelog
{
  my $self  = shift;
  my $entry = shift;

  my %flog = %{$entry->{filelog}}; # copy since destructively modified
  my @fmtflog;
  my $fn = sub
    {
      my $action = shift;
      my $files = (delete $flog{$action});
      return unless $files;
      my $label = $change_label{$action};

      if ($action eq 'R')
        {
          my @renames;
          my $w0 = __maxlen (map { $_->[0] } @$files);
          my $w1 = __maxlen (map { $_->[1] } @$files);
          for my $elt (@$files)
            {
              my ($from, $to, $pct) = @$elt;
              my $line = sprintf ("%-${w0}s => %-${w1}s", $from, $to);
              $line .= " ($pct% similar)" if ($pct < 100 && $pct > 0);
              push @renames, $line;
            }
          unshift @renames, '' if @renames > 1;
          $files = \@renames;
        }

      my $str = sprintf ("# %-5s %s", "$label:", join ( "\n\t", @$files));
      $str =~ s/^/\t/gm;
      $str =~ s/\s+$//gm;
      return $str;
    };

  for my $action (qw(A C D R M))
    {
      my $str = &$fn ($action);
      push @fmtflog, $str if defined $str;
    }
  for my $action (keys %flog)
    {
      my $str = &$fn ($action);
      push @fmtflog, $str if defined $str;
    }
  if (@fmtflog)
    {
      $entry->{filelog} = join ("\n\n", @fmtflog);
    }
  else
    {
      delete $entry->{filelog};
    }
}

sub format_log_entry
{
  my $self = shift;
  my $ent  = shift || $self->next_log_entry();
  return unless $ent;

  my %entry = %$ent;  # destructively modified
  map { if (defined $_)
          {
            $_ =~ s/T/ /;
            $_ =~ s/(.\d\d):(\d\d)$/ $1$2/;
          }
      } @entry{qw(adate cdate)};

  $entry{amail} = '' unless defined $entry{amail};

  # Reformatting is generally too extreme.
  #$entry{desc} = __fold_text ($entry{desc});
  $entry{desc} =~ s/^[ ]{1,8}/\t/gm;
  $entry{desc} =~ s/^/\t/gm;
  $entry{desc} =~ s/^\s+$//gm;

  if (   $entry{cname} ne $entry{aname}
      || $entry{cmail} ne $entry{amail})
    {
      $entry{committedby} =
        sprintf( "\tCommitted-by: %s <%s> %s",
                 @entry{qw(cname cmail cdate)})
    }

  $self->_format_filelog (\%entry);

  local $_ = $template;
  my $lastsub = 0;
  while (/(%\(.*?\)|%n)/g)
    {
      my $text = $1;
      if ($text eq '%n')
        {
          if ($lastsub) { s//\n/ } else { s/// }
        }
      else
        {
          my $elt = $1 if $text =~ /%\((.*?)\)/;
          my $val = $entry{$elt} if defined $elt;
          if (!defined $val || $val eq '')
            { s///;     $lastsub = 0 }
          else
            { s//$val/; $lastsub = 1 }
        }
    }
  return $_;
}


package main;

use strict;
use warnings qw(all);

use Getopt::Long;
use Pod::Usage;

sub parse_options
{
  my $help = -1;
  local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV.

  my $parser = Getopt::Long::Parser->new;
  $parser->configure (qw(pass_through no_ignore_case no_auto_abbrev no_bundling));
  my $succ = $parser->getoptions
    ( 'h|?|help+'        => \$help,
      'C=s'              => sub { push @git_cmd, '-C', $_[1] },
    );

  pod2usage (-exitstatus => 1, -verbose => 0)     unless $succ;
  pod2usage (-exitstatus => 0, -verbose => $help) if $help >= 0;

  for my $arg (@ARGV)
    {
      last if $arg eq '--';
      next unless $arg =~ /^--(?:all|reflog|branches|tags|remotes)(?:=|$)/;
      $template =~ s=\(thash\)=(thash)  %(sref)=;
      last;
    }
}

sub main
{
  parse_options (\@_);
  STDOUT->autoflush (1);
  STDERR->autoflush (1);

  my $log = ChangeLog->new (@_);
  while ($_ = $log->format_log_entry()) { print $_ }
}

main (@ARGV);

# eof