view release on metacpan or  search on metacpan

lib/Carton/CLI.pm  view on Meta::CPAN

package Carton::CLI;
use strict;
use warnings;
use Config;
use Getopt::Long;
use Path::Tiny;
use Try::Tiny;
use Module::CoreList;
use Scalar::Util qw(blessed);

use Carton;
use Carton::Builder;
use Carton::Mirror;
use Carton::Snapshot;
use Carton::Util;
use Carton::Environment;
use Carton::Error;

use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 };

our $UseSystem = 0; # 1 for unit testing

use Class::Tiny {
    verbose => undef,
    carton => sub { $_[0]->_build_carton },
    mirror => sub { $_[0]->_build_mirror },
};

sub _build_mirror {
    my $self = shift;
    Carton::Mirror->new($ENV{PERL_CARTON_MIRROR} || $Carton::Mirror::DefaultMirror);
}

sub run {
    my($self, @args) = @_;

    my @commands;
    my $p = Getopt::Long::Parser->new(
        config => [ "no_ignore_case", "pass_through" ],
    );
    $p->getoptionsfromarray(
        \@args,
        "h|help"    => sub { unshift @commands, 'help' },
        "v|version" => sub { unshift @commands, 'version' },
        "verbose!"  => sub { $self->verbose($_[1]) },
    );

    push @commands, @args;

    my $cmd = shift @commands || 'install';

    my $code = try {
        my $call = $self->can("cmd_$cmd")
            or Carton::Error::CommandNotFound->throw(error => "Could not find command '$cmd'");
        $self->$call(@commands);
        return 0;
    } catch {
        die $_ unless blessed $_ && $_->can('rethrow');

        if ($_->isa('Carton::Error::CommandExit')) {
            return $_->code || 255;
        } elsif ($_->isa('Carton::Error::CommandNotFound')) {
            warn $_->error, "\n\n";
            $self->cmd_usage;
            return 255;
        } elsif ($_->isa('Carton::Error')) {
            warn $_->error, "\n";