view release on metacpan or search on metacpan
lib/Bio/GMOD/Blast/Graph/MyDebug.pm view on Meta::CPAN
sub debugP
{
my( $flag ) = shift;
my( $pkg, $file, $line ) = caller();
$pkgOn{ $pkg } = $flag;
}
# concatenates with " ".
sub dmsg
{
my( @msg ) = @_;
my( $flag );
( $pkg, $file, $line ) = caller();
$flag = $pkgOn{ $pkg };
if( !defined($flag) || $flag != 0 )
{
lib/Bio/GMOD/Blast/Graph/MyDebug.pm view on Meta::CPAN
sub dmsgs
{
my( @msg ) = @_;
my( $flag );
( $pkg, $file, $line ) = caller();
$flag = $pkgOn{ $pkg };
if( !defined($flag) || $flag != 0 )
{
view release on metacpan or search on metacpan
# Can't use Carp because it might cause use_ok() to accidentally succeed
# even though the module being used forgot to use Carp. Yes, this
# actually happened.
sub _carp {
my($file, $line) = (caller(1))[1,2];
warn @_, " at $file line $line\n";
}
sub _export_to_level
{
my $pkg = shift;
my $level = shift;
(undef) = shift; # redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
}
=head1 NAME
view release on metacpan or search on metacpan
DBUtils/DBUtils.pm.in view on Meta::CPAN
my $dbh = shift;
return if ref($dbh) && $dbh->isa('Bio::Genex::Connect');
# Oops, someone blew it, give them a useful error message
# first figure out who called us
my @caller = caller(1);
my $subroutine = $caller[3];
if (ref($dbh) && $dbh->isa('DBI::db')) {
croak "Invalid DB handle. Cannot use DBI::connect()\nto create a DB handle for $subroutine,\nmust create DB handle using Bio::Genex::current_connection() or Bio::Genex::_connect()";
} else {
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 release on metacpan or search on metacpan
lib/Bio/Kmer.pm view on Meta::CPAN
our $enqueueStick :shared; # Helps control access to the kmer queue
# TODO if 'die' is imported by a script, redefine
# sig die in that script as this function.
local $SIG{'__DIE__'} = sub { my $e = $_[0]; $e =~ s/(at [^\s]+? line \d+\.$)/\nStopped $1/; die("$0: ".(caller(1))[3].": ".$e); };
my $startTime = time();
sub logmsg{
local $0 = basename $0;
my $tid = 0;
view release on metacpan or search on metacpan
MAGE/XML/Handler/ObjectHandlerI.pm view on Meta::CPAN
our $VERSION = '0.99';
sub new {
my $pack = shift;
my $self = bless {}, $pack;
$self->throw_not_implemented("new not defined for ".ref(caller()));
}
sub handle {
my $self = shift;
$self->throw_not_implemented("handle not defined for ".ref(caller()));
}
1;
__END__
view release on metacpan or search on metacpan
MAGE/Base.pm view on Meta::CPAN
=cut
sub throw {
my ($self, $msg) = @_;
die(caller().': '.$msg);
}
=item throw_not_implemented
Title : throw_not_implemented
MAGE/Base.pm view on Meta::CPAN
=cut
sub throw_not_implemented {
my ($self) = @_;
die("Abstract method ".caller()." implementing class did not provide method");
}
=back
=head1 BUGS
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 release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
}
view release on metacpan or search on metacpan
lib/Bio/Metabolic/MatrixOps.pm view on Meta::CPAN
sub PDL::Matrix::invert {
my $matrix = shift->copy;
# print "ref(matrix) is ".ref($matrix)."\n";
# my ($pkg,$file,$line)=caller();
my @dims = $matrix->dims;
if ( $dims[0] != $dims[1] ) {
croak("Inverse for non-square matrix not defined!\n");
view release on metacpan or search on metacpan
lib/Bio/NEXUS/Util/Exceptions.pm view on Meta::CPAN
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 ];
}
view release on metacpan or search on metacpan
lib/Bio/Phylo/NeXML/Writable.pm view on Meta::CPAN
my $add_namespaces_to_attributes = sub {
my ( $self, $attrs ) = @_;
my $i = 0;
my $inside_to_xml_recursion = 0;
CHECK_RECURSE: while ( my @frame = caller($i) ) {
if ( $frame[3] =~ m/::to_xml$/ ) {
$inside_to_xml_recursion++;
last CHECK_RECURSE if $inside_to_xml_recursion > 1;
}
$i++;
view release on metacpan or search on metacpan
lib/Bio/Polloc/Polloc/Root.pm view on Meta::CPAN
sub stack_trace {
my $self = shift;
my $i = 0;
my @out = ();
my $prev = [];
while( my @call = caller($i++)){
$prev->[3] = $call[3];
push @out, $prev;
$prev = \@call;
}
$prev->[3] = 'toplevel';
view release on metacpan or search on metacpan
Bio/Prospect/CBT/debug.pm view on Meta::CPAN
use Carp;
sub identify_file
{
my ($p,$f,$l) = caller();
my $v = eval "return \$${p}::VERSION" || 'N/A';
print(STDERR "# use $p (f:$f, v:$v)\n");
}
sub advise
{
my $level = shift;
my $pkg = (caller())[0];
carp( "$pkg ($level):", @_ ) if eval { $pkg::DEBUG >= $level }
}
sub RCSVersion
{
view release on metacpan or search on metacpan
lib/Bio/RNA/RNAaliSplit.pm view on Meta::CPAN
with 'FileDirUtil';
sub BUILD {
my $self = shift;
my $this_function = (caller(0))[3];
confess "ERROR [$this_function] \$self->ifile not available"
unless ($self->has_ifile);
$self->alignment({-file => $self->ifile,
-format => $self->format,
-displayname_flat => 1} );
lib/Bio/RNA/RNAaliSplit.pm view on Meta::CPAN
if ($self->next_aln->num_sequences == 2){ $self->_hamming() }
}
sub dump_subalignment {
my ($self,$alipathsegment,$token,$what) = @_;
my $this_function = (caller(0))[3];
my ($aln,$aln2,$name);
croak "ERROR [$this_function] argument 'token' not provided"
unless (defined($token));
lib/Bio/RNA/RNAaliSplit.pm view on Meta::CPAN
return ( $oalifile_clustal,$oalifile_stockholm );
}
sub _hamming {
my $self = shift;
my $this_function = (caller(0))[3];
my $hamming = -1;
croak "ERROR [$this_function] cannot compute Hamming distance for $self->next_aln->num_sequences sequences"
if ($self->next_aln->num_sequences != 2);
my $aln = $self->next_aln->select_noncont((1,2));
view release on metacpan or search on metacpan
lib/Bio/SDRS.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 release on metacpan or search on metacpan
lib/Bio/Sampling/Valection.pm view on Meta::CPAN
- **seed** (optional): an integer to seed the random number generator with (used to randomize sampling)
use Bio::Sampling::Valection;
# Run the sampling to select 10 candidates
run_equal_per_caller(10, "/home/me/calls.valec", "/home/me/selections.txt", 50);
=cut
use Exporter 'import';
view release on metacpan or search on metacpan
lib/Bio/Tools/Primer3Redux/Result.pm view on Meta::CPAN
my ($ft, $seq, $instance) = @_;
my ($type, $loc) = (delete($ft->{type}), delete($ft->{location}));
# TODO: There is data showing up here that doesn't have locations, traceback
if (!defined($loc)) {
#print STDERR (caller(1))[3].":".Dumper $ft;
return ;
}
my $rank = $ft->{rank};
my $strand = $type eq 'right' ? -1 : 1;
view release on metacpan or search on metacpan
lib/Bio/ViennaNGS/AnnoC.pm view on Meta::CPAN
$self->_get_nr_of_features();
};
sub _set_featstat {
my $self = shift;
my $this_function = (caller(0))[3];
my %fs = ();
confess "ERROR [$this_function] \$self->features not available"
unless ($self->has_features);
$fs{total} = 0;
$fs{origin} = "$this_function ".$VERSION;
lib/Bio/ViennaNGS/AnnoC.pm view on Meta::CPAN
return \%fs;
}
sub _get_nr_of_features {
my $self = shift;
my $this_function = (caller(0))[3];
confess "ERROR [$this_function] \$self->features not available"
unless ($self->has_features);
return (keys %{$self->features});
}
sub parse_gff {
my ($self,$in_file) = @_;
my ($i,$gffio,$header,$f,$gbkey);
my $this_function = (caller(0))[3];
$gffio = Bio::Tools::GFF->new(-file => $in_file,
-gff_version => 3,
);
$gffio->ignore_sequence(1);
lib/Bio/ViennaNGS/AnnoC.pm view on Meta::CPAN
sub features2bed {
my ($self,$gbkey,$dest,$bn,$log) = @_;
my ($chrom,$chrom_start,$chrom_end,$name,$score,$strand,$thick_start);
my ($thick_end,$reserved,$block_count,$block_sizes,$block_starts);
my @ft = ();
my $this_function = (caller(0))[3];
croak "ERROR [$this_function] $self->features not available"
unless ($self->has_features);
croak "ERROT [$this_function] $self->featstat not available"
unless ($self->has_featstat);
lib/Bio/ViennaNGS/AnnoC.pm view on Meta::CPAN
}
sub feature_summary {
my ($self, $dest) = @_;
my ($fn,$fh);
my $this_function = (caller(0))[3];
croak "ERROR [$this_function] $dest does not exist\n"
unless (-d $dest);
croak "ERROR [$this_function] $self->accession not available\n"
unless ($self->has_accession);
view release on metacpan or search on metacpan
lib/Bio/WGS2NCBI/Logger.pm view on Meta::CPAN
# compose the message. Complex messages do some amount of introspection
# to figure out where the message originated.
my $log;
if ( $Complexity ) {
my ( $package, $file1up, $line1up, $sub ) = caller( 2 );
my ( $pack0up, $file, $line, $sub0up ) = caller( 1 );
$log = sprintf( "%s %s [%s %s] - %s\n", uc $method, $sub || '', $file, $line, $msg );
}
else {
$log = $method . ' ' . $msg . "\n";
}
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 release on metacpan or search on metacpan
t/lib/Sub/Uplevel.pm view on Meta::CPAN
bar(); # main - foo.plx - 11
=head1 DESCRIPTION
Like Tcl's uplevel() function, but not quite so dangerous. The idea
is just to fool caller(). All the really naughty bits of Tcl's
uplevel() are avoided.
B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY>
=over 4
t/lib/Sub/Uplevel.pm view on Meta::CPAN
=item B<uplevel>
uplevel $num_frames, \&func, @args;
Makes the given function think it's being executed $num_frames higher
than the current stack level. So when they use caller($frames) it
will actually give caller($frames + $num_frames) for them.
C<uplevel(1, \&some_func, @_)> is effectively C<goto &some_func> but
you don't immediately exit the current subroutine. So while you can't
do this:
t/lib/Sub/Uplevel.pm view on Meta::CPAN
*CORE::GLOBAL::caller = sub(;$) {
my $height = $_[0] || 0;
# shortcut if no uplevels have been called
# always add +1 to CORE::caller to skip this function's caller
return CORE::caller( $height + 1 ) if ! @Up_Frames;
=begin _private
So it has to work like this:
t/lib/Sub/Uplevel.pm view on Meta::CPAN
uplevel 4
function_that_called_uplevel 5
caller_we_want_to_see 6 3
its_caller 7 4
So when caller(X) winds up below uplevel(), it only has to use
CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X)
winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
Which means I'm probably going to have to do something nasty like walk
up the call stack on each caller() to see if I'm going to wind up
before or after Sub::Uplevel::uplevel().
=end _private
=begin _dagolden
t/lib/Sub/Uplevel.pm view on Meta::CPAN
# walk up the call stack to fight the right package level to return;
# look one higher than requested for each call to uplevel found
# and adjust by the amount found in the Up_Frames stack for that call
for ( my $up = 0; $up <= $height + $adjust; $up++ ) {
my @caller = CORE::caller($up + 1);
if( defined $caller[0] && $caller[0] eq __PACKAGE__ ) {
# add one for each uplevel call seen
# and look into the uplevel stack for the offset
$adjust += 1 + $Up_Frames[$saw_uplevel];
$saw_uplevel++;
}
}
my @caller = CORE::caller($height + $adjust + 1);
if( wantarray ) {
if( !@_ ) {
@caller = @caller[0..2];
}
view release on metacpan or search on metacpan
t/lib/Sub/Uplevel.pm view on Meta::CPAN
bar(); # main - foo.plx - 11
=head1 DESCRIPTION
Like Tcl's uplevel() function, but not quite so dangerous. The idea
is just to fool caller(). All the really naughty bits of Tcl's
uplevel() are avoided.
B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY>
=over 4
t/lib/Sub/Uplevel.pm view on Meta::CPAN
=item B<uplevel>
uplevel $num_frames, \&func, @args;
Makes the given function think it's being executed $num_frames higher
than the current stack level. So when they use caller($frames) it
will actually give caller($frames + $num_frames) for them.
C<uplevel(1, \&some_func, @_)> is effectively C<goto &some_func> but
you don't immediately exit the current subroutine. So while you can't
do this:
t/lib/Sub/Uplevel.pm view on Meta::CPAN
*CORE::GLOBAL::caller = sub(;$) {
my $height = $_[0] || 0;
# shortcut if no uplevels have been called
# always add +1 to CORE::caller to skip this function's caller
return CORE::caller( $height + 1 ) if ! @Up_Frames;
=begin _private
So it has to work like this:
t/lib/Sub/Uplevel.pm view on Meta::CPAN
uplevel 4
function_that_called_uplevel 5
caller_we_want_to_see 6 3
its_caller 7 4
So when caller(X) winds up below uplevel(), it only has to use
CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X)
winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
Which means I'm probably going to have to do something nasty like walk
up the call stack on each caller() to see if I'm going to wind up
before or after Sub::Uplevel::uplevel().
=end _private
=begin _dagolden
t/lib/Sub/Uplevel.pm view on Meta::CPAN
# walk up the call stack to fight the right package level to return;
# look one higher than requested for each call to uplevel found
# and adjust by the amount found in the Up_Frames stack for that call
for ( my $up = 0; $up <= $height + $adjust; $up++ ) {
my @caller = CORE::caller($up + 1);
if( defined $caller[0] && $caller[0] eq __PACKAGE__ ) {
# add one for each uplevel call seen
# and look into the uplevel stack for the offset
$adjust += 1 + $Up_Frames[$saw_uplevel];
$saw_uplevel++;
}
}
my @caller = CORE::caller($height + $adjust + 1);
if( wantarray ) {
if( !@_ ) {
@caller = @caller[0..2];
}
view release on metacpan or search on metacpan
lib/Bio/Tools/Run/Infernal.pm view on Meta::CPAN
my ($prog, $model, $out, $version) = ($self->program,
$self->model_file,
$self->outfile_name,
$self->version);
if (my $caller = (caller(1))[3]) {
$caller =~ s{.*::(\w+)$}{$1};
$self->throw("Calling _run() from disallowed method") unless exists $ALLOWED{$caller};
} else {
$self->throw("Can't call _run directly");
}
view release on metacpan or search on metacpan
Bio/Align/DNAStatistics.pm view on Meta::CPAN
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++) {
view release on metacpan or search on metacpan
#________________________________________________________
# Title : caller_info
# Function : tells you calleing programs and sub's information with file, subname, main, etc
# Usage : &caller_info; (just embed anywhere you want to check.
#----------------------------------------------------------------------
sub caller_info{ # caller(1), the num. tells you which info you choose
my($i)=1;
while(($pack, $file, $line, $subname, $args) = caller($i++)){
my($level) = $i-1;
print "\n", chr(169)," This sub info was made by \&caller_info subroutine";
print "\n ", chr(164)," Package from => $pack ";
print "\n ", chr(164)," Exe. file was => $file ";
print "\n ", chr(164)," Line was at? => $line (in $file)";
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 release on metacpan or search on metacpan
lib/Bitcoin/Crypto/Exception.pm view on Meta::CPAN
=head3 caller
B<Not assignable in the constructor>
An array ref containing: package name, file name and line number (same
as C<[caller()]> perl expression). It will point to the first place from
outside Bitcoin::Crypto which called it. May be undefined if it cannot find a
calling source.
=head2 Methods
view release on metacpan or search on metacpan
ccstack = top_si->si_cxstack;
cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
}
if (cxix < 0)
return NULL;
/* caller() should not report the automatic calls to &DB::sub */
if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
level++;
if (!level--)
break;
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
/* caller() should not report the automatic calls to &DB::sub */
if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
cx = &ccstack[dbcxix];
}
return cx;