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
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::/;
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
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
MapDisp2.pm view on Meta::CPAN
=cut
sub upload_sas_script {
my ($s, $q, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
$s->disp_header($q,$ar,1);
MapDisp2.pm view on Meta::CPAN
sub get_scrnames {
my ($s, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $ds = (exists $ar->{dir_sep}) ? $ar->{dir_sep} : '';
$ds = ($^O =~ /MSWin/i)? '\\': '/' if ! $ds;
MapDisp2.pm view on Meta::CPAN
my ($s, $dir) = @_;
# $dir - directory
# $package, $filename, $line, $subroutine, $hasargs,
# $wantarray, $evaltext, $is_require, $hints, $bitmask
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
if (! -d $dir) {
eval { mkpath($dir,0,0777) };
MapDisp2.pm view on Meta::CPAN
my ($s, $ffn, $ar) = @_;
# $ffn - file name
# $ar - parameter array
# $bdr - backup dir
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $ds = ($^O =~ /MSWin/i)? '\\': '/';
my ($bcp) = $s->get_params('bak_copies',$ar);
view release on metacpan or search on metacpan
my ($s, $q, $ar) = @_;
# print $s->disp_form($q, $ar);
print $s->disp_header($q, $ar);
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
# 1. check required parameters
$s->echo_msg("1. checking required parameters...", 2);
}
sub call_plsql {
my ($s, $rr, $ar) = @_;
my @c0 = caller(0); my @c1 = caller(1);
my $cls = (exists $c1[3]) ? $c1[3] : '';
my $prg = "$cls [$c0[2]] -> $c0[3]";
my $vs = 'dir_sep,sql_cfn,sql_cs';
my ($ds,$cfn,$cs) = $s->get_params($vs, $ar);
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/CGI/Application/Framework.pm view on Meta::CPAN
# -------------------------------------------------------
return $self->log_confess
(
__PACKAGE__
. " only implements a virtual interface method for ["
. (caller(1))[3]
. "] -- implement this yourself in a subclass! "
);
# -------------------------------------------------------
}
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
lib/CGI/Application/Pluggable.pm view on Meta::CPAN
use UNIVERSAL::require '0.10';
our $VERSION = '0.03';
sub import {
my ( $self, @options ) = @_;
my $caller = caller(0);
{
no strict 'refs';
push @{"$caller\::ISA"}, $self;
}
view release on metacpan or search on metacpan
lib/CGI/Application/Plugin/AnyCGI.pm view on Meta::CPAN
else {
$dump = \@_;
}
}
my ( $package, $line, $sub ) = (caller())[0,2,3];
my ( $callerpackage, $callerline, $callersub )
= (caller(1))[0,2,3];
$sub ||= '-';
print "\n",
join( ' | ', $package, $line, $sub ),
view release on metacpan or search on metacpan
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
sub log_warn {
# Try to make our call stack invisible
shift;
if (@_ and $_[-1] !~ /\n$/) {
my (undef, $file, $line) = caller();
warn @_, " at $file line $line.\n";
} else {
warn @_;
}
}
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 {