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
#________________________________________________________
# 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 {
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
lib/Bot/Cobalt/Logger.pm view on Meta::CPAN
sub _log_to_level {
my ($self, $level) = splice @_, 0, 2;
$self->output->_write(
$level,
[ caller(1) ],
@_
) if $self->_should_log($level);
1
}
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/Bot/IRC.pm view on Meta::CPAN
return $self;
}
sub vars {
my ( $self, $name ) = @_;
( $name = lc( substr( ( caller() )[0], length(__PACKAGE__) + 2 ) ) ) =~ s/::/\-/g unless ($name);
return ( defined $self->{vars}{$name} ) ? $self->{vars}{$name} : {};
}
sub settings {
my ( $self, $name ) = @_;
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/Boulder/Simple.pm view on Meta::CPAN
return undef unless $thingy;
return $thingy if UNIVERSAL::isa($thingy,'GLOB');
return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
if (!ref($thingy)) {
my $caller = 1;
while (my $package = caller($caller++)) {
my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
return $tmp if defined(fileno($tmp));
}
}
return undef;
view release on metacpan or search on metacpan
lib/Boulder/Util.pm view on Meta::CPAN
return undef unless $thingy;
return $thingy if UNIVERSAL::isa( $thingy, 'GLOB' );
return $thingy if UNIVERSAL::isa( $thingy, 'FileHandle' );
if ( !ref($thingy) ) {
my $caller = 1;
while ( my $package = caller( $caller++ ) ) {
my ($tmp) =
$thingy =~ /[\':]/
? $thingy
: "$package\:\:$thingy";
return $tmp if defined( fileno($tmp) );
view release on metacpan or search on metacpan
Boulder/Stream.pm view on Meta::CPAN
my ($pack,$thingy,$write) = @_;
return unless $thingy;
return $thingy if defined fileno($thingy);
my $caller;
while (my $package = caller(++$caller)) {
my $qualified_thingy = Symbol::qualify_to_ref($thingy,$package);
return $qualified_thingy if defined fileno($qualified_thingy);
}
# otherwise try to open it as a file
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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
lib/Brick/Bucket.pm view on Meta::CPAN
sub __caller_chain_as_list {
my $level = 0;
my @Callers = ();
while( 1 ) {
my @caller = caller( ++$level );
last unless @caller;
push @Callers, {
level => $level,
package => $caller[0],
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 {