caller\( results from the CPAN

Beagle


# I got error: "Goto undefined subroutine &die" on windows strawberry 5.12.2
# &CORE::die doesn't help

    *CORE::GLOBAL::die = sub {
#        goto &die unless ( caller() )[0] =~ /^Beagle::/;
        return die @_ unless ( caller() )[0] =~ /^Beagle::/;

        @_ = map { encode( locale => $_ ) } @_;
        return confess @_ if enabled_devel();

        # we want to show user the line info if there is nothing to print

lib/Beagle/Util.pm view on Meta::CPAN

    };

    *CORE::GLOBAL::warn = sub {
# interesting, I get warn if use goto &warn:
# Goto undefined subroutine &Beagle::Util::warn
#       goto &warn unless (caller())[0] =~ /^Beagle::/;
        return warn @_ unless ( caller() )[0] =~ /^Beagle::/;

        @_ = grep { defined } @_;

        # we want to show user the line info if there is nothing to print
        push @_, newline() if @_;

view all matches for this distribution

Beanstalk-Client

3 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";

view all matches for this distribution

Beekeeper

2 results

view release on metacpan or search on metacpan

lib/Beekeeper/Client.pm view on Meta::CPAN


sub __create_response_topic {
    my $self = shift;
    my $client = $self->{_CLIENT};

    my ($file, $line) = (caller(2))[1,2];
    my $at = "at $file line $line\n";

    # Subscribe to an exclusive topic for receiving RPC responses

    my $response_topic = 'priv/' . $self->{_BUS}->{client_id};

view all matches for this distribution

Bench

1 match

view release on metacpan or search on metacpan

lib/Bench.pm view on Meta::CPAN

}

sub import {
    _set_start_time;
    no strict 'refs';
    my $caller = caller();
    *{"$caller\::bench"} = \&bench;
}

sub _fmt_num {
    my ($num, $unit, $nsig) = @_;

view all matches for this distribution

Bencher-Scenario-Caller

6 results

view release on metacpan or search on metacpan

lib/Bencher/Scenario/Caller.pm view on Meta::CPAN

use 5.010001;
use strict;
use warnings;

our $scenario = {
    summary => 'Benchmark some variations of caller()',
    participants => [
        {
            name => 'CORE::caller() (scalar)',
            code_template => 'CORE::caller()',
        },
        {
            name => 'CORE::caller() (list)',
            code_template => 'CORE::caller()',
            result_is_list => 1,
        },
        {
            name => 'CORE::caller(0)',
            code_template => 'CORE::caller(0)',
            result_is_list => 1,
        },
        {
            name => 'CORE::caller(1)',
            code_template => 'CORE::caller(1)',
            result_is_list => 1,
        },
        {
            name => 'CORE::caller(2)',
            code_template => 'CORE::caller(2)',
            result_is_list => 1,
        },

        {
            name => 'Devel::Caller::Util::caller(0)',
            module => 'Devel::Caller::Util',
            code_template => 'Devel::Caller::Util::caller(0)',
            result_is_list => 1,
        },
        {
            name => 'Devel::Caller::Util::caller(1)',
            module => 'Devel::Caller::Util',
            code_template => 'Devel::Caller::Util::caller(1)',
            result_is_list => 1,
        },
        {
            name => 'Devel::Caller::Util::caller(2)',
            module => 'Devel::Caller::Util',
            code_template => 'Devel::Caller::Util::caller(2)',
            result_is_list => 1,
        },
        {
            name => 'Devel::Caller::Util::caller(0) with-args',
            module => 'Devel::Caller::Util',
            code_template => 'Devel::Caller::Util::caller(0, 1)',
            result_is_list => 1,
        },
        {
            name => 'Devel::Caller::Util::caller(0) with-packages-to-ignore=re',
            module => 'Devel::Caller::Util',
            code_template => 'Devel::Caller::Util::caller(0, 0, qr/^Bencher::Scenario$/)',
            result_is_list => 1,
        },
    ],
};

1;
# ABSTRACT: Benchmark some variations of caller()

__END__

=pod

=encoding UTF-8

=head1 NAME

Bencher::Scenario::Caller - Benchmark some variations of caller()

=head1 VERSION

This document describes version 0.001 of Bencher::Scenario::Caller (from Perl distribution Bencher-Scenario-Caller), released on 2019-04-14.

lib/Bencher/Scenario/Caller.pm view on Meta::CPAN


=head1 BENCHMARK PARTICIPANTS

=over

=item * CORE::caller() (scalar) (perl_code)

Code template:

 CORE::caller()



=item * CORE::caller() (list) (perl_code)

Code template:

 CORE::caller()



=item * CORE::caller(0) (perl_code)

Code template:

 CORE::caller(0)



=item * CORE::caller(1) (perl_code)

Code template:

 CORE::caller(1)



=item * CORE::caller(2) (perl_code)

Code template:

 CORE::caller(2)



=item * Devel::Caller::Util::caller(0) (perl_code)

Code template:

 Devel::Caller::Util::caller(0)



=item * Devel::Caller::Util::caller(1) (perl_code)

Code template:

 Devel::Caller::Util::caller(1)



=item * Devel::Caller::Util::caller(2) (perl_code)

Code template:

 Devel::Caller::Util::caller(2)



=item * Devel::Caller::Util::caller(0) with-args (perl_code)

Code template:

 Devel::Caller::Util::caller(0, 1)



=item * Devel::Caller::Util::caller(0) with-packages-to-ignore=re (perl_code)

Code template:

 Devel::Caller::Util::caller(0, 0, qr/^Bencher::Scenario$/)



=back

lib/Bencher/Scenario/Caller.pm view on Meta::CPAN


 #table1#
 +-----------------------------------------------------------+-----------+-----------+------------+---------+---------+
 | participant                                               | rate (/s) | time (Î¼s) | vs_slowest |  errors | samples |
 +-----------------------------------------------------------+-----------+-----------+------------+---------+---------+
 | Devel::Caller::Util::caller(2)                            |    100000 |     9.7   |        1   | 9.8e-09 |      21 |
 | Devel::Caller::Util::caller(1)                            |    150000 |     6.8   |        1.4 |   1e-08 |      20 |
 | Devel::Caller::Util::caller(0) with-args                  |    230000 |     4.3   |        2.3 | 8.3e-09 |      20 |
 | Devel::Caller::Util::caller(0) with-packages-to-ignore=re |    200000 |     4     |        2   |   2e-07 |      20 |
 | Devel::Caller::Util::caller(0)                            |    280000 |     3.6   |        2.7 | 2.1e-08 |      20 |
 | CORE::caller(1)                                           |  23000000 |     0.043 |      230   | 2.9e-10 |      20 |
 | CORE::caller(0)                                           |  24000000 |     0.042 |      230   |   1e-10 |      22 |
 | CORE::caller(2)                                           |  25000000 |     0.04  |      240   | 5.8e-11 |      20 |
 | CORE::caller() (scalar)                                   |  25000000 |     0.039 |      250   | 1.2e-10 |      20 |
 | CORE::caller() (list)                                     |  27000000 |     0.038 |      260   | 2.4e-10 |      24 |
 +-----------------------------------------------------------+-----------+-----------+------------+---------+---------+


Benchmark module startup overhead (C<< bencher -m Caller --module-startup >>):

view all matches for this distribution

Benchmark-Confirm

1 match

view release on metacpan or search on metacpan

lib/Benchmark/Confirm.pm view on Meta::CPAN

    croak "negative loopcount $n" if $n<0;
    confess usage unless defined $c;
    my($t0, $t1, $td); # before, after, difference

    # find package of caller so we can execute code there
    my($curpack) = caller(0);
    my($i, $pack)= 0;
    while (($pack) = caller(++$i)) {
        last if $pack ne $curpack;
    }

    my ($subcode, $subref, $confirmref);
    if (ref $c eq 'CODE') {

view all matches for this distribution

Benchmark-DKbench

1 match

view release on metacpan or search on metacpan

data/t/recipes/meta_privateorpublic_methodmetaclass.t view on Meta::CPAN

      my $package   = $self->package_name;
      my $real_body = $self->body;

      my $body = sub {
          die "The $package\::$name method is private"
              unless ( scalar caller() ) eq $package;

          goto &{$real_body};
      };

      $self->{body} = $body;

view all matches for this distribution

Benchmark-Harness

5 results

view release on metacpan or search on metacpan

Harness/Handler.pm view on Meta::CPAN

sub ArgumentsXXX {
  my $self = shift;
  return $self unless ref($self);
  return $self unless $self->{_outFH};

  $self->_PrintT('-Arguments', caller(1));

  my $i = 1;
  for ( @_ ) {
    my $obj = ref($_)?$_:\$_;
    my ($nm, $sz) = (ref($_), Devel::Size::total_size($_));

Harness/Handler.pm view on Meta::CPAN

  my $pckg = $_[0];

  my $pckgName = "$pckg";
  $pckgName =~ s{=?(ARRAY|HASH|SCALAR).*$}{};
  my $pckgType = $1;
  $self->_PrintT("-$pckgType $pckgName", caller(1));
  $self->OnObject(@_);

  $self->_PrintT_();
  return $self;
}

Harness/Handler.pm view on Meta::CPAN

# USAGE: Harness::NamedVariables('name1' => $variable1 [, 'name1' => $variable2 ])
sub NamedVariables {
  my $self = ref($_[0])?shift:$Benchmark::Harness::Harness;
  return $self unless ref($self);

  $self->_PrintT(undef, caller(1));

  my $i = 1;
  while ( @_ ) {
    my ($nm, $sz) = (shift, Devel::Size::total_size(shift));
    $nm = $i unless $nm; $i += 1;

view all matches for this distribution

Benchmark-Perl-Formance-Cargo

3 results

view release on metacpan or search on metacpan

share/PerlCritic/Critic/Policy.pm view on Meta::CPAN


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

sub violation {  ## no critic (ArgUnpacking)
    my ( $self, $desc, $expl, $elem ) = @_;
    # HACK!! Use goto instead of an explicit call because P::C::V::new() uses caller()
    my $sev = $self->get_severity();
    @_ = ('Perl::Critic::Violation', $desc, $expl, $elem, $sev );
    goto &Perl::Critic::Violation::new;
}

view all matches for this distribution

Benchmark-ProgressBar

4 results

view release on metacpan or search on metacpan

inc/Module/Install.pm view on Meta::CPAN

#####################################################################
# Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {

view all matches for this distribution

Benchmark-Thread-Size

1 match

view release on metacpan or search on metacpan

lib/Benchmark/Thread/Size.pm view on Meta::CPAN

# Initialize the key list

    shift;
    my %param;
    my $times = '';
    my $oneliner = (join( ' ',caller() ) eq 'main - 0');
    my $refonly = $oneliner;
    my @key;

# While there are keys to be obtained
#  If it is the times setting

view all matches for this distribution

Benchmark-Timer

3 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

view all matches for this distribution

BerkeleyDB-Easy

1 match

view release on metacpan or search on metacpan

lib/BerkeleyDB/Easy/Error.pm view on Meta::CPAN

		code => (int $error || int BDB_UNKNOWN),
	);
	
	# Populate package, file, line and sub attributes.
	# If VERBOSE, get a full stack trace.
	my $caller  = $self->_caller(SKIP);
	$exc{$_}    = $caller->{$_} for qw(package file line sub);
	$exc{trace} = BDB_VERBOSE
		? $self->_carp
		: qq(at $exc{file} line $exc{line}.);

lib/BerkeleyDB/Easy/Error.pm view on Meta::CPAN

sub _const {
	my ($self, $name) = @_;

	DEBUG and $self->_debug(qq(Resolving constant: $name));

	my $caller   = $self->_caller(SKIP)->{package};
	my $fullname = qq(&$caller\::$name);

	# Resolve the name to a coderef. Look in our caller, this module,
	# BerkeleyDB, and Errno, in that order.
	my $func = $caller->can($name)

view all matches for this distribution

BerkeleyDB

2 results

view release on metacpan or search on metacpan

BerkeleyDB.pm view on Meta::CPAN

{
    my ($default, @rest) = @_ ;
    my (%got) = %$default ;
    my (@Bad) ;
    my ($key, $value) ;
    my $sub = (caller(1))[3] ;
    my %options = () ;
    local ($Carp::CarpLevel) = 1 ;

    # allow the options to be passed as a hash reference or
    # as the complete hash.

view all matches for this distribution

Best

3 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

view all matches for this distribution

Bible-OBML

1 match

view release on metacpan or search on metacpan

lib/Bible/OBML.pm view on Meta::CPAN


    return "<obml>$obml</obml>";
}

sub _accessor ( $self, $input = undef ) {
    my $want = ( split( '::', ( caller(1) )[3] ) )[-1];

    if ($input) {
        if ( ref $input ) {
            my $data_refs_ocd;
            $data_refs_ocd = sub ($node) {

view all matches for this distribution

Biblio-RFID

4 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

view all matches for this distribution

Big5

1 match

view release on metacpan or search on metacpan

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5.pm view on Meta::CPAN


#
# instead of Carp::carp
#
sub carp {
    my($package,$filename,$line) = caller(1);
    print STDERR "@_ at $filename line $line.\n";
}

#
# instead of Carp::croak
#
sub croak {
    my($package,$filename,$line) = caller(1);
    print STDERR "@_ at $filename line $line.\n";
    die "\n";
}

#
# instead of Carp::cluck
#
sub cluck {
    my $i = 0;
    my @cluck = ();
    while (my($package,$filename,$line,$subroutine) = caller($i)) {
        push @cluck, "[$i] $filename($line) $package::$subroutine\n";
        $i++;
    }
    print STDERR CORE::reverse @cluck;
    print STDERR "\n";

lib/Ebig5.pm view on Meta::CPAN

# instead of Carp::confess
#
sub confess {
    my $i = 0;
    my @confess = ();
    while (my($package,$filename,$line,$subroutine) = caller($i)) {
        push @confess, "[$i] $filename($line) $package::$subroutine\n";
        $i++;
    }
    print STDERR CORE::reverse @confess;
    print STDERR "\n";

view all matches for this distribution

Big5HKSCS

1 match

view release on metacpan or search on metacpan

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN

    $modifier ||= '';

    $modifier =~ tr/p//d;
    if ($modifier =~ /([adlu])/oxms) {
        my $line = 0;
        for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
            if ($filename ne __FILE__) {
                $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
                last;
            }
        }

lib/Ebig5hkscs.pm view on Meta::CPAN


#
# instead of Carp::carp
#
sub carp {
    my($package,$filename,$line) = caller(1);
    print STDERR "@_ at $filename line $line.\n";
}

#
# instead of Carp::croak
#
sub croak {
    my($package,$filename,$line) = caller(1);
    print STDERR "@_ at $filename line $line.\n";
    die "\n";
}

#
# instead of Carp::cluck
#
sub cluck {
    my $i = 0;
    my @cluck = ();
    while (my($package,$filename,$line,$subroutine) = caller($i)) {
        push @cluck, "[$i] $filename($line) $package::$subroutine\n";
        $i++;
    }
    print STDERR CORE::reverse @cluck;
    print STDERR "\n";

lib/Ebig5hkscs.pm view on Meta::CPAN

# instead of Carp::confess
#
sub confess {
    my $i = 0;
    my @confess = ();
    while (my($package,$filename,$line,$subroutine) = caller($i)) {
        push @confess, "[$i] $filename($line) $package::$subroutine\n";
        $i++;
    }
    print STDERR CORE::reverse @confess;
    print STDERR "\n";

view all matches for this distribution

Bigtop

1 match

view release on metacpan or search on metacpan

lib/Bigtop/Parser.pm view on Meta::CPAN

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

sub add_valid_keywords {
    my $class    = shift;
    my $type     = shift;
    my $caller   = caller( 0 );

    my %callers;

    KEYWORD:
    foreach my $statement ( @_ ) {

view all matches for this distribution

Binance-API

1 match

view release on metacpan or search on metacpan

lib/Binance/API/Logger.pm view on Meta::CPAN


    return if $level eq 'DESTROY';

    my $message = shift || "";

    my $sub = (caller(1))[3];
    my $full_message = "[$sub] ". $message;

    if ($level eq 'debug' || $level eq 'trace') {
        carp $full_message if DEBUG;
    } else {

view all matches for this distribution

Binding

4 results

view release on metacpan or search on metacpan

inc/Module/Install.pm view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion

view all matches for this distribution

Bio-App-SELEX-RNAmotifAnalysis

6 results

view release on metacpan or search on metacpan

bin/selex_clustal2stockholm.pl view on Meta::CPAN

my $usage = "\nUsage: $0 <ClustalW file> [gc_file]
           Converts a ClustalW file (from file or STDIN) to Stockholm format.
           Only converts sequence information, unless a secondary structure
           file is given as the second argument.\n";

main(@ARGV) unless caller();

sub main {
    my @cmd_line_args = @_;
    my @argv;
    my $gc_string;

view all matches for this distribution

Bio-Biblio

2 results

view release on metacpan or search on metacpan

lib/Bio/Biblio/BiblioBase.pm view on Meta::CPAN

    my ($self, $given_type, $expected_type, $method) = @_;
    my $msg = 'In method ';
    if (defined $method) {
        $msg .= $method;
    } else {
        $msg .= (caller(1))[3];
    }
    return ("$msg: Trying to set a value of type '$given_type' but '$expected_type' is expected.");
}

view all matches for this distribution

Bio-Community

1 match

view release on metacpan or search on metacpan

lib/Bio/Community/Member.pm view on Meta::CPAN

      # Assign a new ID
      #$self->id( PREFIX.$max_num++ ); # warns because of call to _register_id
      $self->{id} = PREFIX.++$max_num
   } else {
      # Validate ID
      if ( ($id =~ $id_re) && ((caller(0))[0] !~ $mod_re) && ((caller(1))[0] !~ $mod_re) ) {
         # Check validity of 'bcXX' IDs not requested by Bio::Community* modules
         my $num = $1;
         if ($num > $max_num) {
            $max_num = $num;
         } else {

view all matches for this distribution

Bio-EBI-RNAseqAPI

3 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {

view all matches for this distribution

Bio-ECell

3 results

view release on metacpan or search on metacpan

inc/Module/AutoInstall.pm view on Meta::CPAN


    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {

view all matches for this distribution

Bio-EUtilities

1 match

view release on metacpan or search on metacpan

bin/bp_genbank_ref_extractor view on Meta::CPAN

    $level = 1 + $_[0];
  } else {
    die "Bug found when calculating level for caller function. Please report.";
  }
  my $deeper = shift;
  return "by " . (caller($level))[3] . " at line " . (caller($level))[2];
}


sub file_extension_for {
  ## TODO in some cases, extension changes whether it's protein or DNA or whatever

view all matches for this distribution

Bio-EnsEMBL

1 match

view release on metacpan or search on metacpan

lib/Bio/EnsEMBL/Utils/Exception.pm view on Meta::CPAN

  while ( @path && $i < 2 ) {
    $i++;
    $file = pop(@path) . "/$file";
  }

  @caller = caller(1);
  my $caller_line;
  my $caller_file;
  $i = 0;
  if (@caller) {
    @path        = split( /\//, $caller[1] );

lib/Bio/EnsEMBL/Utils/Exception.pm view on Meta::CPAN

=head2 stack_trace

  Arg [1]    : none
  Example    : use Bio::EnsEMBL::Utils::Exception qw(stack_trace)
  Description: Gives an array to a reference of arrays with stack trace info
               each coming from the caller(stack_number) call
  Returntype : array of listrefs of strings
  Exceptions : none
  Caller     : general, stack_trace_dump()

=cut

sub stack_trace {
  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);

lib/Bio/EnsEMBL/Utils/Exception.pm view on Meta::CPAN


  $level = $DEFAULT_DEPRECATE if(!defined($level));

  return if($VERBOSITY < $level);
                                 
  my @caller = caller(1);
  my $subname = $caller[3] ;
  my $line = $caller[2];

  #use only 2 subdirs for brevity when reporting the filename
  my $file;

view all matches for this distribution

Bio-FdrFet

1 match

view release on metacpan or search on metacpan

lib/Bio/FdrFet.pm view on Meta::CPAN

=cut

sub new {
    my $pkg;
    my $class = shift;
    eval {($pkg) = caller(0);};
    if ($class ne $pkg) {
	unshift @_, $class;
    }
    my $self = {};
    bless $self;

view all matches for this distribution