view release on metacpan or  search on metacpan

lib/App/ClusterSSH.pm  view on Meta::CPAN

            $self->debug( 2, "REAPER currently returns: $kid" );
        } until ( $kid == -1 || $kid == 0 );
    };

    return $self;
}

sub config {
    my ($self) = @_;
    return $self->{config};
}

sub cluster {
    my ($self) = @_;
    return $self->{cluster};
}

sub helper {
    my ($self) = @_;
    return $self->{helper};
}

sub options {
    my ($self) = @_;
    return $self->{options};
}

sub getopts {
    my ($self) = @_;
    return $self->options->getopts;
}

sub add_option {
    my ( $self, %args ) = @_;
    return $self->{options}->add_option(%args);
}

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";
my %ssh_hostnames;
my $host_menu_static_items;    # number of items in the host menu that should
                               # not be touched by build_host_menu
my (@dead_hosts);              # list of hosts whose sessions are now closed
my $sort = sub { sort @_ };   # reference to our sort function which may later
                              # be changed in run() if the user has asked for
                              # natural sorting

$keysymtocode{unknown_sym} = 0xFFFFFF;    # put in a default "unknown" entry
$keysymtocode{EuroSign}
    = 0x20AC;    # Euro sign - missing from X11::Protocol::Keysyms

# and also map it the other way
%keycodetosym = reverse %keysymtocode;

# Set up UTF-8 on STDOUT
binmode STDOUT, ":utf8";

#use bytes;

### all sub-routines ###

# Pick a color based on a string.
sub pick_color {
    my ($string)   = @_;
    my @components = qw(AA BB CC EE);
    my $color      = 0;
    for ( my $i = 0; $i < length($string); $i++ ) {
        $color += ord( substr( $string, $i, 1 ) );
    }

    srand($color);
    my $ans = '\\#';
    $ans .= $components[ int( 4 * rand() ) ];
    $ans .= $components[ int( 4 * rand() ) ];
    $ans .= $components[ int( 4 * rand() ) ];
    return $ans;
}

# close a specific host session
sub terminate_host($) {
    my ( $self, $svr ) = @_;
    $self->debug( 2, "Killing session for $svr" );
    if ( !$servers{$svr} ) {
        $self->debug( 2, "Session for $svr not found" );
        return;
    }

    $self->debug( 2, "Killing process $servers{$svr}{pid}" );
    kill( 9, $servers{$svr}{pid} ) if kill( 0, $servers{$svr}{pid} );
    delete( $servers{$svr} );
    return $self;
}

# catch_all exit routine that should always be used
sub exit_prog() {
    my ($self) = @_;
    $self->debug( 3, "Exiting via normal routine" );

    if ( $self->config->{external_command_pipe}
        && -e $self->config->{external_command_pipe} )
    {
        close( $self->{external_command_pipe_fh} )
            or warn(
            "Could not close pipe "
                . $self->config->{external_command_pipe} . ": ",
            $!
            );
        $self->debug( 2, "Removing external command pipe" );
        unlink( $self->config->{external_command_pipe} )
            || warn "Could not unlink "
            . $self->config->{external_command_pipe}
            . ": ", $!;
    }

    # for each of the client windows, send a kill.
    # to make sure we catch all children, even when they haven't