amassivus/clusterssh
1
0
Fork 0
mirror of https://github.com/duncs/clusterssh.git synced 2025-07-03 18:03:23 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Run through 'perltidy -pbp'

Browse source
This commit is contained in:
duncan_ferguson 2009-03-09 19:02:51 +00:00
parent 6419df7107
commit 26f1230589
1 changed files with 1366 additions and 1330 deletions
Download patch file Download diff file Expand all files Collapse all files

284
clusterssh/src/cssh.pl
View file

@ -103,8 +103,8 @@ my %ssh_hostnames;
# Fudge to get X11::Keysyms working # Fudge to get X11::Keysyms working
%keysymtocode = %main::keysymtocode; %keysymtocode = %main::keysymtocode;
$keysymtocode{unknown_sym} = 0xFFFFFF; # put in a default "unknown" entry $keysymtocode{unknown_sym} = 0xFFFFFF; # put in a default "unknown" entry
$keysymtocode{EuroSign} = $keysymtocode{EuroSign}
0x20AC; # Euro sigyn - missing from X11::Protocol::Keysyms = 0x20AC; # Euro sigyn - missing from X11::Protocol::Keysyms
# and also map it the other way # and also map it the other way
%keycodetosym = reverse %keysymtocode; %keycodetosym = reverse %keysymtocode;
@ -117,20 +117,19 @@ binmode STDOUT, ":utf8";
### all sub-routines ### ### all sub-routines ###
# Pick a color based on a string. # Pick a color based on a string.
sub pick_color sub pick_color {
{ my ($string) = @_;
my($string) = @_;
my @components = qw(AA BB CC EE); my @components = qw(AA BB CC EE);
my $color = 0; my $color = 0;
for (my $i=0; $i<length($string); $i++) { for ( my $i = 0; $i < length($string); $i++ ) {
$color += ord(substr($string, $i, 1)); $color += ord( substr( $string, $i, 1 ) );
} }
srand($color); srand($color);
my $ans = '\\#'; my $ans = '\\#';
$ans .= $components[int(4 * rand())]; $ans .= $components[ int( 4 * rand() ) ];
$ans .= $components[int(4 * rand())]; $ans .= $components[ int( 4 * rand() ) ];
$ans .= $components[int(4 * rand())]; $ans .= $components[ int( 4 * rand() ) ];
return $ans; return $ans;
} }
@ -183,7 +182,8 @@ sub load_config_defaults() {
$config{terminal_title_opt} = "-T"; $config{terminal_title_opt} = "-T";
$config{terminal_colorize} = 1; $config{terminal_colorize} = 1;
$config{terminal_bg_style} = 'dark'; $config{terminal_bg_style} = 'dark';
$config{terminal_allow_send_events} = "-xrm '*.VT100.allowSendEvents:true'"; $config{terminal_allow_send_events}
= "-xrm '*.VT100.allowSendEvents:true'";
$config{terminal_font} = "6x13"; $config{terminal_font} = "6x13";
$config{terminal_size} = "80x24"; $config{terminal_size} = "80x24";
$config{use_hotkeys} = "yes"; $config{use_hotkeys} = "yes";
@ -299,7 +299,7 @@ sub find_binary($) {
} }
if ( !$path || !-f $path || !-x $path ) { if ( !$path || !-f $path || !-x $path ) {
warn( warn(
"Terminal binary not found ($binary) - please amend \$PATH or the cssh config file\n" "Terminal binary not found ($binary) - please amend \$PATH or the cssh config file\n"
); );
die unless ( $options{u} ); die unless ( $options{u} );
} }
@ -321,7 +321,7 @@ sub check_config() {
# make sure comms in an accepted value # make sure comms in an accepted value
die die
"FATAL: Only ssh, rsh and telnet protocols are currently supported (comms=$config{comms})\n" "FATAL: Only ssh, rsh and telnet protocols are currently supported (comms=$config{comms})\n"
if ( $config{comms} !~ /^(:?[rs]sh|telnet)$/ ); if ( $config{comms} !~ /^(:?[rs]sh|telnet)$/ );
# Set any extra config options given on command line # Set any extra config options given on command line
@ -349,8 +349,8 @@ sub check_config() {
$config{terminal_args} = $options{t} if ( $options{t} ); $config{terminal_args} = $options{t} if ( $options{t} );
if ( $config{terminal_args} =~ /-class (\w+)/ ) { if ( $config{terminal_args} =~ /-class (\w+)/ ) {
$config{terminal_allow_send_events} = $config{terminal_allow_send_events}
"-xrm '$1.VT100.allowSendEvents:true'"; = "-xrm '$1.VT100.allowSendEvents:true'";
} }
$config{internal_previous_state} = ""; # set to default $config{internal_previous_state} = ""; # set to default
@ -380,7 +380,8 @@ sub dump_config {
foreach ( sort( keys(%config) ) ) { foreach ( sort( keys(%config) ) ) {
next next
if ( $_ =~ /^internal/ && $debug == 0 ); # do not output internal vars if ( $_ =~ /^internal/ && $debug == 0 )
; # do not output internal vars
print "$_=$config{$_}\n"; print "$_=$config{$_}\n";
} }
exit_prog if ( !$noexit ); exit_prog if ( !$noexit );
@ -424,16 +425,16 @@ sub evaluate_commands {
print STDERR "Testing terminal - running command:\n"; print STDERR "Testing terminal - running command:\n";
my $terminal_command = my $terminal_command
"$config{terminal} $config{terminal_allow_send_events} -e \"$^X\" \"-e\" 'print \"Working\\n\" ; sleep 5'"; = "$config{terminal} $config{terminal_allow_send_events} -e \"$^X\" \"-e\" 'print \"Working\\n\" ; sleep 5'";
print STDERR $terminal_command, $/; print STDERR $terminal_command, $/;
system($terminal_command); system($terminal_command);
print STDERR "\nTesting comms - running command:\n"; print STDERR "\nTesting comms - running command:\n";
my $comms_command = my $comms_command = $config{ $config{comms} } . " "
$config{ $config{comms} } . " " . $config{ $config{comms} . "_args" }; . $config{ $config{comms} . "_args" };
if ( $config{comms} eq "telnet" ) { if ( $config{comms} eq "telnet" ) {
$comms_command .= " $host $port"; $comms_command .= " $host $port";
@ -469,7 +470,8 @@ sub load_keyboard_map() {
foreach ( 0 .. $#keyboard ) { foreach ( 0 .. $#keyboard ) {
if ( defined $keyboard[$_][0] ) { if ( defined $keyboard[$_][0] ) {
if ( defined( $keycodetosym{ $keyboard[$_][0] } ) ) { if ( defined( $keycodetosym{ $keyboard[$_][0] } ) ) {
$keyboardmap{ $keycodetosym{ $keyboard[$_][0] } } = 'n' . ( $_ + $min ); $keyboardmap{ $keycodetosym{ $keyboard[$_][0] } }
= 'n' . ( $_ + $min );
} }
else { else {
logmsg( 2, "Unknown keycode ", $keyboard[$_][0] ) logmsg( 2, "Unknown keycode ", $keyboard[$_][0] )
@ -478,7 +480,8 @@ sub load_keyboard_map() {
} }
if ( defined $keyboard[$_][1] ) { if ( defined $keyboard[$_][1] ) {
if ( defined( $keycodetosym{ $keyboard[$_][1] } ) ) { if ( defined( $keycodetosym{ $keyboard[$_][1] } ) ) {
$keyboardmap{ $keycodetosym{ $keyboard[$_][1] } } = 's' . ( $_ + $min ); $keyboardmap{ $keycodetosym{ $keyboard[$_][1] } }
= 's' . ( $_ + $min );
} }
else { else {
logmsg( 2, "Unknown keycode ", $keyboard[$_][1] ) logmsg( 2, "Unknown keycode ", $keyboard[$_][1] )
@ -487,7 +490,8 @@ sub load_keyboard_map() {
} }
if ( defined $keyboard[$_][2] ) { if ( defined $keyboard[$_][2] ) {
if ( defined( $keycodetosym{ $keyboard[$_][2] } ) ) { if ( defined( $keycodetosym{ $keyboard[$_][2] } ) ) {
$keyboardmap{ $keycodetosym{ $keyboard[$_][2] } } = 'a' . ( $_ + $min ); $keyboardmap{ $keycodetosym{ $keyboard[$_][2] } }
= 'a' . ( $_ + $min );
} }
else { else {
logmsg( 2, "Unknown keycode ", $keyboard[$_][2] ) logmsg( 2, "Unknown keycode ", $keyboard[$_][2] )
@ -496,8 +500,8 @@ sub load_keyboard_map() {
} }
if ( defined $keyboard[$_][3] ) { if ( defined $keyboard[$_][3] ) {
if ( defined( $keycodetosym{ $keyboard[$_][3] } ) ) { if ( defined( $keycodetosym{ $keyboard[$_][3] } ) ) {
$keyboardmap{ $keycodetosym{ $keyboard[$_][3] } } = $keyboardmap{ $keycodetosym{ $keyboard[$_][3] } }
'sa' . ( $_ + $min ); = 'sa' . ( $_ + $min );
} }
else { else {
logmsg( 2, "Unknown keycode ", $keyboard[$_][3] ) logmsg( 2, "Unknown keycode ", $keyboard[$_][3] )
@ -561,15 +565,20 @@ sub get_clusters() {
logmsg( 2, "Loading clusters in from $cluster_file" ); logmsg( 2, "Loading clusters in from $cluster_file" );
open( CLUSTERS, $cluster_file ) || die("Couldnt read $cluster_file"); open( CLUSTERS, $cluster_file ) || die("Couldnt read $cluster_file");
while (<CLUSTERS>) { while (<CLUSTERS>) {
next if ( /^\s*$/ || /^#/ ); # ignore blank lines & commented lines next
if ( /^\s*$/ || /^#/ ); # ignore blank lines & commented lines
chomp(); chomp();
my @line = split(/\s/); my @line = split(/\s/);
#s/^([\w-]+)\s*//; # remote first word and stick into $1 #s/^([\w-]+)\s*//; # remote first word and stick into $1
logmsg( 3, "cluster $line[0] = ", join( " ", @line[ 1 .. $#line ] ) ); logmsg(
$clusters{ $line[0] } = 3,
join( " ", @line[ 1 .. $#line ] ); # Now bung in rest of line "cluster $line[0] = ",
join( " ", @line[ 1 .. $#line ] )
);
$clusters{ $line[0] } = join( " ", @line[ 1 .. $#line ] )
; # Now bung in rest of line
} }
close(CLUSTERS); close(CLUSTERS);
} }
@ -581,7 +590,9 @@ sub get_clusters() {
foreach ( split( /\s+/, $config{clusters} ) ) { foreach ( split( /\s+/, $config{clusters} ) ) {
if ( !$config{$_} ) { if ( !$config{$_} ) {
warn("WARNING: missing cluster definition in .csshrc file ($_)"); warn(
"WARNING: missing cluster definition in .csshrc file ($_)"
);
} }
else { else {
logmsg( 3, "cluster $_ = $config{$_}" ); logmsg( 3, "cluster $_ = $config{$_}" );
@ -594,7 +605,8 @@ sub get_clusters() {
if ( $config{extra_cluster_file} || $options{c} ) { if ( $config{extra_cluster_file} || $options{c} ) {
# check for multiple entries and push it through glob to catch ~'s # check for multiple entries and push it through glob to catch ~'s
foreach my $item ( split( /,/, $config{extra_cluster_file} ), $options{c} ) foreach my $item ( split( /,/, $config{extra_cluster_file} ),
$options{c} )
{ {
next unless ($item); next unless ($item);
@ -613,9 +625,13 @@ sub get_clusters() {
chomp; chomp;
my @line = split(/\s/); my @line = split(/\s/);
logmsg( 3, "cluster $line[0] = ", join( " ", @line[ 1 .. $#line ] ) ); logmsg(
$clusters{ $line[0] } = 3,
join( " ", @line[ 1 .. $#line ] ); # Now bung in rest of line "cluster $line[0] = ",
join( " ", @line[ 1 .. $#line ] )
);
$clusters{ $line[0] } = join( " ", @line[ 1 .. $#line ] )
; # Now bung in rest of line
} }
} }
@ -695,7 +711,8 @@ SWITCH: {
}; };
length($char) > 1 && do { length($char) > 1 && do {
$windows{history}->insert( 'end', chr( $keysymtocode{$char} ) ) $windows{history}
->insert( 'end', chr( $keysymtocode{$char} ) )
if ( $keysymtocode{$char} ); if ( $keysymtocode{$char} );
last SWITCH; last SWITCH;
}; };
@ -855,7 +872,8 @@ sub check_host($) {
return 1; return 1;
} }
else { else {
logmsg( 1, "Failed to check host (falling back to gethostbyname): $!" ); logmsg( 1,
"Failed to check host (falling back to gethostbyname): $!" );
return gethostbyname($host); return gethostbyname($host);
} }
} }
@ -894,7 +912,8 @@ sub open_client_windows(@) {
my $text = "WARNING: '$_' unknown"; my $text = "WARNING: '$_' unknown";
if (%ssh_hostnames) { if (%ssh_hostnames) {
$text .= " (unable to resolve and not in user ssh config file)"; $text
.= " (unable to resolve and not in user ssh config file)";
} }
warn( $text, $/ ); warn( $text, $/ );
@ -902,11 +921,12 @@ sub open_client_windows(@) {
} }
my $color = ''; my $color = '';
if ($config{terminal_colorize}) { if ( $config{terminal_colorize} ) {
my $c = pick_color($server); my $c = pick_color($server);
if ($config{terminal_bg_style} eq 'dark') { if ( $config{terminal_bg_style} eq 'dark' ) {
$color = "-bg \\#000000 -fg $c"; $color = "-bg \\#000000 -fg $c";
} else { }
else {
$color = "-fg \\#000000 -bg $c"; $color = "-fg \\#000000 -bg $c";
} }
} }
@ -936,8 +956,8 @@ sub open_client_windows(@) {
# Since this is the child, we can mark any server unresolved without # Since this is the child, we can mark any server unresolved without
# affecting the main program # affecting the main program
$servers{$server}{realname} .= "==" if ( !$gethost ); $servers{$server}{realname} .= "==" if ( !$gethost );
my $exec = my $exec
"$config{terminal} $color $config{terminal_args} $config{terminal_allow_send_events} $config{terminal_title_opt} '$config{title}:$server' -font $config{terminal_font} -e \"$^X\" \"-e\" '$helper_script' '$servers{$server}{pipenm}' '$servers{$server}{realname}' '$servers{$server}{username}' '$servers{$server}{port_nb}'"; = "$config{terminal} $color $config{terminal_args} $config{terminal_allow_send_events} $config{terminal_title_opt} '$config{title}:$server' -font $config{terminal_font} -e \"$^X\" \"-e\" '$helper_script' '$servers{$server}{pipenm}' '$servers{$server}{realname}' '$servers{$server}{username}' '$servers{$server}{port_nb}'";
logmsg( 2, "Terminal exec line:\n$exec\n" ); logmsg( 2, "Terminal exec line:\n$exec\n" );
exec($exec) == 0 or warn("Failed: $!"); exec($exec) == 0 or warn("Failed: $!");
} }
@ -952,10 +972,14 @@ sub open_client_windows(@) {
# block on open so we get the text when it comes in # block on open so we get the text when it comes in
unless ( unless (
sysopen( $servers{$server}{pipehl}, $servers{$server}{pipenm}, O_RDONLY ) sysopen(
$servers{$server}{pipehl}, $servers{$server}{pipenm},
O_RDONLY
)
) )
{ {
warn("Cannot open pipe for reading when talking to $server: $!\n"); warn(
"Cannot open pipe for reading when talking to $server: $!\n");
} }
else { else {
@ -965,8 +989,8 @@ sub open_client_windows(@) {
logmsg( 2, "Performing sysread" ); logmsg( 2, "Performing sysread" );
my $piperead; my $piperead;
sysread( $servers{$server}{pipehl}, $piperead, 100 ); sysread( $servers{$server}{pipehl}, $piperead, 100 );
( $servers{$server}{pid}, $servers{$server}{wid} ) = ( $servers{$server}{pid}, $servers{$server}{wid} )
split( /:/, $piperead, 2 ); = split( /:/, $piperead, 2 );
warn("Cannot determ pid of '$server' window\n") warn("Cannot determ pid of '$server' window\n")
unless $servers{$server}{pid}; unless $servers{$server}{pid};
warn("Cannot determ window ID of '$server' window\n") warn("Cannot determ window ID of '$server' window\n")
@ -981,7 +1005,8 @@ sub open_client_windows(@) {
delete( $servers{$server}{pipenm} ); delete( $servers{$server}{pipenm} );
$servers{$server}{active} = 1; # mark as active $servers{$server}{active} = 1; # mark as active
$config{internal_activate_autoquit} = 1; # activate auto_quit if in use $config{internal_activate_autoquit}
= 1; # activate auto_quit if in use
} }
logmsg( 2, "All client windows opened" ); logmsg( 2, "All client windows opened" );
$config{internal_total} = int( keys(%servers) ); $config{internal_total} = int( keys(%servers) );
@ -1001,14 +1026,16 @@ sub get_font_size() {
eval { (%font_info) = $xdisplay->QueryFont($font); } eval { (%font_info) = $xdisplay->QueryFont($font); }
|| die( "Fatal: Unrecognised font used ($config{terminal_font}).\n" || die( "Fatal: Unrecognised font used ($config{terminal_font}).\n"
. "Please amend \$HOME/.csshrc with a valid font (see man page).\n" ); . "Please amend \$HOME/.csshrc with a valid font (see man page).\n"
);
$config{internal_font_width} = $font_info{properties}{$quad_width}; $config{internal_font_width} = $font_info{properties}{$quad_width};
$config{internal_font_height} = $font_info{properties}{$pixel_size}; $config{internal_font_height} = $font_info{properties}{$pixel_size};
if ( !$config{internal_font_width} || !$config{internal_font_height} ) { if ( !$config{internal_font_width} || !$config{internal_font_height} ) {
die( "Fatal: Unrecognised font used ($config{terminal_font}).\n" die( "Fatal: Unrecognised font used ($config{terminal_font}).\n"
. "Please amend \$HOME/.csshrc with a valid font (see man page).\n" ); . "Please amend \$HOME/.csshrc with a valid font (see man page).\n"
);
} }
logmsg( 2, "Done with font size" ); logmsg( 2, "Done with font size" );
@ -1047,7 +1074,8 @@ sub retile_hosts {
logmsg( 2, "Retiling windows" ); logmsg( 2, "Retiling windows" );
if ( $config{window_tiling} ne "yes" && !$force ) { if ( $config{window_tiling} ne "yes" && !$force ) {
logmsg( 3, "Not meant to be tiling; just reshow windows as they were" ); logmsg( 3,
"Not meant to be tiling; just reshow windows as they were" );
foreach my $server ( reverse( keys(%servers) ) ) { foreach my $server ( reverse( keys(%servers) ) ) {
$xdisplay->req( 'MapWindow', $servers{$server}{wid} ); $xdisplay->req( 'MapWindow', $servers{$server}{wid} );
@ -1070,15 +1098,17 @@ sub retile_hosts {
# work out terminal pixel size from terminal size & font size # work out terminal pixel size from terminal size & font size
# does not include any title bars or scroll bars - purely text area # does not include any title bars or scroll bars - purely text area
$config{internal_terminal_cols} = ( $config{terminal_size} =~ /(\d+)x.*/ )[0]; $config{internal_terminal_cols}
$config{internal_terminal_width} = = ( $config{terminal_size} =~ /(\d+)x.*/ )[0];
( $config{internal_terminal_cols} * $config{internal_font_width} ) + $config{internal_terminal_width}
$config{terminal_decoration_width}; = ( $config{internal_terminal_cols} * $config{internal_font_width} )
+ $config{terminal_decoration_width};
$config{internal_terminal_rows} = ( $config{terminal_size} =~ /.*x(\d+)/ )[0]; $config{internal_terminal_rows}
$config{internal_terminal_height} = = ( $config{terminal_size} =~ /.*x(\d+)/ )[0];
( $config{internal_terminal_rows} * $config{internal_font_height} ) + $config{internal_terminal_height}
$config{terminal_decoration_height}; = ( $config{internal_terminal_rows} * $config{internal_font_height} )
+ $config{terminal_decoration_height};
# fetch screen size # fetch screen size
$config{internal_screen_height} = $xdisplay->{height_in_pixels}; $config{internal_screen_height} = $xdisplay->{height_in_pixels};
@ -1086,20 +1116,19 @@ sub retile_hosts {
# Now, work out how many columns of terminals we can fit on screen # Now, work out how many columns of terminals we can fit on screen
$config{internal_columns} = int( $config{internal_columns} = int(
( ( $config{internal_screen_width}
$config{internal_screen_width} - - $config{screen_reserve_left}
$config{screen_reserve_left} - - $config{screen_reserve_right}
$config{screen_reserve_right}
) / ( ) / (
$config{internal_terminal_width} + $config{internal_terminal_width}
$config{terminal_reserve_left} + + $config{terminal_reserve_left}
$config{terminal_reserve_right} + $config{terminal_reserve_right}
) )
); );
# Work out the number of rows we need to use to fit everything on screen # Work out the number of rows we need to use to fit everything on screen
$config{internal_rows} = $config{internal_rows} = int(
int( ( $config{internal_total} / $config{internal_columns} ) + 0.999 ); ( $config{internal_total} / $config{internal_columns} ) + 0.999 );
logmsg( 2, "Screen Columns: ", $config{internal_columns} ); logmsg( 2, "Screen Columns: ", $config{internal_columns} );
logmsg( 2, "Screen Rows: ", $config{internal_rows} ); logmsg( 2, "Screen Rows: ", $config{internal_rows} );
@ -1108,14 +1137,13 @@ sub retile_hosts {
# or to get everything on screen # or to get everything on screen
{ {
my $height = int( my $height = int(
( ( ( $config{internal_screen_height}
( - $config{screen_reserve_top}
$config{internal_screen_height} - - $config{screen_reserve_bottom}
$config{screen_reserve_top} -
$config{screen_reserve_bottom}
) - ( ) - (
$config{internal_rows} * ( $config{internal_rows} * (
$config{terminal_reserve_top} + $config{terminal_reserve_bottom} $config{terminal_reserve_top}
+ $config{terminal_reserve_bottom}
) )
) )
) / $config{internal_rows} ) / $config{internal_rows}
@ -1138,24 +1166,26 @@ sub retile_hosts {
if ( $config{window_tiling_direction} =~ /right/i ) { if ( $config{window_tiling_direction} =~ /right/i ) {
logmsg( 2, "Tiling top left going bot right" ); logmsg( 2, "Tiling top left going bot right" );
@hosts = sort( keys(%servers) ); @hosts = sort( keys(%servers) );
$current_x = $config{screen_reserve_left} + $config{terminal_reserve_left}; $current_x
$current_y = $config{screen_reserve_top} + $config{terminal_reserve_top}; = $config{screen_reserve_left} + $config{terminal_reserve_left};
$current_y
= $config{screen_reserve_top} + $config{terminal_reserve_top};
$current_row = 0; $current_row = 0;
$current_col = 0; $current_col = 0;
} }
else { else {
logmsg( 2, "Tiling bot right going top left" ); logmsg( 2, "Tiling bot right going top left" );
@hosts = reverse( sort( keys(%servers) ) ); @hosts = reverse( sort( keys(%servers) ) );
$current_x = $current_x
$config{screen_reserve_right} - = $config{screen_reserve_right}
$config{internal_screen_width} - - $config{internal_screen_width}
$config{terminal_reserve_right} - - $config{terminal_reserve_right}
$config{internal_terminal_width}; - $config{internal_terminal_width};
$current_y = $current_y
$config{screen_reserve_bottom} - = $config{screen_reserve_bottom}
$config{internal_screen_height} - - $config{internal_screen_height}
$config{terminal_reserve_bottom} - - $config{terminal_reserve_bottom}
$config{internal_terminal_height}; - $config{internal_terminal_height};
$current_row = $config{internal_rows} - 1; $current_row = $config{internal_rows} - 1;
$current_col = $config{internal_columns} - 1; $current_col = $config{internal_columns} - 1;
@ -1165,7 +1195,8 @@ sub retile_hosts {
# Move windows to new locatation # Move windows to new locatation
# Remap all windows in correct order # Remap all windows in correct order
foreach my $server (@hosts) { foreach my $server (@hosts) {
logmsg( 3, "x:$current_x y:$current_y, r:$current_row c:$current_col" ); logmsg( 3,
"x:$current_x y:$current_y, r:$current_row c:$current_col" );
$xdisplay->req( 'UnmapWindow', $servers{$server}{wid} ); $xdisplay->req( 'UnmapWindow', $servers{$server}{wid} );
@ -1187,19 +1218,19 @@ sub retile_hosts {
if ( $config{window_tiling_direction} =~ /right/i ) { if ( $config{window_tiling_direction} =~ /right/i ) {
# starting top left, and move right and down # starting top left, and move right and down
$current_x += $current_x
$config{terminal_reserve_left} + += $config{terminal_reserve_left}
$config{terminal_reserve_right} + + $config{terminal_reserve_right}
$config{internal_terminal_width}; + $config{internal_terminal_width};
$current_col += 1; $current_col += 1;
if ( $current_col == $config{internal_columns} ) { if ( $current_col == $config{internal_columns} ) {
$current_y += $current_y
$config{terminal_reserve_top} + += $config{terminal_reserve_top}
$config{terminal_reserve_bottom} + + $config{terminal_reserve_bottom}
$config{internal_terminal_height}; + $config{internal_terminal_height};
$current_x = $current_x = $config{screen_reserve_left}
$config{screen_reserve_left} + $config{terminal_reserve_left}; + $config{terminal_reserve_left};
$current_row++; $current_row++;
$current_col = 0; $current_col = 0;
} }
@ -1260,8 +1291,8 @@ sub capture_terminal() {
my %atoms; my %atoms;
for my $atom ( $xdisplay->req( 'ListProperties', $servers{loki}{wid} ) ) { for my $atom ( $xdisplay->req( 'ListProperties', $servers{loki}{wid} ) ) {
$atoms{ $xdisplay->atom_name($atom) } = $atoms{ $xdisplay->atom_name($atom) }
$xdisplay->req( 'GetProperty', $servers{loki}{wid}, = $xdisplay->req( 'GetProperty', $servers{loki}{wid},
$atom, "AnyPropertyType", 0, 200, 0 ); $atom, "AnyPropertyType", 0, 200, 0 );
print $xdisplay->atom_name($atom), " ($atom) => "; print $xdisplay->atom_name($atom), " ($atom) => ";
@ -1308,7 +1339,8 @@ sub capture_terminal() {
print "geom\n"; print "geom\n";
print join " ", $xdisplay->req( 'GetGeometry', $servers{loki}{wid} ), $/; print join " ", $xdisplay->req( 'GetGeometry', $servers{loki}{wid} ), $/;
print "attrib\n"; print "attrib\n";
print join " ", $xdisplay->req( 'GetWindowAttributes', $servers{loki}{wid} ), print join " ",
$xdisplay->req( 'GetWindowAttributes', $servers{loki}{wid} ),
$/; $/;
} }
@ -1342,7 +1374,8 @@ sub add_host_by_name() {
logmsg( 2, "host=$menus{host_entry}" ); logmsg( 2, "host=$menus{host_entry}" );
open_client_windows( resolve_names( split( /\s+/, $menus{host_entry} ) ) ); open_client_windows(
resolve_names( split( /\s+/, $menus{host_entry} ) ) );
build_hosts_menu(); build_hosts_menu();
$menus{host_entry} = ""; $menus{host_entry} = "";
@ -1422,7 +1455,9 @@ sub setup_repeat() {
#logmsg( 4, "Number after tidy is: ", $config{internal_total} ); #logmsg( 4, "Number after tidy is: ", $config{internal_total} );
# If there are no hosts in the list and we are set to autoquit # If there are no hosts in the list and we are set to autoquit
if ( $config{internal_total} == 0 && $config{auto_quit} =~ /yes/i ) { if ( $config{internal_total} == 0
&& $config{auto_quit} =~ /yes/i )
{
# and some clients were actually opened... # and some clients were actually opened...
if ( $config{internal_activate_autoquit} ) { if ( $config{internal_activate_autoquit} ) {
@ -1551,7 +1586,8 @@ sub create_windows() {
-family => "interface system", -family => "interface system",
-size => 10, -size => 10,
], ],
-text => "Cluster Administrator Console using SSH\n\nVersion: $VERSION.\n\n" -text =>
"Cluster Administrator Console using SSH\n\nVersion: $VERSION.\n\n"
. "Bug/Suggestions to http://clusterssh.sf.net/", . "Bug/Suggestions to http://clusterssh.sf.net/",
); );
@ -1563,8 +1599,8 @@ sub create_windows() {
); );
my $manpage = `pod2text -l -q=\"\" $0`; my $manpage = `pod2text -l -q=\"\" $0`;
$windows{mantext} = $windows{mantext}
$windows{manpage}->Scrolled( "Text", )->pack( -fill => 'both' ); = $windows{manpage}->Scrolled( "Text", )->pack( -fill => 'both' );
$windows{mantext}->insert( 'end', $manpage ); $windows{mantext}->insert( 'end', $manpage );
$windows{mantext}->configure( -state => 'disabled' ); $windows{mantext}->configure( -state => 'disabled' );
@ -1594,7 +1630,8 @@ sub capture_map_events() {
logmsg( 3, "Entering MAP" ); logmsg( 3, "Entering MAP" );
my $state = $windows{main_window}->state(); my $state = $windows{main_window}->state();
logmsg( 3, "state=$state previous=$config{internal_previous_state}" ); logmsg( 3,
"state=$state previous=$config{internal_previous_state}" );
logmsg( 3, "Entering MAP" ); logmsg( 3, "Entering MAP" );
if ( $config{internal_previous_state} eq $state ) { if ( $config{internal_previous_state} eq $state ) {
@ -1606,7 +1643,8 @@ sub capture_map_events() {
return; return;
} }
logmsg( 3, "state=$state previous=$config{internal_previous_state}" ); logmsg( 3,
"state=$state previous=$config{internal_previous_state}" );
if ( $config{internal_previous_state} eq "iconic" ) { if ( $config{internal_previous_state} eq "iconic" ) {
logmsg( 3, "running retile" ); logmsg( 3, "running retile" );
@ -1628,7 +1666,8 @@ sub capture_map_events() {
logmsg( 3, "Entering UNMAP" ); logmsg( 3, "Entering UNMAP" );
my $state = $windows{main_window}->state(); my $state = $windows{main_window}->state();
logmsg( 3, "state=$state previous=$config{internal_previous_state}" ); logmsg( 3,
"state=$state previous=$config{internal_previous_state}" );
if ( $config{internal_previous_state} eq $state ) { if ( $config{internal_previous_state} eq $state ) {
logmsg( 3, "repeating the same" ); logmsg( 3, "repeating the same" );
@ -1644,7 +1683,8 @@ sub capture_map_events() {
foreach my $server ( reverse( keys(%servers) ) ) { foreach my $server ( reverse( keys(%servers) ) ) {
$xdisplay->req( 'UnmapWindow', $servers{$server}{wid} ); $xdisplay->req( 'UnmapWindow', $servers{$server}{wid} );
if ( $config{unmap_on_redraw} =~ /yes/i ) { if ( $config{unmap_on_redraw} =~ /yes/i ) {
$xdisplay->req( 'UnmapWindow', $servers{$server}{wid} ); $xdisplay->req( 'UnmapWindow',
$servers{$server}{wid} );
} }
} }
$xdisplay->flush(); $xdisplay->flush();
@ -1720,7 +1760,7 @@ sub key_event {
# if active # if active
if ( $servers{$_}{active} == 1 ) { if ( $servers{$_}{active} == 1 ) {
logmsg( 3, logmsg( 3,
"Sending event $event with code $keycode (state=$state) to window $servers{$_}{wid}" "Sending event $event with code $keycode (state=$state) to window $servers{$_}{wid}"
); );
$xdisplay->SendEvent( $xdisplay->SendEvent(
@ -1750,14 +1790,12 @@ sub create_menubar() {
$menus{file} = $menus{bar}->cascade( $menus{file} = $menus{bar}->cascade(
-label => 'File', -label => 'File',
-menuitems => [ -menuitems => [
[ [ "command",
"command",
"Show History", "Show History",
-command => \&show_history, -command => \&show_history,
-accelerator => $config{key_history}, -accelerator => $config{key_history},
], ],
[ [ "command",
"command",
"Exit", "Exit",
-command => \&exit_prog, -command => \&exit_prog,
-accelerator => $config{key_quit}, -accelerator => $config{key_quit},
@ -1770,22 +1808,22 @@ sub create_menubar() {
-label => 'Hosts', -label => 'Hosts',
-tearoff => 1, -tearoff => 1,
-menuitems => [ -menuitems => [
[ [ "command",
"command",
"Retile Windows", "Retile Windows",
-command => \&retile_hosts, -command => \&retile_hosts,
-accelerator => $config{key_retilehosts}, -accelerator => $config{key_retilehosts},
], ],
# [ "command", "Capture Terminal", -command => \&capture_terminal, ], # [ "command", "Capture Terminal", -command => \&capture_terminal, ],
[ "command", "Toggle active state", -command => \&toggle_active_state, ], [ "command",
[ "Toggle active state",
"command", -command => \&toggle_active_state,
],
[ "command",
"Close inactive sessions", "Close inactive sessions",
-command => \&close_inactive_sessions, -command => \&close_inactive_sessions,
], ],
[ [ "command",
"command",
"Add Host(s) or Cluster(s)", "Add Host(s) or Cluster(s)",
-command => \&add_host_by_name, -command => \&add_host_by_name,
-accelerator => $config{key_addhost}, -accelerator => $config{key_addhost},
@ -1797,8 +1835,7 @@ sub create_menubar() {
$menus{send} = $menus{bar}->cascade( $menus{send} = $menus{bar}->cascade(
-label => 'Send', -label => 'Send',
-menuitems => [ -menuitems => [
[ [ "command",
"command",
"Hostname", "Hostname",
-command => \&send_clientname, -command => \&send_clientname,
-accelerator => $config{key_clientname}, -accelerator => $config{key_clientname},
@ -1811,8 +1848,7 @@ sub create_menubar() {
-label => 'Help', -label => 'Help',
-menuitems => [ -menuitems => [
[ 'command', "About", -command => sub { $windows{help}->Show } ], [ 'command', "About", -command => sub { $windows{help}->Show } ],
[ [ 'command', "Documentation",
'command', "Documentation",
-command => sub { $windows{manpage}->Show } -command => sub { $windows{manpage}->Show }
], ],
], ],