view release on metacpan or  search on metacpan

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

package CPAN::Mirror::Tiny::CLI;
use strict;
use warnings;

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 {
    my $class = shift;
    bless {
        base => $ENV{PERL_CPAN_MIRROR_TINY_BASE} || "darkpan",
    }, $class;
}

sub run {
    shift->_run(@_) ? 0 : 1;
}

sub _run {
    my $self = shift->new;
    $self->parse_options(@_) 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 {
    my $self = shift;
    local @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 {
    Pod::Usage::pod2usage(verbose => 99, sections => 'SYNOPSIS|OPTIONS|EXAMPLES');
    return 1;
}

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

sub cmd_inject {
    my ($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 {
    my ($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 {
    my ($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 {