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
lib/Log/Any/For/Builtins.pm view on Meta::CPAN
sub import {
no strict 'refs';
my ($self, @args) = @_;
my $caller = caller();
for my $arg (@args) {
if ($arg eq 'system') {
*{"$caller\::system"} = \&system;
} elsif ($arg eq 'my_qx') {
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/Biblio/bp/lib/bp-p-debug.pl view on Meta::CPAN
print "\nBP ERROR: @_\n";
if ($] >= 5.000) {
local($i,$_);
local($p,$f,$l,$s,$h,$w,$a,@a,@sub);
for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
@a = @DB'args;
for (@a) {
if (/^StB\000/ && length($_) == length($_main{'_main'})) {
$_ = sprintf("%s",$_);
}
lib/Biblio/bp/lib/bp-p-debug.pl view on Meta::CPAN
# some number
return if $debl > $level;
local($p,$f,$l,$s,$h,$w);
if ($] >= 5.000) {
($p,$f,$l,$s,$h,$w) = caller(1);
$s = '' unless defined $s; # to initialize
$s =~ s/^bib:://;
} else {
# sigh -- caller is broken in perl 4 apparently, so make the best of it
if (defined $mod) {
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';
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;
}
# Done in evals to avoid confusing Perl::MinimumVersion
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/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/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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
lib/Business/GestPayCrypt.pm view on Meta::CPAN
return $self->{$2};
} elsif ( $1 eq 'Set' && ( $permission{$2} eq 's' || $permission{$2} eq 'gs' ) ) {
$self->{$2} = $value;
return;
} else {
my ($package,$filename,$line) = caller(); # add 0.40
die "The method $method don't exists at $filename line $line\n";
}
}
# add 0.30
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';
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
view release on metacpan or search on metacpan
lib/Business/PayPal/SDK.pm view on Meta::CPAN
return undef;
}
foreach my $req (@$reqs) {
unless ($args->{$req}) {
my @stack = caller(1);
$s->error("$req is required for method $stack[3]");
return undef;
}
}
return 1;
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
lib/Business/Shipping/Logging.pm view on Meta::CPAN
=head1 NOTES
The Log4perl category is Package::subroutine::line. This gives a lot of
information for debugging. (Technically, category is whatever the fourth
return value of caller(1) is.)
=head1 METHODS
=cut
lib/Business/Shipping/Logging.pm view on Meta::CPAN
=head2 is_trace
=cut
# (caller(1))[3] is shorthand for my (undef, undef, undef, $sub) = caller(1);
# Using call frame depth of 1
sub logdie { Log::Log4perl->get_logger((caller(1))[3])->logdie(@_); }
sub logwarn { Log::Log4perl->get_logger((caller(1))[3])->logwarn(@_); }
sub fatal { Log::Log4perl->get_logger((caller(1))[3])->fatal(@_); }
sub error { Log::Log4perl->get_logger((caller(1))[3])->error(@_); }
sub warn { Log::Log4perl->get_logger((caller(1))[3])->warn(@_); }
sub info { Log::Log4perl->get_logger((caller(1))[3])->info(@_); }
sub debug { Log::Log4perl->get_logger((caller(1))[3])->debug(@_); }
sub trace { Log::Log4perl->get_logger((caller(1))[3])->trace(@_); }
sub is_fatal { Log::Log4perl->get_logger((caller(1))[3])->is_fatal(); }
sub is_error { Log::Log4perl->get_logger((caller(1))[3])->is_error(); }
sub is_warn { Log::Log4perl->get_logger((caller(1))[3])->is_warn(); }
sub is_info { Log::Log4perl->get_logger((caller(1))[3])->is_info(); }
sub is_debug { Log::Log4perl->get_logger((caller(1))[3])->is_debug(); }
sub is_trace { Log::Log4perl->get_logger((caller(1))[3])->is_trace(); }
=head2 log_level()
Does the heavy lifting for Business::Shipping->log_level().
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;
}
sub _read {
view release on metacpan or search on metacpan
lib/BusyBird/Log.pm view on Meta::CPAN
our @EXPORT_OK = qw(bblog);
our $Logger = \&default_logger;
sub default_logger {
my ($level, $msg) = @_;
my ($caller_package) = caller(1);
my $output = "$caller_package: $level: $msg";
$output .= "\n" if $output !~ /[\n\r]$/;
print STDERR $output;
}
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/C/DynaLib.pm view on Meta::CPAN
if $^W;
return undef;
}
my @pre_args = ($ptr, $ret_type, $libref);
my $pkg = caller();
# This 'inner' closure must be an eval-string in order to compile the
# function call in our caller's package.
my $proc = eval q/ sub {
package /.$pkg.q/;
view release on metacpan or search on metacpan
lib/C/TinyCompiler.pm view on Meta::CPAN
sub line_number {
my ($line) = @_;
# The line needs to be incremented by one for the bookkeeping to work
$line++;
# Get the source filename using caller()
my (undef, $filename) = caller;
# Escape backslashes:
$filename =~ s/\\/\\\\/g;
return "\n#line $line \"$filename\"";
}
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
easyxs/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;
easyxs/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))
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/Inline.pm view on Meta::CPAN
sub import_heavy {
local ($/, $") = ("\n", ' '); local ($\, $,);
my $o;
my ($pkg, $script) = caller(1);
# Not sure what this is for. Let's see what breaks.
# $pkg =~ s/^.*[\/\\]//;
my $class = shift;
if ($class ne 'Inline') {
croak M01_usage_use($class) if $class =~ /^Inline::/;