clusterssh 4.00.11-2 / usr / share / perl5 / App / ClusterSSH / Base.pm

package App::ClusterSSH::Base;

use warnings;
use strict;
use Carp;
use App::ClusterSSH::L10N;

# Dont use SVN revision as it can cause problems
use version;
our $VERSION = version->new('0.02');

my $debug_level = 0;
our $language = 'en';
our $language_handle;
our $app_configuration;

sub new {
    my ( $class, %args ) = @_;

    my $config = {
        lang  => 'en',
        debug => 0,
        %args,
    };

    my $self = bless $config, $class;

    $self->set_debug_level( $config->{debug} );
    $self->set_lang( $config->{lang} );

    $self->debug(
        7,
        $self->loc( 'Arguments to [_1]->new(): ', $class ),
        $self->_dump_args_hash(%args),
    );

    return $self;
}

sub _dump_args_hash {
    my ( $class, %args ) = @_;
    my $string = $/;

    foreach ( sort( keys(%args) ) ) {
        $string .= "\t";
        $string .= $_;
        $string .= ' => ';
        $string .= $args{$_};
        $string .= ',';
        $string .= $/;
    }
    chomp($string);

    return $string;
}

sub _translate {
    my @args = @_;
    if ( !$language_handle ) {
        $language_handle = App::ClusterSSH::L10N->get_handle($language);
    }

    return $language_handle->maketext(@args);
}

sub loc {
    my ( $self, @args ) = @_;
    $_ ||= q{} foreach (@args);
    return _translate(@args);
}

sub set_lang {
    my ( $self, $lang ) = @_;
    $language = $lang;
    if ($self) {
        $self->debug( 6, $self->loc( 'Setting language to "[_1]"', $lang ), );
    }
    return $self;
}

sub set_debug_level {
    my ( $self, $level ) = @_;
    if ( !defined $level ) {
        croak( _translate('Debug level not provided') );
    }
    if ( $level > 9 ) {
        $level = 9;
    }
    $debug_level = $level;
    return $self;
}

sub debug_level {
    my ($self) = @_;
    return $debug_level;
}

sub output {
    my ( $self, @text ) = @_;
    print @text, $/;
    return $self;
}

sub debug {
    my ( $self, $level, @text ) = @_;
    if ( $level <= $debug_level ) {
        $self->output(@text);
    }
    return $self;
}

sub config {
    my ($self) = @_;

    if ( !$app_configuration ) {
        croak( _translate('config has not yet been set') );
    }

    return $app_configuration;
}

sub set_config {
    my ( $self, $config ) = @_;

    if ($app_configuration) {
        croak( _translate('config has already been set') );
    }

    if(!$config) { 
        croak( _translate('passed config is empty'));
    }

    $self->debug( 3, _translate('Setting app configuration') );

    $app_configuration = $config;

    return $self;
}

1;

=pod

=head1 NAME

App::ClusterSSH::Base

=head1 SYNOPSIS

    use base qw/ App::ClusterSSH::Base /;

    # in object new method
    sub new {
        ( $class, $arg_ref ) = @_;
        my $self = $class->SUPER::new($arg_ref);
        return $self;
    }

=head1 DESCRIPTION

Base object to provide some utility functions on objects - should not be 
used directly

=head1 METHODS

These extra methods are provided on the object

=over 4

=item $obj = App::ClusterSSH::Base->new({ arg => val, });

Creates object.  In higher debug levels the args are printed out.

=item $obj->id 

Return the unique id of the object for use in subclasses, such as

    $info_for{ $self->id } = $info

=item $obj->debug_level();

Returns current debug level

=item $obj->set_debug_level( n )

Set debug level to 'n' for all child objects.

=item $obj->debug($level, @text)

Output @text on STDOUT if $level is the same or lower that debug_level

=item $obj->set_lang

Set the Locale::Maketext language.  Defaults to 'en'.  Expects the 
App::ClusterSSH/L10N/{lang}.pm module to exist and contain all relevant 
translations, else defaults to English.

=item $obj->loc('text to translate [_1]')

Using the App::ClusterSSH/L10N/{lang}.pm module convert the  given text to 
appropriate language.  See L<App::ClusterSSH::L10N> for more details.  Essentially 
a wrapper to maketext in Locale::Maketext

=item $obj->output(@);

Output text on STDOUT.

=item $config = $obj->config;

Returns whatever configuration object has been set up.  Croaks if set_config
hasnt been called

=item $obj->set_config($config);

Set the config to the given value - croaks if has already been called

=back

=head1 AUTHOR

Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>

=head1 LICENSE AND COPYRIGHT

Copyright 1999-2010 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;