#!/usr/bin/env perl
# $Id: p4-swarm-reviews,v 1.23 2019/07/30 17:35:13 friedman Exp $

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::P4Swarm;
use NF::Jira;

our %opt = ( show_files => 0,

             swarm_host => 'https://swarm.perforce.com',
             swarm_user => undef,
             swarm_pass => undef,

             jira_host  => 'http://jira.perforce.com:8080',
             jira_user  => $ENV{JIRA_USER} || 'build',
             jira_pass  => $ENV{JIRA_PASS} || 'rein4ce!',
           );

my $line_maxlen = (($ENV{TERM} eq 'emacs'
                    || (($ENV{INSIDE_EMACS} || $ENV{EMACS})
                        && $ENV{TERM} ne 'eterm'))
                   ? 0
                   # (- 80 (+ tab-width (length "Summary: ")))
                   # where tab-width=8
                   : 56);

my @review_fields   = (qw(id author description participants
                          changes commits commitStatus
                          created updated
                          state));

my @activity_fields = (qw(id action link user change streams));

my @jira_issue_customfields;  # initialized later
my %jira_issue_fields = ( 'Build Changelist(s)'    => 'bld_changes',
                          'Release Changelists(s)' => 'rel_changes',
                          'Release String'         => 'rel_version',
                        );

{ # create closure to hide $swarm from everything below

  # n.b. if you bump the api_version above v3, parse_activity will need
  # handling of streams field since it changes from an array into a
  # dictionary.  There might be other API differences as well.
  my $swarm;
  sub swarm
    {
      return $swarm if $swarm;
      $swarm = NF::P4Swarm->new ( host => $opt{swarm_host},
                                  user => $opt{swarm_user},
                                  pass => $opt{swarm_pass},
                                  api_version => 'v9' ); # minimum api for voting
    }
}

{ # create closure to hide $jira from everything below
  my $jira;
  sub jira
    {
      return $jira if $jira;
      $jira = NF::Jira->new (host => $opt{jira_host},
                             user => $opt{jira_user},
                             pass => $opt{jira_pass}, );
    }
}

sub max
{
  my $x = shift;
  map { $x = $_ if $_ > $x } @_;
  return $x;
}

sub timefmt
{
  strftime ("%Y-%m-%d %H:%M:%S %z (%a)", localtime ($_[0]));
}

sub fold_text
{
  local $_ = shift;
  return unless defined $_;
  return $_ if $line_maxlen < 22;       # vic20 line width!
  return $_ if length ($_) < $line_maxlen;

  s/\r//g;                              # CRLF -> LF
  my @para = split (/\n\n+/, $_);       # Split paragraphs into separate chunks.

  foreach $_ (@para)
    {
      # Remove all newlines, replacing any prior trailing whitespace on the
      # previous line and leading whitespace on the next line with a single
      # space.  This may be a no-op, since in my testing the input was
      # already always a single line.
      s/\s*\n\s*/ /g;

      # split into lines no longer than $max but only at whitespace.
      s/(.{1,$line_maxlen})(?:\s+|$)/$1\n/go;
      s/\n$//s; # but remove final newline
    }
  return join ("\n\n", @para);          # rejoin paragraphs at the end.
}

sub parse_review
{
  my ($found, $list) = @_;

  my %special = map { $_ => undef } (qw(id changes commits description));
  for my $review (@$list)
    {
      my $id = $review->{id};
      next if exists $found->{$id};

      my $f = $found->{$id} = {};
      map { $f->{$_} = $review->{$_}
              unless exists $special{$_};
          } keys %$review;

      my $changes = $review->{changes};
      my $commits = $review->{commits};
      if (defined $commits && @$commits)
        {
          $f->{commits} = $commits;

          # Remove any numbers that appear in commits from changes
          my %rem = map { $_ => undef } @$changes;
          map { delete $rem{$_} } @$commits;
          $changes = [sort keys %rem];
        }
      $f->{orig}  = shift @$changes if @$changes;
      $f->{changes} = $changes if @$changes;

      if ($f->{commits} && ! $f->{orig})
        {
          # Someone requested a review of a commit already made, not a shelf.
          push @{$f->{commit_by}}, [ $f->{commits}->[0], $f->{author} ];
        }

      my $desc = $review->{description};
      if (defined $desc)
        {
          if ($desc =~ m=(https?://\S*jira\S*/browse/)([---a-z0-9]+)=i)
            {
              $f->{jira} = [$2, $1.$2];

              my $j = jira_issue ($2);
              map { $f->{$_} = $j->{$_} } keys %$j if $j;
            }

          $f->{summary} = $1 if ($desc =~ m=^(.+)$=m);
          $f->{summary} .= "..."
            if (length ($desc) - length ($1)) > 2;
        }
    }
}

sub parse_activity
{
  my ($found, $list) = @_;

  for my $activity (@$list)
    {
      my $review;
      if (ref $activity->{streams} eq 'HASH')
        {
          # Later API versions changed from array to hash.
          # Convert back to array, since this is more directly useful to us.
          $activity->{streams}
            = [ map { $activity->{streams}->{$_}
                    } sort { $a <=> $b
                           } keys %{$activity->{streams}} ];
        }

      for my $stream (@{$activity->{streams}})
        {
          if ($stream =~ /^review-(\d+)$/)
            {
              $review = $found->{$1};
              last;
            }
        }
      next unless defined $review;

      my $action = $activity->{action};
      my $fn = { committed => sub
                 { push (@{$review->{commit_by}},
                         [ $activity->{change}, $activity->{user} ]);
                 },

                 approved  => sub
                 { push @{$review->{approved_by}}, $activity->{user} },

                 rejected  => sub
                 { push @{$review->{rejected_by}}, $activity->{user} },

                 archived  => sub
                 { push @{$review->{archived_by}}, $activity->{user} },

                 requested => sub
                 { $review->{review_for} = $activity->{user} },

                 "updated files in" => sub
                 { $review->{review_for} = $activity->{user} },
               }->{$action} if defined $action;
      &$fn if defined $fn;
    }
}

sub prune_needed
{
  my ($need, $reviews) = @_;
  map { map { map { delete $need->{$_}
                  } (ref $_ eq 'ARRAY' ? @$_ : $_);
            } values %$_;
      } @$reviews;
}

sub printr
{
  my $label = shift;
  my $deflabelwidth = 14;
  my $prefix = "\t";

  my @a = map { if (ref $_ eq 'ARRAY')
                  {
                    if (ref $_->[0] eq 'ARRAY')
                      { map { sprintf ("%s (%s)", @$_) } @$_ }
                    else
                      { sprintf ("%s (%s)", @$_) }
                  }
                else
                  { $_ }
              } @_;

  my $data = fold_text (join (" ", @a));
  if ($data =~ /\n/)
    {
      my $nspc = max ($deflabelwidth + 1, length ($label));
      my $indent = $prefix . (" " x $nspc);
      $data =~ s/\n/\n$indent/g;
    }

  my $s = sprintf ("%s%-*s %s\n", $prefix, $deflabelwidth, $label, $data);
  substr ($s, length ($label) + length ($prefix), 1) = ":";
  print $s;
}

sub print_review
{
  my ($id, $data, $desc) = @_;

  printf "%s/reviews/%s\n", $opt{swarm_host}, $id;

  printr ("Summary", $data->{summary}) if $data->{summary};

  printr ("Version",     $data->{rel_version}) if $data->{rel_version};
  printr ("Bld changes", $data->{bld_changes}) if $data->{bld_changes};
  printr ("Rel changes", $data->{rel_changes}) if $data->{rel_changes};

  printr ("JIRA", join ("\n", @{$data->{jira}})) if $data->{jira};

  printr ("Requested by", $data->{review_for})
    if $data->{review_for} && $data->{review_for} ne $data->{author};

  my $culprit;
  for my $who_by (qw(approved_by rejected_by archived_by))
    {
      next unless $data->{$who_by};
      $culprit = $data->{$who_by};
      last;
    }
  if ($culprit)
    {
      printr ("State", $data->{state},
              sprintf ("(%s)", join (", ", @$culprit)));
    }
  else
    {
      printr ("State", $data->{state});
    }

  printr ("User shelf", $data->{orig}, "($data->{author})") if $data->{orig};
  if    ($data->{commit_by}) { printr ("Commits",   $data->{commit_by}) }
  elsif ($data->{commits})   { printr ("Commits", @{$data->{commits}}) }

  printr ("Commit Error", $data->{commitStatus}->{error})
    if (defined $data->{commitStatus}
        && ref $data->{commitStatus} eq 'HASH'
        && defined $data->{commitStatus}->{error});

  printr ("Swarm intern", @{$data->{changes}}) if $data->{changes};

  printr ("Created", timefmt ($data->{created}));
  printr ("Updated", timefmt ($data->{updated}));

  print "\n";
  print $desc, "\n" if $desc;
}

sub swarm_search
{
  my ($swarm, $need, $found, $fields) = (shift, shift, shift, shift);
  my $reviews = $swarm->reviews (fields => $fields, @_);
  if ($reviews && @$reviews)
    {
      prune_needed ($need, $reviews);
      parse_review ($found, $reviews);
    }
}

sub jira_issue
{
  my $task = shift;
  my $jira = jira();

  @jira_issue_customfields = $jira->customfield (keys %jira_issue_fields)
    unless @jira_issue_customfields;

  my $result = $jira->issue ($task, fields => \@jira_issue_customfields);
  return unless $result;

  my $fields = $jira->renamed_customfields ($result);
  for my $key (keys %$fields)
    {
      my $newkey = $jira_issue_fields{$key} or next;

      if (my $newval = $fields->{$key})
        {
          # sort and uniq changelists
          if ($newval =~ /^[\d,\s]+$/)
            {
              my %tem = map { $_ => 1 } split (/[,\s]+/, $newval);
              $newval = join (" ", sort keys %tem);
            }
          $fields->{$newkey} = $newval;
        }
      delete $fields->{$key};
    }
  return $fields;
}

sub jira_issue_reviews
{
  my $result = jira()->issue_remotelink (@_);
  my @review;
  for my $remote (@$result)
    {
      next unless $remote->{object}->{url} =~ m=/reviews/(\d+)=;
      push @review, $1;
    }
  return @review;
}

sub bt # Like `foo` in bourne shell.
{
  my $fh;
  eval
    {
      local $SIG{__DIE__}  = sub { return };
      local $SIG{__WARN__} = sub { return };
      open ($fh, "-|", @_) || die "exec: $_[0]: $!\n";
    };
  print(STDERR $@), return if $@;

  local $/ = undef;
  chomp (local $_ = <$fh>);
  return $_;
}

sub p4_describe_changes
{
  my $found = shift;

  # If a review has already been committed, then the files disappear from
  # that shelf.  So try to use the commit change (if there is one) or the
  # user's original shelf before swarm copied it into its own shelf, for
  # the file list.
  my %idmap;
  while (my ($review, $data) = each %$found)
    {
      if    ($data->{commits}) { my @chg = reverse @{$data->{commits}};
                                 $idmap{$chg[0]} = $review }
      elsif ($data->{orig})    { $idmap{$data->{orig}} = $review }
      else                     { $idmap{$review} = $review }
    }

  local $_ = eval { bt (qw(p4-describe-changes -2Ditz), keys %idmap) };
  return {} unless defined $_;
  my %text;
  $text{$1} = $2 while (/^\S+\s*(\d+).*?\n+(.+?)(?=(?:^\S|\Z))/gms);

  my %desc = map { $idmap{$_} => $text{$_} } keys %text;
  return \%desc;
}

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

  my $action_fn = sub { $opt{action} = $_[0] };

  my $parser = Getopt::Long::Parser->new;
  $parser->configure (qw(bundling autoabbrev no_ignore_case));
  my $succ = $parser->getoptions
    ( "D|debug+"        => \$ENV{NF_REST_DEBUG},
      "h|?|help+"       => \$help,

      "f|files"         => \$opt{show_files},
      "w|wait-commit"   => \$opt{wait_commit},

      "version=i"       => \$opt{version},

      # Even though these all call the same fn, they must be separate
      # because $_[0] is always the first option in any "a|b" string.
      "approve"         => $action_fn,
      "commit"          => $action_fn,
      "reject"          => $action_fn,
      "archive"         => $action_fn,
      "needs_review|needs-review"       => $action_fn,
      "needs_revision|needs-revision"   => $action_fn,
      "vote_up|vote-up|upvote"          => $action_fn,
      "vote_down|vote-down|downvote"    => $action_fn,
      "vote_clear|vote-clear|clearvote" => $action_fn,

      "jh|jira-host=s"  => \$opt{jira_host},
      "ju|jira-user=s"  => \$opt{jira_user},
      "jp|jira-pass=s"  => \$opt{jira_pass},

      "sh|swarm-host=s" => \$opt{swarm_host},
      "su|swarm-user=s" => \$opt{swarm_user},
      "sp|swarm-pass=s" => \$opt{swarm_pass},
    );

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

  $opt{swarm_user} = $ENV{SUDO_USER} || $ENV{USER} || $ENV{LOGNAME}
    unless $opt{swarm_user};

  if ($opt{swarm_user} && ! $opt{swarm_pass})
    {
      # "p4 tickets" ignores -G or other marshalled/tagged output modes,
      # so NF::P4Cmd won't work.  Just parse the text output.
      my $tickets = bt (qw(p4 tickets));
      $opt{swarm_pass} = $1
        # This is probably very perforce.com specific.
        if $tickets =~ /:P4Cluster\s+\($opt{swarm_user}\)\s+(.*)$/m;
    }
}

sub main
{
  parse_options (\@_);

  # This only matters when output is not to a tty, but it keeps any errors
  # synchronized with regular output.
  STDOUT->autoflush(1);
  STDERR->autoflush(1);

  my @list;
  for my $arg (@_)
    {
      if ($arg =~ /^\d+$/)
        { push @list, $arg }
      else
        {
          my @result = eval { jira_issue_reviews ($arg) };
          if ($@) { print STDERR "$arg: ", $@, "\n" }
          elsif (scalar @result == 0)
            { print STDERR "$arg: no reviews found for this issue.\n" }
          else
            { push @list, @result }
        }
    }

  unless (@list)
    {
      if (@_)
        { print STDERR "No results to display.\n" }
      else
        { print STDERR "You must provide review/shelf numbers or jira tasks!\n" }
      exit 1;
    }

  my $swarm = swarm();
  if ($opt{action})
    {
      my $fn = $opt{action};
      my %w;
      $w{wait}    = 'true'        if $opt{wait_commit}     && $fn eq 'commit';
      $w{version} = $opt{version} if defined $opt{version} && $fn =~ /vote/;
      map { my $result = eval { $swarm->$fn ($_, %w) };
            if ($@)
              { print STDERR $@, "\n" if $@ }
            elsif (exists $result->{review})
              {
                printf "%s: %s\n", $_, $result->{review}->{stateLabel};
              }
            elsif (exists $result->{messages})
              {
                my $id = $_;
                map { printf "%s: %s\n", $id, $_ } @{$result->{messages}};
              }
          } @list;
      print "\n" if @list;
    }

  my %need = (map { $_ => undef } @list);
  my %found;
  swarm_search ($swarm, \%need, \%found, \@review_fields, ids => \@list);
  swarm_search ($swarm, \%need, \%found, \@review_fields, change => [keys %need])
    if %need;

  # activity endpoint can only search one stream at a time
  map { my $stream = $_;
        my $activity = $swarm->activity (fields => \@activity_fields,
                                         stream => $stream);
        parse_activity (\%found, $activity);
      } map { "review-$_" } sort keys %found;

  map { print STDERR "$_: no Swarm reference found.\n" } sort keys %need;
  print STDERR "\n" if %need;

  my $desc = p4_describe_changes (\%found) if $opt{show_files};
  map { print_review ($_, $found{$_}, $desc->{$_}) } sort keys %found;
}

main (@ARGV);

# eof