view release on metacpan or  search on metacpan

lib/Algorithm/Genetic/Diploid/Logger.pm  view on Meta::CPAN

package Algorithm::Genetic::Diploid::Logger;
use strict;
use Exporter;
use base 'Exporter';

our $AUTOLOAD;
our @EXPORT_OK = qw(DEBUG INFO WARN ERROR FATAL);
our %EXPORT_TAGS = ( 'levels' => [@EXPORT_OK] );
our $VERBOSE = 2; # i.e. WARN, default 
our %VERBOSE;
my $formatter = \&_simple_formatter;

=head1 NAME

Algorithm::Genetic::Diploid::Logger - reports on progress of the experiment

=head1 METHODS

=over

=item new

This singleton constructor always returns reference to same object

=cut

my $SINGLETON;
sub new {
	my $class = shift;
	if ( not $SINGLETON ) {
		$SINGLETON = bless \$class, $class;
	}
	$SINGLETON->level(@_) if @_;
	return $SINGLETON;
}

=item level

Alters log level. Takes named arguments: C<method> provides a scalar or array of fully
qualified method names whose verbosity to alter. C<class> provides a scalar or array of
package names whose verbosity to alter. C<level> sets the verbosity to one of the levels
described below.

=cut

sub level {
	my $self = shift;
	my %args = @_;
	
	# set verbosity at the level of methods
	if ( $args{'method'} ) {
		if ( ref $args{'method'} eq 'ARRAY' ) {
			$VERBOSE{$_} = $args{'level'} for @{ $args{'method'} };
		}
		else {
			$VERBOSE{$args{'method'}} = $args{'level'};
		}
	}
	
	# set verbosity at the level of classes
	elsif ( $args{'class'} ) {
		if ( ref $args{'class'} eq 'ARRAY' ) {
			$VERBOSE{$_} = $args{'level'} for @{ $args{'class'} };
		}
		else {
			$VERBOSE{$args{'class'}} = $args{'level'};
		}
	}
	
	# set verbosity globally
	else {
		$VERBOSE = $args{'level'};
	}
	return $self;
}

=item formatter

Alters log string formatter. When argument is 'simple' the log string is just
the logging level and message, when argument is 'verbose', the log string has
the calling subroutine name and location in it. 'medium' omits the file location. 
When the argument is a code reference, this reference is executed for every 
log message, with the following named arguments:

	'level' => (DEBUG|INFO|WARN|ERROR|FATAL)
	'sub'   => fully qualified name of the calling subroutine
	'file'  => path to the calling file
	'line'  => line number from whence the call was made
	'msg'   => the log message

=cut