対話式 git-clean

git_clean.pl

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use feature ':5.10';

use Getopt::Long qw(GetOptions :config posix_default no_ignore_case bundling );
use Params::Validate qw/:all/;
use Pod::Usage 'pod2usage';
use Term::UI;
use Try::Tiny;

$SIG{__WARN__} = sub {
    my $w = shift;
    die $w if $w =~ /^Unknown\soption/; #
    warn $w;
};

our $BASE_CMD = 'git clean ';

try {
    GetOptions(\my %opt, qw/d X x h f|help/);
    main( valid(\%opt) );
}
catch {
    warn $_;
    pod2usage(2);
    die;
};

exit;


sub main {
    my $p = shift;
    my $term          = Term::ReadLine->new();

    my $option  = join ' ', map { "-$_" } keys %$p;
    my $dry_cmd = $BASE_CMD. '-n '. $option;
    say `$dry_cmd`;

    my $exec = $term->ask_yn(
        print_me => '========',
        prompt   => 'remove really?',
        default  => 'n',
    );

    return unless $exec;
    my $remove_cmd = $BASE_CMD. $option;
    say `$remove_cmd`;
}


sub valid {
    my %p = validate(@_,
        {
            d => { regex => qr/\A1\z/, optional => 1 },
            x => { regex => qr/\A1\z/, optional => 1 },
            X => { regex => qr/\A1\z/, optional => 1 },
            f => { regex => qr/\A1\z/, optional => 1 },
            h => { regex => qr/\A1\z/, optional => 1 },
        }
    );
    pod2usage(2) if $p{h};
    return \%p;
}

__END__

=pod

=head1 NAME git_clean

  git clean を対話式に行う。

=head1 DESCRIPTION

  git clean を対話式に行う。
  git clean -n {opt} にて削除されるファイルを表示した後、実際に削除するかどうか対話式で行う。

=head1 SYNOPSIS

perl git_clean.pl {-d|-x|-X}

=over options

=item B<-f>

.git/config のclean.requireForce が設定されていたなら、削除にはこの引数が必要になる。

=item B<-d>

ディレクトリも対象にする

=item B<-x>

.gitinore を考慮に入れない。これを指定すると.gitignore で指定してあっても削除の対象になる。

=item B<-X>

.gitinore のみを対象にする。これを指定すると.gitignore で指定してあるものだけ削除対象にする

=back

=cut

=head1 SEE ALSO

man git-clean

=cut