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
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
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
#####################################################################
# 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
return $pass;
}
sub _where {
my @caller = caller($Level);
return "at $caller[1] line $caller[2]";
}
# DON'T use this for matches. Use like() instead.
sub ok ($@) {
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
#
# t/test.pl - from CORE
sub _where {
my @caller = caller($Level);
return "at $caller[1] line $caller[2]";
}
# runperl - Runs a separate perl interpreter.
# Arguments :
view release on metacpan or search on metacpan
lib/B/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))
level++;
if (!level--)
break;
lib/B/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
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
lib/B/XSUB/Dumber.pm view on Meta::CPAN
foreach my $sub ( @subs ) {
my $ref;
unless ( ref($sub) ) {
$ref = eval 'package ' . caller(). '; no strict "refs"; \&{$sub}';
warn $@ if $@;
} elsif ( reftype($sub) eq 'CODE' ) {
$ref = $sub;
}
view release on metacpan or search on metacpan
t/common.ph view on Meta::CPAN
use strict;
use warnings;
sub P() {
no strict 'refs';
return ${(caller(1))[0].'::p'};
}
sub bbtest($$;$) {
my($src,$bbexpect,$htmlexpect);
if(@_ == 3) {
view release on metacpan or search on metacpan
t/503-error-died-within-keyword.t view on Meta::CPAN
BEGIN {
use_ok('BEGIN::Lift');
BEGIN::Lift::install(
('main', 'double') => sub {
die('Died within (' . (caller(0))[3] . ')');
}
);
}
our $EXCEPTION;
view release on metacpan or search on metacpan
use Cwd qw( cwd );
use File::Spec;
sub import {
no strict 'refs';
*{caller() . "::d"} = \&d;
}
sub dump_ref {
require Data::Dumper;
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
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
$USE_OUR_ST = 0;
sub import{
no strict 'refs';
my $pkg = shift;
my $callpkg = caller();
if (my ($flag) = @_){ # we have an arg
if ($flag eq ":FIELDS"){
# import everything available
@_ = (@{"$pkg\::EXPORT"}, @{"$pkg\::EXPORT_OK"});
$USE_OUR_ST = 1;
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
lib/BZ/Client/API.pm view on Meta::CPAN
# Move stuff here so we dont do it over and over
sub _create {
my(undef, $client, $methodName, $params, $key) = @_;
$key ||= 'id';
my $sub = ( caller(1) )[3];
$client->log('debug', $sub . ': Running');
my $result = __PACKAGE__->api_call($client, $methodName, $params);
my $id = $result->{$key};
__PACKAGE__->error($client, "Invalid reply by server, expected $methodName $key.")
unless $id;
lib/BZ/Client/API.pm view on Meta::CPAN
return $id
}
sub _returns_array {
my(undef, $client, $methodName, $params, $key) = @_;
my $sub = ( caller(1) )[3];
$client->log('debug',$sub . ': Running');
my $result = __PACKAGE__->api_call($client, $methodName, $params);
my $foo = $result->{$key};
__PACKAGE__->error($client, "Invalid reply by server, expected array of $methodName details")
unless ($foo and 'ARRAY' eq ref $foo);
view release on metacpan or search on metacpan
lib/Badger/Base.pm view on Meta::CPAN
map {
my $name = $_;
$name => sub {
my $self = shift;
my $ref = ref $self || $self;
my ($pkg, $file, $line, $sub) = caller(0);
$sub = (caller(1))[3]; # subroutine the caller was called from
$sub =~ s/(.*):://;
my $msg = @_ ? join(BLANK, SPACE, @_) : BLANK;
return $self->error_msg( $name => "$sub()$msg", "for $ref in $file at line $line" );
};
}
view release on metacpan or search on metacpan
lib/Banal/Mini/Utils.pm view on Meta::CPAN
#######################################
sub msg(@) { # Message text builder to be used in error output (warn, die, ...)
#######################################
my $o = blessed ($_[0]) ? shift : caller();
state $pfx = eval { $o->_msg_pfx(@_) } // '';
join ('', $pfx, @_, "\n")
}
lib/Banal/Mini/Utils.pm view on Meta::CPAN
# NO LUCK with any invocation.
# At this point, '$@' would normally be set to a true value by the last failed eval.
if (@e) {
my @emsg = map { $_->{msg} } @e;
my $name = (caller(0))[3]; # The name of this particular subroutine.
croak "$name : Failed to sucessfully invoke any of the given code blocks!\n"
. "Here's the list of all errors:\n\n @emsg"
}
return;
}
view release on metacpan or search on metacpan
lib/Banal/Util/Mini.pm view on Meta::CPAN
#######################################
sub msg(@) { # Message text builder to be used in error output (warn, die, ...)
#######################################
my $o = blessed ($_[0]) ? shift : caller();
state $pfx = eval { $o->_msg_pfx(@_) } // '';
join ('', $pfx, @_, "\n")
}
lib/Banal/Util/Mini.pm view on Meta::CPAN
# NO LUCK with any invocation.
# At this point, '$@' would normally be set to a true value by the last failed eval.
if (@e) {
my @emsg = map { $_->{msg} } @e;
my $name = (caller(0))[3]; # The name of this particular subroutine.
croak "$name : Failed to sucessfully invoke any of the given code blocks!\n"
. "Here's the list of all errors:\n\n @emsg"
}
return;
}
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/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/Basic/Coercion/XS.xs view on Meta::CPAN
hv_store(hash, "name", 4, type, 0);
hv_store(hash, "coerce", 6, (SV*)coerce, 0);
return sv_bless(newRV_noinc((SV*)hash), gv_stashsv(newSVpv("Basic::Coercion::XS", 19), 0));
}
char *get_caller(void) {
dTHX;
char *callr = HvNAME((HV*)CopSTASH(PL_curcop));
return callr;
}
lib/Basic/Coercion/XS.xs view on Meta::CPAN
RETVAL
void
import( ...)
CODE:
char *pkg = get_caller();
STRLEN retlen;
int i = 1;
for (i = 1; i < items; i++) {
char * ex = SvPV(ST(i), retlen);
int name_len = strlen(pkg) + retlen + 3;
view release on metacpan or search on metacpan
lib/Basic/Types/XS.xs view on Meta::CPAN
}
return 0;
}
char *get_caller(void) {
dTHX;
char *callr = HvNAME((HV*)CopSTASH(PL_curcop));
return callr;
}
lib/Basic/Types/XS.xs view on Meta::CPAN
RETVAL
void
import( ...)
CODE:
char *pkg = get_caller();
STRLEN retlen;
int i = 1;
for (i = 1; i < items; i++) {
char * ex = SvPV(ST(i), retlen);
char name [strlen(pkg) + 2 + retlen];
view release on metacpan or search on metacpan
lib/Basset/Object.pm view on Meta::CPAN
my @verbose_caller = ("Package: ", "Filename: ", "Line number: ", "Subroutine: ", "Has Args? : ",
"Want array? : ", "Evaltext: ", "Is require? : ");
push @verbose_caller, ("Hints: ", "Bitmask: ") if $] >= 5.006; #5.6 has a more verbose caller stack.
while (my @caller = caller($caller_count++)){
$caller_stack .= "\t---------\n";
foreach (0..$#caller){
my $callvalue = defined $caller[$_] ? $caller[$_] : '';
$caller_stack .= "\t\t$verbose_caller[$_]$callvalue\n";# if $caller[$_];
};
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