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/AE/AdHoc.pm view on Meta::CPAN
croak "Parameter timeout must be a nonzero real number"
if (!$timeout or !looks_like_number($timeout));
# find out where we are
$iter++;
my @caller = caller(0);
local $where = "ae_recv[$iter] at $caller[1]:$caller[2]";
my $on_timeout = $opt{soft_timeout}
? sub { $cv->send }
: sub { $cv->croak("Timeout after $timeout seconds"); };
lib/AE/AdHoc.pm view on Meta::CPAN
my @args = @_;
croak("$name called outside ae_recv") unless $cv;
my $myiter = $iter; # remember where cb was created
my @caller = caller(0);
my $exact = "$name at $caller[1]:$caller[2] from $where";
return sub {
return _error( "Leftover $exact called outside ae_recv" )
unless $cv;
lib/AE/AdHoc.pm view on Meta::CPAN
my ($name, @fixed_args) = @_;
croak "ae_goal called outside ae_recv" unless $cv;
my $myiter = $iter;
my @caller = caller(0);
my $exact = "ae_goal('$name') at $caller[1]:$caller[2] from $where";
$goals{$name}++ unless $results{$name};
return sub {
return _error( "Leftover $exact called outside ae_recv" )
lib/AE/AdHoc.pm view on Meta::CPAN
my %opt = @_;
# TODO copypaste from ae_goal, make a sub
croak "ae_action called outside ae_recv" unless $cv;
my $myiter = $iter;
my @caller = caller(0);
my $exact = "ae_action at $caller[1]:$caller[2] from $where";
$opt{after} ||= 0;
my $count = $opt{count};
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
src/BOS/BOS.pm view on Meta::CPAN
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub DESTROY {
my (undef, undef, undef, $subroutine) = caller(1);
if (! defined $subroutine or $subroutine !~ /eval/) { undef $_[0]; } # self->DESTROY
else { AFS::BOS::_DESTROY($_[0]); } # undef self
}
sub create {
view release on metacpan or search on metacpan
lib/AI/Categorizer/Document/XML.pm view on Meta::CPAN
# call super class such as XML::SAX::Base
my $self = $class->SUPER::new;
# save weights of elements which is a hash for pairs <elementName, weight>
# weight is times duplication of corresponding element
# It is provided by caller(one of parameters) at construction, and
# we must save it in order to use doing duplication at end_element
$self->{weightHash} = $args{weights};
# It is storage to store the data produced by Text, CDataSection and etc.
$self->{content} = '';
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/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
bin/remote.pl view on Meta::CPAN
use Carp;
#our @ISA = qw( AI::MicroStructure::RemoteKnowledge );
sub init {
my $class = caller(0);
my $data = AI::MicroStructure->load_data($class);
no strict 'refs';
my $sep = ${"$class\::Separator"} ||= '/';
my $tail = qr/$sep?[^$sep]*$/;
bin/remote.pl view on Meta::CPAN
${"$class\::Default"} = $data->{default} || ':all';
${"$class\::Theme"} = ( split /::/, $class )[-1];
*{"$class\::import"} = sub {
my $callpkg = caller(0);
my $theme = ${"$class\::Theme"};
my $meta = $class->new;
*{"$callpkg\::meta$theme"} = sub { $meta->name(@_) };
};
bin/remote.pl view on Meta::CPAN
our @ISA = qw( AI::MicroStructure::RemoteKnowledge );
sub init {
my ($self, $data) = @_;
my $class = caller(0);
$data ||= AI::MicroStructure->load_data($class);
croak "The optional argument to init() must be a hash reference"
if ref $data ne 'HASH';
no strict 'refs';
no warnings;
${"$class\::Theme"} = ( split /::/, $class )[-1];
@{"$class\::Knowledge"} = split /\s+/, $data->{names};
*{"$class\::import"} = sub {
my $callpkg = caller(0);
my $theme = ${"$class\::Theme"};
my $meta = $class->new();
*{"$callpkg\::meta$theme"} = sub { $meta->name(@_) };
};
${"$class\::meta"} = $class->new();
view release on metacpan or search on metacpan
BackProp.pm view on Meta::CPAN
return $x;
}
# Debugging subs
$AI::NeuralNet::BackProp::DEBUG = 0;
sub whowasi { (caller(1))[3] . '()' }
sub debug { shift; $AI::NeuralNet::BackProp::DEBUG = shift || 0; }
sub out1 { print shift() if ($AI::NeuralNet::BackProp::DEBUG eq 1) }
sub out2 { print shift() if (($AI::NeuralNet::BackProp::DEBUG eq 1) || ($AI::NeuralNet::BackProp::DEBUG eq 2)) }
sub out3 { print shift() if ($AI::NeuralNet::BackProp::DEBUG) }
sub out4 { print shift() if ($AI::NeuralNet::BackProp::DEBUG eq 4) }
view release on metacpan or search on metacpan
# See POD for usage of this variable.
$AI::NeuralNet::Mesh::Connector = '_c';
# Debugging subs
$AI::NeuralNet::Mesh::DEBUG = 0;
sub whowasi { (caller(1))[3] . '()' }
sub debug { shift; $AI::NeuralNet::Mesh::DEBUG = shift || 0; }
sub d { shift if(substr($_[0],0,4) eq 'AI::'); my ($a,$b,$c)=(shift,shift,$AI::NeuralNet::Mesh::DEBUG); print $a if($c == $b); return $c }
sub verbose {debug @_};
sub verbosity {debug @_};
sub v {debug @_};
view release on metacpan or search on metacpan
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
sub foreach_xy{
my $self = shift;
my $sub = shift;
no strict 'refs';
local *a= *{ caller() . '::a' };
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
sub foreach_xy_set{
my $self = shift;
my $sub = shift;
no strict 'refs';
local *a= *{ caller() . '::a' };
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
view release on metacpan or search on metacpan
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
my ($self) = @_;
my $antecedent;
my $ant_phrase;
my ($pkg, $filename, $line_num) = caller();
if($self->{_predecessor}){
$antecedent = $self->{_predecessor};
$ant_phrase = $antecedent->{_phrase} ? $antecedent->{_phrase} : $antecedent->{_start_word};
}
view release on metacpan or search on metacpan
maint/process-capi.pl view on Meta::CPAN
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Sub::Uplevel; # place early to override caller()
package TF::CAPI::Extract {
use Mu;
use CLI::Osprey;
use AI::TensorFlow::Libtensorflow::Lib;
maint/process-capi.pl view on Meta::CPAN
wrap 'FFI::Platypus::DL::dlsym',
post => sub { $real_name = $_[1] if $_[-1] };
my $ret = uplevel 3, $orig, @_[1..$#_];
push $self->_attached_functions->{$real_name}->@*, {
c => $real_name,
package => (caller(2))[0],
perl => ref($name) ? $name->[1] : $name,
args => $_[3],
return => $_[4],
};
$ret;
view release on metacpan or search on metacpan
# that can store and retreive hash references
# and has a working DELETE method
#
# but if you change it, you'll also need to change
# the lines that refer to DirDB subsequently,
# including the tieing of %{"caller().'::AIS_STASH'}
sub miniget($$$$){
my($HostName, $PortNumber, $Desired, $agent) = @_;
eval <<'ENDMINIGET';
use Socket qw(:DEFAULT :crlf);
exit;
};
# print STDERR "setting ",caller().'::AIS_IDENTITY', " to $Sessions{$Coo}->{identity}\n";
# $ENV{AIS_IDENTITY} = $Sessions{$Coo}->{identity};
$ENV{AIS_IDENTITY} =
${caller().'::AIS_IDENTITY'} = $Sessions{$Coo}->{identity};
tie %{caller().'::AIS_STASH'}, DirDB => ${tied(%{$Sessions{$Coo}})};
}; # import
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
lib/ARSObject.pm view on Meta::CPAN
# see CGI::Carp::ineval comments and errors
return $^S if !($ENV{GATEWAY_INTERFACE}
&& ($ENV{GATEWAY_INTERFACE} =~/PerlEx/))
&& !$ENV{MOD_PERL};
my ($i, @a) =(1);
while (@a =caller($i)) {
return(0) if $a[0] =~/^(?:PerlEx::|Apache::Perl|Apache::Registry|Apache::ROOT)/i;
return(1) if $a[3] eq '(eval)';
$i +=1;
}
$^S
view release on metacpan or search on metacpan
ARS/CodeTemplate.pm view on Meta::CPAN
foreach $line ( @input ){
if( $line =~ /^@@\s+(\S+)\s+(.*)$/ ){
my( $openMode, $outFile ) = ( $1, $2 );
if( $outFile =~ /^<@(.*)@>\s*$/ ){
eval( 'package '.caller()."; \$outFile = $1; package ARS::CodeTemplate;" );
# print "OUTFILE: $outFile\n";
}
# print "OM($openMode) FILE($outFile)\n";
die "Syntax error in \"$line\"\n" unless $openMode =~ /^[>|]+$/;
if( defined $opt{debug} ){
print "#------------------------------------------------------------\n";
print "# OUTPUT: $line\n";
print $pCode;
print "#------------------------------------------------------------\n\n";
}else{
eval( 'package '.caller()."; $pCode; package ARWT::Template;" );
if( $@ ){
warn $@, "\n";
exit 1;
}
open( OUTPUT, "$openMode $outFile" ) or die "Open Error($openMode $outFile): $!\n";
ARS/CodeTemplate.pm view on Meta::CPAN
if( defined $opt{debug} ){
print $pCode;
exit;
}else{
eval( 'package '.caller()."; $pCode; package ARWT::Template;" );
if( $@ ){
warn $@, "\n";
exit 1;
}
}
view release on metacpan or search on metacpan
lib/ASNMTAP/Asnmtap/Plugins/NPTest.pm view on Meta::CPAN
}
# Apply default values for optional arguments
$scoped = ( defined( $scoped ) && $scoped );
my $testharness = basename( (caller(0))[1], ".t" ); # used for scoping
if ( defined( $envvar ) && exists( $ENV{$envvar} ) && $ENV{$envvar} )
{
return $ENV{$envvar};
}
lib/ASNMTAP/Asnmtap/Plugins/NPTest.pm view on Meta::CPAN
}
chomp $output;
$object->output($output);
if ($ENV{'NPTEST_DEBUG'}) {
my ($pkg, $file, $line) = caller(0);
print "testCmd: Called from line $line in $file", $/;
print "Testing: $command", $/;
print "Output: ", $object->output, $/;
print "Return code: ", $object->return_code, $/;
}
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
#####################################################################
# 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
#####################################################################
# 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
#####################################################################
# 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
#####################################################################
# 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
#####################################################################
# 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/Abstract/Meta/Class.pm view on Meta::CPAN
=cut
sub has {
my $name = shift;
my $package = caller();
my $meta_class = meta_class($package);
my $attribute = $meta_class->attribute_class->new(name => $name, @_, class => $package, storage_type => $meta_class->storage_type);
$meta_class->add_attribute($attribute);
$meta_class->install_cleanup
if($attribute->transistent || $attribute->index_by);
lib/Abstract/Meta/Class.pm view on Meta::CPAN
return $param->{'$.storage_type'} ||= 'Hash'
if (ref($param));
my $type = $param;
confess "unknown storage type $type - should be Array or Hash"
unless($type =~ /Array|Hash/);
my $package = caller();
my $meta_class = meta_class($package);
$meta_class->{'$.storage_type'} = $type;
remove_method($meta_class->associated_class, 'new');
$meta_class->install_constructor();
lib/Abstract/Meta/Class.pm view on Meta::CPAN
=cut
sub abstract {
my $name = shift;
my $package = caller();
my $meta_class = meta_class($package);
$meta_class->install_abstract_methods($name);
}
lib/Abstract/Meta/Class.pm view on Meta::CPAN
=cut
sub abstract_class {
my $name = shift;
my $package = caller();
my $meta_class = meta_class($package);
$meta_class->set_abstract(1);
no warnings 'redefine';
no strict 'refs';
*{"${package}::new"} = sub {
view release on metacpan or search on metacpan
delete $self->{database};
}
sub DESTROY {
my $self = shift;
return if caller() =~ /^Cache\:\:/;
warn "$self->DESTROY at ", join ' ',caller() if Ace->debug;
$self->close;
}
#####################################################################
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 {