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/Test2/Tools/Affix.pm view on Meta::CPAN
$opt = path($opt)->absolute;
}
else {
$opt = tempfile(
UNLINK => !$keep,
SUFFIX => '_' . path( [ caller() ]->[1] )->basename . ( $name =~ m[^\s*//\s*ext:\s*\.c$]ms ? '.c' : '.cxx' )
)->absolute;
push @cleanup, $opt unless $keep;
my ( $package, $filename, $line ) = caller;
$filename = path($filename)->canonpath;
$line++;
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/Aion/Types.pm view on Meta::CPAN
subtype "ProtoCode[prototype]", as &CodeRef, where { Sub::Util::prototype($_) ~~ A };
subtype "ForwardRef", as &CodeRef, where { !subref_is_reachable($_) };
subtype "ImplementRef", as &CodeRef, where { subref_is_reachable($_) };
subtype "Isa[type...]", as &CodeRef,
init_where {
my $pkg = caller(2);
SELF->{args} = [ map { External([UNIVERSAL::isa($_, 'Aion::Type')? $_: $pkg->can($_)? $pkg->can($_)->(): $_]) } ARGS ]
}
where {
my $subroutine = $Aion::Isa{pack "J", refaddr $_} or return "";
my $signature = $subroutine->{signature};
lib/Aion/Types.pm view on Meta::CPAN
awhere { my $A = A; ref $_ eq "HASH" && all { $A->test } values %$_ };
subtype "Object`[class]", as &Ref,
where { blessed($_) ne "" }
awhere { blessed($_) && $_->isa(A) };
subtype "Me", as &Object,
init_where { SELF->{me} = caller(2) }
where { UNIVERSAL::isa($_, SELF->{me}) };
subtype "Map[K, V]", as &HashRef,
where {
my ($K, $V) = ARGS;
while(my ($k, $v) = each %$_) {
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