view release on metacpan or  search on metacpan

lib/Bio/NEXUS/Util/Exceptions.pm  view on Meta::CPAN

#
package Bio::NEXUS::Util::StackTrace;
use strict;

sub new {
	my $class = shift;
	my $self = [];
	my $i = 0;
	my $j = 0;
	package DB; # to get @_ stack from previous frames, see perldoc -f caller
	while( my @frame = caller($i) ) {
		my $package = $frame[0];
		if ( not Bio::NEXUS::Util::StackTrace::_skip_me( $package ) ) {
			my @args = @DB::args;
			$self->[$j++] = [ @frame, @args ];
		}
		$i++;
	}
	package Bio::NEXUS::Util::StackTrace;
	shift @$self; # to remove "throw" frame
	return bless $self, $class;

lib/Bio/NEXUS/Util/Logger.pm  view on Meta::CPAN

			}
			else {
				throw 'BadArgs' => "$arg not a CODE reference";
			}
		}
		return $self;
	}
	
	sub log {
		my ( $self, $level, $msg ) = @_;
		my ( $package, $file1up,  $line1up, $subroutine ) = caller(2);
		my ( $pack0up, $filename, $line,    $sub0up )     = caller(1);		
		my $verbosity = exists $VERBOSE{$pack0up} ? $VERBOSE{$pack0up} : $VERBOSE;
		if ( $verbosity >= $LEVEL{$level} ) {			
			my $log_string;
			if ( $filename =~ s/\Q$class_dir\E// ) {
				$log_string = sprintf( "%s %s [\$PREFIX/%s, %s] - %s\n",
				$level, $subroutine, $filename, $line, $msg );
			}
			else {
				$log_string = sprintf( "%s %s [%s, %s] - %s\n",
				$level, $subroutine, $filename, $line, $msg );