view release on metacpan or  search on metacpan

lib/CPAN/Mirror/Tiny/CLI.pm  view on Meta::CPAN

package CPAN::Mirror::Tiny::CLI;
use v5.24;
use warnings;
use experimental qw(lexical_subs signatures);

use CPAN::Mirror::Tiny;
use File::Find ();
use File::Spec;
use File::stat ();
use Getopt::Long ();
use IPC::Run3 ();
use POSIX ();
use Pod::Usage 1.33 ();

sub new ($class) {
    bless {
        base => $ENV{PERL_CPAN_MIRROR_TINY_BASE} || "darkpan",
    }, $class;
}

sub run ($class, @argv) {
    $class->_run(@argv) ? 0 : 1;
}

sub _run ($class, @argv) {
    my $self = $class->new;
    $self->parse_options(@argv) or return;

    my $cmd = shift $self->{argv}->@*;
    if (!$cmd) {
        warn "Missing subcommand, try `$0 --help`\n";
        return;
    }

    ( my $_cmd = $cmd ) =~ s/-/_/g;
    if (my $sub = $self->can("cmd_$_cmd")) {
        return $self->$sub($self->{argv}->@*);
    } else {
        warn "Unknown subcommand '$cmd', try `$0 --help`\n";
        return;
    }

}

sub parse_options ($self, @argv) {
    local @ARGV = @argv;
    my $parser = Getopt::Long::Parser->new(
        config => [qw(no_auto_abbrev no_ignore_case pass_through)],
    );
    $parser->getoptions(
        "h|help" => sub (@) { $self->cmd_help; exit },
        "v|version" => sub (@) { $self->cmd_version; exit },
        "q|quiet" => \$self->{quiet},
        "b|base=s" => \$self->{base},
        "a|author=s" => \$self->{author},
    ) or return 0;
    $self->{argv} = \@ARGV;
    return 1;
}

sub cmd_help ($self) {
    Pod::Usage::pod2usage(verbose => 99, sections => 'SYNOPSIS|OPTIONS|EXAMPLES');
    return 1;
}

sub cmd_version ($self) {
    my $klass = "CPAN::Mirror::Tiny";
    printf "%s %s\n", $klass, $klass->VERSION;
}

sub cmd_inject ($self, @argv) {
    die "Missing urls, try `$0 --help`\n" unless @argv;
    my $cpan = CPAN::Mirror::Tiny->new(base => $self->{base});
    my $option = $self->{author} ? { author => $self->{author} } : +{};
    for my $argv (@argv) {
        print STDERR "Injecting $argv" unless $self->{quiet};
        if (eval { $cpan->inject($argv, $option); 1 }) {
            print STDERR " DONE\n" unless $self->{quiet};
        } else {
            print STDERR " FAIL\n" unless $self->{quiet};
            die $@;
        }
    }
    return 1;
}

sub cmd_gen_index ($self, @argv) {
    my $cpan = CPAN::Mirror::Tiny->new(base => $self->{base});
    $cpan->write_index(compress => 1, $self->{quiet} ? () : (show_progress => 1));
    warn sprintf "Generated %s\n", $cpan->index_path(compress => 1) unless $self->{quiet};
    return 1;
}

sub cmd_cat_index ($self, @argv) {
    my $cpan = CPAN::Mirror::Tiny->new(base => $self->{base});
    my $index = $cpan->index_path(compress => 1);
    return unless -f $index;
    my @cmd = ($cpan->{gzip}, "--decompress", "--stdout", $index);
    IPC::Run3::run3 \@cmd, \undef, undef, undef;
    return $? == 0;
}

sub cmd_list ($self) {
    return unless -d $self->{base};
    my ($index, @dist);
    my $wanted = sub (@) {