#!/usr/bin/env perl
# p4-describe-changes - combine p4 change and p4 describe -s
# Author: Noah Friedman <friedman@splode.com>
# Created: 2014-11-13
# Public domain.

# $Id: p4-describe-changes,v 1.22 2019/02/12 01:50:25 friedman Exp $

# Commentary:
# Code:

use strict;
use warnings qw(all);

use FindBin;
use lib "$FindBin::Bin/../../lib/perl";
use lib "$ENV{HOME}/lib/perl";

use Getopt::Long;
use Pod::Usage;
use POSIX qw(strftime);

use NF::PrintObject qw(:debug);
use NF::P4cmd       qw(:direct);

use constant { CL_depotFile  => 0,    FL_CHG   => 0,
               CL_rev        => 1,    FL_FILE  => 1,
               CL_action     => 2,    FL_SREV  => 2,
               CL_type       => 3,    FL_EREV  => 3,
               CL_fileSize   => 4,    FL_HOW   => 4,
               CL_FL_HOW     => 5,    FL_REV   => 5,
               CL_FL_CHG     => 6,    FL_TYPE  => 6,
               CL_FL_FILE    => 7,    FL_MVTO  => 7,
               CL_FL_RANGE   => 8,
               CL_FL_TYPE    => 9,                   };

my %opt = ( traditional => 0,
            show_integs => 0,
            show_desc   => 1,
            show_files  => 1,
            show_jobs   => 1,
            show_size   => 0,
            show_type   => 0,
            dblspace    => 0,
            reverse     => 0, );

sub parse_options
{
  my $help = -1;

  p4_process_cmdline_options ($_[0]);
  local *ARGV = \@{$_[0]}; # modify our local arglist, not real ARGV.

  my $pthrough = sub { push @{$opt{changesflags}}, join ("", '-', @_) };

  my $parser = Getopt::Long::Parser->new;
  $parser->configure (qw(bundling autoabbrev no_ignore_case));
  my $succ = $parser->getoptions
    ( "debug"            => \$NF::P4cmd::DEBUG,
      "h|?|help+"        => \$help,

      "p|p4port=s"       => \$ENV{OVERRIDE_P4PORT},

      "c|client=s"       => $pthrough,
      "m|max=i"          => $pthrough,
      "s|status=s"       => $pthrough,
      "u|user=s"         => $pthrough,

      "2|double-space!"  => \$opt{dblspace},
      "d|descriptions!"  => \$opt{show_desc},
      "f|files!"         => \$opt{show_files},
      "i|integrations!"  => \$opt{show_integs},
      "j|jobs!"          => \$opt{show_jobs},
      "r|reverse!"       => \$opt{reverse},
      "t|type|filetype!" => \$opt{show_type},
      "z|size!"          => \$opt{show_size},

      "recursion!"       => \$opt{recur},
      "traditional!"     => \$opt{traditional},

      # The long options above are automatically negated
      "1"                => sub { $opt{dblspace}    = 0 },
      "D"                => sub { $opt{show_desc}   = 0 },
      "F"                => sub { $opt{show_files}  = 0 },
      "I"                => sub { $opt{show_integs} = 0 },
      "J"                => sub { $opt{show_jobs}   = 0 },
      "R"                => sub { $opt{reverse}     = 0 },
      "T"                => sub { $opt{show_type}   = 0 },
      "Z"                => sub { $opt{show_size}   = 0 },
    );

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

sub p4error
{
  my $errorcount = 0;
  for my $elt (@_)
    {
      if (exists $elt->{code} && $elt->{code} eq 'error')
        {
          $errorcount++;
          (my $err = $elt->{data}) =~ s/^/p4: /gm;
          print STDERR $err, "\n";
        }
    }
  return $errorcount;
}

sub uniq
{
  my (%seen, @l);
  map { push @l, $_ unless exists $seen{$_}; $seen{$_} = 1; } @_;
  return @l;
}

sub get_changes
{
  my $list = shift if ref $_[0];

  my @args = @_;
  unshift @args, "-i" if $opt{recur};
  unshift @args, @{$opt{changesflags}} if $opt{changesflags};

  # Return only 1 instance of each change number.
  # There might be duplicates if multiple files listed explicitly were
  # modified in the same change.
  uniq (map { p4error ($_) ? () : $_->{change}
            } p4 (($list || ()), "changes", @args));
}

sub get_describe
{
  my @desc;
  my @shelved;

  for my $elt (p4 (\@_, qw(describe -s)))
    {
      next if p4error ($elt);
      if (exists $elt->{shelved})
        { push @shelved, $elt->{change} }
      else
        { push @desc, $elt }
    }

  push @desc, map { p4error ($_) ? () : $_
                  } p4 (\@shelved, qw(describe -S -s))
    if @shelved;

  my @fields = (qw(depotFile rev action type fileSize));
  for my $obj (@desc)
    {
      next unless exists $obj->{depotFile};
      my $rowlist = $obj->{row} = [];
      while (@{$obj->{depotFile}})
        {
          push @$rowlist, [map { shift @{$obj->{$_}} } @fields];
        }
      map { delete $obj->{$_} } @fields, 'digest';
    }

  return @desc;
}

sub get_filelog
{
  my $flist = shift;
  my %flog;
  for my $elt (p4 ($flist, qw(filelog -s)))
    {
      # Files that are newly shelved don't have a log yet.
      next if exists $elt->{code} && $elt->{code} eq 'error';

      my $depotFile = $elt->{depotFile};
      my $n = scalar @{$elt->{change}};
      for (my $i = 0; $i < $n; $i++)
        {
          my $change = $elt->{change}->[$i];
          my $rev    = $elt->{rev}->[$i];
          my $type   = $elt->{type}->[$i];

          my @fdata = ($change);
          if (exists $elt->{file} && defined $elt->{file}->[$i])
            {
               $fdata[FL_FILE] = $elt->{file}->[$i]->[0];
              ($fdata[FL_SREV] = $elt->{srev}->[$i]->[0]) =~ s/#//;
              ($fdata[FL_EREV] = $elt->{erev}->[$i]->[0]) =~ s/#//;
               $fdata[FL_HOW]  = $elt->{how}->[$i]->[0];
               $fdata[FL_TYPE] = $type;
            }
          $flog{$depotFile}->{$rev} = \@fdata;
        }
    }
  return \%flog;
}

my $fstat_fields = join (",", (qw(depotFile
                                  headRev
                                  headType type
                                  resolveAction0
                                  resolveFromFile0
                                  resolveStartFromRev0
                                  resolveEndFromRev0
                                  movedFile movedRev
                                )));
sub get_shelved_fstat
{
  my $change = shift;

  my %result;
  for my $elt (p4 (qw(fstat -Os -Or -Rs),
                   '-e', $change, '-T', $fstat_fields, '//...'))
    {
      next if p4error ($elt) || exists $elt->{desc};
      if (exists $elt->{resolveFromFile})
        {
          my @fdata = ($change);
          $fdata[FL_FILE] = $elt->{resolveFromFile}->[0];
          $fdata[FL_SREV] = $elt->{resolveStartFromRev}->[0];
          $fdata[FL_EREV] = $elt->{resolveEndFromRev}->[0];
          $fdata[FL_HOW]  = $elt->{resolveAction}->[0];
          $fdata[FL_REV]  = $elt->{headRev} || $fdata[FL_EREV];  # Branched files are first rev
          $fdata[FL_TYPE] = $elt->{type};

          $result{$elt->{depotFile}} = \@fdata;
        }
      elsif (exists $elt->{movedFile})
        {
          my @fdata = ($change);
          $fdata[FL_SREV] = '';
          $fdata[FL_EREV] = '';
          $fdata[FL_REV]  = $elt->{movedRev} || $elt->{headRev};
          $fdata[FL_HOW]  = 'moved to';
          $fdata[FL_MVTO] = $elt->{movedFile};
          $result{$elt->{depotFile}} = \@fdata;
        }
    }
  return \%result;
}

# This is complicated; I can barely follow it myself.
# In order to track where files were integrated/branched/moved from or to,
# we can consult the filelog for changelists that are already committed.
# For shelved changes, those entries are not in the filelog yet; instead
# they are accessible via fstat (with the right magic flags).
# That gives you file version numbers.  If you want to get the changelist
# for those versions, you have to run filelog again on those file
# revisions!
sub integ_map
{
  my %integ;
  my %shelve;

  __PP_DEBUG { \@_ } @_;
  for my $elt (@_)
    {
      next if p4error ($elt);

      next unless my $rowlist = $elt->{row}; # no files in change
      my $change = $elt->{change};

      if (exists $elt->{shelved} && $elt->{status} eq 'pending')
        {
          my $fstat = $shelve{$change} = get_shelved_fstat ($change);
          __PP_DEBUG { 'shelved_fstat', $fstat };

          for my $row (@$rowlist)
            {
              __PP_DEBUG { 'row', $row };
              my $depotFile = $row->[CL_depotFile];
              my $file = $fstat->{$depotFile} or next;
              $row->[CL_rev] = $file->[FL_REV];
            }
        }
      else
        {
          # These changes are already committed.
          $integ{$change} = { map { $_->[CL_depotFile] => $_->[CL_rev]
                                  } @$rowlist };
        }
    }

  # Collect files and version information in preparation for filelog
  my @flist;
  map { while (my ($file, $rev) = each %$_)
          {
            push @flist, $file . "#=" . $rev if $rev ne 'none';
          }
      } values %integ;
  # Copy in any fromfile information from shelves into the filelog.
  __PP_DEBUG { '%shelve', \%shelve };
  while (my ($change, $depotFile_tbl) = each %shelve)
    {
      while (my ($depotFile, $elt) = each %$depotFile_tbl)
        {
          next unless defined $elt->[FL_FILE];
          push @flist, $elt->[FL_FILE] . "#=" . $elt->[FL_EREV];
        }
    }
  my $filelog = get_filelog (\@flist);
  __PP_DEBUG { 'filelog', $filelog };

  # Now get the change number of the source files.
  undef @flist;
  while (my ($depotFile, $elt) = each %$filelog)
    {
      while (my ($rev, $vals) = each %$elt)
        {
          next unless @$vals > 1;
          push @flist, $vals->[FL_FILE] . "#=" . $vals->[FL_EREV];
        }
    }
  if (@flist)
    {
      my $histmap = get_filelog (\@flist);
      __PP_DEBUG { 'histmap', $histmap };
      while (my ($depotFile, $elt) = each %$filelog)
        {
          while (my ($rev, $vals) = each %$elt)
            {
              next unless @$vals > 1;
              my $file = $vals->[FL_FILE];
              my $erev = $vals->[FL_EREV];
              $vals->[FL_CHG] = $histmap->{$file}->{$erev}->[FL_CHG];
            }
        }
    }

  # Merge the filelog into the integ table.
  while (my ($changeno, $depotFile_tbl) = each %integ)
    {
      while (my ($depotFile, $revno) = each %$depotFile_tbl)
        {
          my $data = $filelog->{$depotFile}->{$revno};
          if ($data && @$data > 1)
            { $depotFile_tbl->{$depotFile} = { $revno => $data } }
          else
            { delete $depotFile_tbl->{$depotFile} }
        }
      delete $integ{$changeno} unless %{$integ{$changeno}};
    }

  # update integration changelists from fstat list
  while (my ($shelfno, $depotFile_tbl) = each %shelve)
    {
      while (my ($depotFile, $elt) = each %$depotFile_tbl)
        {
          my $rev = $elt->[FL_REV];

          if (ref $filelog->{$depotFile} eq 'HASH')
            { $filelog->{$depotFile}->{$rev} = $elt }
          else
            { $filelog->{$depotFile} = { $rev => $elt } }

          $integ{$shelfno}->{$depotFile} = $filelog->{$depotFile};

          my $file = $elt->[FL_FILE]          or next;
          my $flog = $filelog->{$file}        or next;
          my $erev = $flog->{$elt->[FL_EREV]} or next;
          $elt->[FL_CHG] = $erev->[FL_CHG];
        }
    }

  # Finally, merge the integration information into each changelist depotFile row.
  for my $elt (@_)
    {
      next if p4error ($elt);

      my $rowlist = $elt->{row} or next;  # no files in change
      my $changeno = $elt->{change};

      for my $row (@$rowlist)
        {
          my $depotFile = $row->[CL_depotFile];
          my $rev       = $row->[CL_rev];
          push @$row, integ_of (\%integ, $changeno, $depotFile, $rev);
        }
    }
}

sub integ_of
{
  my ($integs, $changeno, $file, $rev) = @_;

  my $change_tbl = $integs->{$changeno} or return;
  my $file_tbl   = $change_tbl->{$file} or return;
  my $rev_list   = $file_tbl->{$rev}    or return;
  return unless @$rev_list > 1;

  my $srev = $rev_list->[FL_SREV];
  my $erev = $rev_list->[FL_EREV];
  my $range = "";
  $srev = 0 if $srev eq 'none';
  $srev++; # not sure why this is always 1 less than inclusive range
  $range .= "#$srev," unless $erev eq $srev;
  $range .= "#$erev";

  my @result = ($rev_list->[FL_HOW],
                $rev_list->[FL_CHG],
                $rev_list->[FL_FILE] || $rev_list->[FL_MVTO],
                $range);
  push @result, $rev_list->[FL_TYPE] if $opt{show_type};
  return @result;
}

sub change_integs
{
  my ($change) = @_;

  my %tbl;
  for my $row (@{$change->{row}})
    {
      my $chgno = $row->[CL_FL_CHG] or next;
      $tbl{$chgno} = undef;  # just vivify
    }
  sort keys %tbl;
}

sub describe_change
{
  my ($change) = @_;
  return unless $change->{code} eq 'stat';  # todo: print error messages

  my $stamp = strftime ("%Y-%m-%d %H:%M:%S %z", localtime ($change->{time}));

  my $status = ($change->{status} eq 'submitted'
                ? ""
                : sprintf (" *%s*", $change->{status}));

  my $changeno = $change->{change};
  printf("%s %d  %s  %s@%s%s\n\n",
         (exists $change->{shelved} ? "Shelf" : "Change"),
         $changeno,
         $stamp,
         $change->{user},
         $change->{client},
         $status);

  if ($opt{show_desc} && $change->{desc} ne '')
    {
      (my $desc = $change->{desc}) =~ s/^/\t/mg;
      print $desc, "\n";
      print "\n" unless $desc =~ /\n$/s;
    }

  if ($opt{show_jobs} && exists $change->{job})
    {
      my ($job, $jst) = ($change->{job}, $change->{jobstat});
      my @joblist;
      for (my $i = 0; $i < @$job; $i++)
        {
          my ($j, $s) = ($job->[$i], $jst->[$i]);
          $j .= sprintf ("(%s)", $s) unless $s eq 'closed' || $s eq 'fixed';
          push @joblist, $j;
        }
      print "\tJobs: ", join (" ", @joblist), "\n\n";
    }

  if ($opt{show_integs})
    {
      my @integs = change_integs ($change);
      print "\tIntegrated changes: @integs\n\n" if @integs;
    }

  if ($opt{show_files})
    {
      my $tmpl = "\t%3s %-5s  %-11s";
      $tmpl .= "  %-11s"        if $opt{show_type};
      $tmpl .= "  %5s"          if $opt{show_size};
      $tmpl .= "  %s\n";

      my $m2fmt = '';
      $m2fmt .= (' ' x 13) if $opt{show_type};
      $m2fmt .= (' ' x  7) if $opt{show_size};
      $m2fmt .= '%2$s';

      my $ifmt  = $m2fmt . '%3$s (@%1$s)';

      my $sztotal = 0;
      my @val;

      for my $row (sort { lc $a->[CL_depotFile] cmp lc $b->[CL_depotFile]
                        } @{$change->{row}})
        {
          my $depotFile = $row->[CL_depotFile];
          my $rev       = $row->[CL_rev];
          my $action    = $row->[CL_action];
          my $type      = $row->[CL_type];
          my $integ_how = $row->[CL_FL_HOW];

          @val = ('...', '#' . $rev, $action);
          push @val, $type if $opt{show_type};

          if ($opt{show_size})
            {
              my $size = $row->[CL_fileSize];
              $sztotal += $size if defined $size;
              push @val, fmtsize ($size);
            }

            push @val, $depotFile;
            printf $tmpl, @val;

            if ($opt{show_integs} && $integ_how)
              {
                map { $_ = "" } @val;  # set all to empty string
                $val[ CL_action ] = $integ_how;

                my $from = $row->[CL_FL_FILE];
                $from .= sprintf ('%s (@%s)', @{$row}[CL_FL_RANGE, CL_FL_CHG])
                  if $integ_how ne 'moved to';

                my $fidx = 3;
                $fidx++ if $opt{show_type};
                $fidx++ if $opt{show_size};
                $val[$fidx] = $from;
                printf $tmpl, @val;
              }
          print "\n" if $opt{dblspace};
        }

      if ($opt{show_size} && $sztotal > 0 && @{$change->{row}} > 1)
        {
          map { $_ = "" } @val;  # set all to empty string
          $val[3 + $opt{show_type}] = fmtsize ($sztotal);
          $val[4 + $opt{show_type}] = 'Total';
          printf $tmpl, @val;
        }

      print "\n";
    }
}

sub fmtsize
{
  return '' unless defined $_[0] && $_[0] ne '0';

  my $size   = shift;
  my $fmtsize = 1024;
  my @suffix = ('', qw(K M G T P E));
  my $idx = 0;

  while ($size > $fmtsize)
    {
      $size /= $fmtsize;
      $idx++;
    }

  my $fmtstr = $size < 100 && $idx != 0 ? "%.1f%s" : "%d%s" ;
  return sprintf ($fmtstr, $size, $suffix[$idx]);
}

sub main
{
  parse_options (\@_);

  my (@changelist, @option, @path);
  map { if (/^[,\s\d]+$/) { push @changelist, split (/[,\s]+/, $_) }
        elsif (/^-/)      { push @option,     $_ }
        else              { push @path,       $_ }
      } @_;

  unless (@path || @changelist || $opt{changesflags})
    {
      print STDERR
        "Cowardly refusing to print the complete revision history of the server.\n",
        "Provide some combination of --status, --user, --client, or --max flags,\n",
        "a change number, or file pattern.\n";
      exit (1);
    }

  if    (@path)         { push @changelist, get_changes (\@path, @option) }
  elsif (! @changelist) { push @changelist, get_changes (@option) }

  return unless @changelist;

  if ($opt{traditional})
    {
      @changelist = sort { ($opt{reverse}
                            ? $a <=> $b
                            : $b <=> $a);
                         } @changelist;
      p4 (\@changelist, qw(describe -s))
    }
  else
    {
      my @desc   = get_describe (@changelist);
      integ_map (@desc) if $opt{show_integs};

      map { describe_change ($_)
          } sort { ($opt{reverse}
                    ? $a->{change} <=> $b->{change}
                    : $b->{change} <=> $a->{change});
                 } @desc;
    }

  return $?;
}

main (@ARGV);

1;

__END__

=head1 NAME

 p4-describe-changes - combine "p4 changes" with "p4 describe -s"

=head1 SYNOPSIS

     {--debug}             {-?|-h|--help}
     {-d|--descriptions}   {-D|--no-descriptions}
     {-f|--files}          {-F|--no-files}
     {-i|--integrations}   {-I|--no-integrations}
     {-j|--jobs}           {-J|--no-jobs}
     {-r|--reverse}        {-R|--no-reverse}
     {-t|--filetype}       {-T|--no-filetype}
     {-z|--size}           {-Z|--no-size}

     {--traditional}       {--no-traditional}

     {--p4user    USER}    {-u|--user   CHANGE-USER}
     {--p4client  CLIENT}  {-c|--client CHANGE-CLIENT}
     {--p4port    PORT}    {-s|--status CHANGE-STATUS}
     {--p4dir     DIR}     {-m|--max    CHANGE-COUNT}
     {--p4host    HOST}

     ... changelists or files


 The -h option may be repeated up to 3 times for increased verbosity.

=head1 OPTIONS

Long-format options may be abbreviated as long as the result is not ambiguous.

=over 8

=item B<-d>, B<--descriptions>			(default)

Display the description of the change.

=item B<-f>, B<--files>				(default)

Display the files associated with the change.

=item B<-i>, B<--integrations>

Show which changes, if any, were integrated into each change and display
which origin each submitted file was integrated, branched, copied, or
merged from.

=item B<-2>, B<--double-space>

Insert a blank line between each listed file.
In the case where integrations are displayed, the destination and origin
are grouped together with no blank in between.
This may enhance readability.

=item B<-j>, B<--jobs>				(default)

Display the job names fixed by the change.

=item B<-r>, B<--reverse>

Display changes from lowest (oldest) to highest (newest).

=item B<--traditional>

Use builtin C<p4 describe> output format instead of slightly modified custom
format implemented in this script.

If this option is specified, all of the descriptions, files, integrations,
jobs, filetype, and size options are ignored.

=item B<-t>, B<--type>, B<--filetype>

Show the type of the file (e.g. C<text>, C<binary+x>), at its specified revision.

=item B<-z>, B<--size>

Display the size of each file in the changelist, if they have one
(e.g. deleted files don't), and a total sum at the end if there is more
than one file.

This option only has effect if B<--files> is enabled.

=back

The inverse options are as follows.

=over 8

=item B<-D>, B<--no-descriptions>

Do not display the change description.

=item B<-F>, B<--no-files>

Do not display the files associated with each change.

If this option is combined with B<--integrations>, the output will include
a list of the integrated changes but will not display the individual files
from those changes.

=item B<-I>, B<--no-integrations>		(default)

Do not display changes or files integrated into the change.

=item B<-1>, B<--no-double-space>		(default)

Do not insert any blank lines between file.
This produces a more dense display, but might be harder to read in the case
where integration are enabled.

=item B<-J>, B<--no-jobs>

Do not display job names fixed by the change.

=item B<-R>, B<--no-reverse>			(default)

Display changes from highest (newest) to lowest (oldest).

=item B<--no-traditional>			(default)

Do not use builtin C<p4 describe> formatting.

=item B<-T>, B<--no-type>, B<--no-filetype>	(default)

Show the type of the file (e.g. C<text>, C<binary+x>), at its specified revision.

=item B<-Z>, B<--no-size>			(default)

Do not display file sizes in the file list.

=back

The following options filter the changelists to return.
They are actually passed straight through to C<p4 changes>.

If any of these options are specified, it's not necessary to specify
changelists or file paths unless you want to further constrain the search.

=over 8

=item B<-c>, B<--client>=I<client>

Limit changes to those created by the specified client only.

=item B<-m>, B<--max>=I<count>

Limit changes to the C<count> most recent.

=item B<-s>, B<--status>=I<status>

Limit the output to changelists with the specified C<status>.
Recognized values include (but might not be limited to)
C<pending>, C<shelved>, and C<submitted>.

=item B<-u>, B<--user>=I<user>

Display only changes owned by the specified user.

=back

=head1 DESCRIPTION

The command

    p4-describe-changes //depot/p14.2/...@\>2014/11/11,\<2014/11/12

performs essentially the more torturous equivalent of

    p4 changes //depot/p14.2/...@\>2014/11/11,\<2014/11/12  | awk '{print $2}' | p4 -x - describe -s

but with the same or easier-to-read results.

The usual flags to C<p4 changes> work, e.g.

    p4-describe-changes -s pending -u noahf //depot/main/...

    p4-describe-changes 962492

Use the B<--p4*> options to override P4PORT, P4USER, etc.

=cut