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
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::/;
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/CGI/Alert.pm view on Meta::CPAN
Otherwise, don't panic: I have sent a notification to the
[MAINTAINER], providing details of the error.
</p>
-
# For stack trace: names of the fields returned by caller(), in order.
our @Caller_Fields =
qw(
package
filename
line
lib/CGI/Alert.pm view on Meta::CPAN
# Get a full callback history, first-is-first (that is, the
# main script is first, instead of the usual most-recent-first).
# @levels will be a LoH, an array containing hashrefs.
#
# See perlfunc(1) for details on caller() and the 'DB' hack.
my $i = 0;
my @call_info;
while (do { { package DB; @call_info = caller($i++) } } ) {
unshift @levels, {
(map { $_ => shift @call_info } @Caller_Fields),
args => [ @DB::args ],
};
}
view release on metacpan or search on metacpan
$tx1 = "# File Name: $dtl\n# Start at $stm\n";
print $fh_dtl $tx1;
return $ar if ! $brf;
my ($pkg, $fn, $line, $subroutine, $hasargs, $wantarray,
$evaltext, $is_require, $hints, $bitmask) = caller(3);
$subroutine = 'start_log' if ! $subroutine;
$tx1 = "# File Name: $brf\n# Generated By: $subroutine\n";
$tx1 .= "# Fields: (elapsed times are in seconds)\n";
$cn1 = $cns; $cn1 =~ s/,/\|/g;
$tx1 .= "# $cn1\n";
view release on metacpan or search on metacpan
# fixes GH #11 (and GH #12 in CGI::Fast since
# sub import was added to CGI::Fast in 9537f90
# so we need to move up a level to export the
# routines to the namespace of whatever is using
# CGI::Fast
($callpack, $callfile, $callline) = caller(1);
}
# To allow overriding, search through the packages
# Till we find one in which the correct subroutine is defined.
my @packages = ($self,@{"$self\:\:ISA"});
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;
sub ReadParse {
local(*in);
if (@_) {
*in = $_[0];
} else {
my $pkg = caller();
*in=*{"${pkg}::in"};
}
tie(%in,CGI);
return scalar(keys %in);
}