App-ClusterSSH
view release on metacpan or search on metacpan
$base = App::ClusterSSH::Base->new();
isa_ok( $base, 'App::ClusterSSH::Base' );
diag('testing output') if ( $ENV{TEST_VERBOSE} );
trap {
$base->stdout_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' );
like( $trap->stdout, qr/\Atesting\n\Z/xsm,
'checking for expected print output' );
diag('Testing debug output') if ( $ENV{TEST_VERBOSE} );
for my $level ( 0 .. 9 ) {
$base->set_debug_level($level);
is( $base->debug_level(), $level, 'debug level is correct' );
trap {
for my $log_level ( 0 .. 9 ) {
$base->debug( $log_level, 'test' );
}
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout =~ tr/\n//,
$level + 1, 'got correct number of debug lines' );
like( $trap->stdout, qr/(?:test\n){$level}/xsm,
'checking for expected debug output' );
}
my $level;
trap {
$level = $base->set_debug_level();
};
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
like( $trap->die, qr/^Debug level not provided/, 'Got correct croak text' );
$base->set_debug_level(10);
is( $base->debug_level(), 9, 'checking debug_level reset to 9' );
$base = undef;
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' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en"/xsm,
'got expected new() output'
);
$base = undef;
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' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en"/xsm,
'got expected new() output'
);
$base = undef;
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' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"rubbish"/xsm,
'got expected new() output'
);
$base = undef;
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' );
like(
$trap->stdout,
qr/^Setting\slanguage\sto\s"en".Arguments\sto\sApp::ClusterSSH::Base->new.*debug\s=>\s7,$/xsm,
'got expected new() output'
);
# config tests
$base = undef;
my $get_config;
my $object;
trap {
$base = App::ClusterSSH::Base->new( debug => 3, );
};
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, '', 'Expecting no STDOUT' );
$base = undef;
trap {
$base = App::ClusterSSH::Base->new( debug => 3, parent => 'guardian' );
};
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, '', 'Expecting no STDOUT' );
is( $base->parent, 'guardian', 'Expecting no STDOUT' );
trap {
$get_config = $base->config();
};
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
is( $trap->leaveby, 'die', 'died ok' );
like( $trap->die, qr/^config has not yet been set/,
'Got correct croak text' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Expecting not STDOUT' );
is( $get_config, undef, 'config left empty' );
trap {
$object = $base->set_config();
};
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
is( $trap->leaveby, 'die', 'died ok' );
like( $trap->die, qr/^passed config is empty/, 'Got correct croak text' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
trap {
$object = $base->set_config('set to scalar');
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'config set ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
like(
$trap->stdout,
qr/^Setting\sapp\sconfiguration/xsm,
'Got expected STDOUT'
);
isa_ok( $object, 'App::ClusterSSH::Base' );
trap {
$get_config = $base->config();
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Expecting not STDOUT' );
is( $get_config, 'set to scalar', 'config set as expected' );
trap {
$object = $base->set_config('set to another scalar');
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
like(
$trap->die,
qr/^config\shas\salready\sbeen\sset/,
'config cannot be reset'
);
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Got expected STDOUT' );
trap {
$object = $base->set_config();
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
like(
$trap->die,
qr/^config\shas\salready\sbeen\sset/,
'config cannot be reset'
);
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Got expected STDOUT' );
# basic checks - validity of config is tested elsewhere
my %config;
trap {
%config = $object->load_file;
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
is( $trap->die,
q{"filename" arg not passed},
'missing filename arg die message'
);
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->stdout, '', 'Got expected STDOUT' );
trap {
%config = $object->load_file( filename => $Bin . '/15config.t.file1' );
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
'Caught exception object OK' );
is( $trap->die, q{"type" arg not passed}, 'missing type arg die message' );
is( $trap->stderr, '', 'Expecting no STDERR' );
done_testing();
t/05getopts.t view on Meta::CPAN
my $mock_object = Test::ClusterSSH::Mock->new();
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
isa_ok( $getopts, 'App::ClusterSSH::Getopt' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on new object okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
isa_ok( $getopts, 'App::ClusterSSH::Getopt' );
trap {
$getopts->add_option();
};
is( $trap->leaveby, 'die', 'adding an empty option failed' );
is( $trap->die,
q{No "spec" passed to add_option},
'empty add_option message'
);
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->add_option( spec => 'option' );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->option;
};
is( $trap->leaveby, 'return', 'calling option' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option, undef, 'Expecting no die message' );
local @ARGV = '--option1';
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1' );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->option1;
};
is( $trap->leaveby, 'return', 'calling option' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 1, 'Expecting no die message' );
local @ARGV = ''; # @ARGV is never undef, but an empty string
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1', default => 5 );
};
is( $trap->leaveby, 'return', 'adding an empty option with a default value' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->option1;
};
is( $trap->leaveby, 'return', 'calling option' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 5, 'correct default value' );
local @ARGV = ( '--option1', '8' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'option1=i', default => 5, );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->option1;
};
is( $trap->leaveby, 'return', 'calling option' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 8, 'default value overridden' );
@ARGV = ( '--option1', '--option2', 'string', '--option3', '10' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_option( spec => 'hidden', hidden => 1, no_acessor => 1, );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->add_option( spec => 'option1', help => 'help for 1' );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->add_option( spec => 'option2|o=s', help => 'help for 2' );
};
is( $trap->leaveby, 'return', 'adding option2 failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->add_option(
spec => 'option3|alt_opt|O=i',
help => 'help for 3',
default => 5
);
};
is( $trap->leaveby, 'return', 'adding option3 failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->option1;
};
is( $trap->leaveby, 'return', 'calling option1' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option1, 1, 'option1 is as expected' );
trap {
$getopts->option1;
};
is( $trap->leaveby, 'return', 'calling option2' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option2, 'string', 'option2 is as expected' );
trap {
$getopts->option3;
};
is( $trap->leaveby, 'return', 'calling option3' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $getopts->option3, 10, 'option3 is as expected' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_common_ssh_options;
};
is( $trap->leaveby, 'return', 'calling option2' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->add_common_session_options;
};
is( $trap->leaveby, 'return', 'calling option2' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
my $pod;
@ARGV = ('--generate-pod');
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
$getopts->add_option(
spec => 'long_opt|l=s',
help => 'long opt help',
default => 'default string'
);
t/05getopts.t view on Meta::CPAN
$getopts->add_option( spec => 'long', help => 'long option only', );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
$pod = $trap->stdout;
# run pod through a checker at some point as it should be 'clean'
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
@ARGV = ('--help');
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
@ARGV = ('-?');
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
@ARGV = ('-v');
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'exit', 'version option exist okay' );
is( $trap->die, undef, 'no error when spec provided' );
like( $trap->stdout, qr/^Version: /, 'Version string correct' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
@ARGV = ('-@');
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
like( $trap->stderr, qr{Unknown option: @}, 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
# test some common options
@ARGV = (
'--unique-servers', '--title', 'title', '-p',
'22', '--autoquit', '--tile', '--autoclose',
'10',
);
$mock_object->{auto_close} = 0;
$mock_object->{auto_quit} = 0;
$mock_object->{window_tiling} = 0;
$mock_object->{show_history} = 0;
$mock_object->{use_all_a_records} = 1;
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $mock_object->{auto_close}, 10, 'auto_close set right' );
is( $mock_object->{auto_quit}, 1, 'auto_quit set right' );
is( $mock_object->{window_tiling}, 1, 'window_tiling set right' );
is( $mock_object->{show_history}, 0, 'show_history set right' );
is( $mock_object->{use_all_a_records}, 1, 'use_all_a_records set right' );
@ARGV = (
'--unique-servers', '--title', 'title', '-p', '22', '--autoquit',
'--tile', '--show-history', '-A',
);
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
is( $mock_object->{auto_close}, 10, 'auto_close set right' );
is( $mock_object->{auto_quit}, 0, 'auto_quit set right' );
is( $mock_object->{window_tiling}, 0, 'window_tiling set right' );
is( $mock_object->{show_history}, 1, 'show_history set right' );
is( $mock_object->{use_all_a_records}, 0, 'use_all_a_records set right' );
TODO: {
local $TODO = "explitely test for duplicate options";
$getopts = App::ClusterSSH::Getopt->new(
parent => Test::ClusterSSH::Mock->new() );
trap {
$getopts->add_option( spec => 'option1' );
};
is( $trap->leaveby, 'return', 'adding an empty option failed' );
is( $trap->die, undef, 'no error when spec provided' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
trap {
$getopts->add_option( spec => 'option1' );
};
is( $trap->leaveby, 'die', 'adding an empty option failed' );
is( $trap->die, "bling bling", 'no error when spec provided' );
is( $trap->stdout, 'bling bling', 'Expecting no STDOUT' );
is( $trap->stderr, 'bling bling', 'Expecting no STDERR' );
trap {
$getopts->getopts;
};
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
is( $trap->stdout, '', 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
is( $trap->die, undef, 'Expecting no die message' );
}
@ARGV = ( '--rows', 5, '--cols', 10 );
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
trap {
$getopts->getopts;
};
$trap->did_return(" ... returned");
geometry => q{},
type => 'ipv6',
},
'::1:2323' => {
hostname => '::1:2323',
port => q{},
username => q{},
realname => '::1:2323',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'::1/2323' => {
hostname => '::1',
port => 2323,
username => q{},
realname => '::1',
geometry => q{},
type => 'ipv6',
},
'::1:2323=3x3+3+3' => {
hostname => '::1:2323',
port => q{},
username => q{},
realname => '::1:2323',
geometry => '3x3+3+3',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'::1/2323=3x3+3+3' => {
hostname => '::1',
port => 2323,
username => q{},
realname => '::1',
geometry => '3x3+3+3',
type => 'ipv6',
},
'user@::1' => {
geometry => q{},
type => 'ipv6',
},
'user@::1:4242' => {
hostname => '::1:4242',
port => q{},
username => 'user',
realname => '::1:4242',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'user@::1/4242' => {
hostname => '::1',
port => 4242,
username => 'user',
realname => '::1',
geometry => q{},
type => 'ipv6',
},
'user@::1=5x5+5+5' => {
geometry => '5x5+5+5',
type => 'ipv6',
},
'user@::1:4242=5x5+5+5' => {
hostname => '::1:4242',
port => q{},
username => 'user',
realname => '::1:4242',
geometry => '5x5+5+5',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'user@::1/4242=5x5+5+5' => {
hostname => '::1',
port => 4242,
username => 'user',
realname => '::1',
geometry => '5x5+5+5',
type => 'ipv6',
},
'[::1]' => {
geometry => q{},
type => 'ipv6',
},
'2001:0db8:85a3::8a2e:0370:7334' => {
hostname => '2001:0db8:85a3::8a2e:0370:7334',
port => q{},
username => q{},
realname => '2001:0db8:85a3::8a2e:0370:7334',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'2001:0db8:85a3::8a2e:0370/7334' => {
hostname => '2001:0db8:85a3::8a2e:0370',
port => 7334,
username => q{},
realname => '2001:0db8:85a3::8a2e:0370',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'pete@2001:0db8:85a3::8a2e:0370:7334' => {
hostname => '2001:0db8:85a3::8a2e:0370:7334',
port => q{},
username => 'pete',
realname => '2001:0db8:85a3::8a2e:0370:7334',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'pete@2001:0db8:85a3::8a2e:0370/7334' => {
hostname => '2001:0db8:85a3::8a2e:0370',
port => 7334,
username => 'pete',
realname => '2001:0db8:85a3::8a2e:0370',
geometry => q{},
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'pete@2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
hostname => '2001:0db8:85a3::8a2e:0370:7334',
port => q{},
username => 'pete',
realname => '2001:0db8:85a3::8a2e:0370:7334',
geometry => '2x3+4+5',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'pete@2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
hostname => '2001:0db8:85a3::8a2e:0370',
port => 7334,
username => 'pete',
realname => '2001:0db8:85a3::8a2e:0370',
geometry => '2x3+4+5',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
hostname => '2001:0db8:85a3::8a2e:0370:7334',
port => q{},
username => q{},
realname => '2001:0db8:85a3::8a2e:0370:7334',
geometry => '2x3+4+5',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
hostname => '2001:0db8:85a3::8a2e:0370',
port => 7334,
username => q{},
realname => '2001:0db8:85a3::8a2e:0370',
geometry => '2x3+4+5',
type => 'ipv6',
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
},
'[2001:0db8:85a3::8a2e:0370:7334]' => {
hostname => '2001:0db8:85a3::8a2e:0370:7334',
port => q{},
username => q{},
realname => '2001:0db8:85a3::8a2e:0370:7334',
geometry => q{},
type => 'ipv6',
},
'pete@[2001:0db8:85a3::8a2e:0370:7334]' => {
}
else {
like(
$trap->$trap_type,
$parse_tests{$ident}{$trap_type},
"$ident $trap_type"
);
}
}
for my $trap_empty (qw/ stdout stderr /) {
like(
$trap->$trap_empty,
$parse_tests{$ident}{$trap_empty} || qr{^$},
"$ident $trap_empty"
);
}
for my $attr (qw/ hostname type port username realname geometry /) {
my $method = "get_$attr";
is( $host->$method,
$parse_tests{$ident}{$attr},
t/15config.t view on Meta::CPAN
$expected{screen_reserve_right} = 100;
$expected{screen_reserve_top} = 100;
$expected{screen_reserve_bottom} = 160;
trap {
$config = $config->parse_config_file( $file, );
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
$file = "$Bin/$Script.file2";
note("using $file");
$config = App::ClusterSSH::Config->new();
%expected = %default_config;
trap {
$config = $config->parse_config_file( $file, );
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
is( $trap->die,
'Unknown configuration parameters: missing,rubbish' . $/,
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
$file = "$Bin/$Script.file3";
note("using $file");
$config = App::ClusterSSH::Config->new();
%expected = %default_config;
trap {
$config = $config->parse_config_file( $file, );
};
is( $trap->leaveby, 'return', 'returned ok' );
is( $trap->die, undef, 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
note('find_binary tests');
my $path;
$config = App::ClusterSSH::Config->new();
trap {
$path = $config->find_binary();
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, 'argument not provided' . $/, 'die message correct' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
trap {
$path = $config->find_binary('missing');
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die,
'"missing" binary not found - please amend $PATH or the cssh config file'
. $/,
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
trap {
$path = $config->find_binary('ls');
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
is( $path, 'ls', 'Found correct path to "ls"' );
# check for a binary already found
my $newpath;
trap {
$newpath = $config->find_binary($path);
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
is( $path, 'ls', 'Found correct path to "ls"' );
is( $path, $newpath, 'No change made from find_binary' );
# give false path to force another search
trap {
$newpath = $config->find_binary( '/does/not/exist/' . $path );
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
is( $path, 'ls', 'Found correct path to "ls"' );
is( $path, $newpath, 'No change made from find_binary' );
note('Checks on loading configs');
note('empty dir');
$ENV{HOME} = tempdir( CLEANUP => 1 );
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
'Created new configuration file within $HOME/.clusterssh/' . $/,
'Got correct STDERR output for .csshrc'
);
#note(qx/ls -laR $ENV{HOME}/);
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
$ENV{HOME} = undef;
t/15config.t view on Meta::CPAN
$expected{auto_quit} = 'no';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
'Moved $HOME/.csshrc to $HOME/.csshrc.DISABLED'
. $/
. 'Created new configuration file within $HOME/.clusterssh/'
. $/,
'Got correct STDERR output for .csshrc'
);
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
t/15config.t view on Meta::CPAN
$expected{window_tiling} = 'no';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
'Moved $HOME/.csshrc to $HOME/.csshrc.DISABLED' . $/,
'Got correct STDERR output for .csshrc'
);
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning and .clusterssh dir');
unlink( $ENV{HOME} . '/.csshrc' );
$expected{auto_quit} = 'yes';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning, .clusterssh dir plus config + extra config');
open( $csshrc, '>', $ENV{HOME} . '/clusterssh.config' );
print $csshrc 'terminal_args = something', $/;
close($csshrc);
$expected{terminal_args} = 'something';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs( $ENV{HOME} . '/clusterssh.config' );
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning, .clusterssh dir plus config + more extra configs');
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh/config_ABC' );
print $csshrc 'ssh_args = something', $/;
close($csshrc);
$expected{ssh_args} = 'something';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs( $ENV{HOME} . '/clusterssh.config', 'ABC' );
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('check .clusterssh file is an error');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh' );
print $csshrc 'should_be_dir_not_file = PROBLEM', $/;
close($csshrc);
$config = App::ClusterSSH::Config->new();
t/15config.t view on Meta::CPAN
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die,
'Unable to create directory $HOME/.clusterssh: File exists' . $/,
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
note('check failure to write default config is caught');
$ENV{HOME} = tempdir( CLEANUP => 1 );
mkdir( $ENV{HOME} . '/.clusterssh' );
mkdir( $ENV{HOME} . '/.clusterssh/config' );
$config = App::ClusterSSH::Config->new();
trap {
$config->write_user_config_file();
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die,
'Unable to write default $HOME/.clusterssh/config: Is a directory' . $/,
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
note('check .clusterssh errors via load_configs are not fatal');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh' );
print $csshrc 'should_be_dir_not_file = PROBLEM', $/;
close($csshrc);
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'died ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
q{Unable to create directory $HOME/.clusterssh: File exists} . $/ . $/,
'Expecting no STDERR'
);
SKIP: {
skip "Test inappropriate when running as root", 5 if $< == 0;
note('move of .csshrc failure');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open( $csshrc, '>', $ENV{HOME} . '/.csshrc' );
print $csshrc "Something", $/;
t/15config.t view on Meta::CPAN
print $csshrc "Something else", $/;
close($csshrc);
chmod( 0666, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
$config = App::ClusterSSH::Config->new();
trap {
$config->write_user_config_file();
};
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die,
q{Unable to create directory $HOME/.clusterssh: Permission denied}
. $/,
'Expected die msg ' . $trap->stderr
);
chmod( 0755, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
}
note('check failure to write default config is caught');
$ENV{HOME} = tempdir( CLEANUP => 1 );
mkdir( $ENV{HOME} . '/.clusterssh' );
mkdir( $ENV{HOME} . '/.clusterssh/config' );
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
q{Unable to write default $HOME/.clusterssh/config: Is a directory}
. $/
. $/,
'Expecting no STDERR'
);
note('Checking dump');
$config = App::ClusterSSH::Config->new(
send_menu_xml_file => $ENV{HOME} . '/.clusterssh/send_menu', );
t/15config.t view on Meta::CPAN
use_hotkeys=yes
use_natural_sort=0
#user=
window_tiling=yes
window_tiling_direction=right
};
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
eq_or_diff( $trap->stdout, $expected, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
done_testing();
t/20helper.t view on Meta::CPAN
$helper = App::ClusterSSH::Helper->new();
isa_ok( $helper, 'App::ClusterSSH::Helper' );
my $script;
trap {
$script = $helper->script;
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, 'No configuration provided or in wrong format', 'no config' );
trap {
$script = $helper->script( something => 'nothing' );
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, 'No configuration provided or in wrong format',
'bad format' );
my $mock_config = App::ClusterSSH::Config->new();
trap {
$script = $helper->script($mock_config);
};
is( $trap->leaveby, 'die', 'returned ok' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
# ignore stderr here as it will complain about missing xxx_arg var
#is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->die, q{Config 'comms' not provided}, 'missing arg' );
$mock_config->{comms} = 'method';
trap {
$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' );
$mock_config->{method} = 'binary';
trap {
$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_args' not provided}, 'missing arg' );
$mock_config->{method_args} = 'rubbish';
$mock_config->{command} = 'echo';
$mock_config->{auto_close} = 5;
trap {
$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' );
trap {
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' );
done_testing();
t/30cluster.t view on Meta::CPAN
scalar @default_expected,
'Count correct'
);
my $tags;
trap {
$tags = $cluster1->get_tag('does_not_exist');
};
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' );
@default_expected
= sort qw/ default people tag1 tag2 tag3 tag10 tag20 tag30 tag40 tag50 /;
trap {
@default = $cluster1->list_tags;
};
is( $trap->leaveby, 'return', 'list_tags returned okay' );
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is_deeply( \@default, \@default_expected, 'tag list correct' );
my $count;
trap {
$count = $cluster1->list_tags;
};
is( $trap->leaveby, 'return', 'list_tags returned okay' );
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is_deeply( $count, 10, 'tag list count correct' );
# now checks against running an external command
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();
};
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' );
$mock_object->{external_cluster_command} = "$Bin/external_cluster_command";
@external_expected = $cluster1->list_external_clusters();
is_deeply(
t/30cluster.t view on Meta::CPAN
trap {
@external_expected = $cluster1->get_external_clusters("-x $redirect");
};
like(
$trap->die,
qr/External command failure.*external_cluster_command.*Return Code: 5/ms,
'External command: caught exception message'
);
is( $trap->stdout, '', 'External command: no stdout from perl code' );
is( $trap->stderr, '', 'External command: no stderr from perl code' );
trap {
@external_expected = $cluster1->get_external_clusters("-q $redirect");
};
like(
$trap->die,
qr/External command failure.*external_cluster_command.*Return Code: 255/ms,
'External command: caught exception message'
);
is( $trap->stdout, '', 'External command: no stdout from perl code' );
is( $trap->stderr, '', 'External command: no stderr from perl code' );
# check reading of cluster files
trap {
$cluster1->get_cluster_entries( $Bin . '/30cluster.file3' );
};
is( $trap->leaveby, 'return', 'exit okay on get_cluster_entries' );
is( $trap->stdout, '', 'no stdout for get_cluster_entries' );
is( $trap->stderr, '', 'no stderr for get_cluster_entries' );
# check reading of tag files
trap {
$cluster1->get_tag_entries( $Bin . '/30cluster.tag1' );
};
is( $trap->leaveby, 'return', 'exit okay on get_tag_entries' );
is( $trap->stdout, '', 'no stdout for get_tag_entries' );
is( $trap->stderr, '', 'no stderr for get_tag_entries' );
# This step is required for using find_binary within the underlying
# code of the following methods
$cluster1->set_config( App::ClusterSSH::Config->new() );
# test bash expansion
my @expected = ( 'aa', 'ab', 'ac' );
$cluster1->register_tag( 'glob1', 'a{a,b,c}' );
@got = $cluster2->get_tag('glob1');
is_deeply( \@got, \@expected, 'glob1 expansion, words' )
t/30cluster.t view on Meta::CPAN
or diag explain @got;
@expected = ();
trap {
$cluster1->register_tag( 'glob6', 'c{a..c} ; echo NASTY' );
};
is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
is( $trap->die, undef, 'didnt die on nasty chars' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
like(
$trap->stderr,
qr/Bad characters picked up in tag 'glob6':.*/,
'warned on nasty chars'
);
@got = $cluster2->get_tag('glob6');
is_deeply( \@got, \@expected, 'glob6 expansion, nasty chars' )
or diag explain @got;
@expected = ();
trap {
$cluster1->register_tag( 'glob7', 'c{a..b} `echo NASTY`' );
};
is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
is( $trap->die, undef, 'didnt die on nasty chars' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
like(
$trap->stderr,
qr/Bad characters picked up in tag 'glob7':.*/,
'warned on nasty chars'
);
@got = $cluster2->get_tag('glob7');
is_deeply( \@got, \@expected, 'glob7 expansion, nasty chars' )
or diag explain @got;
@expected = ();
trap {
$cluster1->register_tag( 'glob8', 'c{a..b} $!', );
};
is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
is( $trap->die, undef, 'didnt die on nasty chars' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
like(
$trap->stderr,
qr/Bad characters picked up in tag 'glob8':.*/,
'warned on nasty chars'
);
@got = $cluster2->get_tag('glob8');
is_deeply( \@got, \@expected, 'glob8 expansion, nasty chars' )
or diag explain @got;
done_testing();
sub test_expected {
for my $key ( sort keys %tests ) {
my $expected = $tests{$key};
my @expected = split / /, $tests{$key};
my $got;
trap {
$got = $range->expand($key);
};
is( $trap->stdout, '', "No stdout for scalar $key" );
is( $trap->stderr, '', "No stderr for scalar $key" );
is( $trap->leaveby, 'return', "correct leaveby for scalar $key" );
is( $trap->die, undef, "die is undef for scalar $key" );
is( $got, "$expected", "expected return for scalar $key" );
my @got;
trap {
@got = $range->expand($key);
};
is( $trap->stdout, '', "No stdout for array $key" );
is( $trap->stderr, '', "No stderr for array $key" );
is( $trap->leaveby, 'return', "correct leaveby for array $key" );
is( $trap->die, undef, "die is undef for array $key" );
is_deeply( \@got, \@expected, "expected return for array $key" )
|| diag explain \@got;
}
done_testing();
( run in 0.372 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )