view release on metacpan or search on metacpan
my(
%options, %option_name, %commands, @aliases, @installables,
%plugin_loaded, @plugins,
);
run(@ARGV) unless caller(); # Don't run anything if loaded via 'require'
sub run {
App::BCVI->base_init();
App::BCVI->load_plugins();
if(!defined $key or !length $key) {
die "Can't register option without 'name'";
}
my($package, $filename, $line) = caller();
$opt->{provider} = "$package at $filename line $line";
my $taken = $options{$key};
if($taken && !$opt->{force_override}) {
warn "option '--$key' already registered by $taken->{provider}\n";
}
die "Can't register command without 'name'";
}
$cmd->{dispatch_to} ||= "execute_$key";
my($package, $filename, $line) = caller();
$cmd->{provider} = "$package at $filename line $line";
warn "option '$key' already registered by $commands{$key}->{provider}\n"
if $commands{$key} && !$cmd->{force_override};
$commands{$key} = $cmd;
}
}
sub register_installable {
my $class = shift;
my($package, $filename, $line) = caller();
push @installables, $filename;
}
sub shell_aliases {
sub hook_client_class {
my($class) = @_;
my($calling_class, $calling_file) = caller();
my $client_class = $class->client_class();
$class->map_class(client => $calling_class);
no strict 'refs';
unshift @{"${calling_class}::ISA"}, $client_class;
sub hook_server_class {
my($class) = @_;
my($calling_class, $calling_file) = caller();
my $server_class = $class->server_class();
$class->map_class(server => $calling_class);
no strict 'refs';
unshift @{"${calling_class}::ISA"}, $server_class;
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/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
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
bin/bootstrap-perl view on Meta::CPAN
sub caller_line {
my $i = 0;
my ($rc, $rc_prev, $func);
while (1) {
my @v = caller($i);
defined($v[0]) or last;
$rc_prev = $rc;
($rc, $func) = @v[2..3];
$i++;
};
view release on metacpan or search on metacpan
script/borg-restore.pl view on Meta::CPAN
log4perl.appender.screenlog = Log::Log4perl::Appender::$appender
log4perl.appender.screenlog.stderr = 1
log4perl.appender.screenlog.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.screenlog.layout.ConversionPattern = %p %m%n
log4perl.PatternLayout.cspec.U = sub {my \@c = caller(\$_[4]); \$c[0] =~ s/::/./g; return sprintf('%s:%s', \$c[0], \$c[2]);}
";
Log::Log4perl::init( \$conf );
Log::Any::Adapter->set('Log4perl');
$SIG{__WARN__} = sub {
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/CELL.pm view on Meta::CPAN
$status = App::CELL::Load::init( %ARGS );
return $status unless $status->ok;
$log->info( "App::CELL has finished loading messages and site conf params",
cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE;
$log->show_caller( $site->CELL_LOG_SHOW_CALLER );
$log->debug_mode ( $site->CELL_DEBUG_MODE );
$App::CELL::Message::supp_lang = $site->CELL_SUPP_LANG || [ 'en' ];
$App::CELL::Message::def_lang = $site->CELL_DEF_LANG || 'en';
lib/App/CELL.pm view on Meta::CPAN
}
my %ARGS = @ARGS;
return App::CELL::Status->new(
level => $level_uc,
code => $code,
caller => [ CORE::caller() ],
%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;
}
# 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;
}
# 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;
}
# 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;
}
# 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;
}
# 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;
}
# 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;
}
# 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;
}
# 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';
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';
}
# 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
bin/cpan-sbom view on Meta::CPAN
use warnings;
use utf8;
use App::CPAN::SBOM;
exit App::CPAN::SBOM->run(@ARGV) unless caller();
__END__
=encoding utf-8
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/CSVUtils.pm view on Meta::CPAN
}
} # CREATE_META
{
my $package = caller();
no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
*{"$package\::$name"} = $code;
#use DD; dd $meta;
${"$package\::SPEC"}{$name} = $meta;
}
view release on metacpan or search on metacpan
inc/My/Tests/Below.pm view on Meta::CPAN
package MyPackage;
<the text of the package goes here>
require My::Tests::Below unless caller();
1;
__END__
inc/My/Tests/Below.pm view on Meta::CPAN
our $VERSION = 2.0;
## This is done at the top level, not in a sub, as "require
## My::Tests::Below" is what gets the ball rolling:
our $singleton = __PACKAGE__->_parse(\*main::DATA, caller(0));
unless (defined $singleton) {
die "My::Tests::Below invoked, but no tests were found below!";
}
close(main::DATA);
$singleton->run();
inc/My/Tests/Below.pm view on Meta::CPAN
sub zoinx {1}
package Fake::Module::Sub;
require My::Tests::Below unless (caller());
1;
__END__
inc/My/Tests/Below.pm view on Meta::CPAN
package Fake::Module;
use strict;
1;
require My::Tests::Below unless (caller());
__END__
use Test::More qw(no_plan);
view release on metacpan or search on metacpan
lib/App/Chained.pm view on Meta::CPAN
my $class = ref($invocant) || $invocant ;
confess 'Error: Invalid constructor call!' unless defined $class ;
my $object = {} ;
my ($package, $file_name, $line) = caller() ;
bless $object, $class ;
$object->Setup($package, $file_name, $line, @setup_data) ;
return($object) ;
view release on metacpan or search on metacpan
lib/App/Chart/DownloadHandler.pm view on Meta::CPAN
my $self = bless \%self, $class;
push @handler_list, $self;
$self{'name'} ||= do {
my ($package,$filename,$line) = caller();
"$package:" . Glib::filename_to_unicode($filename) . ":$line" };
# highest priority first and 'stable' above for order added for equals
@handler_list
= sort { ($b->{'priority'}||0) <=> ($a->{'priority'}||0) }
view release on metacpan or search on metacpan
# Show a stack trace in perl. (Carp uses a similar approach).
# @DB::args is set (for a scope) when this command is run (some magic).
{
package DB;
my @caller = caller($scope);
() = caller($scope); # Same thing (to invoke LIST context).
}
perl -E 'sub fun1{ fun2("TO FUN2") } sub fun2{ my $scope = 0; while(my @caller = caller($scope)){ {package DB; () = caller($scope)} say "@caller[1,2,3,4] - (@DB::args)"; $scope++ }} fun1("TO FUN1")'
#############################################################
## Perl Modules - Carton
#############################################################
+ package Subs::Trace;
+
+ use v5.32;
+
+ sub import {
+ my $pkg = caller();
+
+ INIT {
+ no strict 'refs';
+
+ for my $func (sort keys %{"${pkg}::"}) {
# Tie Watch. OOP interface that hides making packages for tied variables
perl -MTie::Watch -le 'my $v=1; Tie::Watch->new(-variable => \$v, -fetch => sub{my $s=shift; $v=$s->Fetch; $s->Store($v+1); $v}); print $v; print $v; print $v'
# Check when a variable is updated. (watcher)
perl -MTie::Watch -Mojo -le 'my $h={a => [1..2]}; say r $h; Tie::Watch->new( -variable => \$h->{a}, -store => sub{my ($s,$v) = @_; $s->Store($v); my $Scope = 0; while( my ($Pkg,$Line) = caller(++$Scope) ){ say "$Pkg:$Line" } }); sub func{$h->{a}=456}...
# Check when a variable is updated. (watcher)
use Tie::Watch;
Tie::Watch->new(
-variable => \$Self->{Cache}->{ $Param{Type} }->{ $Param{Key} },
-store => sub{
my ($S,$Value) = @_;
$S->Store($Value);
my $Scope = 0;
my $Limit = 5;
while( my ($Package,$Line) = (caller(++$Scope))[0,2] ){
next if $Package =~ /\ATie::/;
say "* Store: $Package line $Line";
last if $Scope >= $Limit;
}
},
+ function PerlDev()
+ let l:PERL_DEV = "
+ \\nuse v5.32;
+ \\nuse Mojo::Util qw(dumper);
+ \\nuse Carp qw( croak confess carp cluck );
+ \\nsub WhoAmI { say '--> ' . (caller(1))[3] }
+ \\nsay 'var: ', dumper $var;
+ \\n$Self->HandleException('message'); # New - Test/*
+ \\n$Selenium->HandleError('message'); # Legacy - script/*
+ \\n
+ \\n"
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";