git-branch-summary-tool

#!/usr/bin/env perl
use v5.32.0;
use warnings;
use utf8;

binmode *STDOUT, ':encoding(UTF-8)';
binmode *STDERR, ':encoding(UTF-8)';

use experimental qw(declared_refs refaliasing);

use Cpanel::JSON::XS;
use Digest::SHA1 qw(sha1_hex);
use Encode qw(decode);
use Getopt::Long::Descriptive;
use HTML::Entities;
use LWP::UserAgent;
use Path::Tiny;
use String::Truncate qw(elide);

my $BIG_SPACE = "\N{IDEOGRAPHIC SPACE}";

my ($opt, $usage) = describe_options(
  '%c %o',
  [ 'repo|r=s',   'what github repository for the API? owner/repo format', { required => 1 } ],
  [ 'since=s',    'start from what commit?', { required => 1 } ],
  # TODO: make this use the "find main or master" logic from BranchManager
  # -- rjbs, 2024-06-05
  [ 'remote=s',   'what remote are we cleaning up? default: origin', { default => 'origin' } ],
  [ 'branch=s',   'what branch is the default? default: master', { default => 'master' } ],
  [ 'cgnu',       'attempt to find the same commit in blead by commit msg' ],
  [],
  [ 'prelude=s',  'text file containing introductory text for email', { required => 1 } ],
  [ 'user|u=s',   'what Fastmail user?' ],
  [ 'send',       'do not just create a draft, actually send' ],
  [ 'print',      'do not even create a draft, just print the text' ],
);

die "you can't --send and --print\n" if $opt->send && $opt->print;

my $prelude = path($opt->prelude)->slurp_utf8;

my $branch_count = 0;
my $cleanable_count = 0;

# Put these into variables so we can interpolate them often:
my $REPO    = $opt->repo;
my $SINCE   = $opt->since;
my $REMOTE  = $opt->remote;
my $BRANCH  = $opt->branch;

my %commits_by_msg;
if ($opt->cgnu) {
  # 557b887a4219c4f375c8d0bd3219fb4da7bbc7ff is roughly first commit of 2005
  my @lines = `git log $SINCE..$REMOTE/$BRANCH --pretty='format:%H%n%ai %ae%n%B%nCUT-CUT-CUT'`;
  chomp @lines;

  warn 0+@lines;

  my $accum = q{};
  my $sha;

  LINE: while (@lines) {
    my $line = shift @lines;

    unless (defined $sha) {
      $sha = $line;
      next LINE;
    }

    if ($line eq 'CUT-CUT-CUT') {
      my $target = $commits_by_msg{ sha1_hex($accum) } //= [];

      push @$target, $sha;

      if (@$target > 1) {
        warn "Woah, repeated commit msg in @$target\n";
      }

      undef $sha;
      $accum = q{};
      next LINE;
    }

    $accum .= $line;
  }
}

sub h { goto &HTML::Entities::encode_entities }

my $JSON = Cpanel::JSON::XS->new->utf8->canonical;

my @branch = `git branch -r | grep ' $REMOTE'`;
chomp @branch;
s/^..// for @branch;
$_ = decode('UTF-8', $_) for @branch;

# TODO: parameterize/config this
my @special = (
  qr{^\Q$REMOTE\E/main$},
  qr{^\Q$REMOTE\E/master$},
  qr{^\Q$REMOTE\E/cyrus-imapd-\d\.},
);

my %is_merged = do {
  my @merged = `git branch --remote --merged $REMOTE/$BRANCH | grep ' $REMOTE'`;
  chomp @merged;
  s/^..// for @merged;
  map {; $_ => 1 } @merged;
};

# email => branch => date

my %found;

my $gh_ua = LWP::UserAgent->new(keep_alive => 5);
   $gh_ua->default_header('Authorization' => "token $ENV{GITHUB_OAUTH_TOKEN}");

my %present_as;

for my $branch (@branch) {
  next if grep { $branch =~ $_ } @special;
  next if $is_merged{ $branch };

  if ($opt->cgnu) {
    my @lines = `git show --no-patch --pretty="format:%ai %ae%n%B" $branch`;
    chomp @lines;
    my $body = join q{}, @lines;
    if (my $got = $commits_by_msg{ sha1_hex($body) }) {
      $present_as{$branch} = $got;
    }
  }

  my ($sha, $who, $date) = split /\s/, scalar `git show --pretty='format:%H %cE %ci' $branch`;

  my $res = $gh_ua->get(
    "https://api.github.com/repos/$REPO/commits/$sha/pulls",
    Accept => 'application/vnd.github.groot-preview+json',
  );

  die $res->as_string unless $res->is_success;

  my $mrs = $JSON->decode($res->decoded_content(charset => undef));

  my @keep = map {; +{ $_->%{ qw( number title state html_url merged_at draft ) } } } @$mrs;

  if (@$mrs) {
    # warn "$branch - " . join(q{, }, map {; $_->{number} } @keep) . "\n";
  } else {
    # warn "$branch - n/a\n";
  }

  push $found{ $who }->@*, [ $date, $branch, \@keep ];
}

my $text = q{};
my $html = <<'END-HTML';
<style>
  table { border-collapse: collapse }
  th    { text-align: left; padding-top: 1em }
  td    { border: 1px solid black; padding: 0.25em 0.5em; vertical-align: top }
  td a  { text-decoration: none }
  td.date { font-face: monospace }
  td.already-merged   { background: #f2f2e2 }
  td.has-pull-request { background: #fde2fd }
</style>
END-HTML

$html .= "<table>";

for my $email (sort keys %found) {
  $text .= "\n" if length $text;

  $text .= "==[ $email ]==\n";

  $html .= sprintf "<tr><th colspan='3'>%s</th></tr>", h($email);

  for my $got (sort { $a->[0] cmp $b->[0] } $found{$email}->@*) {
    $branch_count++;

    my ($date, $branch, \@mrs) = @$got;

    $text .= "  - $date - $branch\n";
    $html .= "<tr>";

    my @extra;

    my $cleanable = 0;

    for (@mrs) {
      my $icon = $_->{state} eq 'open'  ? ($_->{draft} ? "🚧" : "🌀")
               : $_->{merged_at}        ? "✅"
               :                          "❌";

      $cleanable = 1 if $_->{state} eq 'closed';
      $cleanable = 1 if $_->{merged_at};

      $text .= sprintf "%*s%s\n%*s%s\n",
        (length($date) + 7), '', # leader plus indent past " - date -"
        "$icon $_->{title}",
        (length($date) + 7), '', # leader plus indent past " - date -"
        $_->{html_url};

      push @extra, sprintf "<a href='%s'>%s</a> — %s</a>",
        h($_->{html_url}),
        h("$BIG_SPACE$icon $_->{number}"),
        h(elide($_->{title}, 48));
    }

    my $class = (grep {; $_->{merged_at} } @mrs)  ? 'already-merged'
              : (0+@{$present_as{$branch}//[]})   ? 'already-merged'
              : (0+@mrs)                          ? 'has-pull-request'
              :                                     'unknown';

    $cleanable = 1 if $class eq 'already-merged';
    $cleanable_count++ if $cleanable;

    for my $merged (($present_as{$branch} // [])->@*) {
      state $icon = "\N{BALLOT BOX WITH CHECK}\N{VARIATION SELECTOR-16}";

      $text .= sprintf "%*s$icon Apparently merged as %s\n",
        (length($date) + 7), '', # leader plus indent past " - date -"
        $merged;

      push @extra, sprintf "$BIG_SPACE$icon Apparently merged as <a href='%s'>%s</a>",
        h("https://github.com/$REPO/commit/$merged"),
        substr($merged, 0, 8);
    }

    my $no_remote = $branch =~ s{^github/}{}r;

    $html .= sprintf "<td class='date'>%s</td><td class='%s'><a href='%s'>%s</a>%s</td>",
      h($date),
      $class,
      h("https://github.com/$REPO/tree/$no_remote"),
      h(elide($no_remote, 48)),
      join q{<br />}, (@extra ? '' : ()), @extra;

    $html .= "</tr>\n";
  }
}

if ($opt->print) {
  print $text;
  exit 0;
}

require Fastmail::Client::Config;
my $fm_client = Fastmail::Client::Config->new->client(
  $opt->user ? $opt->user : ()
);

my @mailboxes = $fm_client->request([[ 'Mailbox/get', {} ]])
                          ->get
                          ->single_sentence('Mailbox/get')
                          ->arguments->{list}->@*;

my ($drafts_mailbox) = grep {; ($_->{role}//'') eq 'drafts' } @mailboxes;
my ($sent_mailbox)   = grep {; ($_->{role}//'') eq 'sent' } @mailboxes;

die "can't find drafts mailbox!\n" unless $drafts_mailbox;
die "can't find sent mailbox!\n"   unless $sent_mailbox;

$html .= "</table>";

my @prelude = split /\n\n/, $prelude;

$html = join(qq{\n}, map {; sprintf "<p>%s</p>", h($_) } @prelude) . "\n$html";
$text = join(qq{\n\n}, @prelude, $text);

$html .= sprintf "<p>Branches found: %i</p>", $branch_count;
$html .= sprintf "<p>Cleanable branches: %i</p>", $cleanable_count;

$text .= "Branches found: $branch_count\n";
$text .= "Cleanable branches: $cleanable_count\n";

my $draft = {
  from      => [
    {
      name  => 'Ricardo Signes',
      email => 'rjbs@semiotic.systems',
    }
  ],

  to      => [
    {
      name  => 'Ricardo Signes',
      email => 'rjbs@semiotic.systems',
    },
  ],

  subject   => "branches in $REPO.git",
  keywords  => {
    '$draft' => \1,
  },
  mailboxIds => { $drafts_mailbox->{id} => \1 },

  bodyValues  => {
    textBody => { value => $text, charset => 'utf-8' },
    htmlBody => { value => $html, charset => 'utf-8' },
  },
  htmlBody    => [ { partId => 'htmlBody', type => 'text/html' } ],
  textBody    => [ { partId => 'textBody', type => 'text/plain' } ],
};

my $send = 1;
my $res = $fm_client->request([
  [ 'Email/set', { create => { draft => $draft } } ],
  ($opt->send
  ?
    [ 'EmailSubmission/set', {
        onSuccessUpdateEmail => {
          '#sendIt' => {
            "mailboxIds/$drafts_mailbox->{id}"  => undef,
            "mailboxIds/$sent_mailbox->{id}"    => \1,
            'keywords/$draft' => undef,
          },
        },
        create => {
          sendIt => { emailId => '#draft' }
        }
      }
    ]
  : ())
])->get;

use Data::Dumper;
print Dumper($res->as_stripped_pairs);