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;
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;
}
sub _read {
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
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
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
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 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 release on metacpan or search on metacpan
lib/Book/Collate/Section.pm view on Meta::CPAN
=cut
sub _trim {
my ( $self, $string ) = @_;
my $caller = caller();
( my $new_string ) = $string =~ m/^\s*(\S.*\S)\s*$/s;
return $new_string;
}
=head2 avg_sentence_length
view release on metacpan or search on metacpan
src/boost/python/detail/caller.hpp view on Meta::CPAN
F,CallPolicies,Sig
>::type base;
typedef PyObject* result_type;
caller(F f, CallPolicies p) : base(f,p) {}
};
}}} // namespace boost::python::detail
view release on metacpan or search on metacpan
include/boost/lambda/detail/member_ptr.hpp view on Meta::CPAN
template<class RET, class A, class B>
class member_pointer_caller {
A a; B b;
public:
member_pointer_caller(const A& aa, const B& bb) : a(aa), b(bb) {}
RET operator()() const { return (a->*b)(); }
template<class A1>
RET operator()(const A1& a1) const { return (a->*b)(a1); }
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;
}
sub _read {
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 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;
}
sub _read {