view release on metacpan or  search on metacpan

lib/App/ClusterSSH/Helper.pm  view on Meta::CPAN

package App::ClusterSSH::Helper;

use strict;
use warnings;

use version;
our $VERSION = version->new('0.02');

use Carp;
use Try::Tiny;

use base qw/ App::ClusterSSH::Base /;

sub new {
    my ( $class, %args ) = @_;

    my $self = $class->SUPER::new(%args);

    return $self;
}

sub script {
    my ( $self, $config ) = @_;

    if (   !defined $config
        || !ref $config
        || ref $config ne "App::ClusterSSH::Config" )
    {
        croak(
            App::ClusterSSH::Exception::Helper->throw(
                error => 'No configuration provided or in wrong format',
            ),
        );
    }

    foreach my $arg ( "comms", $config->{comms}, $config->{comms} . '_args',
        'command', 'auto_close' )
    {
        if ( !defined $config->{$arg} ) {
            croak(
                App::ClusterSSH::Exception::Helper->throw(
                    error => "Config '$arg' not provided",
                ),
            );
        }
    }

    my $comms          = $config->{ $config->{comms} };
    my $comms_args     = $config->{ $config->{comms} . '_args' };
    my $config_command = $config->{command};
    my $autoclose      = $config->{auto_close};

    my $postcommand
        = $autoclose
        ? "echo Sleeping for $autoclose seconds; sleep $autoclose"
        : "echo Press RETURN to continue; read IGNORE"
        ;    # : "sleep $autoclose";

    my $script = <<"    HERE";
           my \$pipe=shift;
           my \$svr=shift;
           my \$user=shift;
           my \$port=shift;
           my \$mstr=shift;
           my \$command="$comms $comms_args ";
           open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
           print PIPE "\$\$:\$ENV{WINDOWID}" 
               or die("Failed to write to pipe: $!\\n");
           close(PIPE) or die("Failed to close pipe: $!\\n");
           if(\$svr =~ m/==\$/)
           {
               \$svr =~ s/==\$//;
               warn("\\nWARNING: failed to resolve IP address for \$svr.\\n\\n"
               );
               sleep 5;
           }
           if(\$mstr) {
               unless("$comms" ne "console") {
                   \$mstr = \$mstr ? "-M \$mstr " : "";
                   \$command .= \$mstr;
               }
           }
           if(\$user) {
               unless("$comms" eq "telnet") {
                   \$user = \$user ? "-l \$user " : "";
                   \$command .= \$user;
               }
           }
           if("$comms" eq "telnet") {
               \$command .= "\$svr \$port";
           } else {
               if (\$port) {
                   \$command .= "-p \$port \$svr";
               } else {
                 \$command .= "\$svr";
               }
           }
           if("$config_command") {
            \$command .= " \\\"$config_command\\\"";
           }
           \$command .= " ; $postcommand";