WIP: get new config module into use

This commit is contained in:
Duncan Ferguson 2011-07-28 10:23:49 +01:00
parent 74e3913680
commit 6c32234f5f
4 changed files with 338 additions and 490 deletions

File diff suppressed because it is too large Load diff

View file

@ -116,6 +116,12 @@ sub debug {
return $self;
}
sub exit {
my ($self) = @_;
exit;
}
sub config {
my ($self) = @_;
@ -212,6 +218,10 @@ a wrapper to maketext in Locale::Maketext
Output text on STDOUT.
=item $obj->exit;
Stub to allow program to exit neatly from wherever in the code
=item $config = $obj->config;
Returns whatever configuration object has been set up. Croaks if set_config

View file

@ -85,7 +85,10 @@ sub validate_args {
my @unknown_config = ();
foreach my $config ( sort( keys(%args) ) ) {
next if grep /$config/, @app_specific;
if (grep /$config/, @app_specific) {
$self->{$config} ||= 'unknown';
next;
}
if ( exists $self->{$config} ) {
$self->{$config} = $args{$config};
@ -153,7 +156,7 @@ sub parse_config_file {
# grab any clusters from the config before validating it
if ( $read_config{clusters} ) {
carp("TODO - deal with clusters");
carp("TODO: deal with clusters");
$self->debug( 3, "Picked up clusters defined in $config_file" );
foreach my $cluster ( sort split / /, $read_config{clusters} ) {
delete( $read_config{$cluster} );
@ -172,7 +175,7 @@ sub load_configs {
my ($self, @configs) = @_;
if ( -e $ENV{HOME} . '/.csshrc' ) {
warn( $self->loc('[_1] is no longer used - please see documentation and remove', $ENV{HOME} . '/.csshrc'), $/);
warn( $self->loc('NOTICE: [_1] is no longer used - please see documentation and remove', $ENV{HOME} . '/.csshrc'), $/);
}
for my $config ( '/etc/csshrc', $ENV{HOME} . '/.csshrc', $ENV{HOME} . '/.clusterssh/config', ) {
@ -189,6 +192,7 @@ sub load_configs {
# Attempt to load in provided config files. Also look for anything
# 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 );
my $file = $ENV{HOME} . '/.clusterssh/config_'.$config;
@ -288,6 +292,19 @@ sub find_binary {
return $path;
}
sub dump {
my ( $self, $no_exit, ) = @_;
$self->debug(3, 'Dumping config to STDOUT');
print('# Configuration dump produced by "cssh -u"',$/);
foreach my $key (keys %$self) {
print $key, '=', $self->{$key}, $/;
}
$self->exit if(!$no_exit);
}
#use overload (
# q{""} => sub {
# my ($self) = @_;
@ -331,7 +348,7 @@ Validate and apply all configuration loaded at this point
Locate the binary <name> and return the full path. Doesn't just search
$PATH in case the environment isn't set up correctly
=item $conifig->load_configs(@extra);
=item $config->load_configs(@extra);
Load up configuration from known locations (warn if .csshrc file found) and
load in option files as necessary.
@ -341,6 +358,10 @@ load in option files as necessary.
Write out default $HOME/.clusterssh/config file (before option config files
are loaded).
=item $config->dump()
Write currently defined configuration to STDOUT
=back
=head1 AUTHOR

View file

@ -254,7 +254,7 @@ isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, $ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
is( $trap->stderr, 'NOTICE: '.$ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
is_deeply( $config, \%expected, 'amended config is correct' );
@ -273,7 +273,7 @@ isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, $ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
is( $trap->stderr, 'NOTICE: '.$ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
is_deeply( $config, \%expected, 'amended config is correct' );
@ -377,7 +377,6 @@ trap {
};
is( $trap->leaveby, 'return', 'died ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{Unable to create directory $HOME/.clusterssh: File exists}.$/, 'Expecting no STDERR' );
@ -389,10 +388,68 @@ $config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'died ok' );
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{Unable to write default $HOME/.clusterssh/config: Is a directory}.$/, 'Expecting no STDERR' );
note('Checking dump');
$config = App::ClusterSSH::Config->new();trap {
$config->dump();
};
my $expected=<<'EOF';
# Configuration dump produced by "cssh -u"
terminal_reserve_top=5
terminal_bg_style=dark
window_tiling_direction=right
screen_reserve_left=0
window_tiling=yes
key_addhost=Control-Shift-plus
max_addhost_menu_cluster_items=6
key_clientname=Alt-n
terminal_allow_send_events=-xrm '*.VT100.allowSendEvents:true'
debug=0
menu_host_autotearoff=0
console_position=
lang=en
terminal_colorize=1
unmap_on_redraw=no
terminal_reserve_left=5
screen_reserve_right=0
key_retilehosts=Alt-r
rsh_args=
history_height=10
key_quit=Control-q
screen_reserve_top=0
send_menu_xml_file=/home/dferguson/.csshrc_send_menu
use_hotkeys=yes
terminal_decoration_height=10
menu_send_autotearoff=0
terminal_args=
terminal_decoration_width=8
auto_quit=yes
terminal=xterm
command=
telnet_args=
mouse_paste=Button-2
key_history=Alt-h
terminal_reserve_right=0
show_history=0
terminal_font=6x13
terminal_reserve_bottom=0
history_width=40
extra_cluster_file=
ssh_args=
terminal_title_opt=-T
screen_reserve_bottom=60
max_host_menu_items=30
key_paste=Control-v
terminal_size=80x24
EOF
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, $expected, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
done_testing();