Compare commits

..

No commits in common. "master" and "v4.15" have entirely different histories.

27 changed files with 190 additions and 271 deletions

View file

@ -1,68 +0,0 @@
name: CI test builds
on:
push:
branches: '*'
pull_request:
branches: '*'
jobs:
perl-job:
runs-on: ubuntu-latest
strategy:
fail-fast: false
matrix:
perl-version:
- 'devel'
- 'latest'
- '5.40'
- '5.38'
- '5.36'
- '5.34'
- '5.32'
- '5.30'
- '5.28'
- '5.26'
- '5.24'
- '5.22'
- '5.20'
- '5.18'
- '5.16'
include:
- perl-version: '5.38'
os: ubuntu-latest
coverage: true
container:
image: perldocker/perl-tester:${{ matrix.perl-version }}
name: Perl ${{ matrix.perl-version }}
steps:
- uses: actions/checkout@main
- name: Amend PATH
run: echo "${GITHUB_WORKSPACE}/t/bin" >> $GITHUB_PATH
- name: Current env
run: env
- name: Perl info
run: perl -V
- name: CPAN test modules
run: cpanm -n Pod::Coverage::TrustPod Test::Perl::Critic Test::Pod::Coverage Test::Pod Test::Trap
- name: CPAN build modules
run: cpanm -n Tk X11::Protocol X11::Protocol::Other
- name: Initial Build
run: perl Build.PL
- name: Build the MANIFEST
run: perl Build manifest
- name: Test suite
if: ${{ !matrix.coverage }}
run: perl Build test
env:
RELEASE_TESTING: 1
AUTHOR_TESTING: 1
- name: Coverage tests
if: ${{ matrix.coverage }}
run: perl Build test
env:
COVERAGE: 1
RELEASE_TESTING: 1
AUTHOR_TESTING: 1

32
.travis.yml Normal file
View file

@ -0,0 +1,32 @@
language: perl
perl:
- blead
- dev
# No clean build due to removal of '.' from lib path
# - 5.26
- 5.24
- 5.22
- 5.20
- 5.18
- 5.16
- 5.14
- 5.12
- 5.10
# stopping builds; is anyone really still using this version?
# - 5.8
matrix:
include:
- perl: 5.24
env: COVERAGE=1
allow_failures:
- perl: blead
- perl: blead-thr
- perl: dev
sudo: false
env:
global:
- RELEASE_TESTING=1
- AUTHOR_TESTING=1
before_install:
- eval $(curl https://travis-perl.github.io/init) --auto
- cpanm -n -f Pod::Coverage::TrustPod Test::Perl::Critic Test::Pod::Coverage Test::Pod

View file

@ -3,8 +3,7 @@ use lib 'inc';
require Module::Build;
my %module_build_args = (
module_name => 'App::ClusterSSH',
dist_abstract => "Cluster administration tool",
module_name => 'App::ClusterSSH',
##{ $plugin->get_prereqs(1) ##}
##{ $plugin->get_default('share_dir') ##}
script_files => [
@ -12,7 +11,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',

12
Changes
View file

@ -1,17 +1,5 @@
Revision history for {{$dist->name}}
4.18 2024-10-19 Duncan Ferguson <duncan_ferguson@user.sf.net>
- Re-release due to poor release upload to CPAN
4.17 2024-10-16 Duncan Ferguson <duncan_ferguson@user.sf.net>
- Swap the hostname lookup macro from DNS to using the system hostname (Github issue #158)
- Swap from using Travis-CI to Github Actions
- Fix tests on perl 5.38 and 5.40 (Github Issue #153)
4.16 2020-06-20 Duncan Ferguson <duncan_ferguson@user.sf.net>
- Further fix for 'resolve_names' error when adding hosts via the UI
- Fix missing space separator for ssh_args (thanks to Petr Vorel)
4.15 2020-05-18 Duncan Ferguson <duncan_ferguson@user.sf.net>
- Include all utilies within each man page
- Add in 'command_pre' and 'command_post' configuration options

2
README
View file

@ -2,7 +2,7 @@ NAME
cssh - Cluster administration tool
VERSION
This documentation is for version: 4.18
This documentation is for version: 4.15
SYNOPSIS
cssh [-a '<command>'] [-K <seconds>] [-q] [-c '<filename>'] [-x <cols>]

1
THANKS
View file

@ -48,4 +48,3 @@ Bill Rushmore
Ankit Vadehra
Azenet
Markus Frosch (lazyfrosch)
Petr Vorel

View file

@ -6,42 +6,41 @@ 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: $!";
}

View file

@ -15,9 +15,7 @@ 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();

View file

@ -1,12 +1,11 @@
use warnings;
use strict;
package App::ClusterSSH;
# ABSTRACT: Cluster administration tool
# ABSTRACT: Cluster administration tool
use version; our $VERSION = version->new('4.18');
use version; our $VERSION = version->new('4.15');
=head1 SYNOPSIS
@ -41,7 +40,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;
@ -486,6 +485,7 @@ sub run {
1;
=item REAPER
=item add_host_by_name
@ -593,7 +593,7 @@ slash_slash_equal($a, 0) is equivalent to $a //= 0
=item window
Method to access associated window module
Method to access assosiated window module
=item write_default_user_config

View file

@ -304,13 +304,15 @@ sub parent {
sub sort {
my $self = shift;
my $sort = sub { sort @_ };
return $sort
unless ref( $self->config() ) eq "HASH"
&& $self->config()->{'use_natural_sort'};
# if the user has asked for natural sorting we need to include an extra
# module
my $config = $self->config();
# Make sure the configuration object has been set correctly before
# referencing anything
if ( ref $config eq "HASH" && $config->{'use_natural_sort'} ) {
if ( $self->config()->{'use_natural_sort'} ) {
eval { Module::Load::load('Sort::Naturally'); };
if ($@) {
warn(
@ -318,17 +320,16 @@ sub sort {
);
}
else {
my $sort = sub { Sort::Naturally::nsort(@_) };
return $sort;
$sort = sub { Sort::Naturally::nsort(@_) };
}
}
my $sort = sub { sort @_ };
return $sort;
}
1;
=head1 METHODS
These extra methods are provided on the object

View file

@ -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";

View file

@ -114,11 +114,10 @@ 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 => '',
max_addhost_menu_cluster_items => 6,
menu_send_autotearoff => 0,
@ -298,7 +297,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 +314,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 );
}
# write out default config file if necesasry
@ -330,22 +329,10 @@ 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 );
my $file = $ENV{HOME} . '/.clusterssh/config_' . $config;
$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) } ) {
$env_config_key = uc($env_config_key);
}
if ( exists $ENV{$env_config_key} ) {
$self->{$config_key} = $ENV{$env_config_key};
}
$self->parse_config_file($file) if ( -e $file );
}
return $self;

View file

@ -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,9 +585,7 @@ 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';
@ -712,8 +710,7 @@ 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).'
@ -816,8 +813,7 @@ 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';
@ -856,9 +852,7 @@ 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>';

View file

@ -71,9 +71,9 @@ sub script {
my \$user=shift;
my \$port=shift;
my \$mstr=shift;
my \$command="$command_pre $comms $comms_args ";
my \$command="$command_pre $comms $comms_args";
open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
print PIPE "\$\$:\$ENV{WINDOWID}"
print PIPE "\$\$:\$ENV{WINDOWID}"
or die("Failed to write to pipe: $!\\n");
close(PIPE) or die("Failed to close pipe: $!\\n");
if(\$svr =~ m/==\$/)

View file

@ -381,7 +381,7 @@ Set specific details about the host after its been created.
=item get_realname
If the server name provided is not an IP address (either IPv4 or IPv6)
attempt to resolve it and return the discovered names.
attempt to resolve it and retun the discovered names.
=item get_givenname

View file

@ -21,6 +21,7 @@ use base 'App::ClusterSSH::L10N';
1;
=head1 METHODS
No method are exported. See L<Locale::Maketext>.

View file

@ -28,12 +28,8 @@ sub import {
my ($class) = @_;
# 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";
return;
}
# as travis build servers will not have Tk installed
return if $ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING};
# Find what windows module we should be using and just overlay it into
# this object

View file

@ -10,8 +10,8 @@ use English qw( -no_match_vars );
use base qw/ App::ClusterSSH::Base /;
use vars qw/ %keysymtocode %keycodetosym /;
use Sys::Hostname qw/ hostname /;
use File::Temp qw/:POSIX/;
use Net::Domain qw(hostfqdn);
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,8 +348,7 @@ 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);
}
@ -357,7 +356,7 @@ sub add_host_by_name() {
if ( defined $menus{listbox} && $menus{listbox}->curselection() ) {
my @hosts = $menus{listbox}->get( $menus{listbox}->curselection() );
$self->debug( 2, "host=", join( ' ', @hosts ) );
$self->open_client_windows( $self->parent->resolve_names(@hosts) );
$self->open_client_windows( $self->resolve_names(@hosts) );
}
$self->build_hosts_menu();
@ -436,9 +435,8 @@ sub load_keyboard_map() {
# keyboard layout contains the keycode at $modifier level
if (defined(
$keyboardmap{
$keycodetosym{ $keyboard[$i][$modifier] }
}
$keyboardmap{ $keycodetosym{ $keyboard[$i][$modifier]
} }
)
)
{
@ -603,7 +601,7 @@ sub substitute_macros {
}
{
my $macro_hostname = $self->config->{macro_hostname};
my $hostname = $self->config->{hostname_override} || hostname();
my $hostname = hostfqdn();
$text =~ s!$macro_hostname!$hostname!xsmg;
$ENV{CSSH_HOSTNAME} = $hostname;
}
@ -629,48 +627,46 @@ 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);
}
}
@ -1208,8 +1204,7 @@ sub setup_repeat() {
for ($cmd) {
if (m/^open$/) {
my @new_hosts
= $self->parent->resolve_names(@tags);
my @new_hosts = $self->resolve_names(@tags);
$self->open_client_windows(@new_hosts);
$self->build_hosts_menu();
last;
@ -1280,18 +1275,11 @@ sub setup_repeat() {
### Window and menu definitions ###
sub create_windows() {
my ($self) = @_;
my ($screen_height) = $xdisplay->{height_in_pixels};
my ($screen_width) = $xdisplay->{width_in_pixels};
my ($self) = @_;
$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
{
$windows{main_window}->optionAdd( '*font', 'Nimbus 14' )
; # better for 4k displays
}
$windows{main_window}->withdraw; # leave withdrawn until needed
if ( defined( $self->config->{console_position} )
@ -1570,7 +1558,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} = "";

View file

@ -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" );

View file

@ -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;

View file

@ -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 = (

View file

@ -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;
@ -101,8 +101,6 @@ Readonly::Hash my %default_config => {
history_width => 40,
history_height => 10,
hostname_override => '',
command => q{},
command_pre => q{},
command_post => q{},
@ -537,7 +535,7 @@ SKIP: {
chmod( 0755, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
}
note('check failure to write default config is caught when loading config');
note('check failure to write default config is caught');
$ENV{HOME} = tempdir( CLEANUP => 1 );
mkdir( $ENV{HOME} . '/.clusterssh' );
mkdir( $ENV{HOME} . '/.clusterssh/config' );
@ -582,7 +580,6 @@ fillscreen=no
hide_menu=0
history_height=10
history_width=40
hostname_override=
key_addhost=Control-Shift-plus
key_clientname=Alt-n
key_history=Alt-h

View file

@ -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';

View file

@ -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

View file

@ -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;
}

View file

@ -2,10 +2,18 @@ use strict;
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"
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all =>
"Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
plan skip_all => "Skipping coverage tests" unless $ENV{COVERAGE};
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();

View file

@ -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',