The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;

package Options;
$Options::VERSION = '0.000013';
use Moo;
use MooX::Options;

option all => (
    is       => 'ro',
    required => 0,
    doc      => 'regex to filter branches',
);

option grep => (
    is       => 'ro',
    format   => 's',
    required => 0,
    doc      => 'regex to filter branches',
);

package main;
$main::VERSION = '0.000013';
use Capture::Tiny qw( capture );
use Git::Sub;
use String::Trim qw( trim );
use Term::UI;
use Term::ReadLine ();

my $term = Term::ReadLine->new('brand');

## no critic (ControlStructures::ProhibitMutatingListFunctions)

my $options = Options->new_with_options;

# Don't include the branch we're currently on
my @branches = map { trim($_) }
    grep { !m{^\*} }
    git::branch( '--no-color', $options->all ? ('--all') : () );

if ( $options->grep ) {
    @branches = grep { $_ =~ $options->grep } @branches;
}

## use critic

my @reply = $term->get_reply(
    choices => \@branches,
    multi   => 1,
    prompt  => 'Which branch(es) would you like to delete?',
);

for my $branch (@reply) {
    my @to_delete = ($branch);

    for my $name (@to_delete) {
        my $is_remote = $name =~ s{\Aremotes/}{};

        if ( my $stderr
            = delete_branch( $is_remote ? ('--remotes') : (), $name ) ) {

            if ( $stderr =~ m{not fully merged} ) {

                my $prompt = <<"EOF";
Branch $branch is not fully merged. Would you still like to delete it?",
EOF

                my $reply = $term->get_reply(
                    choices => [ 'Yes', 'No' ],
                    prompt  => $prompt,
                );

                if ( $reply eq 'Yes' ) {
                    my $stderr = delete_branch( '--force', $name );
                    print "$stderr\n" if $stderr;
                }
            }
            else {
                print "$stderr\n";
            }
        }
    }
}

sub delete_branch {
    my @args = @_;
    unshift @args, '--delete';
    my ( undef, $stderr ) = capture {
        eval { git::branch(@args) };
    };

    return $stderr;
}

sub remotes {
    my $branch = shift;
    my @remotes = map { trim($_) } git::branch( '-r', '--contains', $branch );
    return @remotes;
}


# ABSTRACT: Interactively delete git branches
# PODNAME: delete-git-branches

__END__

=pod

=encoding UTF-8

=head1 NAME

delete-git-branches - Interactively delete git branches

=head1 VERSION

version 0.000013

=head1 SYNOPSIS

    $ git branch
    * delete-branches
      foo
      foo-bar
      foo-bar-baz
      foo-bar-baz-qux
      master

    $ delete-git-branches
      1> foo
      2> foo-bar
      3> foo-bar-baz
      4> foo-bar-baz-qux
      5> master

    Which branch(es) would you like to delete? : 1 2 3 4

    $ git branch
    * delete-branches
      master

=head2 DESCRIPTION

Interactive command line script which allows you to select one or many git
branches to delete.  Use C<ctrl-c> to exit without deleting any branches.

=head2 OPTIONS

=over

=item all

Includes remote branches when enabled.

    $ delete-git-branches --all

      1> foo-bar-baz
      2> foo-bar-baz-qux
      3> master
      4> remotes/origin/cpan-repo
      5> remotes/origin/delete-branches
      6> remotes/origin/foo

=item grep

A regex to filter git branches against.

    $ delete-git-branches --grep foo

      1> foo-bar-baz
      2> foo-bar-baz-qux

=back

=head1 AUTHOR

Olaf Alders <olaf@wundercounter.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015-2017 by Olaf Alders.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut