mirror of
https://github.com/duncs/clusterssh.git
synced 2025-07-01 17:11:14 +00:00

Code previously added did not work as intended, so removed as it was unnecessary. Leave in macro substitution for '--action' though as this resolves Github issue #42. Rework wording in Changes file
165 lines
3.9 KiB
Perl
165 lines
3.9 KiB
Perl
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";
|
|
# provide some info for debugging purposes
|
|
warn("Running: \$command\\n");
|
|
exec(\$command);
|
|
HERE
|
|
|
|
$self->debug( 4, $script );
|
|
$self->debug( 2, 'Helper script done' );
|
|
|
|
return $script;
|
|
}
|
|
|
|
#use overload (
|
|
# q{""} => sub {
|
|
# my ($self) = @_;
|
|
# return $self->{hostname};
|
|
# },
|
|
# fallback => 1,
|
|
#);
|
|
|
|
1;
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
ClusterSSH::Helper - Object representing helper script
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Object representing application configuration
|
|
|
|
=head1 METHODS
|
|
|
|
=over 4
|
|
|
|
=item $host=ClusterSSH::Helper->new ({ })
|
|
|
|
Create a new helper object.
|
|
|
|
=item $host=ClusterSSH::Helper->script ({ })
|
|
|
|
Return the helper script
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
Copyright 1999-2015 Duncan Ferguson.
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of either: the GNU General Public License as published
|
|
by the Free Software Foundation; or the Artistic License.
|
|
|
|
See http://dev.perl.org/licenses/ for more information.
|
|
|
|
=cut
|
|
|
|
1;
|