shell_support-host-role.patch

 * s/@!/$@/g following eval
 * support shell mode command like "{on,with} ... do command" and
   "task {on,with} ...".
 * added test code for shell mode command
   

diff --git a/lib/Archer.pm b/lib/Archer.pm
index 91cb3c8..2c3e5a7 100644
--- a/lib/Archer.pm
+++ b/lib/Archer.pm
@@ -44,7 +44,7 @@ sub run {
         # TODO: role support
         require Archer::Shell;
         my @servers
-            = map { @{ $_ } }
+            = uniq map { @{ $_ } }
             values
             %{ $context->{ config }->{ projects }->{ $self->{ project } } };
         my $shell = Archer::Shell->new(
diff --git a/lib/Archer/Shell.pm b/lib/Archer/Shell.pm
index 11f1df9..b99d576 100644
--- a/lib/Archer/Shell.pm
+++ b/lib/Archer/Shell.pm
@@ -6,6 +6,7 @@ use Term::ReadLine;
 use POSIX;
 use File::HomeDir;
 use Path::Class;
+use List::MoreUtils qw/uniq/;
 
 sub new {
     my ( $class, $args ) = @_;
@@ -31,7 +32,7 @@ sub run_loop {
    # If there is Term::ReadLine::Gnu, be sure to do : export "PERL_RL=Gnu o=0"
     eval { $term->stifle_history($HISTSIZE); };
 
-    if (@!) {
+    if ($@) {
         $self->{context}
             ->log( 'debug' => "You will need Term::ReadLine::Gnu" );
     }
@@ -51,7 +52,7 @@ sub run_loop {
     print "\n";
 
     eval { $term->WriteHistory($HISTFILE); };
-    if (@!) {
+    if ($@) {
         $self->{context}
             ->log( 'debug' => "perlsh: cannot write history file: $!" );
     }
@@ -96,29 +97,29 @@ sub catch_run {
                 return print "[WARNING] error in your syntax, see help\n";
             }
             my $executed = 0;
+            my %valid_host = map {$_=>1} @{$self->{servers}};
             for my $plugin ( @{ $self->{config}->{tasks}->{process} } ) {
                 next if $plugin->{name} ne $task;
                 $executed = 1;
                 if ( defined $action ) {
                     if ( $action eq "on" ) {
                         my @hosts = split " ", $machines;
-                        for my $host (@hosts) {
-                            $self->process_task( $plugin, $host );
+                        for my $host (uniq @hosts) {
+                            $self->process_task( $plugin, $host ) if $valid_host{$host};
                         }
                     }
                     else {
                         my @roles = split " ", $machines;
+                        my $server_tree = $self->{config}->{projects}->{$self->{context}->{project}};
                         for my $role (@roles) {
-                            for my $host ( @{ $self->{servers}->{$role} } ) {
-                                $self->process_task( $plugin, $host );
+                            for my $host ( @{ $server_tree->{$role} } ) {
+                                $self->process_task( $plugin, $host ) if $valid_host{$host};
                             }
                         }
                     }
                 }
                 else {
-                    for my $host (
-                        @{ $self->{servers}->{ $plugin->{config}->{role} } } )
-                    {
+                    for my $host (@{$self->{servers}}) {
                         $self->process_task( $plugin, $host );
                     }
                 }
@@ -142,11 +143,8 @@ sub process_host {
     my @hosts = split /\s/, $hosts;
 
     # check if hosts are in our config.
-    for my $host (@hosts) {
-        for my $role ( keys %{ $self->{servers} } ) {
-            @hosts = grep ( /$host/, @{ $self->{servers}->{$role} } );
-        }
-    }
+    my %valid_host = map {$_=>1} @{$self->{servers}};
+    @hosts = grep { $valid_host{$_} } @hosts;
 
     if (@hosts) {
         $self->process_command( $cmd, \@hosts );
@@ -159,12 +157,14 @@ sub process_role {
     my @roles      = split /\s/, $roles;
     my @hosts      = ();
     my @inexistant = ();
+    my $server_tree = $self->{config}->{projects}->{$self->{context}->{project}};
+
     for my $role (@roles) {
-        if ( !defined $self->{servers}->{$role} ) {
+        if ( !defined $server_tree->{$role} ) {
             push( @inexistant, $role );
             next;
         }
-        for my $host ( @{ $self->{servers}->{$role} } ) {
+        for my $host ( @{ $server_tree->{$role} } ) {
             push @hosts, $host;
         }
     }
@@ -195,6 +195,7 @@ sub process_command {
             }
         }
     }
+    $hosts = [ sort( uniq(@{$hosts}) ) ];
 
     $manager->run(
         {   elems    => $hosts,
@@ -209,7 +210,7 @@ sub process_command {
 
 sub process_task {
     my ( $self, $plugin, $host ) = @_;
-    my $class = "Archer::Plugin::$plugin->{module}";
+    my $class = ($plugin->{module} =~ /^\+(.+)$/) ? $1 : "Archer::Plugin::$plugin->{module}";
     $class->use or die $@;
     $class->new(
         {   config  => $plugin->{config},
diff --git a/t/02_shell.t b/t/02_shell.t
new file mode 100644
index 0000000..a76ea8c
--- /dev/null
+++ b/t/02_shell.t
@@ -0,0 +1,98 @@
+# -*- mode: cperl -*-
+use strict;
+use warnings;
+use Test::More;
+
+eval "use IO::Scalar;";
+plan skip_all => 'this test requires IO::Scalar' if $@;
+
+plan tests => 8;
+
+use Archer;
+use Archer::Shell;
+use Archer::Parallel::ForkManager;
+use FindBin;
+use List::MoreUtils qw/uniq/;
+
+no warnings 'redefine';
+local *Archer::Shell::callback = sub {
+    my ( $self, $server, $cmd ) = @_;
+    print "$server:$cmd\n";
+};
+use warnings 'redefine';
+
+my $OUT;
+
+sub capture(&) {
+    my $code = shift;
+
+    $OUT = undef;
+    tie *STDOUT, 'IO::Scalar', \$OUT;
+
+    eval { $code->(); };
+    if ($@) {
+        warn "capture: $@";
+    }
+
+    untie *STDOUT;
+}
+
+$FindBin::Bin .= "/..";
+
+my $archer =
+    Archer->new(
+        {
+            project      => 'YourProj',
+            dry_run_fg   => 0,
+            parallel_num => 0,
+            skips        => {},
+            config_yaml  => 't/02_shell.yaml',
+            argv_str     => '',
+            shell        => 1,
+            write_config => 0,
+            log_level    => 'error',
+        }
+       );
+my $context = $archer->context;
+
+my @servers
+    = uniq map { @{ $_ } }
+    values
+    %{ $context->{ config }->{ projects }->{ $archer->{ project } } };
+my $shell = Archer::Shell->new(
+    {   context => $archer,
+        config  => $archer->{ config },
+        servers => \@servers,
+        parallel => "Archer::Parallel::ForkManager",
+    }
+   );
+
+
+my @app = qw(127.0.0.1 127.0.0.2);
+my @db  = qw(127.0.0.3 127.0.0.4);
+my @all = (@app, @db);
+
+capture { $shell->catch_run("date"); };
+is($OUT, join("\n",map{"$_:date"}@all)."\n","command");
+
+capture { $shell->catch_run("on 127.0.0.0 127.0.0.2 127.0.0.2 do date"); };
+is($OUT, join("\n",map{"$_:date"}qw(127.0.0.2))."\n", "on host do command");
+
+capture { $shell->catch_run("with app do uname"); };
+is($OUT, join("\n",map{"$_:uname"}@app)."\n", "with role do command");
+
+capture { $shell->catch_run("with app db do w"); };
+is($OUT, join("\n",map{"$_:w"}@app,@db)."\n", "with role role do command");
+
+
+capture { $shell->catch_run("!test"); };
+is($OUT, join("\n",map{"$_:hostname"}@all)."\n", "task");
+
+capture { $shell->catch_run("!test on 127.0.0.0 127.0.0.2 127.0.0.2"); };
+is($OUT, join("\n",map{"$_:hostname"}qw(127.0.0.2))."\n", "task on host");
+
+capture { $shell->catch_run("!test with app"); };
+is($OUT, join("\n",map{"$_:hostname"}@app)."\n", "task with role");
+
+capture { $shell->catch_run("!test with app db"); };
+is($OUT, join("\n",map{"$_:hostname"}@app,@db)."\n", "task with role role");
diff --git a/t/02_shell.yaml b/t/02_shell.yaml
new file mode 100644
index 0000000..7a8e0f7
--- /dev/null
+++ b/t/02_shell.yaml
@@ -0,0 +1,24 @@
+global:
+  work_dir: /tmp
+
+tasks:
+  process:
+   - module: +t::Plugin::Dummy
+     name: dummy
+     config: ~
+
+   - module: +t::Plugin::Print
+     name: test
+     config:
+       command: hostname
+
+projects:
+  YourProj:
+    app:
+      - 127.0.0.1
+      - 127.0.0.2
+    db:
+      - 127.0.0.3
+      - 127.0.0.4
+    free:
+      - 127.0.0.3
diff --git a/t/Plugin/Print.pm b/t/Plugin/Print.pm
new file mode 100644
index 0000000..7711265
--- /dev/null
+++ b/t/Plugin/Print.pm
@@ -0,0 +1,13 @@
+package t::Plugin::Print;
+use strict;
+use warnings;
+use base qw/Archer::Plugin/;
+use FindBin ();
+
+sub run {
+    my ( $self, $context, $args ) = @_;
+    printf "%s:%s\n", $self->{server}, $self->{config}->{command};
+}
+
+1;
+