Migrate target to TargetConfigCommand.

Need to add tests for the alter command, but otherwise on parity with the engine command.
sqitchers · Aug 12, 2015 · f729903 · f729903
1 parent b61705a
commit f729903
Show file tree

Hide file tree

Showing 9 changed files with 312 additions and 231 deletions.
diff --git a/Changes b/Changes
@@ -30,20 +30,22 @@ Revision history for Perl extension App::Sqitch
        `deploy_dir`, `revert_dir`, or `verify_dir` settings. I think these
        settings are not commonly used, and it would start to get crowded if we
        also added their "reworked" variants, which will be used still less.
-     - Added the `alter` action to the `engine` command to set engine
+     - Added the `alter` action to the `engine` and `target` commands to set
-       properties.
+       engine and target properties.
-     - Deprecated the `set-*` actions in the `engine` command in favor of the
+     - Deprecated the `set-*` actions in the `engine` and `target` commands in
-       new `alter` action.
+       favor of the new `alter` action.
-     - Added support for setting reworked directories to the `engine` command.
+     - Added support for setting reworked directories to the `engine` and
-     - Reformatted the output of the `engine` command's `show` action include
+       `target` commands.
-       reworked directories, and to bit a bit less flat.
+     - Reformatted the output of the `engine` and `target` command `show`
+       actions to include reworked directories, and to bit a bit less flat.
      - Attempting to add or alter an engine with a target URI that connects to
        a different engine now triggers an error. For example, you can't set
        the target for engine `pg` to `db:sqlite:`.
-     - The `add` and `alter` actions of the `engine` commmand now create
+     - The `add` and `alter` actions of the `engine` and `target` commmands
-       script directories if they don't already exist.
+       now create script directories if they don't already exist.
-     - The `add` action of the `engine` commmand now creates a plan file if
+     - The `add` action of the `engine` and `target` commmands now creates a
-       one does not exist in the specified location for the engine.
+       plan file if one does not exist in the specified location for the
+       engine or target.
 
 0.9992 2015-05-20T23:51:41Z
      - On PostgreSQL, Sqitch now sets the `client_encoding` parameter to

diff --git a/lib/App/Sqitch/Command/engine.pm b/lib/App/Sqitch/Command/engine.pm
@@ -12,6 +12,8 @@ use Try::Tiny;
 use URI::db;
 use Path::Class qw(file dir);
 use List::Util qw(max first);
+use namespace::autoclean;
+
 use constant property_keys => qw(
     top_dir
     plan_file
@@ -27,7 +29,6 @@ use constant property_keys => qw(
     reworked_verify_dir
     extension
 );
-use namespace::autoclean;
 
 extends 'App::Sqitch::Command';
 with 'App::Sqitch::Role::TargetConfigCommand';
@@ -131,7 +132,7 @@ sub add {
         push @vars => {
             key   => "$key.$prop",
             value => $val,
-        } if $prop ne 'target'
+        } if $prop ne 'target';
     }
 
     # Make it so.
@@ -293,6 +294,7 @@ sub show {
         verify       => '  ' . __ 'Verify',
         reworked     => '  ' . __ 'Reworked',
     );
+
     my $len = max map { length } values %label_for;
     $_ .= ': ' . ' ' x ($len - length $_) for values %label_for;
 

diff --git a/lib/App/Sqitch/Command/target.pm b/lib/App/Sqitch/Command/target.pm
@@ -14,7 +14,24 @@ use Path::Class qw(file dir);
 use List::Util qw(max);
 use namespace::autoclean;
 
+use constant property_keys => qw(
+    top_dir
+    plan_file
+    registry
+    client
+    uri
+    deploy_dir
+    revert_dir
+    verify_dir
+    reworked_dir
+    reworked_deploy_dir
+    reworked_revert_dir
+    reworked_verify_dir
+    extension
+);
+
 extends 'App::Sqitch::Command';
+with 'App::Sqitch::Role::TargetConfigCommand';
 
 our $VERSION = '0.9993';
 
@@ -24,50 +41,13 @@ has verbose => (
     default => 0,
 );
 
-has properties => (
+sub options { qw(verbose|v+) }
-    is      => 'ro',
-    isa     => HashRef,
-    default => sub { {} },
-);
-
-sub options {
-    return qw(
-        set|s=s%
-        registry|r=s
-        client|c=s
-        verbose|v+
-    );
-}
-
-my %normalizer_for = (
-    top_dir   => sub { $_[0] ? dir($_[0])->cleanup : undef },
-    plan_file => sub { $_[0] ? file($_[0])->cleanup : undef },
-    client    => sub { $_[0] },
-);
-
-$normalizer_for{"$_\_dir"} = $normalizer_for{top_dir} for qw(deploy revert verify);
-$normalizer_for{$_} = $normalizer_for{client} for qw(registry extension);
 
 sub configure {
     my ( $class, $config, $options ) = @_;
-
-    # Handle deprecated options.
-    for my $key (qw(registry client)) {
-        my $val = delete $options->{$key} or next;
-        App::Sqitch->warn(__x(
-            'Option --{key} has been deprecated; use "--set {key}={val}" instead',
-            key => $key,
-            val => $val
-        ));
-        my $set = $options->{set} ||= {};
-        $set->{$key} = $val;
-    }
-
-    $options->{properties} = delete $options->{set}
-        if $options->{set};
-
     # No config; target config is actually targets.
-    return $options;
+    return { verbose => $options->{verbose} } if exists $options->{verbose};
+    return {};
 }
 
 sub execute {
@@ -112,25 +92,51 @@ sub add {
         value => URI::db->new($uri, 'db:')->as_string,
     });
 
-    # Collect properties.
+    # Add the other properties.
     my $props = $self->properties;
     while (my ($prop, $val) = each %{ $props } ) {
-        my $normalizer = $normalizer_for{$prop} or $self->usage(__x(
-            'Unknown property "{property}"',
-            property => $prop,
-        ));
         push @vars => {
             key   => "$key.$prop",
-            value => $normalizer->($val),
+            value => $val,
-        };
+        } if $prop ne 'uri';
     }
 
     # Make it so.
     $config->group_set( $config->local_file, \@vars );
-
+    $self->write_plan;
+    $self->make_directories_for( $self->config_target );
     return $self;
 }
 
+sub alter {
+    my ($self, $target) = @_;
+    $self->usage unless $target;
+
+    my $key    = "target.$target";
+    my $config = $self->sqitch->config;
+    my $props  = $self->properties;
+
+    hurl target => __x(
+        'Missing Target "{target}"; use "{command}" to add it',
+        target  => $target,
+        command => "add $target " . ($props->{uri} || ""),
+    ) unless $config->get( key => "target.$target.target");
+
+    my @vars;
+    while (my ($prop, $val) = each %{ $props } ) {
+        push @vars => {
+            key   => "$key.$prop",
+            value => $val,
+        };
+    }
+
+    # Make it so.
+    $config->group_set( $config->local_file, \@vars );
+    $self->make_directories_for( $self->config_target );
+}
+
+# XXX Begin deprecated.
+
 sub _set {
     my ($self, $key, $name, $value) = @_;
     $self->usage unless $name && $value;
@@ -151,6 +157,15 @@ sub _set {
     return $self;
 }
 
+my %normalizer_for = (
+    top_dir   => sub { $_[0] ? dir($_[0])->cleanup : undef },
+    plan_file => sub { $_[0] ? file($_[0])->cleanup : undef },
+    client    => sub { $_[0] },
+);
+
+$normalizer_for{"$_\_dir"} = $normalizer_for{top_dir} for qw(deploy revert verify);
+$normalizer_for{$_} = $normalizer_for{client} for qw(registry extension);
+
 sub set_url { shift->set_uri(@_) };
 sub set_uri {
     my ($self, $name, $uri) = @_;
@@ -180,6 +195,8 @@ sub set_plan_file {
     $self->_set( 'plan_file', $name, $normalizer_for{plan_file}->($file) );
 }
 
+# XXX End deprecated.
+
 sub rm { shift->remove(@_) }
 sub remove {
     my ($self, $name) = @_;
@@ -241,47 +258,48 @@ sub show {
     my $sqitch = $self->sqitch;
     my $config = $sqitch->config;
 
-    # Set up labels.
-    my $len = max map { length } (
-        __ 'URI',
-        __ 'Registry',
-        __ 'Client',
-        __ 'Top Directory',
-        __ 'Plan File',
-        __ 'Deploy Directory',
-        __ 'Revert Directory',
-        __ 'Verify Directory',
-        __ 'Extension',
-    );
-
     my %label_for = (
-        uri      => __('URI')                . ': ' . ' ' x ($len - length __ 'URI'),
+        uri      => __('URI'),
-        registry => __('Registry')           . ': ' . ' ' x ($len - length __ 'Registry'),
+        registry => __('Registry'),
-        client   => __('Client')             . ': ' . ' ' x ($len - length __ 'Client'),
+        client   => __('Client'),
-        top_dir    => __('Top Directory')    . ': ' . ' ' x ($len - length __ 'Top Directory'),
+        top_dir    => __('Top Directory'),
-        plan_file  => __('Plan File')        . ': ' . ' ' x ($len - length __ 'Plan File'),
+        plan_file  => __('Plan File'),
-        deploy_dir => __('Deploy Directory') . ': ' . ' ' x ($len - length __ 'Deploy Directory'),
+        extension  => __('Extension'),
-        revert_dir => __('Revert Directory') . ': ' . ' ' x ($len - length __ 'Revert Directory'),
+        revert       => '  ' . __ 'Revert',
-        verify_dir => __('Verify Directory') . ': ' . ' ' x ($len - length __ 'Verify Directory'),
+        deploy       => '  ' . __ 'Deploy',
-        extension  => __('Extension')        . ': ' . ' ' x ($len - length __ 'Extension'),
+        verify       => '  ' . __ 'Verify',
+        reworked     => '  ' . __ 'Reworked',
     );
 
+    my $len = max map { length } values %label_for;
+    $_ .= ': ' . ' ' x ($len - length $_) for values %label_for;
+
+    # Header labels.
+    $label_for{script_dirs} = __('Script Directories') . ':';
+    $label_for{reworked_dirs} = __('Reworked Script Directories') . ':';
+
     require App::Sqitch::Target;
     for my $name (@names) {
         my $target = App::Sqitch::Target->new(
             sqitch => $sqitch,
             name   => $name,
         );
         $self->emit("* $name");
-        $self->emit('  ', $label_for{uri},        $target->uri->as_string);
+        $self->emit('    ', $label_for{uri},        $target->uri->as_string);
-        $self->emit('  ', $label_for{registry},   $target->registry);
+        $self->emit('    ', $label_for{registry},   $target->registry);
-        $self->emit('  ', $label_for{client},     $target->client);
+        $self->emit('    ', $label_for{client},     $target->client);
-        $self->emit('  ', $label_for{top_dir},    $target->top_dir);
+        $self->emit('    ', $label_for{top_dir},    $target->top_dir);
-        $self->emit('  ', $label_for{plan_file},  $target->plan_file);
+        $self->emit('    ', $label_for{plan_file},  $target->plan_file);
-        $self->emit('  ', $label_for{deploy_dir}, $target->deploy_dir);
+        $self->emit('    ', $label_for{extension},  $target->extension);
-        $self->emit('  ', $label_for{revert_dir}, $target->revert_dir);
+        $self->emit('    ', $label_for{script_dirs});
-        $self->emit('  ', $label_for{verify_dir}, $target->verify_dir);
+        $self->emit('    ', $label_for{deploy}, $target->deploy_dir);
-        $self->emit('  ', $label_for{extension},  $target->extension);
+        $self->emit('    ', $label_for{revert}, $target->revert_dir);
+        $self->emit('    ', $label_for{verify}, $target->verify_dir);
+        $self->emit('    ', $label_for{reworked_dirs});
+        $self->emit('    ', $label_for{reworked}, $target->reworked_dir);
+        $self->emit('    ', $label_for{deploy}, $target->reworked_deploy_dir);
+        $self->emit('    ', $label_for{revert}, $target->reworked_revert_dir);
+        $self->emit('    ', $label_for{verify}, $target->reworked_verify_dir);
     }
 
     return $self;
@@ -306,6 +324,12 @@ Manages Sqitch targets, which are stored in the local configuration file.
 
 =head1 Interface
 
+=head3 Class Methods
+
+=head3 C<property_keys>
+
+Returns a list of keys that may be specified in the C<--set> option.
+
 =head2 Instance Methods
 
 =head2 Attributes
@@ -328,6 +352,10 @@ Executes the C<target> command.
 
 Implements the C<add> action.
 
+=head3 C<alter>
+
+Implements the C<alter> action.
+
 =head3 C<list>
 
 Implements the C<list> action.

diff --git a/lib/App/Sqitch/Role/TargetConfigCommand.pm b/lib/App/Sqitch/Role/TargetConfigCommand.pm
@@ -113,6 +113,12 @@ around configure => sub {
             }
         }
 
+        # Convert URI.
+        if ( my $uri = delete $set->{uri} || delete $set->{url} ) {
+            require URI::db;
+            $props->{uri} = URI::db->new($uri, 'db:');
+        }
+
         # Convert directory properties to Class::Path::Dir objects.
         for my $name (qw(
             top_dir