Re-release/version bump

Re-release due to poor release upload to CPAN (4.17)

.github/workflows/dzil_tester.yml

@@ -0,0 +1,68 @@
+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

.travis.yml

@@ -1,32 +0,0 @@
-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

Build.PL

@@ -3,7 +3,8 @@ 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') ##}
     script_files => [
@@ -11,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',

Changes

@@ -1,5 +1,24 @@
 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
+- Fix 'Add Host' menu error finding 'resolved_names'
+- Ensure lib path is added to range tests to find the libraries
+- Mark permission test as TODO as it appears to be inconsistent
+
 4.14 2019-08-21 Duncan Ferguson <duncan_ferguson@user.sf.net>
 - Include README within the repository, not just created tar.gz files
 - Add 'autoquit' setting to 'File' menu (Github issue #114)

README

@@ -2,7 +2,7 @@ NAME
     cssh - Cluster administration tool
 
 VERSION
-    This documentation is for version: 4.14
+    This documentation is for version: 4.18
 
 SYNOPSIS
     cssh [-a '<command>'] [-K <seconds>] [-q] [-c '<filename>'] [-x <cols>]
@@ -12,6 +12,14 @@ SYNOPSIS
     [-t '<STRING>'] [-g] [-T '<title>'] [-u] [-?] [-A] [-l '<username>']
     [-v]
 
+RELATED
+    Also see the individual man pages for each of these utilities
+
+    ccon - Use 'console' as the communication method
+    crsh - Use 'rsh' as the communication method
+    csftp - Use 'sftp' as the communication method
+    ctel - Use 'telnet' as the communication method
+
 DESCRIPTION
     The command opens an administration console and an xterm to all
     specified hosts. Any text typed into the administration console is
@@ -338,6 +346,21 @@ FILES
             Enable or disable alternative algorithm for calculating terminal
             positioning.
 
+        command_pre =
+        command_post =
+            Add extra commands around the communication method. For example:
+
+            command_pre= . $HOME/virtualenvs/default/bin/active ;
+            command_post= | ct
+
+            would allow for using Python virtual envronments and then piping
+            all shell output through "chromaterm" for syntax highlighting.
+            Note: you must use appropriate command separators/terminators to
+            keep the meaning of the command pipline (such as ";" and "|"
+            between commands).
+
+            These are not put through macro parsing.
+
         comms = ssh
             Sets the default communication method (initially taken from the
             name of the program, but can be overridden here).

THANKS

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

bin_PL/_build_docs

@@ -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: $!";
 }

bin_PL/ccon

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

lib/App/ClusterSSH.pm

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

lib/App/ClusterSSH/Base.pm

@@ -304,15 +304,13 @@ 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
-    if ( $self->config()->{'use_natural_sort'} ) {
+    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'} ) {
         eval { Module::Load::load('Sort::Naturally'); };
         if ($@) {
             warn(
@@ -320,16 +318,17 @@ sub sort {
             );
         }
         else {
-            $sort = sub { Sort::Naturally::nsort(@_) };
+            my $sort = sub { Sort::Naturally::nsort(@_) };
+            return $sort;
         }
     }
 
+    my $sort = sub { sort @_ };
     return $sort;
 }
 
 1;
 
-
 =head1 METHODS
 
 These extra methods are provided on the object

lib/App/ClusterSSH/Cluster.pm

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

lib/App/ClusterSSH/Config.pm

@@ -98,6 +98,8 @@ my %default_config = (
     history_height => 10,
 
     command             => q{},
+    command_pre         => q{},
+    command_post        => q{},
     hide_menu           => 0,
     max_host_menu_items => 30,
 
@@ -112,10 +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     => '',
+    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,
@@ -295,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}"};
         }
     }
@@ -312,7 +315,7 @@ sub load_configs {
         $ENV{HOME} . '/.clusterssh/config',
         )
     {
-        $self->parse_config_file($config) if ( -e $config );
+        $self->parse_config_file($config) if ( -e $config && !-d _ );
     }
 
     # write out default config file if necesasry
@@ -327,10 +330,22 @@ 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 );
+        $self->parse_config_file($config) if ( -e $config && !-d _ );
 
         my $file = $ENV{HOME} . '/.clusterssh/config_' . $config;
-        $self->parse_config_file($file) if ( -e $file );
+        $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};
+        }
     }
 
     return $self;

lib/App/ClusterSSH/Getopt.pm

@@ -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');
@@ -446,6 +446,28 @@ sub _generate_pod {
     }
     print $/, $/;
 
+    output '=head1 ', $self->loc('RELATED');
+    output $self->loc(
+        q{Also see the individual man pages for each of these utilities});
+
+    my %utils = (
+        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} );
+    }
+
+    output '=back';
+
     output '=head1 ', $self->loc('DESCRIPTION');
     output $self->loc(
         q{The command opens an administration console and an xterm to all specified hosts.  Any text typed into the administration console is replicated to all windows.  All windows may also be typed into directly.
@@ -563,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';
 
@@ -678,6 +702,18 @@ would replace the <Alt-n> with the client's name in each window.}
         'Enable or disable alternative algorithm for calculating terminal positioning.',
     );
 
+    output '=item command_pre =';
+    output '=item command_post =';
+    output $self->loc(
+        q{Add extra commands around the communication method.  For example:
+
+command_pre= . $HOME/virtualenvs/default/bin/active ;
+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.}
+    );
     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).'
@@ -780,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';
@@ -819,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>';

lib/App/ClusterSSH/Helper.pm

@@ -52,6 +52,8 @@ sub script {
         }
     }
 
+    my $command_pre    = $config->{command_pre}  || q{};
+    my $command_post   = $config->{command_post} || q{};
     my $comms          = $config->{ $config->{comms} };
     my $comms_args     = $config->{ $config->{comms} . '_args' };
     my $config_command = $config->{command};
@@ -69,9 +71,9 @@ sub script {
            my \$user=shift;
            my \$port=shift;
            my \$mstr=shift;
-           my \$command="$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/==\$/)
@@ -105,6 +107,7 @@ sub script {
            if("$config_command") {
             \$command .= " \\\"$config_command\\\"";
            }
+           \$command .= "$command_post";
            \$command .= " ; $postcommand";
            # provide some info for debugging purposes
            warn("Running: \$command\\n");

lib/App/ClusterSSH/Host.pm

@@ -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 retun the discovered names.
+attempt to resolve it and return the discovered names.
 
 =item get_givenname
 

lib/App/ClusterSSH/L10N/en.pm

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

lib/App/ClusterSSH/Window.pm

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

lib/App/ClusterSSH/Window/Tk.pm

@@ -10,8 +10,8 @@ use English qw( -no_match_vars );
 use base qw/ App::ClusterSSH::Base /;
 use vars qw/ %keysymtocode %keycodetosym /;
 
-use Net::Domain qw(hostfqdn);
-use File::Temp qw/:POSIX/;
+use Sys::Hostname qw/ hostname /;
+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);
 
@@ -314,6 +314,8 @@ sub set_half_inactive() {
     my ($self) = @_;
     $self->debug( 2, "Setting approx half of all hosts to inactive" );
 
+    return if !%servers;
+
     my (@keys) = keys(%servers);
     $#keys /= 2;
     foreach my $svr (@keys) {
@@ -346,7 +348,8 @@ sub add_host_by_name() {
     if ( $menus{host_entry} ) {
         $self->debug( 2, "host=", $menus{host_entry} );
         my @names
-            = $self->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);
     }
@@ -354,7 +357,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->resolve_names(@hosts) );
+        $self->open_client_windows( $self->parent->resolve_names(@hosts) );
     }
 
     $self->build_hosts_menu();
@@ -433,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] }
+                        }
                     )
                     )
                 {
@@ -599,7 +603,7 @@ sub substitute_macros {
     }
     {
         my $macro_hostname = $self->config->{macro_hostname};
-        my $hostname       = hostfqdn();
+        my $hostname       = $self->config->{hostname_override} || hostname();
         $text =~ s!$macro_hostname!$hostname!xsmg;
         $ENV{CSSH_HOSTNAME} = $hostname;
     }
@@ -625,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 );
         }
     }
 
@@ -1202,7 +1208,8 @@ sub setup_repeat() {
 
                         for ($cmd) {
                             if (m/^open$/) {
-                                my @new_hosts = $self->resolve_names(@tags);
+                                my @new_hosts
+                                    = $self->parent->resolve_names(@tags);
                                 $self->open_client_windows(@new_hosts);
                                 $self->build_hosts_menu();
                                 last;
@@ -1273,11 +1280,18 @@ 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};
     $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} )
@@ -1556,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} = "";
 

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

t/05getopts.t

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

t/10host.t

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

t/15config.t

@@ -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,7 +101,11 @@ Readonly::Hash my %default_config => {
     history_width  => 40,
     history_height => 10,
 
+    hostname_override => '',
+
     command             => q{},
+    command_pre         => q{},
+    command_post        => q{},
     title               => q{15CONFIG.T},
     comms               => q{ssh},
     hide_menu           => 0,
@@ -533,7 +537,7 @@ SKIP: {
     chmod( 0755, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
 }
 
-note('check failure to write default config is caught');
+note('check failure to write default config is caught when loading config');
 $ENV{HOME} = tempdir( CLEANUP => 1 );
 mkdir( $ENV{HOME} . '/.clusterssh' );
 mkdir( $ENV{HOME} . '/.clusterssh/config' );
@@ -564,6 +568,8 @@ auto_close=5
 auto_quit=yes
 auto_wm_decoration_offsets=no
 cols=-1
+command_post=
+command_pre=
 console=console
 console_args=
 console_position=
@@ -576,6 +582,7 @@ 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

t/20helper.t

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

t/30cluster.t

@@ -84,21 +84,23 @@ isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
 
 # no point running this test as root since root cannot be blocked
 # from accessing the file
-if ( $EUID != 0 ) {
-    my $no_read = $Bin . '/30cluster.cannot_read';
-    chmod 0000, $no_read;
-    trap {
-        $cluster1->read_cluster_file($no_read);
-    };
-    chmod 0644, $no_read;
-    isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
-    is( $trap->die,
-        "Unable to read file $no_read: Permission denied",
-        'Error on reading an existing file ok'
-    );
-}
-else {
-    pass('Cannot test for lack of read access when run as root');
+TODO: {
+    if ( $EUID != 0 ) {
+        my $no_read = $Bin . '/30cluster.cannot_read';
+        chmod 0000, $no_read;
+        trap {
+            $cluster1->read_cluster_file($no_read);
+        };
+        chmod 0644, $no_read;
+        isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
+        is( $trap->die,
+            "Unable to read file $no_read: Permission denied",
+            'Error on reading an existing file ok'
+        );
+    }
+    else {
+        pass('Cannot test for lack of read access when run as root');
+    }
 }
 
 $expected{tag1} = ['host1'];

t/bin/xterm

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

t/external_cluster_command

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

t/pod-coverage.t

@@ -2,18 +2,10 @@ use strict;
 use warnings;
 use Test::More;
 
-# 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"
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
     if $@;
 
-# 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 $@;
+plan skip_all => "Skipping coverage tests" unless $ENV{COVERAGE};
 
 all_pod_coverage_ok();

t/range.t

@@ -2,6 +2,9 @@
 use strict;
 use warnings;
 
+use FindBin qw($Bin);
+use lib "$Bin/../lib";
+
 use Test::More;
 use Test::Trap;
 use Data::Dump;
@@ -10,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',