BioPerl

 view release on metacpan or  search on metacpan

Bio/Align/DNAStatistics.pm  view on Meta::CPAN

	push @return, {id=>'1', seq=> $_};
    }
    return \@return;
}

sub _get_av_ds_dn {
    # takes array of hashes of sequence strings and ids   #
    my $self = shift;
    my $seq_ref = shift;
    my $result = shift if @_;
    my @caller = caller(1);
    my @seqarray = @$seq_ref;
    my $bootstrap_score_list;
    #for a multiple alignment considers all pairwise combinations#
    my %dsfor_average = (ds => [], dn => []); 
    for (my $i = 0; $i < scalar @seqarray; $i++) {
	for (my $j = $i +1; $j<scalar @seqarray; $j++ ){
#			print "comparing $i and $j\n";
	    if (length($seqarray[$i]{'seq'}) != length($seqarray[$j]{'seq'})) {
		$self->warn(" aligned sequences must be of equal length!");
		next;

Bio/Phenotype/Correlate.pm  view on Meta::CPAN

# Title   : _check_ref_type              
# Function: Checks for the correct type.
# Returns : 
# Args    : The value to be checked, the expected class.
sub _check_ref_type {
    my ( $self, $value, $expected_class ) = @_;

    if ( ! defined( $value ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found [undef" 
        ."] where [$expected_class] expected" );
    }
    elsif ( ! ref( $value ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found scalar"
        ." where [$expected_class] expected" );
    } 
    elsif ( ! $value->isa( $expected_class ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found [". ref( $value ) 
        ."] where [$expected_class] expected" );
    }    
} # _check_ref_type



1;

Bio/Phenotype/Phenotype.pm  view on Meta::CPAN

 Function: Checks for the correct type.
 Returns : 
 Args    : The value to be checked, the expected class.

=cut

sub _check_ref_type {
    my ( $self, $value, $expected_class ) = @_;

    if ( ! defined( $value ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found [undef" 
        ."] where [$expected_class] expected" );
    }
    elsif ( ! ref( $value ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found scalar"
        ." where [$expected_class] expected" );
    } 
    elsif ( ! $value->isa( $expected_class ) ) {
        $self->throw( ( caller( 1 ) )[ 3 ] .": Found [". ref( $value ) 
        ."] where [$expected_class] expected" );
    }    
} # _check_ref_type



1;

Bio/Root/RootI.pm  view on Meta::CPAN

    $warn_version =~ s/_//g;
    
    for my $v ( $warn_version, $throw_version) {
        no warnings 'numeric';
        $self->throw("Version must be numerical, such as 1.006000 for v1.6.0, not $v")
            unless !defined $v || $v + 0 == $v;
    }

    # below default insinuates we're deprecating a method and not a full module
    # but it's the most common use case
    $msg ||= "Use of ".(caller(1))[3]."() is deprecated.";

    if( $throw_version && $class_version && $class_version >= $throw_version ) {
        $self->throw($msg)
    }
    elsif( $warn_version && $class_version && $class_version >= $warn_version ) {

        $msg .= "\nTo be removed in $throw_version." if $throw_version;

        # passing this on to warn() should deal properly with verbosity issues
        $self->warn($msg);

Bio/Root/RootI.pm  view on Meta::CPAN

    return $out;
}


=head2 stack_trace

 Title   : stack_trace
 Usage   : @stack_array_ref= $self->stack_trace
 Function: gives an array to a reference of arrays with stack trace info
           each coming from the caller(stack_number) call
 Returns : array containing a reference of arrays
 Args    : none


=cut

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

    my $i = 0;
    my @out = ();
    my $prev = [];
    while( my @call = caller($i++)) {
        # major annoyance that caller puts caller context as
        # function name. Hence some monkeying around...
        $prev->[3] = $call[3];
        push(@out,$prev);
        $prev = \@call;
    }
    $prev->[3] = 'toplevel';
    push(@out,$prev);
    return @out;
}

Bio/Root/RootI.pm  view on Meta::CPAN

}

=head2 _not_implemented_msg

Unify 'not implemented' message. -Juguang
=cut

sub _not_implemented_msg {
    my $self = shift;
    my $package = ref $self;
    my $meth = (caller(2))[3];
    my $msg =<<EOD_NOT_IMP;
Abstract method \"$meth\" is not implemented by package $package.
This is not your fault - author of $package should be blamed!
EOD_NOT_IMP
    return $msg;
}

1;

Bio/Root/Storable.pm  view on Meta::CPAN

  Exceptions:
  Caller    :
  Example   : $obj->workdir('/tmp/foo');

=cut

sub workdir {
    my $key = '_workdir';
    my $self = shift;
    if( @_ ){
        my $caller = join( ', ', (caller(0))[1..2] );
        $self->{$key} && $self->debug("Overwriting workdir: probably bad!");
        $self->{$key} = shift
    }
    #$self->{$key} ||= $Bio::Root::IO::TEMPDIR;
    $self->{$key} ||= File::Spec->tmpdir();
    return $self->{$key};
}

#----------------------------------------------------------------------

Bio/Root/Version.pm  view on Meta::CPAN

=head1 AUTHOR Aaron Mackey

=cut

our $VERSION = '1.007002';

sub import {
    # try to handle multiple levels of inheritance:
    my $i = 0;
    my $pkg = caller($i);
    no strict 'refs';
    while ($pkg) {
        if (    $pkg =~ m/^Bio::/o
            and not defined ${$pkg . "::VERSION"}
            ) {
            ${$pkg . "::VERSION"} = $VERSION;
        }
        $pkg = caller(++$i);
    }
}

1;

__END__

Bio/Search/SearchUtils.pm  view on Meta::CPAN

	    $hash{"hsp$hspcount\_gaps"}    = $hsp->gaps('total');
	    $hspcount++;
	}
	$hitcount++;
    }
    return %hash;
}

sub _warn_about_no_hsps {
    my $hit = shift;
    my $prev_func=(caller(1))[3];
    $hit->warn("There is no HSP data for hit '".$hit->name."'.\n".
               "You have called a method ($prev_func)\n".
               "that requires HSP data and there was no HSP data for this hit,\n".
               "most likely because it was absent from the BLAST report.\n".
               "Note that by default, BLAST lists alignments for the first 250 hits,\n".
               "but it lists descriptions for 500 hits. If this is the case,\n".
               "and you care about these hits, you should re-run BLAST using the\n".
               "-b option (or equivalent if not using blastall) to increase the number\n".
               "of alignments.\n"
              );

t/lib/Error.pm  view on Meta::CPAN

use strict;
use 5.004;

use overload (
	'""'	   =>	'stringify',
	'0+'	   =>	'value',
	'bool'     =>	sub { return 1; },
	'fallback' =>	1
);

$Error::Depth = 0;	# Depth to pass to caller()
$Error::Debug = 0;	# Generate verbose stack traces
@Error::STACK = ();	# Clause stack for try
$Error::THROWN = undef;	# last error thrown, a workaround until die $ref works

my $LAST;		# Last error created
my %ERROR;		# Last error associated with package

# Exported subs are defined in Error::subs

sub import {

t/lib/Error.pm  view on Meta::CPAN

	${*$obj}{'__Error__'} = $err;
    }
    $obj = ref($obj);
    $ERROR{ ref($obj) } = $err;

    return;
}

sub new {
    my $self = shift;
    my($pkg,$file,$line) = caller($Error::Depth);

    my $err = bless {
	'-package' => $pkg,
	'-file'    => $file,
	'-line'    => $line,
	@_
    }, $self;

    $err->associate($err->{'-object'})
	if(exists $err->{'-object'});