view release on metacpan or  search on metacpan

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

package App::Sqitch::Command::target;

use 5.010;
use strict;
use warnings;
use utf8;
use Moo;
use Types::Standard qw(Str Int HashRef);
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::X qw(hurl);
use URI::db;
use Try::Tiny;
use Path::Class qw(file dir);
use List::Util qw(max);
use namespace::autoclean;
use constant extra_target_keys => qw(uri);

extends 'App::Sqitch::Command';
with 'App::Sqitch::Role::TargetConfigCommand';

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

sub configure {
    # No config; target config is actually targets.
    return {};
}

sub execute {
    my ( $self, $action ) = (shift, shift);
    $action ||= 'list';
    $action =~ s/-/_/g;
    my $meth = $self->can($action) or $self->usage(__x(
        'Unknown action "{action}"',
        action => $action,
    ));
    return $self->$meth(@_);
}

sub list {
    my $self    = shift;
    my $sqitch  = $self->sqitch;
    my %targets = $sqitch->config->get_regexp(key => qr/^target[.][^.]+[.]uri$/);

    # Make it verbose if --verbose was passed at all.
    my $format = $sqitch->options->{verbosity} ? "%1\$s\t%2\$s" : '%1$s';
    for my $key (sort keys %targets) {
        my ($target) = $key =~ /target[.]([^.]+)/;
        $sqitch->emit(sprintf $format, $target, $targets{$key});
    }

    return $self;
}

sub add {
    my ($self, $name, $uri) = @_;
    $self->usage unless $name && $uri;

    my $key    = "target.$name";
    my $config = $self->sqitch->config;

    hurl target => __x(
        'Target "{target}" already exists',
        target => $name
    ) if $config->get( key => "$key.uri");

    # Put together the URI and other config variables.
    my $vars = $self->config_params($key);
    unshift @{ $vars } => {
        key   => "$key.uri",
        value => URI::db->new($uri, 'db:')->as_string,
    };

    # Make it so.
    $config->group_set( $config->local_file, $vars );
    my $target = $self->config_target(name => $name);