mirror of
https://github.com/duncs/clusterssh.git
synced 2025-07-03 09:53:23 +00:00
122 lines
2.4 KiB
Perl
122 lines
2.4 KiB
Perl
package App::ClusterSSH::Gui::Terminal::Command;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use version;
|
|
our $VERSION = version->new(qw$Revision: 1$);
|
|
|
|
use Carp;
|
|
|
|
use base qw/ App::ClusterSSH::Base /;
|
|
|
|
sub new {
|
|
my ( $class, %args ) = @_;
|
|
|
|
my $self = $class->SUPER::new(%args);
|
|
|
|
return $self;
|
|
}
|
|
|
|
use overload (
|
|
q{""} => sub {
|
|
my ($self) = @_;
|
|
return $self->{script};
|
|
},
|
|
fallback => 1,
|
|
);
|
|
|
|
sub script() {
|
|
my ($self) = @_;
|
|
|
|
# -p => pipe name
|
|
# -s => server name
|
|
# -u => username
|
|
# -p => port
|
|
# -c => command to run
|
|
# -b => session binary (ssh, telnet, rsh, etc)
|
|
# -a => session arguments
|
|
my $script = <<'!EOF!';
|
|
use strict;
|
|
use Getopt::Std;
|
|
my %o;
|
|
getopts( "p:s:u:p:c:d:b:a:", \%o );
|
|
|
|
if($o{p}) {
|
|
open( my $pipe, ">", $o{p} ) or die( "Failed to open pipe: ", $!, $/ );
|
|
print {$pipe} $$, ":", $ENV{WINDOWID}
|
|
or die( "Failed to write to pipe: ", $!, $/ );
|
|
close($pipe) or die( "Failed to close pipe: ", $!, $/ );
|
|
}
|
|
|
|
my $command = join( " ", $o{b}, $o{a}, );
|
|
|
|
if ( $o{u} ) {
|
|
if ( $o{b} !~ /telnet$/ ) {
|
|
$command .= join( " ", "-l", $o{u} );
|
|
}
|
|
}
|
|
|
|
if ( $o{b} =~ /telnet$/ ) {
|
|
$command .= join( " ", $o{s}, $o{p} );
|
|
}
|
|
else {
|
|
if ( $o{p} ) {
|
|
$command .= join( " ", "-p", $o{p} );
|
|
}
|
|
$command .= $o{s};
|
|
}
|
|
|
|
$command .= $o{c};
|
|
|
|
if ( $o{d} ) {
|
|
warn( "Running: ", $command, $/ );
|
|
}
|
|
exec($command);
|
|
!EOF!
|
|
eval $script;
|
|
if ($@) {
|
|
croak( 'Error in compiling helper script: ', $@ );
|
|
}
|
|
return $script;
|
|
}
|
|
|
|
1;
|
|
|
|
=pod
|
|
|
|
=head1
|
|
|
|
ClusterSSH::Gui::Terminal
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use ClusterSSH::Gui::Terminal;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Object for creating and maintaining terminal session to server
|
|
|
|
=head1 METHODS
|
|
|
|
=over 4
|
|
|
|
=item $host=ClusterSSH::Gui->new()
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>)
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
Copyright (c) 2010 Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>).
|
|
All rights reserved
|
|
|
|
This module is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself. See L<perlartistic>.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|