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

Ensure code is run through 'perltidy -pbp -nst -nse'

Browse source
This commit is contained in:
Duncan Ferguson 2014-09-19 23:33:08 +01:00
parent d9446aa28a
commit f8ed9da353
13 changed files with 184 additions and 156 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Build.PL
View file

@ -83,15 +83,14 @@ my $build = $class->new(
'Test::Differences' => 0,
'CPAN::Changes' => 0.27,
'File::Slurp' => 0,
'Test::PerlTidy' => 0,
},
configure_requires => { 'Module::Build' => 0, },
add_to_cleanup => ['App-ClusterSSH-*'],
create_makefile_pl => 'traditional',
script_files => 'bin',
get_options => { changes => { type => '=s' }, },
PL_files => {
'bin_PL/_build_docs' => [],
},
get_options => { changes => { type => '=s' }, },
PL_files => { 'bin_PL/_build_docs' => [], },
);
$build->create_build_script;

2
MANIFEST
View file

@ -46,5 +46,7 @@ t/external_cluster_command
THANKS
t/manifest.t
TODO
t/perltidy.t
t/perltidyrc
t/pod-coverage.t
t/pod.t

59
Makefile.PL
View file

@ -1,36 +1,27 @@
# Note: this file was auto-generated by Module::Build::Compat version 0.4003
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'App::ClusterSSH',
'VERSION_FROM' => 'lib/App/ClusterSSH.pm',
'PREREQ_PM' => {
'CPAN::Changes' => '0.27',
'Exception::Class' => '1.31',
'File::Slurp' => 0,
'File::Temp' => 0,
'File::Which' => 0,
'Locale::Maketext' => 0,
'Readonly' => 0,
'Test::Differences' => 0,
'Test::DistManifest' => 0,
'Test::Pod' => 0,
'Test::Pod::Coverage' => 0,
'Test::Trap' => 0,
'Tk' => '800.022',
'Try::Tiny' => 0,
'X11::Protocol' => '0.56',
'version' => '0'
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [
'bin/ccon',
'bin/crsh',
'bin/cssh',
'bin/ctel'
],
'PL_FILES' => {
'bin_PL/_build_docs' => []
}
)
;
WriteMakefile(
'NAME' => 'App::ClusterSSH',
'VERSION_FROM' => 'lib/App/ClusterSSH.pm',
'PREREQ_PM' => {
'CPAN::Changes' => '0.27',
'Exception::Class' => '1.31',
'File::Slurp' => 0,
'File::Temp' => 0,
'File::Which' => 0,
'Locale::Maketext' => 0,
'Readonly' => 0,
'Test::Differences' => 0,
'Test::DistManifest' => 0,
'Test::Pod' => 0,
'Test::Pod::Coverage' => 0,
'Test::Trap' => 0,
'Tk' => '800.022',
'Try::Tiny' => 0,
'X11::Protocol' => '0.56',
'version' => '0'
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [ 'bin/ccon', 'bin/crsh', 'bin/cssh', 'bin/ctel' ],
'PL_FILES' => { 'bin_PL/_build_docs' => [] }
);

8
lib/App/ClusterSSH.pm
View file

@ -518,7 +518,7 @@ sub send_text($@) {
my $macro_servername = $self->config->{macro_servername};
my $servername = $svr;
$servername =~ s/\s+//;
$text =~ s/$macro_servername/$servername/xsmg;
$text =~ s/$macro_servername/$servername/xsmg;
}
$text =~ s/%h/hostname()/xsmeg;
@ -592,7 +592,7 @@ sub send_text_to_all_servers {
}
sub send_variable_text_to_all_servers($&) {
my($self, $code) = @_;
my ( $self, $code ) = @_;
foreach my $svr ( keys(%servers) ) {
$self->send_text( $svr, $code->($svr) )
@ -1881,8 +1881,8 @@ sub populate_send_menu {
-label => 'Random Number',
-command => sub {
$self->send_variable_text_to_all_servers(
sub { int(rand(1024)) }
),
sub { int( rand(1024) ) } ),
;
},
);
}

19
lib/App/ClusterSSH/Cluster.pm
View file

@ -51,9 +51,8 @@ sub get_tag_entries {
sub list_external_clusters {
my ( $self, ) = @_;
my @list = $self->_run_external_clusters('-L');
return
wantarray
my @list = $self->_run_external_clusters('-L');
return wantarray
? sort @list
: scalar @list;
}
@ -69,8 +68,12 @@ sub _run_external_clusters {
my $external_command = $self->parent->config->{external_cluster_command};
if(!$external_command || ! -x $external_command) {
$self->debug( 1, 'Cannot run external cluster command: ', $external_command || '');
if ( !$external_command || !-x $external_command ) {
$self->debug(
1,
'Cannot run external cluster command: ',
$external_command || ''
);
return;
}
@ -184,8 +187,7 @@ sub get_tag {
join( ' ', sort @{ $self->{tags}->{$tag} } )
);
return
wantarray
return wantarray
? sort @{ $self->{tags}->{$tag} }
: scalar @{ $self->{tags}->{$tag} };
}
@ -196,8 +198,7 @@ sub get_tag {
sub list_tags {
my ($self) = @_;
return
wantarray
return wantarray
? sort keys( %{ $self->{tags} } )
: scalar keys( %{ $self->{tags} } );
}

63
lib/App/ClusterSSH/Getopt.pm
View file

@ -212,7 +212,9 @@ sub add_common_options {
);
$self->add_option(
spec => 'unique-servers|u',
help => $self->loc('Toggle connecting to each host only once when a hostname has been specified multiple times.'),
help => $self->loc(
'Toggle connecting to each host only once when a hostname has been specified multiple times.'
),
);
$self->add_option(
spec => 'use-all-a-records|A',
@ -271,7 +273,7 @@ sub getopts {
pod2usage( -verbose => 1 ) if ( $options->{'h'} || $options->{help} );
pod2usage( -verbose => 2 ) if ( $options->{H} || $options->{man} );
# record what was given on the command line in case this
# record what was given on the command line in case this
# object is ever dumped out
$self->{options_parsed} = $options;
@ -302,12 +304,13 @@ sub getopts {
no warnings 'redefine';
*$accessor = sub {
return $options->{$acc} || $default;
# defined $options->{$acc} ? $options->{$acc}
# : defined $self->{command_options}->{$acc}->{default}
# ? $self->{command_options}->{$acc}->{default}
# : undef;
# defined $options->{$acc} ? $options->{$acc}
# : defined $self->{command_options}->{$acc}->{default}
# ? $self->{command_options}->{$acc}->{default}
# : undef;
};
my $accessor_default=$accessor.'_default';
my $accessor_default = $accessor . '_default';
*$accessor_default = sub { return $default; };
}
}
@ -326,14 +329,14 @@ sub getopts {
= !$self->parent->config->{unique_servers} || 0;
}
$self->parent->config->{title} = $self->title if ( $self->title );
$self->parent->config->{port} = $self->port if ( $self->port );
$self->parent->config->{title} = $self->title if ( $self->title );
$self->parent->config->{port} = $self->port if ( $self->port );
# note, need to check if these actions can be performed as they are
# not common acorss all communiction methods
$self->parent->config->{command} = $self->action
if ( $self->can('action') && $self->action );
$self->parent->config->{user} = $self->username
$self->parent->config->{user} = $self->username
if ( $self->can('username') && $self->username );
$self->parent->config->{terminal_font} = $self->font if ( $self->font );
@ -361,7 +364,7 @@ sub getopts {
sub output {
my (@text) = @_;
confess if( exists $text[1] && !$text[1]);
confess if ( exists $text[1] && !$text[1] );
print @text, $/, $/;
}
@ -395,7 +398,8 @@ This tool is intended for (but not limited to) cluster administration where the
Connections are opened using [_1] which must be correctly installed and configured.
Extra caution should be taken when editing files as lines may not necessarily be in the same order; assuming line 5 is the same across all servers and modifying that is dangerous. It's better to search for the specific line to be changed and double-check all terminals are as expected before changes are committed.}, $self->parent->config->{comms}
Extra caution should be taken when editing files as lines may not necessarily be in the same order; assuming line 5 is the same across all servers and modifying that is dangerous. It's better to search for the specific line to be changed and double-check all terminals are as expected before changes are committed.},
$self->parent->config->{comms}
);
output '=head2 ', $self->loc('Further Notes');
@ -431,8 +435,9 @@ Extra caution should be taken when editing files as lines may not necessarily be
[_1]
This will test the mechanisms used to open windows to hosts. This could be due to either the [_2] terminal option which enables [_3] (some terminals do not require this option, other terminals have another method for enabling it - see your terminal documentation) or the configuration of [_4].},
"C<< $Script -e {single host name} >>", 'C<-xrm>', 'C<AllowSendEvents>',
'C<'.$self->parent->config->{comms}.'>',
"C<< $Script -e {single host name} >>", 'C<-xrm>',
'C<AllowSendEvents>',
'C<' . $self->parent->config->{comms} . '>',
);
output '=back';
@ -490,39 +495,37 @@ would replace the <Alt-n> with the client's name in each window.}
);
output '=item ', $self->parent->config->{key_localname};
output $self->loc(
q{Paste in the hostname of the server cssh is ebing run on}
);
q{Paste in the hostname of the server cssh is ebing run on});
output '=item ', $self->parent->config->{key_quit};
output $self->loc(
'Quit the program and close all connections and windows.');
output '=item ', $self->parent->config->{key_retilehosts};
output $self->loc(q{Retile all the client windows.});
output '=item ', $self->parent->config->{key_username};
output $self->loc(
q{Paste in the username for the connection}
);
output $self->loc(q{Paste in the username for the connection});
output '=back';
output '=head1 ' . $self->loc('EXAMPLES');
output '=over';
output '=item ', $self->loc(q{Open up a session to 3 servers});
output q{S<$ }.$Script.q{ server1 server2 server3>};
output q{S<$ } . $Script . q{ server1 server2 server3>};
output '=item ',
$self->loc(
q{Open up a session to a cluster of servers identified by the tag 'farm1' and give the controlling window a specific title, where the tag is defined in one of the default configuration files}
);
output q{S<$ }.$Script.q{ -T 'Web Farm Cluster 1' farm1>};
output q{S<$ } . $Script . q{ -T 'Web Farm Cluster 1' farm1>};
output '=item ',
$self->loc(
q{Connect to different servers using different login names. NOTE: this can also be achieved by setting up appropriate options in the configuration files. Do not close the console when the last terminal exits.}
);
output q{S<$ }.$Script.q{ -Q user1@server1 admin@server2>};
output q{S<$ } . $Script . q{ -Q user1@server1 admin@server2>};
output '=item ',
$self->loc(
q{Open up a cluster defined in a non-default configuration file});
output q{S<$ }.$Script.q{ -c $HOME/cssh.extra_clusters db_cluster>};
output '=item ', $self->loc(q{Connect on port 2022 instead of the default port});
output q{S<$ }.$Script.q{ -p 2022 server1 server2>};
output q{S<$ } . $Script . q{ -c $HOME/cssh.extra_clusters db_cluster>};
output '=item ',
$self->loc(q{Connect on port 2022 instead of the default port});
output q{S<$ } . $Script . q{ -p 2022 server1 server2>};
output '=back';
output '=head1 ' . $self->loc('FILES');
@ -796,9 +799,7 @@ B<NOTE:> Any "generic" change to the method (e.g., specifying the ssh port to us
);
output '=item use_hotkeys = 1';
output $self->loc(
q{Setting to [_1] will disable all hotkeys.},
'C<0>' );
output $self->loc( q{Setting to [_1] will disable all hotkeys.}, 'C<0>' );
output '=item user = $LOGNAME';
output $self->loc(
@ -912,7 +913,8 @@ B<NOTE:> Any "generic" change to the method (e.g., specifying the ssh port to us
[_2]
This performs two tests to confirm cssh is able to work properly with the settings provided within the [_3] file (or internal defaults).
}, $Script, 'C<< '.$Script.' -e [user@]<hostname>[:port] >>', 'F<$HOME/.clusterssh/config>'
}, $Script, 'C<< ' . $Script . ' -e [user@]<hostname>[:port] >>',
'F<$HOME/.clusterssh/config>'
);
output '=over';
@ -921,7 +923,8 @@ This performs two tests to confirm cssh is able to work properly with the settin
q{Test the terminal window works with the options provided});
output '=item 2';
output $self->loc(
q{Test [_1] works to a host with the configured arguments}, $self->parent->config->{comms});
q{Test [_1] works to a host with the configured arguments},
$self->parent->config->{comms} );
output '=back';
output $self->loc(q{Configuration options to watch for in ssh are});

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

@ -22,7 +22,10 @@ sub new {
sub script {
my ( $self, $config ) = @_;
if(! defined $config || ! ref $config || ref $config ne "App::ClusterSSH::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',
@ -30,9 +33,10 @@ sub script {
);
}
foreach my $arg ( "comms", $config->{comms}, $config->{comms} . '_args', 'command', 'auto_close'
) {
if( !defined $config->{ $arg } ) {
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",

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

@ -73,7 +73,7 @@ sub get_username {
sub get_type {
my ($self) = @_;
if($self->check_ssh_hostname) {
if ( $self->check_ssh_hostname ) {
return 'ssh_alias';
}
return $self->{type} || q{};
@ -165,7 +165,10 @@ sub parse_host_string {
{
$self->debug(
5,
$self->loc( 'bracketed IPv6: u=[_1] h=[_2] p=[_3] g=[_4]', $1, $2, $3, $4 ),
$self->loc(
'bracketed IPv6: u=[_1] h=[_2] p=[_3] g=[_4]',
$1, $2, $3, $4
),
);
return __PACKAGE__->new(
parse_string => $parse_string,
@ -188,8 +191,12 @@ sub parse_host_string {
}xms
)
{
$self->debug( 5,
$self->loc( 'std IPv4: u=[_1] h=[_2] p=[_3] g=[_4]', $1, $2, $3, $4 ),
$self->debug(
5,
$self->loc(
'std IPv4: u=[_1] h=[_2] p=[_3] g=[_4]',
$1, $2, $3, $4
),
);
return __PACKAGE__->new(
parse_string => $parse_string,
@ -218,9 +225,9 @@ sub parse_host_string {
$geometry = $1;
}
# Check for a '/nnnn' port definition
# Check for a '/nnnn' port definition
if ( $host_string =~ s!(?:/(\d+)$)!! ) {
$port = $1;
$port = $1;
}
# use number of colons as a possible indicator
@ -230,7 +237,7 @@ sub parse_host_string {
# if its 8 then assumed full IPv6 address with a port
# also catch localhost address here
if ( $colon_count == 7 || $colon_count == 8 || $host_string eq '::1' ) {
if( $colon_count == 8) {
if ( $colon_count == 8 ) {
$host_string =~ s/(?::(\d+?))$//;
$port = $1;
}
@ -251,8 +258,7 @@ sub parse_host_string {
);
}
if ( $colon_count > 1
&& $colon_count < 8
)
&& $colon_count < 8 )
{
warn 'Ambiguous host string: "', $host_string, '"', $/;
warn 'Assuming you meant "[', $host_string, ']"?', $/;
@ -260,8 +266,8 @@ sub parse_host_string {
$self->debug(
5,
$self->loc(
'Ambiguous IPv6 u=[_1] h=[_2] p=[_3] g=[_4]', $username,
$host_string, $port, $geometry,
'Ambiguous IPv6 u=[_1] h=[_2] p=[_3] g=[_4]',
$username, $host_string, $port, $geometry,
)
);

40
t/02base.t
View file

@ -21,10 +21,10 @@ diag('testing output') if ( $ENV{TEST_VERBOSE} );
trap {
$base->output('testing');
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got correct number of print lines' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got correct number of print lines' );
like( $trap->stdout, qr/\Atesting\n\Z/xsm,
'checking for expected print output' );
@ -68,10 +68,10 @@ trap {
$base = App::ClusterSSH::Base->new( debug => 6, );
};
isa_ok( $base, 'App::ClusterSSH::Base' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en"/xsm,
@ -83,10 +83,10 @@ trap {
$base = App::ClusterSSH::Base->new( debug => 6, lang => 'en' );
};
isa_ok( $base, 'App::ClusterSSH::Base' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en"/xsm,
@ -98,10 +98,10 @@ trap {
$base = App::ClusterSSH::Base->new( debug => 6, lang => 'rubbish' );
};
isa_ok( $base, 'App::ClusterSSH::Base' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 1, 'got new() debug output lines' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"rubbish"/xsm,
@ -113,10 +113,10 @@ trap {
$base = App::ClusterSSH::Base->new( debug => 7, );
};
isa_ok( $base, 'App::ClusterSSH::Base' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 3, 'got new() debug output lines' );
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//, 3, 'got new() debug output lines' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en".Arguments\sto\sApp::ClusterSSH::Base->new.*debug\s=>\s7,$/xsm,

35
t/10host.t
View file

@ -668,12 +668,9 @@ my %parse_tests = (
geometry => q{},
type => 'ipv6',
},
'2001:0db8:8a2e:0370:7334:2001:0db8:8a2e:0370:7334:4535:3453:3453:3455' => {
die => qr{Unable to parse hostname from}ms,
},
'some random rubbish' => {
die => qr{Unable to parse hostname from}ms,
},
'2001:0db8:8a2e:0370:7334:2001:0db8:8a2e:0370:7334:4535:3453:3453:3455'
=> { die => qr{Unable to parse hostname from}ms, },
'some random rubbish' => { die => qr{Unable to parse hostname from}ms, },
);
foreach my $ident ( keys(%parse_tests) ) {
@ -684,23 +681,32 @@ foreach my $ident ( keys(%parse_tests) ) {
if ( $parse_tests{$ident}{die} ) {
is( $trap->leaveby, 'die', $ident . ' died correctly' );
like( $trap->die, $parse_tests{$ident}{die}, $ident . ' died correctly' );
like(
$trap->die,
$parse_tests{$ident}{die},
$ident . ' died correctly'
);
next;
}
is( $trap->leaveby, 'return', $ident . ' returned correctly' );
is( $host, $parse_tests{$ident}{hostname}, 'stringify works on: '.$ident );
is( $host,
$parse_tests{$ident}{hostname},
'stringify works on: ' . $ident
);
isa_ok( $host, "App::ClusterSSH::Host" );
for my $trap_type (qw/ die /) {
if ( ! $parse_tests{$ident}{$trap_type} ) {
if ( !$parse_tests{$ident}{$trap_type} ) {
is( $trap->$trap_type,
$parse_tests{$ident}{$trap_type},
"$ident $trap_type"
);
} else {
like( $trap->$trap_type,
}
else {
like(
$trap->$trap_type,
$parse_tests{$ident}{$trap_type},
"$ident $trap_type"
);
@ -725,7 +731,6 @@ foreach my $ident ( keys(%parse_tests) ) {
is( $host->check_ssh_hostname, 0, $ident . ' not from ssh' );
}
# check for a non-existant file
trap {
$host = App::ClusterSSH::Host->new(
@ -775,9 +780,9 @@ for my $hostname (
is( $host, $hostname, 'stringify works' );
is( $host->check_ssh_hostname, 1,
'check_ssh_hostname ok for ' . $hostname );
is( $host->get_realname, $hostname, 'realname set' );
is( $host->get_geometry, q{}, 'geometry set' );
is( $host->get_type, 'ssh_alias', 'geometry set' );
is( $host->get_realname, $hostname, 'realname set' );
is( $host->get_geometry, q{}, 'geometry set' );
is( $host->get_type, 'ssh_alias', 'geometry set' );
}
done_testing();

36
t/20helper.t
View file

@ -14,7 +14,7 @@ use Readonly;
package App::ClusterSSH::Config;
sub new {
my ($class, %args) = @_;
my ( $class, %args ) = @_;
my $self = {%args};
return bless $self, $class;
}
@ -51,7 +51,7 @@ is( $trap->die, 'No configuration provided or in wrong format',
my $mock_config = App::ClusterSSH::Config->new();
trap {
$script = $helper->script( $mock_config );
$script = $helper->script($mock_config);
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
@ -62,16 +62,16 @@ is( $trap->die, q{Config 'comms' not provided}, 'missing arg' );
$mock_config->{comms} = 'method';
trap {
$script = $helper->script( $mock_config );
$script = $helper->script($mock_config);
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, q{Config 'method' not provided}, 'missing arg' );
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, q{Config 'method' not provided}, 'missing arg' );
$mock_config->{method} = 'binary';
trap {
$script = $helper->script( $mock_config );
$script = $helper->script($mock_config);
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
@ -79,22 +79,22 @@ is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, q{Config 'method_args' not provided}, 'missing arg' );
$mock_config->{method_args} = 'rubbish';
$mock_config->{command} = 'echo';
$mock_config->{auto_close} = 5;
$mock_config->{command} = 'echo';
$mock_config->{auto_close} = 5;
trap {
$script = $helper->script( $mock_config );
$script = $helper->script($mock_config);
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, undef, 'not died' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, undef, 'not died' );
trap {
eval { $script };
eval {$script};
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, undef, 'not died' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, undef, 'not died' );
done_testing();

15
t/30cluster.t
View file

@ -109,7 +109,8 @@ $expected{tag20} = [ 'host10', ];
$expected{tag30} = [ 'host10', ];
$expected{tag40} = [ 'host20', 'host30', ];
$expected{tag50} = [ 'host30', ];
$cluster1->read_tag_file( $Bin . '/30cluster.tag1' ); test_expected( 'tag 1', %expected );
$cluster1->read_tag_file( $Bin . '/30cluster.tag1' );
test_expected( 'tag 1', %expected );
$cluster1->read_cluster_file( $Bin . '/30cluster.file3' );
my @default_expected = (qw/ host7 host8 host9 /);
@ -158,17 +159,16 @@ my @external_expected;
# text fetching external clusters when no command set or runnable
#$mock_object->{external_cluster_command} = '/tmp/doesnt_exist';
trap {
@external_expected = $cluster1->_run_external_clusters();
@external_expected = $cluster1->_run_external_clusters();
};
is( $trap->leaveby, 'return', 'non-existant tag returns correctly' );
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is( $tags, undef, 'non-existant tag returns undef' );
@external_expected = $cluster1->list_external_clusters();
is_deeply( \@external_expected, [],
'External command doesnt exist'
);
is( scalar $cluster1->list_external_clusters, 0, 'External command failed tag count');
is_deeply( \@external_expected, [], 'External command doesnt exist' );
is( scalar $cluster1->list_external_clusters,
0, 'External command failed tag count' );
$mock_object->{external_cluster_command} = "$Bin/external_cluster_command";
@ -178,7 +178,8 @@ is_deeply(
[qw/ tag100 tag200 tag300 tag400 /],
'External command no args'
);
is( scalar $cluster1->list_external_clusters, 4, 'External command tag count');
is( scalar $cluster1->list_external_clusters,
4, 'External command tag count' );
@external_expected = $cluster1->get_external_clusters();
is_deeply( \@external_expected, [], 'External command no args' );

16
t/perltidy.t Normal file
View file

@ -0,0 +1,16 @@
#!perl -T
use strict;
use warnings;
use Test::More;
use FindBin qw($Bin);
eval "use Test::PerlTidy";
plan skip_all => "Test::PerlTidy required for testing code" if $@;
# Please see t/perltidyrc for the authors normal perltidy options
run_tests(
perltidyrc => $Bin . '/perltidyrc',
exclude => [ '_build/', 'blib/' ]
);