amassivus/clusterssh
1
0
Fork 0
mirror of https://github.com/duncs/clusterssh.git synced 2025-07-03 09:53:23 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Improve test coverage

Browse source
This commit is contained in:
Duncan Ferguson 2014-07-02 22:39:36 +01:00
parent 0853d8fee6
commit 3e2392e9b6
9 changed files with 280 additions and 119 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lib/App/ClusterSSH/Base.pm
View file

@ -12,6 +12,7 @@ use Exception::Class (
},
'App::ClusterSSH::Exception::Cluster',
'App::ClusterSSH::Exception::LoadFile',
'App::ClusterSSH::Exception::Helper',
);
# Don't use SVN revision as it can cause problems
@ -85,10 +86,7 @@ sub loc {
sub set_lang {
my ( $self, $lang ) = @_;
$language = $lang;
if ($self) {
$self->debug( 6, $self->loc( 'Setting language to "[_1]"', $lang ), );
}
$self->debug( 6, $self->loc( 'Setting language to "[_1]"', $lang ), );
return $self;
}
@ -184,10 +182,10 @@ sub load_file {
);
}
if ( !$args{type} || $args{type} !~ m/cluster|config/ ) {
if ( !$args{type} ) {
croak(
App::ClusterSSH::Exception->throw(
error => '"type" arg invalid'
error => '"type" arg not passed'
)
);
}

70
lib/App/ClusterSSH/Helper.pm
View file

@ -22,6 +22,25 @@ sub new {
sub script {
my ( $self, $config ) = @_;
if(! defined $config || ref $config ne "HASH") {
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};
@ -33,57 +52,6 @@ sub script {
: "echo Press RETURN to continue; read IGNORE"
; # : "sleep $autoclose";
# # P = pipe file
# # s = server
# # u = username
# # p = port
# # m = ccon master
# # c = comms command
# # a = command args
# # C = command to run
# my $lelehelper_script = q{
# use strict;
# use warnings;
# use Getopt::Std;
# my %opts;
# getopts('PsupmcaC', \%opts);
# my $command="$opts{c} $opts{a}";
# open(PIPE, ">", $opts{P}) 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($opts{s} =~ m/==$/)
# {
# $opts{s} =~ s/==$//;
# warn("\nWARNING: failed to resolve IP address for $opts{s}.\n\n");
# sleep 5;
# }
# if($opts{m}) {
# unless("$comms" ne "console") {
# $opts{m} = $opts{m} ? "-M $opts{m} " : "";
# $opts{c} .= $opts{m};
# }
# }
# if($opts{u}) {
# unless("$comms" eq "telnet") {
# $opts{u} = $opts{u} ? "-l $opts{u} " : "";
# $opts{c} .= $opts{u};
# }
# }
# if("$comms" eq "telnet") {
# $command .= "$opts{s} $opts{p}";
# } else {
# if ($opts{p}) {
# $opts{c} .= "-p $opts{p} $opts{s}";
# } else {
# $opts{c} .= "$opts{s}";
# }
# }
# #$command .= " $command || sleep 5";
# warn("Running:$command\n"); # for debug purposes
# exec($command);
# };
my $script = <<" HERE";
my \$pipe=shift;
my \$svr=shift;

67
lib/App/ClusterSSH/Host.pm
View file

@ -7,6 +7,7 @@ use version;
our $VERSION = version->new('0.03');
use Carp;
use Net::hostent;
use base qw/ App::ClusterSSH::Base /;
@ -60,11 +61,6 @@ sub new {
return $self;
}
sub get_givenname {
my ($self) = @_;
return $self->{hostname};
}
sub get_hostname {
my ($self) = @_;
return $self->{hostname};
@ -77,6 +73,9 @@ sub get_username {
sub get_type {
my ($self) = @_;
if($self->check_ssh_hostname) {
return 'ssh_alias';
}
return $self->{type} || q{};
}
@ -129,22 +128,20 @@ sub get_realname {
my ($self) = @_;
if ( !$self->{realname} ) {
if ( $self->{type} && $self->{type} eq 'name' ) {
if ( $ssh_hostname_for{ $self->{hostname} } ) {
$self->{realname} = $self->{hostname};
}
else {
my $gethost_obj = gethostbyname( $self->{hostname} );
$self->{realname}
= defined($gethost_obj)
? $gethost_obj->name()
: $self->{hostname};
}
}
else {
if ( $self->get_type eq 'ssh_alias' ) {
$self->{realname} = $self->{hostname};
}
else {
my $gethost_obj = gethostbyname( $self->{hostname} );
$self->{realname}
= defined($gethost_obj)
? $gethost_obj->name()
: $self->{hostname};
}
}
else {
$self->{realname} = $self->{hostname};
}
return $self->{realname};
}
@ -213,17 +210,17 @@ sub parse_host_string {
if ( $host_string =~ s/\A(?:(.*?)@)// ) {
# catch where @ is in host_string but no text before it
$username = $1 || q{};
$username = $1;
}
# check for any geometry settings
if ( $host_string =~ s/(?:=(.*?)$)// ) {
$geometry = $1 || q{};
$geometry = $1;
}
# Check for a '/nnnn' port definition
if ( $host_string =~ s!(?:/(\d+)$)!! ) {
$port = $1 || q{};
$port = $1;
}
# use number of colons as a possible indicator
@ -255,7 +252,7 @@ sub parse_host_string {
}
if ( $colon_count > 1
&& $colon_count < 8
&& $host_string =~ m/:(\d+)$/xsm )
)
{
warn 'Ambiguous host string: "', $host_string, '"', $/;
warn 'Assuming you meant "[', $host_string, ']"?', $/;
@ -277,30 +274,6 @@ sub parse_host_string {
type => 'ipv6',
);
}
elsif ( $colon_count == 9 ) {
if ( $host_string =~ s/:(\d+)\A// ) {
$port = $1;
}
my $hostname = $host_string;
$self->debug(
5,
$self->loc(
'Default parse u=[_1] h=[_2] p=[_3] g=[_4]',
$username, $hostname, $port, $geometry,
)
);
return __PACKAGE__->new(
parse_string => $parse_string,
username => $username,
hostname => $hostname,
port => $port,
geometry => $geometry,
type => 'name',
);
}
# if we got this far, we didnt parse the host_string properly
croak(