view release on metacpan or search on metacpan
$_[0]->{please}
};
sub import{
no strict 'refs';
tie ${caller().'::please'}, shift, @_;
};
1;
__END__
following the examples above.
=head2 EXPORT
C<$please> is exported into caller's package through the mechanism of
tieing C<${caller().'::please'}>. This can be suppressed by
using Acme::please with an empty list:
use Acme::please (); # if you don't need please in your package
view release on metacpan or search on metacpan
lib/Acme/require/case.pm view on Meta::CPAN
# Valid case or invalid?
if ($valid) {
$INC{$filename} = $realfilename;
# uplevel so calling package looks right
my $caller = caller(0);
# deletes $realfilename from %INC after loading it since that's
# just a proxy for $filename, which is already set above
my $code = qq{
package $caller; sub { local %^H; my \$r = do \$_[0]; delete \$INC{\$_[0]}; \$r }
};
view release on metacpan or search on metacpan
lib/Acme/Crux.pm view on Meta::CPAN
my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
# Get project name and moniker
my $project = $args->{project} || $args->{name}
|| ($Script =~ /^(.+?)\.(pl|t|pm|cgi)$/ ? $1 : $Script)
|| $class || scalar(caller(0));
my $moniker = $args->{moniker} || _project2moniker($project)
|| _project2moniker($class || scalar(caller(0)));
# Current dir
my $pwd = getcwd();
# Create
my $self = bless {
# Common
error => "",
script => $Script,
invocant => scalar(caller(0)),
project => $project,
moniker => $moniker,
pid => $$,
running => 0,
lib/Acme/Crux.pm view on Meta::CPAN
}
sub lookup_handler {
my $self = shift;
my $name = trim(shift // '');
return undef unless length $name;
my $invocant = ref($self) || scalar(caller(0));
my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
return undef unless defined($handlers) && is_hash_ref($handlers);
foreach my $n (keys %$handlers) {
my $aliases = as_array_ref($handlers->{$n}->{aliases});
return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
lib/Acme/Crux.pm view on Meta::CPAN
return undef;
}
sub handlers {
my $self = shift;
my $all = shift // 0; # returns aliases too
my $invocant = ref($self) || scalar(caller(0));
my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
return [] unless defined($handlers) && is_hash_ref($handlers);
return [(sort {$a cmp $b} keys %$handlers)] unless $all;
# All: names and aliases
view release on metacpan or search on metacpan
lib/Action/CircuitBreaker.pm view on Meta::CPAN
use Scalar::Util qw(blessed);
use Time::HiRes qw(gettimeofday);
use Carp;
use base 'Exporter';
our @EXPORT = ((caller())[1] eq '-e' ? @EXPORT_OK : ());
use Moo;
view release on metacpan or search on metacpan
lib/Action/Retry.pm view on Meta::CPAN
use Carp;
use base 'Exporter';
our @EXPORT_OK = qw(retry);
# export by default if run from command line
our @EXPORT = ((caller())[1] eq '-e' ? @EXPORT_OK : ());
use Moo;
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/Address/PostCode/UserAgent.pm view on Meta::CPAN
?
($ua->request('GET', $url, { headers => $headers }))
:
($ua->request('GET', $url));
my @caller = caller(1);
@caller = caller(2) if $caller[3] eq '(eval)';
unless ($response->{success}) {
Address::PostCode::UserAgent::Exception->throw({
method => $caller[3],
message => "request to API failed",
view release on metacpan or search on metacpan
lib/Ado/Control.pm view on Meta::CPAN
sub debug;
if ($DEV_MODE) {
sub debug {
my ($package, $filename, $line, $subroutine) = caller(0);
state $log = $_[0]->app->log;
return $log->debug(
@_[1 .. $#_] #, " at $filename:$line"
);
}
view release on metacpan or search on metacpan
my $msg = "Your config file name doesn't exist or isn't readable.";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_config";
my $by2 = __PACKAGE__ . "::_load_config_with_new_date_opts";
if ( $c eq $by ) {
# Manually merging in another config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
# Dynamically correct based on type of string ...
$read_opts->{use_utf8} = ( $string =~ m/[^\x00-\xff]/ ) ? 1 : 0;
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_string";
if ( $c eq $by ) {
# Manually merging in another string as a config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
} else {
view release on metacpan or search on metacpan
lib/Affix.pm view on Meta::CPAN
CORE::state $_lib_cache;
( $name, $version ) = @$name if ref $name eq 'ARRAY';
{
my $i = -1;
my $pkg = __PACKAGE__;
($pkg) = caller( ++$i ) while $pkg eq __PACKAGE__; # Dig out of the hole first
my $ok = $pkg->can($name);
$name = $ok->() if $ok;
}
$name // return (); # NULL
return $name if -e $name;
view release on metacpan or search on metacpan
} elsif ($code) {
if (ref($stored) eq 'ARRAY') {
$code = join('', @$code);
}
} else {
my ($pkg, $fl, $ln) = caller();
warn "$fl:$ln passed no valid arguments!";
return;
}
unless (defined($code)) {
warn "agent's source code could not be resolved!";
view release on metacpan or search on metacpan
lib/Akamai/Open/Debug.pm view on Meta::CPAN
sub debugger {
my $self = shift;
my $new = shift;
my $prev = shift;
my $sub = (caller(1))[3];
$self->debug->logger->debug(sprintf('setting %s to %s (%s before)', $sub, $new, $prev ? $prev : 'undef'));
return;
}
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))
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/Module/Install.pm view on Meta::CPAN
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
}
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
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/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/Algorithm/CP/IZ/ParamValidator.pm view on Meta::CPAN
$rc = &{$Validator{$types->[$i]}}($params->[$i]);
}
unless ($rc) {
my ($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller(1);
$subroutine =~ /(.*)::([^:]*)$/;
my ($p, $s) = ($1, $2);
croak "$p: $hint";
}
}
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
Combinatorics.pm view on Meta::CPAN
return @result;
} else {
return $iter;
}
} else {
my $sub = (caller(1))[3];
carp("Useless use of $sub in void context");
}
}
sub __null_iter {
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
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
lib/Algorithm/Diff.pm view on Meta::CPAN
}
# Check for bogus (non-ref) argument values
if ( !ref($a) || !ref($b) )
{
my @callerInfo = caller(1);
die 'error: must pass array or hash references to ' . $callerInfo[3];
}
# set up code refs
# Note that these are optimized.
lib/Algorithm/Diff.pm view on Meta::CPAN
sub _ChkPos
{
my( $me )= @_;
return if $me->[_Pos];
my $meth= ( caller(1) )[3];
Die( "Called $meth on 'reset' object" );
}
sub _ChkSeq
{
my( $me, $seq )= @_;
return $seq + $me->[_Off]
if 1 == $seq || 2 == $seq;
my $meth= ( caller(1) )[3];
Die( "$meth: Invalid sequence number ($seq); must be 1 or 2" );
}
sub getObjPkg
{
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
lib/Algorithm/Evolutionary.pm view on Meta::CPAN
sub import {
my $self = shift;
my @modules = grep(!/^(Op|Indi|Fitness)$/, @_);
my $package = caller();
my @failed;
# Load all the others.
foreach my $module (@modules) {
my $code = "package $package; use Algorithm::Evolutionary::$module;";
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 {