view release on metacpan or search on metacpan
t/30-tons_of_sync.t view on Meta::CPAN
use Async::Queue;
sub stack_frame_num {
my $num = 0;
while(caller($num)) {
$num++;
}
return $num;
}
view release on metacpan or search on metacpan
src/ppport.h view on Meta::CPAN
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))
count++;
if (!count--)
break;
src/ppport.h view on Meta::CPAN
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
lib/At/Error.pm view on Meta::CPAN
push @stack, \%i;
}
}
method throw() {
my ( undef, $file, $line ) = caller();
my $msg = join "\n\t", sprintf( qq[%s at %s line %d], $message, $file, $line ),
map { sprintf q[%s called at %s line %d], $_->{sub_name}, $_->{file}, $_->{line} } @stack;
$fatal ? die "$msg\n" : warn "$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
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
#####################################################################
# 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
#####################################################################
# 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
#####################################################################
# 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;
}
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
bench/attr_bench.pl view on Meta::CPAN
use Cache::MemoryCache;
my %caches;
sub getCache {
my (undef, undef, undef, $method) = caller(2);
return $caches{$method} ||= do {
warn "Getting cache $method";
Cache::MemoryCache->new({namespace=>$method});
};
}
view release on metacpan or search on metacpan
lib/Attribute/Default.pm view on Meta::CPAN
## once 'exsub' is exported for compile-time speed.
##
sub import {
my $class = shift;
my ($subname) = @_;
my $callpkg = (caller())[0];
if (defined($subname) && $subname eq 'exsub') {
no strict 'refs';
*{ "${callpkg}::exsub" } = \&exsub;
}
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/Attribute/GlobalEnable.pm view on Meta::CPAN
my $class = shift();
croak "Must specify some arguments." if not @_;
my $args = {@_};
## set the package to the caller
$PACKAGE = caller();
croak "Must sub-package ".$PACKAGE if not $PACKAGE or $PACKAGE eq __PACKAGE__;
## make sure our sub-packaged module is using the exporter
_export_the_exporter_to( $PACKAGE ) or die "Bad exporting exporter";
lib/Attribute/GlobalEnable.pm view on Meta::CPAN
my $debug_level = _is_flag_on($attribute, $flag);
if( not defined $debug_level ) {
unshift( @_, $flag ) if not defined $debug_level;
}
my $full_package = (caller(2))[3];
my $caller_sub_name = '';
GET_PROPER_PACKAGE_NAME: {
my @packages = split /::/, $full_package;
pop @packages;
view release on metacpan or search on metacpan
demo/Demo.pm view on Meta::CPAN
"with data ($data)\nin phase $phase\n";
};
sub This : ATTR(SCALAR) {
print STDERR "This at ",
join(":", map { defined() ? $_ : "" } caller(1)),
"\n";
}
sub Demo : ATTR(HASH) {
my ($package, $symbol, $referent, $attr, $data) = @_;
view release on metacpan or search on metacpan
demo/Demo.pm view on Meta::CPAN
"with data (@$data)\nin phase $phase\n";
};
sub This : ATTR(SCALAR) {
print STDERR "This at ",
join(":", map { defined() ? $_ : "" } caller(1)),
"\n";
}
sub Multi : ATTR(RAWDATA) {
my ($package, $symbol, $referent, $attr, $data) = @_;
view release on metacpan or search on metacpan
demo/Demo.pm view on Meta::CPAN
"with data ($data)\nin phase $phase\n";
};
sub This : ATTR(SCALAR) {
print STDERR "This at ",
join(":", map { defined() ? $_ : "" } caller(1)),
"\n";
}
sub Demo : ATTR(HASH) {
my ($package, $symbol, $referent, $attr, $data) = @_;
view release on metacpan or search on metacpan
lib/Attribute/Lexical.pm view on Meta::CPAN
=head1 SYNOPSIS
use Attribute::Lexical "CODE:Funky" => \&funky_attr_handler;
sub thingy :Funky { ... }
$handler = Attribute::Lexical->handler_for_caller([caller(0)],
"CODE:Funky");
=head1 DESCRIPTION
This module manages attributes that can be attached to subroutine and
lib/Attribute/Lexical.pm view on Meta::CPAN
use if !_KLUDGE_FAKE_MRO, "mro";
our $VERSION = "0.005";
# Hints stored in %^H only maintain referenceful structure during the
# compilation phase. Copies of %^H that are accessible via caller(),
# which we need in order to support runtime use of the lexical state,
# flatten all values to plain strings. So %interned_handler permanently
# holds references to all handler functions seen, keyed by the string
# form of the reference.
my %interned_handler;
lib/Attribute/Lexical.pm view on Meta::CPAN
my $invocant = shift(@_);
my $target = shift(@_);
my @unhandled;
my @caller;
for(my $i = 0; ; $i++) {
@caller = caller($i);
if(!@caller || $caller[3] =~ /::BEGIN\z/) {
# Strangely not called via attributes::import.
# No idea of the relevant lexical environment,
# so don't handle any attributes.
ALL_UNHANDLED:
lib/Attribute/Lexical.pm view on Meta::CPAN
}
if($caller[3] eq "attributes::import") {
if(Attribute::Lexical::_KLUDGE_RUNTIME_HINTS) {
# On earlier perls we can only get lexical
# hints during compilation, because %^H
# isn't shown by caller(). In that case,
# we check here that the attributes are
# being applied as part of compilation,
# indicated by attributes::import being
# called directly from a BEGIN block.
# If it's called elsewhere, including
# indirectly from within a BEGIN
# block, then it's a runtime attribute
# application, which we can't handle.
my @nextcall = caller($i+1);
unless(@nextcall &&
$nextcall[3] =~ /::BEGIN\z/) {
goto ALL_UNHANDLED;
}
}
lib/Attribute/Lexical.pm view on Meta::CPAN
([A-Za-z_][0-9A-Za-z_]*)
(?:\((.*)\))?
\z/sx);
if(defined($ident) && defined(my $handler = (
Attribute::Lexical::_KLUDGE_RUNTIME_HINTS ?
# %^H is not available through caller() on
# earlier perls. In that case, if called
# during compilation, we can kludge by
# looking at the current compilation %^H.
Attribute::Lexical->handler_for_compilation(
"$type:$ident")
:
Attribute::Lexical->handler_for_caller(
\@caller, "$type:$ident")
))) {
$handler->($target, $ident, $arg, \@caller);
} else {
push @unhandled, $attr;
lib/Attribute/Lexical.pm view on Meta::CPAN
All these methods are meant to be invoked on the C<Attribute::Lexical>
package.
=over
=item Attribute::Lexical->handler_for_caller(CALLER, NAME)
Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>")
according to the lexical declarations prevailing in a specified place.
I<CALLER> must be a reference to an array of the form returned by
the L<caller|perlfunc/caller> function, describing the lexical site
lib/Attribute/Lexical.pm view on Meta::CPAN
don't make lexical state available at runtime.
=cut
BEGIN { unless(_KLUDGE_RUNTIME_HINTS) { eval q{
sub handler { shift->handler_for_caller([caller(0)], @_) }
1; } or die $@; } }
=item Attribute::Lexical->handler_for_compilation(NAME)
Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>") according to
view release on metacpan or search on metacpan
t/lib/Test/Builder.pm view on Meta::CPAN
=cut
sub todo {
my($self, $pack) = @_;
$pack = $pack || $self->exported_to || $self->caller(1);
no strict 'refs';
return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
: 0;
}
=item B<caller>
my $package = $Test->caller;
my($pack, $file, $line) = $Test->caller;
my($pack, $file, $line) = $Test->caller($height);
Like the normal caller(), except it reports according to your level().
=cut
sub caller {
my($self, $height) = @_;
$height ||= 0;
my @caller = CORE::caller($self->level + $height + 1);
return wantarray ? @caller : $caller[0];
}
=back
t/lib/Test/Builder.pm view on Meta::CPAN
# We don't want to muck with death in an eval, but $^S isn't
# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
# with it. Instead, we use caller. This also means it runs under
# 5.004!
my $in_eval = 0;
for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
$in_eval = 1 if $sub =~ /^\(eval\)/;
}
$Test_Died = 1 unless $in_eval;
};
view release on metacpan or search on metacpan
lib/Attribute/Tie.pm view on Meta::CPAN
# Anything else
eval qq{ require Tie::$mod2tie };
return $MOD2TIE{$mod2tie} = 'Tie::'.$mod2tie unless $@;
# Report Failure and die
my ( $pkg, $file, $line ) = caller(4);
die "Neither $mod2tie nor Tie::$mod2tie is available",
" at $file line $line\n";
}
sub error {
my ( $ref, $mod2tie, @tiearg ) = @_;
my ( $pkg, $file, $line ) = caller(4);
my $s = $SIGIL{ ref $ref };
die "tie(", join( ", ", $s . ref $ref, qq('$mod2tie'), @tiearg ),
") failed : $! at $file line $line\n";
}
view release on metacpan or search on metacpan
lib/Attribute/Method.pm view on Meta::CPAN
'%' => {},
);
sub import {
my ( $class, @vars ) = @_;
my $pkg = caller();
push @vars, '$self';
for my $var (@vars) {
my $sigil = substr( $var, 0, 1, '' );
no strict 'refs';
*{ $pkg . '::' . $var } = $sigil2ref{$sigil};
view release on metacpan or search on metacpan
sub crit { my $self = shift; return $self->log('crit', @_); }
sub warn { my $self = shift; return $self->log('warn', @_); }
sub log {
my $self = shift;
my @caller = caller(2);
# print "caller line is ".$caller[2]."\n";
# ($package, $filename, $line, $subroutine, $hasargs,
# $wantarray, $evaltext, $is_require, $hints, $bitmask)
if (defined $self->{Log}) {
&{$self->{Log}}(@_, @caller);
view release on metacpan or search on metacpan
sub crit { my $self = shift; return $self->log('crit', @_); }
sub warn { my $self = shift; return $self->log('warn', @_); }
sub log {
my $self = shift;
my @caller = caller(2);
# print "caller line is ".$caller[2]."\n";
# ($package, $filename, $line, $subroutine, $hasargs,
# $wantarray, $evaltext, $is_require, $hints, $bitmask)
if (defined $self->{Log}) {
&{$self->{Log}}(@_, @caller);
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
#####################################################################
# 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
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))
count++;
if (!count--)
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
@found;
}
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
lib/Audio/Nama.pm view on Meta::CPAN
waitpid $pid, 1;
} @pids;
}
sub cleanup_exit {
logsub((caller(0))[3]);
remove_riff_header_stubs();
trigger_rec_cleanup_hooks();
# for each process:
# - SIGINT (1st time)
# - allow time to close down