package App::ClusterSSH::Base; use warnings; use strict; use Carp; use App::ClusterSSH::L10N; use Exception::Class ( 'App::ClusterSSH::Exception', 'App::ClusterSSH::Exception::Config' => { fields => 'unknown_config', }, 'App::ClusterSSH::Exception::Cluster', ); # 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( App::ClusterSSH::Exception->throw( error => _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 exit { my ($self) = @_; exit; } sub config { my ($self) = @_; if ( !$app_configuration ) { croak( App::ClusterSSH::Exception->throw( _translate('config has not yet been set') ) ); } return $app_configuration; } sub set_config { my ( $self, $config ) = @_; if ($app_configuration) { croak( App::ClusterSSH::Exception->throw( _translate('config has already been set') ) ); } if(!$config) { croak( App::ClusterSSH::Exception->throw( _translate('passed config is empty')) ); } $self->debug( 3, _translate('Setting app configuration') ); $app_configuration = $config; return $self; } 1; =pod =head1 NAME App::ClusterSSH::Base - Base object provding utility functions =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 for more details. Essentially a wrapper to maketext in Locale::Maketext =item $obj->output(@); 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 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<< >> =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;