view release on metacpan or  search on metacpan

lib/App/Sqitch/Command.pm  view on Meta::CPAN

package App::Sqitch::Command;

use 5.010;
use strict;
use warnings;
use utf8;
use Try::Tiny;
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::X qw(hurl);
use Hash::Merge 'merge';
use File::Path qw(make_path);
use Moo;
use App::Sqitch::Types qw(Sqitch Target);

our $VERSION = 'v1.6.1'; # VERSION

use constant ENGINES => qw(
    pg
    sqlite
    mysql
    oracle
    firebird
    vertica
    exasol
    snowflake
    cockroach
    clickhouse
);

has sqitch => (
    is       => 'ro',
    isa      => Sqitch,
    required => 1,
    handles  => [qw(
        run
        shell
        quote_shell
        capture
        probe
        verbosity
        trace
        trace_literal
        debug
        debug_literal
        info
        info_literal
        comment
        comment_literal
        emit
        emit_literal
        vent
        vent_literal
        warn
        warn_literal
        page
        page_literal
        prompt
        ask_y_n
    )],
);

has default_target => (
    is      => 'ro',
    isa     => Target,
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $sqitch = $self->sqitch;
        my @params = $self->target_params;
        unless (
               $sqitch->config->get(key => 'core.engine')
            || $sqitch->config->get(key => 'core.target')
        ) {
            # No specified engine, so specify an engineless URI.
            require URI::db;
            unshift @params, uri => URI::db->new('db:');
        }
        require App::Sqitch::Target;
        return App::Sqitch::Target->new(@params);
    },
);

sub command {
    my $class = ref $_[0] || shift;
    return '' if $class eq __PACKAGE__;
    my $pkg = quotemeta __PACKAGE__;
    $class =~ s/^$pkg\:://;
    $class =~ s/_/-/g;
    return $class;
}

sub class_for {
    my ( $class, $sqitch, $cmd ) = @_;

    $cmd =~ s/-/_/g;

    # Load the command class.
    my $pkg = __PACKAGE__ . "::$cmd";
    eval "require $pkg; 1" or do {
        # Emit the original error for debugging.
        $sqitch->debug($@);
        return undef;
    };
    return $pkg;
}

sub load {
    my ( $class, $p ) = @_;
    # We should have a command.
    my $cmd = delete $p->{command} or $class->usage;
    my $pkg = $class->class_for($p->{sqitch}, $cmd) or hurl {
        ident   => 'command',
        exitval => 1,
        message => __x(
            '"{command}" is not a valid command',
            command => $cmd,
        ),