File Coverage

blib/lib/Shipwright/Script/Delete.pm

Criterion	Covered	Total	%
statement	15	41	36.5
branch	0	16	0.0
condition	0	9	0.0
subroutine	5	7	71.4
pod	0	2	0.0
total	20	75	26.6

package Shipwright::Script::Delete;

use strict;
use warnings;

use base qw/App::CLI::Command Shipwright::Base Shipwright::Script/;
__PACKAGE__->mk_accessors(qw/unreferenced check_only/);

use Shipwright;
use Shipwright::Util;

sub options {
    (
        'unreferenced' => 'unreferenced',
        'C|check-only' => 'check_only',
    );
}

sub run {
    my $self = shift;
    my @sources = @_;

    unless ( @sources || $self->unreferenced ) {
        confess_or_die "need name arg or --unreferenced\n";
    }

    if ( @sources && $self->unreferenced ) {
        confess_or_die "please choose only one thing: a dist name or --unreferenced";
    }

    my $shipwright = Shipwright->new( repository => $self->repository, );
    my @names;

    if (@sources) {
        for my $name (@sources) {
            my $map = $shipwright->backend->map;
            if ( $map && $map->{$name} ) {

                # it's a cpan module
                $name = $map->{$name};
            }
            push @names, $name;
        }
    }
    else {

        # unreferenced dists except the last one
        my $refs  = $shipwright->backend->refs;
        my $order = $shipwright->backend->order;
        if ($refs) {
            for my $name ( keys %$refs ) {
                next if $name eq $order->[-1];
                push @names, $name unless $refs->{$name};
            }
        }
    }

    if ( $self->check_only ) {
        $self->log->fatal( "dists to be deleted are: @names" );
    }
    else {
        for my $name (@names) {
            $shipwright->backend->trim( name => $name );
        }
        $self->log->fatal( "successfully deleted @names" );
    }

}

1;

__END__