mirror of
https://github.com/duncs/clusterssh.git
synced 2025-04-20 16:59:06 +00:00
Run through 'dzil perltidy'
This commit is contained in:
Duncan Ferguson
parent
fea0b80d48
commit
cc90a9a3fb
20 changed files with 152 additions and 136 deletions
4
Build.PL
4
Build.PL
|
|
@ -3,7 +3,7 @@ use lib 'inc';
|
|||
require Module::Build;
|
||||
|
||||
my %module_build_args = (
|
||||
module_name => 'App::ClusterSSH',
|
||||
module_name => 'App::ClusterSSH',
|
||||
dist_abstract => "Cluster administration tool",
|
||||
##{ $plugin->get_prereqs(1) ##}
|
||||
##{ $plugin->get_default('share_dir') ##}
|
||||
|
|
@ -12,7 +12,7 @@ my %module_build_args = (
|
|||
'bin/ccon', 'bin/crsh',
|
||||
'bin/ctel', 'bin/clusterssh_bash_completion.dist'
|
||||
],
|
||||
PL_files => {
|
||||
PL_files => {
|
||||
'bin_PL/_build_docs' => [
|
||||
'bin/cssh', 'bin/csftp',
|
||||
'bin/ccon', 'bin/crsh',
|
||||
|
|
|
|||
2
README
2
README
|
|
@ -2,7 +2,7 @@ NAME
|
|||
cssh - Cluster administration tool
|
||||
|
||||
VERSION
|
||||
This documentation is for version: 4.16
|
||||
This documentation is for version: 4.17
|
||||
|
||||
SYNOPSIS
|
||||
cssh [-a '<command>'] [-K <seconds>] [-q] [-c '<filename>'] [-x <cols>]
|
||||
|
|
|
|||
|
|
@ -6,41 +6,42 @@ use warnings;
|
|||
use FindBin qw($Bin $Script);
|
||||
use File::Basename;
|
||||
|
||||
my $bindir="bin";
|
||||
my $bindir = "bin";
|
||||
|
||||
if(! -d $bindir) {
|
||||
if ( !-d $bindir ) {
|
||||
mkdir $bindir || die "Could not mkdir $bindir: $!";
|
||||
}
|
||||
|
||||
print "Using perl binary: $^X",$/;
|
||||
print "Using perl version $^V",$/;
|
||||
print "Using perl binary: $^X", $/;
|
||||
print "Using perl version $^V", $/;
|
||||
|
||||
for my $dest (@ARGV) {
|
||||
my $source=$Bin.'/'.basename($dest);
|
||||
my $source = $Bin . '/' . basename($dest);
|
||||
|
||||
next if($source =~ m/$Script/);
|
||||
next if($source =~ m/\.x$/);
|
||||
next if ( $source =~ m/$Script/ );
|
||||
next if ( $source =~ m/\.x$/ );
|
||||
|
||||
print "Generating: $source",$/;
|
||||
print "Generating: $source", $/;
|
||||
|
||||
if(-f $dest) {
|
||||
chmod(0755, $dest) || die "Could not chmod $dest for removing: $!";
|
||||
if ( -f $dest ) {
|
||||
chmod( 0755, $dest ) || die "Could not chmod $dest for removing: $!";
|
||||
}
|
||||
|
||||
open(my $sfh, '<', $source) || die "Could not open $source for reading: $!";
|
||||
open(my $dfh, '>', $dest ) || die "Could not open $dest for writing: $!";
|
||||
print $dfh $_ while(<$sfh>);
|
||||
open( my $sfh, '<', $source )
|
||||
|| die "Could not open $source for reading: $!";
|
||||
open( my $dfh, '>', $dest ) || die "Could not open $dest for writing: $!";
|
||||
print $dfh $_ while (<$sfh>);
|
||||
close($sfh);
|
||||
|
||||
if($source !~ m/clusterssh_bash_completion.dist/) {
|
||||
if ( $source !~ m/clusterssh_bash_completion.dist/ ) {
|
||||
print $dfh "\n\n__END__\n\n";
|
||||
|
||||
my $pod= qx{ $^X $source --generate-pod };
|
||||
die "Failed to generate pod" if($?);
|
||||
my $pod = qx{ $^X $source --generate-pod };
|
||||
die "Failed to generate pod" if ($?);
|
||||
print $dfh $pod;
|
||||
}
|
||||
|
||||
close($dfh);
|
||||
|
||||
chmod(0555, $dest) || die "Could not chmod $dest: $!";
|
||||
chmod( 0555, $dest ) || die "Could not chmod $dest: $!";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,7 +15,9 @@ my $app = App::ClusterSSH->new();
|
|||
|
||||
$app->add_option(
|
||||
spec => 'master|M=s',
|
||||
help => $app->loc("The console client program polls master as the primary server, rather than the default set at compile time (typically ``console'')."),
|
||||
help => $app->loc(
|
||||
"The console client program polls master as the primary server, rather than the default set at compile time (typically ``console'')."
|
||||
),
|
||||
);
|
||||
|
||||
$app->run();
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package App::ClusterSSH;
|
||||
|
||||
# ABSTRACT: Cluster administration tool
|
||||
|
|
@ -40,7 +41,7 @@ use App::ClusterSSH::Window;
|
|||
use FindBin qw($Script);
|
||||
|
||||
use POSIX ":sys_wait_h";
|
||||
use POSIX qw/:sys_wait_h strftime mkfifo/;
|
||||
use POSIX qw/:sys_wait_h strftime mkfifo/;
|
||||
use File::Temp qw/:POSIX/;
|
||||
use Fcntl;
|
||||
use File::Basename;
|
||||
|
|
@ -485,7 +486,6 @@ sub run {
|
|||
|
||||
1;
|
||||
|
||||
|
||||
=item REAPER
|
||||
|
||||
=item add_host_by_name
|
||||
|
|
|
|||
|
|
@ -87,7 +87,7 @@ sub _run_external_clusters {
|
|||
|
||||
$self->debug( 3, 'Running tags through external command' );
|
||||
$self->debug( 4, 'External command: ', $external_command );
|
||||
$self->debug( 3, 'Args ', join( ',', @args ) );
|
||||
$self->debug( 3, 'Args ', join( ',', @args ) );
|
||||
|
||||
my $command = "$external_command @args";
|
||||
|
||||
|
|
|
|||
|
|
@ -114,11 +114,11 @@ my %default_config = (
|
|||
macro_user_3 => '%3',
|
||||
macro_user_4 => '%4',
|
||||
|
||||
macro_user_1_command => '',
|
||||
macro_user_2_command => '',
|
||||
macro_user_3_command => '',
|
||||
macro_user_4_command => '',
|
||||
hostname_override => '',
|
||||
macro_user_1_command => '',
|
||||
macro_user_2_command => '',
|
||||
macro_user_3_command => '',
|
||||
macro_user_4_command => '',
|
||||
hostname_override => '',
|
||||
|
||||
max_addhost_menu_cluster_items => 6,
|
||||
menu_send_autotearoff => 0,
|
||||
|
|
@ -298,7 +298,7 @@ sub parse_config_file {
|
|||
|
||||
# Look at the user macros and if not set remove the hotkey for them
|
||||
for my $i (qw/ 1 2 3 4 /) {
|
||||
if ( ! $self->{"macro_user_${i}_command"} ) {
|
||||
if ( !$self->{"macro_user_${i}_command"} ) {
|
||||
delete $self->{"key_user_${i}"};
|
||||
}
|
||||
}
|
||||
|
|
@ -315,7 +315,7 @@ sub load_configs {
|
|||
$ENV{HOME} . '/.clusterssh/config',
|
||||
)
|
||||
{
|
||||
$self->parse_config_file($config) if ( -e $config && ! -d _ );
|
||||
$self->parse_config_file($config) if ( -e $config && !-d _ );
|
||||
}
|
||||
|
||||
# write out default config file if necesasry
|
||||
|
|
@ -330,17 +330,17 @@ sub load_configs {
|
|||
# relative to config directory
|
||||
for my $config (@configs) {
|
||||
next unless ($config); # can be null when passed from Getopt::Long
|
||||
$self->parse_config_file($config) if ( -e $config && ! -d _ );
|
||||
$self->parse_config_file($config) if ( -e $config && !-d _ );
|
||||
|
||||
my $file = $ENV{HOME} . '/.clusterssh/config_' . $config;
|
||||
$self->parse_config_file($file) if ( -e $file && ! -d _ );
|
||||
$self->parse_config_file($file) if ( -e $file && !-d _ );
|
||||
}
|
||||
|
||||
# Override confuration via environment variable using cssh_ prefix
|
||||
# eg: terminal_size => cssh_terminal_size
|
||||
foreach my $config_key ( sort( keys(%default_config) ) ) {
|
||||
my $env_config_key = "cssh_".$config_key;
|
||||
if ( exists $ENV{uc($env_config_key)} ) {
|
||||
my $env_config_key = "cssh_" . $config_key;
|
||||
if ( exists $ENV{ uc($env_config_key) } ) {
|
||||
$env_config_key = uc($env_config_key);
|
||||
}
|
||||
if ( exists $ENV{$env_config_key} ) {
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@ sub add_option {
|
|||
}
|
||||
$desc .= " $arg" if ($arg);
|
||||
$short .= " $arg" if ( $short && $arg );
|
||||
$long .= " $arg" if ( $long && $arg );
|
||||
$long .= " $arg" if ( $long && $arg );
|
||||
}
|
||||
$args{option_desc} = $desc;
|
||||
$args{option_short} = $short;
|
||||
|
|
@ -426,7 +426,7 @@ sub output {
|
|||
sub _generate_pod {
|
||||
my ($self) = @_;
|
||||
|
||||
output $/ , "=pod";
|
||||
output $/, "=pod";
|
||||
output '=head1 ', $self->loc('NAME');
|
||||
output "$Script - ", $self->loc("Cluster administration tool");
|
||||
output '=head1 ', $self->loc('VERSION');
|
||||
|
|
@ -448,22 +448,22 @@ sub _generate_pod {
|
|||
|
||||
output '=head1 ', $self->loc('RELATED');
|
||||
output $self->loc(
|
||||
q{Also see the individual man pages for each of these utilities} );
|
||||
q{Also see the individual man pages for each of these utilities});
|
||||
|
||||
my %utils = (
|
||||
ctel => 'telnet',
|
||||
cssh => 'ssh',
|
||||
crsh => 'rsh',
|
||||
csftp => 'sftp',
|
||||
ccon => 'console',
|
||||
ctel => 'telnet',
|
||||
cssh => 'ssh',
|
||||
crsh => 'rsh',
|
||||
csftp => 'sftp',
|
||||
ccon => 'console',
|
||||
);
|
||||
|
||||
output '=over';
|
||||
|
||||
for my $util (sort grep { !/$Script/ } keys %utils) {
|
||||
output "=item $util - ".$self->loc(
|
||||
q{Use '[_1]' as the communication method}, $utils{$util}
|
||||
);
|
||||
for my $util ( sort grep { !/$Script/ } keys %utils ) {
|
||||
output "=item $util - "
|
||||
. $self->loc( q{Use '[_1]' as the communication method},
|
||||
$utils{$util} );
|
||||
}
|
||||
|
||||
output '=back';
|
||||
|
|
@ -585,7 +585,9 @@ would replace the <Alt-n> with the client's name in each window.}
|
|||
output '=item ', $self->parent->config->{key_user_2} || 'Alt-2';
|
||||
output '=item ', $self->parent->config->{key_user_3} || 'Alt-3';
|
||||
output '=item ', $self->parent->config->{key_user_4} || 'Alt-4';
|
||||
output $self->loc(q{Run the matching user defined macro on the server and send the output to the client});
|
||||
output $self->loc(
|
||||
q{Run the matching user defined macro on the server and send the output to the client}
|
||||
);
|
||||
|
||||
output '=back';
|
||||
|
||||
|
|
@ -710,7 +712,8 @@ command_post= | ct
|
|||
|
||||
would allow for using Python virtual envronments and then piping all shell output through C<chromaterm> for syntax highlighting. Note: you must use appropriate command separators/terminators to keep the meaning of the command pipline (such as C<;> and C<|> between commands).
|
||||
|
||||
These are not put through macro parsing.});
|
||||
These are not put through macro parsing.}
|
||||
);
|
||||
output '=item comms = ' . $self->parent->config->{comms};
|
||||
output $self->loc(
|
||||
'Sets the default communication method (initially taken from the name of the program, but can be overridden here).'
|
||||
|
|
@ -813,7 +816,8 @@ If the external command is given a C<-L> option it should output a list of tags
|
|||
output '=item key_user_4 = Alt-4';
|
||||
output $self->loc(
|
||||
q{Default key sequence to send user defined macros to client. If the matching [_2] macro is undefined, the sequence is passed straight to the terminal. See [_1] for more information.},
|
||||
'L<KEY SHORTCUTS>', 'L<macro_user_1>'
|
||||
'L<KEY SHORTCUTS>',
|
||||
'L<macro_user_1>'
|
||||
);
|
||||
|
||||
output '=item macro_servername = %s';
|
||||
|
|
@ -852,7 +856,9 @@ If the external command is given a C<-L> option it should output a list of tags
|
|||
},
|
||||
);
|
||||
|
||||
output $self->loc("The following environment variables are set in the shell of the macro process");
|
||||
output $self->loc(
|
||||
"The following environment variables are set in the shell of the macro process"
|
||||
);
|
||||
output '=over';
|
||||
output '=item C<CSSH_SERVERNAME>';
|
||||
output '=item C<CSSH_HOSTNAME>';
|
||||
|
|
|
|||
|
|
@ -21,7 +21,6 @@ use base 'App::ClusterSSH::L10N';
|
|||
|
||||
1;
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
No method are exported. See L<Locale::Maketext>.
|
||||
|
|
|
|||
|
|
@ -29,8 +29,9 @@ sub import {
|
|||
|
||||
# If we are building or in test here, just exit
|
||||
# as the build servers will not have Tk installed
|
||||
if ($ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING}) {
|
||||
print STDERR "skipping initialisation; AUTHOR_TESTING or RELEASE_TESTING are set\n";
|
||||
if ( $ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING} ) {
|
||||
print STDERR
|
||||
"skipping initialisation; AUTHOR_TESTING or RELEASE_TESTING are set\n";
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ use base qw/ App::ClusterSSH::Base /;
|
|||
use vars qw/ %keysymtocode %keycodetosym /;
|
||||
|
||||
use Sys::Hostname qw/ hostname /;
|
||||
use File::Temp qw/:POSIX/;
|
||||
use File::Temp qw/:POSIX/;
|
||||
use Fcntl;
|
||||
use POSIX ":sys_wait_h";
|
||||
use POSIX qw/:sys_wait_h strftime mkfifo/;
|
||||
|
|
@ -27,14 +27,14 @@ use X11::Protocol::Constants qw/ Shift Mod5 ShiftMask /;
|
|||
use X11::Protocol::WM 29;
|
||||
use X11::Keysyms '%keysymtocode', 'MISCELLANY', 'XKB_KEYS', '3270', 'LATIN1',
|
||||
'LATIN2', 'LATIN3', 'LATIN4', 'KATAKANA', 'ARABIC', 'CYRILLIC', 'GREEK',
|
||||
'TECHNICAL', 'SPECIAL', 'PUBLISHING', 'APL', 'HEBREW', 'THAI', 'KOREAN';
|
||||
'TECHNICAL', 'SPECIAL', 'PUBLISHING', 'APL', 'HEBREW', 'THAI', 'KOREAN';
|
||||
|
||||
# Module to contain all Tk specific functionality
|
||||
|
||||
my %windows; # hash for all window definitions
|
||||
my %menus; # hash for all menu definitions
|
||||
my @servers; # array of servers provided on cmdline
|
||||
my %servers; # hash of server cx info
|
||||
my %windows; # hash for all window definitions
|
||||
my %menus; # hash for all menu definitions
|
||||
my @servers; # array of servers provided on cmdline
|
||||
my %servers; # hash of server cx info
|
||||
my $xdisplay;
|
||||
my %keyboardmap;
|
||||
my $sysconfigdir = "/etc";
|
||||
|
|
@ -185,8 +185,8 @@ sub open_client_windows(@) {
|
|||
$servers{$server}{realname} = $realname;
|
||||
$servers{$server}{username} = $self->config->{user};
|
||||
$servers{$server}{username} = $username if ($username);
|
||||
$servers{$server}{username} = $username || '';
|
||||
$servers{$server}{port} = $port || '';
|
||||
$servers{$server}{username} = $username || '';
|
||||
$servers{$server}{port} = $port || '';
|
||||
$servers{$server}{master} = $self->config->{mstr} || '';
|
||||
$servers{$server}{master} = $master if ($master);
|
||||
|
||||
|
|
@ -348,7 +348,8 @@ sub add_host_by_name() {
|
|||
if ( $menus{host_entry} ) {
|
||||
$self->debug( 2, "host=", $menus{host_entry} );
|
||||
my @names
|
||||
= $self->parent->resolve_names( split( /\s+/, $menus{host_entry} ) );
|
||||
= $self->parent->resolve_names(
|
||||
split( /\s+/, $menus{host_entry} ) );
|
||||
$self->debug( 0, 'Opening to: ', join( ' ', @names ) ) if (@names);
|
||||
$self->open_client_windows(@names);
|
||||
}
|
||||
|
|
@ -435,8 +436,9 @@ sub load_keyboard_map() {
|
|||
|
||||
# keyboard layout contains the keycode at $modifier level
|
||||
if (defined(
|
||||
$keyboardmap{ $keycodetosym{ $keyboard[$i][$modifier]
|
||||
} }
|
||||
$keyboardmap{
|
||||
$keycodetosym{ $keyboard[$i][$modifier] }
|
||||
}
|
||||
)
|
||||
)
|
||||
{
|
||||
|
|
@ -627,46 +629,48 @@ sub substitute_macros {
|
|||
$ENV{CSSH_CONNECTION_PORT} = $servers{$svr}{port};
|
||||
|
||||
# Set up environment variables in the macro environment
|
||||
for my $i (qw/ 1 2 3 4 / ) {
|
||||
my $macro_user_command = 'macro_user_'.$i.'_command';
|
||||
my $macro_user = $self->config->{'macro_user_'.$i};
|
||||
for my $i (qw/ 1 2 3 4 /) {
|
||||
my $macro_user_command = 'macro_user_' . $i . '_command';
|
||||
my $macro_user = $self->config->{ 'macro_user_' . $i };
|
||||
|
||||
next unless $text =~ $macro_user;
|
||||
if( ! $self->config->{ $macro_user_command } ) {
|
||||
if ( !$self->config->{$macro_user_command} ) {
|
||||
$text =~ s/$macro_user//xsmg;
|
||||
next;
|
||||
}
|
||||
|
||||
my $cmd = $self->config->{ $macro_user_command };
|
||||
my $cmd = $self->config->{$macro_user_command};
|
||||
|
||||
local $SIG{CHLD} = undef;
|
||||
|
||||
my $stderr_fh = gensym;
|
||||
my $stdout_fh = gensym;
|
||||
my $child_pid = eval { open3(undef, $stdout_fh, $stderr_fh, $cmd) };
|
||||
my $child_pid = eval { open3( undef, $stdout_fh, $stderr_fh, $cmd ) };
|
||||
|
||||
if (my $err=$@) {
|
||||
# error message is hardcoded into open3 - tidy it up a little for our users
|
||||
$err=~ s/ at .*//;
|
||||
$err=~ s/open3: //;
|
||||
if ( my $err = $@ ) {
|
||||
|
||||
# error message is hardcoded into open3 - tidy it up a little for our users
|
||||
$err =~ s/ at .*//;
|
||||
$err =~ s/open3: //;
|
||||
$err =~ s/( failed)/' $1/;
|
||||
$err =~ s/(exec of) /$1 '/;
|
||||
warn "Macro failure for '$macro_user_command': $err";
|
||||
next;
|
||||
}
|
||||
waitpid($child_pid, 0);
|
||||
waitpid( $child_pid, 0 );
|
||||
my $cmd_rc = $? >> 8;
|
||||
|
||||
my @stdout = <$stdout_fh>;
|
||||
my @stderr = <$stderr_fh>;
|
||||
|
||||
if ( $cmd_rc > 0 || @stderr ){
|
||||
warn "Macro failure for '$macro_user_command'",$/;
|
||||
if ( $cmd_rc > 0 || @stderr ) {
|
||||
warn "Macro failure for '$macro_user_command'", $/;
|
||||
warn "Exited with error output:: @stderr" if @stderr;
|
||||
warn "Exited with non-zero return code: $cmd_rc", $/ if $cmd_rc;
|
||||
} else {
|
||||
}
|
||||
else {
|
||||
#$self->send_text_to_all_servers( $stdout );
|
||||
return join('', @stdout);
|
||||
return join( '', @stdout );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1204,7 +1208,8 @@ sub setup_repeat() {
|
|||
|
||||
for ($cmd) {
|
||||
if (m/^open$/) {
|
||||
my @new_hosts = $self->parent->resolve_names(@tags);
|
||||
my @new_hosts
|
||||
= $self->parent->resolve_names(@tags);
|
||||
$self->open_client_windows(@new_hosts);
|
||||
$self->build_hosts_menu();
|
||||
last;
|
||||
|
|
@ -1275,16 +1280,17 @@ sub setup_repeat() {
|
|||
### Window and menu definitions ###
|
||||
|
||||
sub create_windows() {
|
||||
my ($self) = @_;
|
||||
my ($self) = @_;
|
||||
my ($screen_height) = $xdisplay->{height_in_pixels};
|
||||
my ($screen_width) = $xdisplay->{width_in_pixels};
|
||||
my ($screen_width) = $xdisplay->{width_in_pixels};
|
||||
$self->debug( 2, "create_windows: started" );
|
||||
|
||||
$windows{main_window}
|
||||
= MainWindow->new( -title => "ClusterSSH", -class => 'cssh', );
|
||||
if ($screen_height * $screen_width >= 8294400) # display 4k or bigger
|
||||
if ( $screen_height * $screen_width >= 8294400 ) # display 4k or bigger
|
||||
{
|
||||
$windows{main_window}->optionAdd('*font', 'Nimbus 14'); # better for 4k displays
|
||||
$windows{main_window}->optionAdd( '*font', 'Nimbus 14' )
|
||||
; # better for 4k displays
|
||||
}
|
||||
$windows{main_window}->withdraw; # leave withdrawn until needed
|
||||
|
||||
|
|
@ -1564,7 +1570,7 @@ sub key_event {
|
|||
my $keycode = $Tk::event->k;
|
||||
my $keysymdec = $Tk::event->N;
|
||||
my $keysym = $Tk::event->K;
|
||||
my $state = $Tk::event->s || 0;
|
||||
my $state = $Tk::event->s || 0;
|
||||
|
||||
$menus{entrytext} = "";
|
||||
|
||||
|
|
|
|||
46
t/02base.t
46
t/02base.t
|
|
@ -21,10 +21,10 @@ 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' );
|
||||
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,
|
||||
|
|
@ -114,10 +114,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,
|
||||
|
|
@ -246,8 +246,8 @@ trap {
|
|||
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' );
|
||||
is( $trap->die, q{"type" arg not passed}, 'missing type arg die message' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
|
||||
my $get_options;
|
||||
|
||||
|
|
@ -341,7 +341,7 @@ trap {
|
|||
# $trap->quiet("No errors getting 'sort'");
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( ref($sort), 'CODE', "got results from sort" );
|
||||
is( ref($sort), 'CODE', "got results from sort" );
|
||||
@sorted = $sort->( 4, 8, 1, 5, 3 );
|
||||
@expected = ( 1, 3, 4, 5, 8 );
|
||||
is_deeply( \@sorted, \@expected, "simple sort results okay" );
|
||||
|
|
|
|||
|
|
@ -188,7 +188,7 @@ 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' );
|
||||
@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, );
|
||||
|
|
@ -295,7 +295,7 @@ $getopts->add_option(
|
|||
default => 'default string'
|
||||
);
|
||||
$getopts->add_option( spec => 'another_long_opt|n=i', );
|
||||
$getopts->add_option( spec => 'a=s', help => 'short option only', );
|
||||
$getopts->add_option( spec => 'a=s', help => 'short option only', );
|
||||
$getopts->add_option( spec => 'long', help => 'long option only', );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -380,8 +380,8 @@ 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',
|
||||
'--unique-servers', '--title', 'title', '-p', '22', '--autoquit',
|
||||
'--tile', '--show-history', '-A',
|
||||
);
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
|
|
@ -425,7 +425,7 @@ TODO: {
|
|||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
}
|
||||
|
||||
@ARGV = ( '--rows', 5, '--cols', 10 );
|
||||
@ARGV = ( '--rows', 5, '--cols', 10 );
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
|
|||
|
|
@ -754,7 +754,7 @@ is( $trap->leaveby, 'return', 'returned ok' );
|
|||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'No unexpected STDOUT' );
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host->check_ssh_hostname, 0, 'check_ssh_hostname ok for ssh_test', );
|
||||
|
||||
trap {
|
||||
|
|
@ -767,9 +767,9 @@ is( $trap->leaveby, 'return', 'returned ok' );
|
|||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'No unexpected STDOUT' );
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host->check_ssh_hostname, 0, 'check_ssh_hostname ok for ssh_test', );
|
||||
is( $host->get_type, q{}, 'hostname type is correct for ssh_test', );
|
||||
is( $host->get_type, q{}, 'hostname type is correct for ssh_test', );
|
||||
|
||||
for my $ssh_file (qw/ 10host_ssh_config 10host_ssh_include/) {
|
||||
my @hosts = (
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ BEGIN {
|
|||
use Test::More;
|
||||
use Test::Trap;
|
||||
use File::Which qw(which);
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Temp qw(tempdir);
|
||||
use Test::Differences;
|
||||
|
||||
use Readonly;
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ use lib "$Bin/../lib";
|
|||
use Test::More;
|
||||
use Test::Trap;
|
||||
use File::Which qw(which);
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Temp qw(tempdir);
|
||||
|
||||
use Readonly;
|
||||
|
||||
|
|
@ -81,7 +81,7 @@ trap {
|
|||
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' );
|
||||
is( $trap->die, q{Config 'method_args' not provided}, 'missing arg' );
|
||||
|
||||
$mock_config->{method_args} = 'rubbish';
|
||||
$mock_config->{command} = 'echo';
|
||||
|
|
|
|||
|
|
@ -3,6 +3,6 @@
|
|||
# small 'fake' script to allow xterm to be found when performing tests
|
||||
# on systems that do not have it
|
||||
|
||||
warn "$_=$ENV{$_}",$/ for (sort keys %ENV) if ( $ENV{TEST_VERBOSE} );;
|
||||
warn "$_=$ENV{$_}", $/ for ( sort keys %ENV ) if ( $ENV{TEST_VERBOSE} );
|
||||
|
||||
exit 0
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@ if ( $opt->{x} ) {
|
|||
|
||||
# '-L' means list out available tags
|
||||
if ( $opt->{L} ) {
|
||||
print join(' ', sort keys %tag_lookup), $/;
|
||||
print join( ' ', sort keys %tag_lookup ), $/;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@ use warnings;
|
|||
use Test::More;
|
||||
|
||||
eval "use Test::Pod::Coverage 1.00";
|
||||
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
|
||||
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
|
||||
if $@;
|
||||
|
||||
plan skip_all => "Skipping coverage tests" unless $ENV{COVERAGE};
|
||||
|
||||
|
|
|
|||
26
t/range.t
26
t/range.t
|
|
@ -13,19 +13,19 @@ require_ok('App::ClusterSSH::Range')
|
|||
|| BAIL_OUT('Failed to use App::ClusterSSH::Range');
|
||||
|
||||
my %tests = (
|
||||
'a' => 'a',
|
||||
'c{a,b}' => 'ca cb',
|
||||
'd{a,b,c}' => 'da db dc',
|
||||
'e{0}' => 'e0',
|
||||
'f{0..3}' => 'f0 f1 f2 f3',
|
||||
'g{0..2,4}' => 'g0 g1 g2 g4',
|
||||
'h{0..2,4..6}' => 'h0 h1 h2 h4 h5 h6',
|
||||
'i{0..1,a}' => 'i0 i1 ia',
|
||||
'j{0..2,a,b,c}' => 'j0 j1 j2 ja jb jc',
|
||||
'k{4..6,a..c}' => 'k4 k5 k6 ka kb kc',
|
||||
'l{0..2,7..9,e..g}' => 'l0 l1 l2 l7 l8 l9 le lf lg',
|
||||
'm{0,1}' => 'm0 m1',
|
||||
'n0..2}' => 'n0..2}',
|
||||
'a' => 'a',
|
||||
'c{a,b}' => 'ca cb',
|
||||
'd{a,b,c}' => 'da db dc',
|
||||
'e{0}' => 'e0',
|
||||
'f{0..3}' => 'f0 f1 f2 f3',
|
||||
'g{0..2,4}' => 'g0 g1 g2 g4',
|
||||
'h{0..2,4..6}' => 'h0 h1 h2 h4 h5 h6',
|
||||
'i{0..1,a}' => 'i0 i1 ia',
|
||||
'j{0..2,a,b,c}' => 'j0 j1 j2 ja jb jc',
|
||||
'k{4..6,a..c}' => 'k4 k5 k6 ka kb kc',
|
||||
'l{0..2,7..9,e..g}' => 'l0 l1 l2 l7 l8 l9 le lf lg',
|
||||
'm{0,1}' => 'm0 m1',
|
||||
'n0..2}' => 'n0..2}',
|
||||
'host{a,b}-test{1,2}' =>
|
||||
'hosta-test1 hosta-test2 hostb-test1 hostb-test2',
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue