root/library/perl/trunk/Archer/lib/Archer/Plugin/Shell.pm

package Archer::Plugin::Shell;

use strict;
use warnings;
use base qw( Archer::Plugin );

sub run {
    my ($self, $context, $args) = @_;

    my $config  = $self->{config};
    my $project = $context->{project};
    my $role    = $config->{role};

    my $shell = MyShell->new({
        context => $context,
        config  => $config,
        servers => $context->{config}->{projects}->{$project}->{$role},
    });

    $shell->cmdloop;
};

package MyShell;

use base qw( Term::Shell );

sub new {
    my ( $class, $args ) = @_;
    my $self = $class->SUPER::new;

    for ( keys %$args ) {
        $self->{$_} = $args->{$_};
    }

    return $self;
}

sub catch_run {
    my ($self, $cmd, @args) = @_;

    my $parallel = $self->{context}->{config}->{global}->{parallel}
        || 'Archer::Parallel::ForkManager';
    $parallel->use or die $@;

    my $manager = $parallel->new;
    $manager->run({
        elems => $self->{servers},
        callback => sub {
            my $server = shift;
            $self->callback($server, $cmd, @args);
        },
        num => $self->{config}->{para},
    });
}

sub callback {
    my ( $self, $server, $cmd, @args ) = @_;

    my $out = `ssh $server $cmd @args`;
    chomp $out;

    print "[$server] $out\n";

}

1;
__END__

=head1 NAME

Archer::Plugin::Shell - display shell prompt for remote servers.

=head1 SYNOPSIS

  init:
    - module: Shell
      config:
        role: app
        para: 5

=head1 DESCRIPTION

Shell prompt for remote servers.

=head1 AUTHORS

Gosuke Miyashita

=head1 SEE ALSO

L<Term::Shell>

=cut