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
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";
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
sub sub_entry {
if ($App::trace) {
my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
$stacklevel = 1;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
$stacklevel++;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
}
my ($name, $obj, $class, $package, $sub, $method, $firstarg, $trailer);
# split subroutine into its "package" and the "sub" within the package
if ($subroutine =~ /^(.*)::([^:]+)$/) {
sub sub_exit {
if ($App::trace) {
my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
$stacklevel = 1;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
$stacklevel++;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
}
my ($package, $sub);
# split subroutine into its "package" and the "sub" within the package
if ($subroutine =~ /^(.*)::([^:]+)$/) {
sub in_debug_scope {
if ($App::debug) {
my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
$stacklevel = 1;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
$stacklevel++;
($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
}
my ($package, $sub);
# split subroutine into its "package" and the "sub" within the package
if ($subroutine =~ /^(.*)::([^:]+)$/) {
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
scripts/dex view on Meta::CPAN
sub exception {
my ($self, $msg) = @_;
my $next = $self->next_tokens;
$next = [];
my $line = @$next ? $next->[0]->{line} : $self->line;
my @caller = caller(0);
my $yaml = '';
if (my $nl = $self->next_line) {
$yaml = join '', @$nl;
$yaml = $nl->[1];
}
scripts/dex view on Meta::CPAN
}
else {
$remaining = join '', @$next_line;
}
}
my $caller = $args{caller} || [ caller(0) ];
my $e = YAML::PP::Exception->new(
got => $args{got},
expected => $args{expected},
line => $line,
column => $offset,
scripts/dex view on Meta::CPAN
sub expected {
my ($self, %args) = @_;
my $expected = $args{expected};
@$expected = sort grep { m/^[A-Z_]+$/ } @$expected;
my $got = $args{got}->{name};
my @caller = caller(0);
$self->exception("Expected (@$expected), but got $got",
caller => \@caller,
expected => $expected,
got => $args{got},
);