Fix tests

- perltidy
- add pod to new modules
- code fix for accessing config via Base.pm
- fix some minor typos
This commit is contained in:
Duncan Ferguson 2017-12-27 10:58:28 +00:00
parent 0fe831e25f
commit b9731d0e35
5 changed files with 179 additions and 15 deletions

View file

@ -20,6 +20,8 @@ lib/App/ClusterSSH/L10N/en.pm
lib/App/ClusterSSH/L10N.pm
lib/App/ClusterSSH.pm
lib/App/ClusterSSH/Range.pm
lib/App/ClusterSSH/Window.pm
lib/App/ClusterSSH/Window/Tk.pm
Makefile.PL
MANIFEST
MANIFEST.SKIP

View file

@ -100,7 +100,6 @@ sub window {
return $self->{window};
}
# Set up UTF-8 on STDOUT
binmode STDOUT, ":utf8";
@ -595,6 +594,10 @@ slash_slash_equal($a, 0) is equivalent to $a //= 0
=item update_display_text
=item window
Method to access assosiated window module
=item write_default_user_config
=back

View file

@ -142,14 +142,18 @@ sub config {
);
}
return $self->{parent}->{config} if $self->{parent} && $self->{parent}->{config};
return $self->{parent}->{config}
if $self->{parent}
&& ref $self->{parent} eq "HASH"
&& $self->{parent}->{config};
#return $app_configuration;
return $app_configuration;
}
sub options {
my ($self) = @_;
return $self->{parent}->{options} if $self->{parent} && $self->{parent}->{options};
return $self->{parent}->{options}
if $self->{parent} && $self->{parent}->{options};
return undef;
}
@ -370,11 +374,15 @@ a wrapper to maketext in Locale::Maketext
Output text on STDOUT.
=item $ovj->parent;
=item $obj->parent;
Reutrned the object that is the parent of this one, if it was set when the
Returned the object that is the parent of this one, if it was set when the
object was created
=item %obj->options;
Accessor to configured options, if it is set up by this point
=item $obj->exit;
Stub to allow program to exit neatly from wherever in the code
@ -388,6 +396,11 @@ hasnt been called
Set the config to the given value - croaks if has already been called
=item $sort = $obj->sort
Code reference used to sort lists; if configured (and installed) use
Sort;:Naturally, else use perl sort
=item %results = $obj->load_file( filename => '/path/to/file', type => '(cluster|config}' )
Load in the specified file and return a hash, parsing the file depending on

View file

@ -39,3 +39,41 @@ sub new {
}
1;
=pod
=head1 NAME
App::ClusterSSH::Window - Base obejct for different types of window module
=head1 DESCRIPTION
Base object to allow for configuring and using different types of windows libraries
=head1 METHODS
=over 4
=item $obj = App::ClusterSSH::Window->new({});
Creates object
=back
=head1 AUTHOR
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
=head1 LICENSE AND COPYRIGHT
Copyright 1999-2016 Duncan Ferguson.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;

View file

@ -749,7 +749,8 @@ sub show_console() {
$windows{main_window}->update();
select( undef, undef, undef, 0.2 ); #sleep for a mo
$windows{main_window}->withdraw if $windows{main_window}->state ne "withdrawn";
$windows{main_window}->withdraw
if $windows{main_window}->state ne "withdrawn";
# Sleep for a moment to give WM time to bring console back
select( undef, undef, undef, 0.5 );
@ -946,8 +947,11 @@ sub retile_hosts {
}
# in case the WM call failed we set some defaults
for my $v (qw/ internal_terminal_wm_decoration_left internal_terminal_wm_decoration_right internal_terminal_wm_decoration_top internal_terminal_wm_decoration_bottom /) {
$self->config->{ $v } = 0 if(!defined $self->config->{ $v });
for my $v (
qw/ internal_terminal_wm_decoration_left internal_terminal_wm_decoration_right internal_terminal_wm_decoration_top internal_terminal_wm_decoration_bottom /
)
{
$self->config->{$v} = 0 if ( !defined $self->config->{$v} );
}
}
@ -1129,7 +1133,7 @@ sub setup_repeat() {
);
# See if there are any commands in the external command pipe
if(defined $self->{external_command_pipe_fh} ) {
if ( defined $self->{external_command_pipe_fh} ) {
my $ext_cmd;
sysread( $self->{external_command_pipe_fh}, $ext_cmd, 400 );
if ($ext_cmd) {
@ -1254,7 +1258,8 @@ sub create_windows() {
);
}
$windows{main_window}->bind( '<Destroy>' => sub { $self->parent->exit_prog } );
$windows{main_window}
->bind( '<Destroy>' => sub { $self->parent->exit_prog } );
# remove all Paste events so we set them up cleanly
$windows{main_window}->eventDelete('<<Paste>>');
@ -1344,7 +1349,8 @@ sub create_windows() {
);
my @tags = $self->{parent}->cluster->list_tags();
my @external_tags = map {"$_ *"} $self->parent->cluster->list_external_clusters();
my @external_tags
= map {"$_ *"} $self->parent->cluster->list_external_clusters();
push( @tags, @external_tags );
if ( $self->config->{max_addhost_menu_cluster_items}
@ -1532,7 +1538,7 @@ sub key_event {
$self->retile_hosts("force")
if ( $hotkey eq "key_retilehosts" );
$self->show_history() if ( $hotkey eq "key_history" );
$self->parent->exit_prog() if ( $hotkey eq "key_quit" );
$self->parent->exit_prog() if ( $hotkey eq "key_quit" );
}
return;
}
@ -1798,7 +1804,7 @@ sub populate_send_menu {
}
sub console_focus {
my($self) = @_;
my ($self) = @_;
$self->debug( 2, "Sorting focus on console" );
$windows{text_entry}->focus();
@ -1812,7 +1818,7 @@ sub console_focus {
}
sub mainloop {
my($self) = @_;
my ($self) = @_;
$self->debug( 2, "Starting MainLoop" );
MainLoop();
@ -1820,3 +1826,105 @@ sub mainloop {
}
1;
=pod
=head1 NAME
App::ClusterSSH::Window::TK - Base Tk windows object
=head1 DESCRIPTION
Base object for using Tk - must be pulled into App::ClusterSSH::Window for use
=head1 METHODS
=over 4
=item add_host_by_name
=item build_hosts_menu
=item capture_map_events
=item change_main_window_title
=item close_inactive_sessions
=item console_focus
=item create_menubar
=item create_windows
=item get_font_size
=item get_keycode_state
=item initialise
=item key_event
=item load_keyboard_map
=item mainloop
=item open_client_windows
=item pick_color
=item populate_send_menu
=item populate_send_menu_entries_from_xml
=item re_add_closed_sessions
=item retile_hosts
=item send_resizemove
=item send_text
=item send_text_to_all_servers
=item send_variable_text_to_all_servers
=item set_all_active
=item set_half_inactive
=item setup_repeat
=item show_console
=item show_history
=item substitute_macros
=item terminate_all_hosts
=item terminate_host
=item toggle_active_state
=item update_display_text
=back
=head1 AUTHOR
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
=head1 LICENSE AND COPYRIGHT
Copyright 1999-2016 Duncan Ferguson.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;