Functionality to call external command

Code and tests to call the external command

lib/App/ClusterSSH.pm

@@ -439,8 +439,7 @@ sub resolve_names(@) {
         };
 
         if ($@) {
-            warn 'Failure running external cluster command "',
+            warn $@, $/;
-                $self->config->{external_cluster_command}, '": ', $@;
         }
         else {
             @servers = @new_servers;

lib/App/ClusterSSH/Cluster.pm

@@ -8,6 +8,7 @@ our $VERSION = version->new('0.01');
 
 use Carp;
 use Try::Tiny;
+use English qw( -no_match_vars );
 
 use base qw/ App::ClusterSSH::Base /;
 
@@ -26,7 +27,9 @@ sub new {
 sub get_cluster_entries {
     my ( $self, @files ) = @_;
 
-    for my $file ( '/etc/clusters', $ENV{HOME}.'/.clusterssh/clusters',@files ) {
+    for my $file ( '/etc/clusters', $ENV{HOME} . '/.clusterssh/clusters',
+        @files )
+    {
         $self->debug( 3, 'Loading in clusters from: ', $file );
         $self->read_cluster_file($file);
     }
@@ -52,21 +55,44 @@ sub get_external_clusters {
     $self->debug( 4, 'External command: ', $external_command );
     $self->debug( 3, 'Tags: ', join( ',', @tags ) );
 
-    ############################
+    my $command = "$external_command @tags";
-    ###########################
-    ###########################
-    ###########################
 
-    die "catchall while testing",$/;
+    $self->debug( 3, 'Running ', $command );
 
-    return $self;
+    my $result;
+    my $return_code;
+    {
+        local  $SIG{CHLD} = undef;
+        $result      = qx/ $command /;
+        $return_code = $CHILD_ERROR >> 8;
+    }
+    chomp($result);
+
+    $self->debug( 3, "Result: $result" );
+    $self->debug( 3, "Return code: $return_code" );
+
+    if ( $return_code != 0 ) {
+        croak(
+            App::ClusterSSH::Exception::Cluster->throw(
+                error => $self->loc(
+                    "External command exited failed.\nCommand: [_1]\nReturn Code: [_2]",
+                    $command, $return_code,
+                ),
+            )
+        );
+    }
+
+    my @results=split / /, $result;
+
+    return @results;
 }
 
 sub read_tag_file {
     my ( $self, $filename ) = @_;
     $self->debug( 2, 'Reading tags from file ', $filename );
     if ( -f $filename ) {
-        my %hosts = $self->load_file( type => 'cluster', filename => $filename);
+        my %hosts
+            = $self->load_file( type => 'cluster', filename => $filename );
         foreach my $host ( keys %hosts ) {
             $self->debug( 4, "Got entry for $host on tags $hosts{$host}" );
             $self->register_host( $host, split( /\s+/, $hosts{$host} ) );
@@ -83,7 +109,8 @@ sub read_cluster_file {
     $self->debug( 2, 'Reading clusters from file ', $filename );
 
     if ( -f $filename ) {
-        my %tags = $self->load_file( type => 'cluster', filename => $filename);
+        my %tags
+            = $self->load_file( type => 'cluster', filename => $filename );
 
         foreach my $tag ( keys %tags ) {
             $self->register_tag( $tag, split( /\s+/, $tags{$tag} ) );
@@ -101,10 +128,13 @@ sub register_host {
 
     foreach my $tag (@tags) {
         if ( $self->{tags}->{$tag} ) {
-        $self->{tags}->{$tag} = [ sort @{ $self->{tags}->{$tag} }, $node ] ;
+            $self->{tags}->{$tag}
-        } else {
+                = [ sort @{ $self->{tags}->{$tag} }, $node ];
+        }
+        else {
             $self->{tags}->{$tag} = [$node];
         }
+
         #push(@{ $self->{tags}->{$tag} }, $node);
     }
     return $self;
@@ -124,8 +154,11 @@ sub get_tag {
     my ( $self, $tag ) = @_;
 
     if ( $self->{tags}->{$tag} ) {
-        $self->debug( 2, "Retrieving tag $tag: ",
+        $self->debug(
-            join( ' ', sort @{ $self->{tags}->{$tag} } ) );
+            2,
+            "Retrieving tag $tag: ",
+            join( ' ', sort @{ $self->{tags}->{$tag} } )
+        );
 
         return sort @{ $self->{tags}->{$tag} };
     }

t/30cluster.t

@@ -76,9 +76,48 @@ $expected{tag50} = [ 'host30', ];
 $cluster1->read_tag_file( $Bin . '/30cluster.tag1' );
 test_expected( 'tag 1', %expected );
 
-# now checks agains running an external command
+# now checks against running an external command
 
+my @external_expected;
 
+@external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command");
+is_deeply(\@external_expected,[], 'External command no args');
+
+@external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command tag1 tag2");
+is_deeply(\@external_expected,[ qw/tag1 tag2 / ] , 'External command: 2 args passed through');
+
+@external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command tag100");
+is_deeply(\@external_expected,[ qw/host100 / ] , 'External command: 1 tag expanded to one host');
+
+@external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command tag200");
+is_deeply(\@external_expected,[ qw/host200 host205 host210 / ] , 'External command: 1 tag expanded to 3 hosts and sorted');
+
+@external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command tag400");
+is_deeply(\@external_expected,[ qw/host100 host200 host205 host210 host300 host325 host350 host400 host401 / ] , 'External command: 1 tag expanded with self referencing tags');
+
+# NOTE
+# Since this is calling a shell run command, the tests cannot capture 
+# the shell STDOUT and STDERR.  By default redirect STDOUT and STDERR into
+# /dev/null so it dones't make noise in normal test output
+# However, don't hide it if running with -v flag
+my $redirect=' 1>/dev/null 2>&1';
+if($ENV{TEST_VERBOSE}) {
+    $redirect='';
+}
+
+trap {
+    @external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command -x $redirect");
+};
+is( $trap->die, 'External command exited with non-zero status: 5', 'External command: caught exception message' );
+is( $trap->stdout, '', 'External command: no stdout from perl code' );
+is( $trap->stderr, '', 'External command: no stderr from perl code' );
+
+trap {
+    @external_expected=$cluster1->get_external_clusters("$Bin/external_cluster_command -q $redirect");
+};
+is( $trap->die, 'External command exited with non-zero status: 255', 'External command: caught exception message' );
+is( $trap->stdout, '', 'External command: no stdout from perl code' );
+is( $trap->stderr, '', 'External command: no stderr from perl code' );
 
 done_testing();
 

t/external_cluster_command

@@ -1,13 +1,31 @@
 #!/usr/bin/perl
+#
+# test script for proving external command for fetching tags works
+#
 use strict;
 use warnings;
+use Getopt::Std;
 
-# test script for proving external command for fetching tags works
+my $opt = {};
+getopts('qx', $opt);
+
+# if we get '-q' option, force an error
+if($opt->{q}) {
+    my $fail;
+    $fail->cause_death();
+}
+
+# if we get '-x' option, die with non-0 return code
+if($opt->{x}) {
+    warn 'Forced non-0 exit',$/;
+    exit 5;
+}
 
 my %tag_lookup = (
-    tag100 => [ qw/ host100 host110 host105 / ],
+    tag100 => [ qw/ host100 / ],
-    tag200 => [ qw/ host200 host250 host125 /],
+    tag200 => [ qw/ host200 host210 host205 / ],
-    tag300 => [ qw/ tag100 tag200 host300 host301 / ],
+    tag300 => [ qw/ host300 host350 host325 /],
+    tag400 => [ qw/ tag100 tag200 tag300 host400 host401 / ],
 );
 
 
@@ -22,4 +40,6 @@ for (@lookup) {
 
 @lookup = grep { $_ !~ m/^$/ } sort @lookup;
 
+if(@lookup) {
     print "@lookup",$/;
+}