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
lib/App/PDRUtils/MultiCmd.pm view on Meta::CPAN
my %cargs = @_;
my $name = $cargs{dist_ini_cmd};
my $source_pkg = "App::PDRUtils::DistIniCmd::$name";
my $target_pkg = caller();#"App::PDRUtils::MultiCmd::$name";
eval "use $source_pkg"; die if $@;
my $source_specs = \%{"$source_pkg\::SPEC"};
my $spec = clone($source_specs->{handle_cmd});
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
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/App/Padadoy.pm view on Meta::CPAN
# _msg( $fh, [\$caller], $msg [@args] )
sub _msg (@) {
my $fh = shift;
my $caller = ref($_[0]) ? ${(shift)} :
((caller(2))[3] =~ /^App::Padadoy::(.+)/ ? $1 : '');
my $text = shift;
say $fh (($caller ? "[$caller] " : "")
. (@_ ? sprintf($text, @_) : $text));
}
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/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
script/_pick view on Meta::CPAN
#}
#
#sub get_logger {
# my ($package, %per_target_conf) = @_;
#
# my $caller = caller(0);
# $per_target_conf{category} = $caller
# if !defined($per_target_conf{category});
# my $obj = []; $obj =~ $re_addr;
# my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
# add_target(object => $obj, \%per_target_conf);
script/_pick view on Meta::CPAN
#}
#
#sub import {
# my ($package, %per_target_conf) = @_;
#
# my $caller = caller(0);
# $package->_import_to($caller, %per_target_conf);
#}
#
#1;
## ABSTRACT: A lightweight, flexible logging framework
script/_pick view on Meta::CPAN
# %args = %{shift()};
# } else {
# %args = (name => shift, conf => {@_});
# }
#
# my $caller = caller(0);
# $args{target} = 'package';
# $args{target_arg} = $caller;
#
# set($pkg, \%args);
#}
script/_pick view on Meta::CPAN
#our $_i; # temporary variable
#sub err {
# require Scalar::Util;
#
# # get information about caller
# my @caller = CORE::caller(1);
# if (!@caller) {
# # probably called from command-line (-e)
# @caller = ("main", "-e", 1, "program");
# }
#
script/_pick view on Meta::CPAN
# $stack_trace = [];
# $_i = 1;
# while (1) {
# {
# package DB;
# @_c = CORE::caller($_i);
# if (@_c) {
# $_c[4] = [@DB::args];
# }
# }
# last unless @_c;
script/_pick view on Meta::CPAN
# my @r;
# my $i = 0;
# my $j = -1;
# while ($i <= $n+1) { # +1 for this sub itself
# $j++;
# @r = CORE::caller($j);
# last unless @r;
# if ($r[0] eq $pkg && $r[1] =~ /^\(eval /) {
# next;
# }
# $i++;
script/_pick view on Meta::CPAN
# require Function::Fallback::CoreOrPP;
#
# my %args = @_;
#
# # get base code/meta
# my $caller_pkg = CORE::caller();
# my ($base_code, $base_meta);
# my ($base_pkg, $base_leaf);
# if ($args{base_name}) {
# if ($args{base_name} =~ /(.+)::(.+)/) {
# ($base_pkg, $base_leaf) = ($1, $2);
script/_pick view on Meta::CPAN
# result_naked => 1,
#};
#sub gen_curried_sub {
# my ($base_name, $set_args, $output_name) = @_;
#
# my $caller = CORE::caller();
#
# my ($base_pkg, $base_leaf);
# if ($base_name =~ /(.+)::(.+)/) {
# ($base_pkg, $base_leaf) = ($1, $2);
# } else {
script/_pick view on Meta::CPAN
#
#This document describes version 0.472 of Perinci::Sub::Util (from Perl distribution Perinci-Sub-Util), released on 2023-10-28.
#
#=head1 SYNOPSIS
#
#Example for err() and caller():
#
# use Perinci::Sub::Util qw(err caller);
#
# sub foo {
# my %args = @_;
# my $res;
#
# my $caller = caller();
#
# $res = bar(...);
# return err($err, 500, "Can't foo") if $res->[0] != 200;
#
# [200, "OK"];
script/_pick view on Meta::CPAN
#that contains extra information, much like how HTTP response headers provide additional metadata.
#
#Return value: (hash)
#
#
#=head2 caller([ $n ])
#
#Just like Perl's builtin caller(), except that this one will ignore wrapper code
#in the call stack. You should use this if your code is potentially wrapped. See
#L<Perinci::Sub::Wrapper> for more details.
#
#=head2 err(...) => ARRAY
#
script/_pick view on Meta::CPAN
# }
#}
#
#sub func_args_by_tag {
# my ($func_name, $args, $tag) = @_;
# my $meta = _find_meta([caller(1)], $func_name)
# or die "Can't find Rinci function metadata for $func_name";
# args_by_tag($meta, $args, $tag);
#}
#
#sub func_argnames_by_tag {
# my ($func_name, $tag) = @_;
# my $meta = _find_meta([caller(1)], $func_name)
# or die "Can't find Rinci function metadata for $func_name";
# argnames_by_tag($meta, $tag);
#}
#
#sub call_with_its_args {
script/_pick view on Meta::CPAN
# defined &{$func_name}
# or die "Function $func_name not defined";
# $func = \&{$func_name};
# $meta = ${"$1::SPEC"}{$2};
# } else {
# my @caller = caller(1);
# my $fullname = "$caller[0]::$func_name";
# defined &{$fullname}
# or die "Function $fullname not defined";
# $func = \&{$fullname};
# $meta = ${"$caller[0]::SPEC"}{$func_name};
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/App/Pocoirc.pm view on Meta::CPAN
sub _event_debug {
my ($self, $irc, $args, $event) = @_;
if (!defined $event) {
$event = (caller(1))[3];
$event =~ s/.*:://;
}
my @output;
for my $i (0..$#{ $args }) {
view release on metacpan or search on metacpan
lib/App/Pocosi.pm view on Meta::CPAN
sub _event_debug {
my ($self, $args, $event) = @_;
if (!defined $event) {
$event = (caller(1))[3];
$event =~ s/.*:://;
}
my @output;
for my $i (0..$#{ $args }) {
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
scripts/testrail-migrate.pl view on Meta::CPAN
use App::Prove::Elasticsearch::Indexer;
our $case_cache = {};
our $sec_cache = {};
if (!caller()) {
my %ARGS = main(@ARGV);
exit 0 unless delete $ARGS{ingest};
foreach my $k (keys(%ARGS)) { delete $ARGS{$k} unless $ARGS{$k}; }
my $extra_args = delete $ARGS{patterns};
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/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;
}
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/App/RecordStream/OptionalRequire.pm view on Meta::CPAN
my @missing_modules;
sub import {
my $class = shift;
my $calling_package = (caller())[0];
return optional_use_with_caller($calling_package, @_);
}
# For testing and calling outside of other things... CHECK will not work in this case...
sub optional_use {
my $calling_package = (caller())[0];
return optional_use_with_caller($calling_package, @_);
}
sub optional_use_with_caller {
my $calling_package = shift;
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
scripts/templates/master_categories.pl view on Meta::CPAN
'_DEFINITION' => 'System training and documentation'
},
},
};
my ($package) = caller() ;
unless(defined $package)
{
my ($missing_definitions, $number_of_categories) = (0, 0) ;
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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
lib/App/Sandy/CLI/App.pm view on Meta::CPAN
);
sub _build_app_path {
# Determine dynamic the app path that inherit from this class
# If no one is inheriting, return this class path
my $class = (caller(1))[3];
$class =~ s/::new//;
my $command_pm = file(split /::/ => "$class.pm");
return $INC{$command_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;
}
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
local/lib/perl5/Devel/GlobalPhase.pm view on Meta::CPAN
# END blocks are FILO so we can't install one to run first.
# only way to detect END reliably seems to be by using caller.
# I hate this but it seems to be the best available option.
# The top two frames will be an eval and the END block.
my $i = 0;
$i++ while defined CORE::caller($i + 1);
if ($i < 1) {
# there should always be the sub call and an eval frame ($^S is true).
# this will only happen if we're in END, but the outer frames are broken.
$global_phase = 'END';
}
elsif ($i > 1) {
my $top = CORE::caller($i);
my $next = CORE::caller($i - 1);
if (!$top || !$next) {
$global_phase = 'END';
}
elsif ($top eq 'main' && $next eq 'main') {
# If we're ENDing due to an exit or die in a sub generated in an eval,
# these caller calls can cause a segfault. I can't find a way to detect
# this.
my @top = CORE::caller($i);
my @next = CORE::caller($i - 1);
if (
$top[3] eq '(eval)'
&& $next[3] =~ /::END$/
&& $top[2] == $next[2]
&& $top[1] eq $next[1]
local/lib/perl5/Devel/GlobalPhase.pm view on Meta::CPAN
package # hide
Devel::GlobalPhase::_Tie;
sub TIESCALAR { bless \(my $s), $_[0]; }
sub STORE {
die sprintf "Modification of a read-only value attempted at %s line %s.\n", (caller(0))[1,2];
}
sub FETCH {
return undef
if caller eq 'Devel::GlobalDestruction';
Devel::GlobalPhase::global_phase;