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
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
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
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
sub jump_test
{
my (%setup_arguments) = @_ ;
$setup_arguments{caller} = join(':', @{[caller()]}[1 .. 2]) ;
$setup_arguments{name} =~ s/ +/_/g ;
if(exists $setup_arguments{directories_and_db})
{
@setup_arguments{'temporary_directory_structure', 'db_start'} = get_directories_and_db($setup_arguments{directories_and_db}) ;
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/Devel/App/Test/Generator/LCSAJ/Runtime.pm view on Meta::CPAN
#
# Purpose: Called by the Perl debugger before every
# statement. Records (file, line) hits for
# later LCSAJ coverage analysis.
#
# Entry: No arguments — caller(0) is used to get
# the current file and line number.
#
# Exit: Returns nothing. Updates %HITS in place.
#
# Side effects: Increments %HITS{$norm}{$line}.
lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm view on Meta::CPAN
# be as fast as possible.
# Internal files and out-of-target files
# are skipped immediately.
# --------------------------------------------------
sub DB::DB {
my (undef, $file, $line) = caller(0);
return unless defined $file && defined $line;
# Resolve symlinks and relative components to a stable absolute path
my $abs = abs_path($file) // $file;
view release on metacpan or search on metacpan
extras/Perl/KnownToFail/src/main/perl/Org/Cpan/Knth/TestMoreKTF.pm_x view on Meta::CPAN
sub __dispatch
{
my $method = shift;
my $addLvl = 1;
while ((caller($addLvl))[0] eq __PACKAGE__)
{
$addLvl++;
}
$addLvl++;
extras/Perl/KnownToFail/src/main/perl/Org/Cpan/Knth/TestMoreKTF.pm_x view on Meta::CPAN
{
my $method = shift;
my $msg = shift || '<no test msg given>';
my $addLvl = 1;
while ((caller($addLvl))[0] eq __PACKAGE__)
{
$addLvl++;
}
$addLvl++;
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
lib/App/TimeClock/Daily/PrinterInterface.pm view on Meta::CPAN
=cut
sub print_footer { shift->_must_implement; };
sub _must_implement {
(my $name = (caller(1))[3]) =~ s/^.*:://;
my ($filename, $line) = (caller(0))[1..2];
die "You must implement $name() method at $filename line $line";
}
1;
=back
view release on metacpan or search on metacpan
lib/App/TimeTracker/Gtk3StatusIcon.pm view on Meta::CPAN
my $TRACKER_HOME = App::TimeTracker::Proto->new->home;
sub init {
my ($class, $run) = @_;
my @caller = caller();
my $lock;
if ($caller[1] =~ /tracker_gtk3statusicon.pl$/) {
$lock = Lock::File->new($TRACKER_HOME.'/tracker_gtk3statusicon.lock', { blocking=>0 });
unless ($lock) {
say "tracker_gtk3statusicon.pl seems to be running already...";
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/Tool/Base.pm view on Meta::CPAN
sub import
{
my $class = shift;
my $inheritor = caller(0);
my ($run) = @_;
{
no strict 'refs';
push @{"$inheritor\::ISA"}, $class;
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/Trace.pm view on Meta::CPAN
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 =~ /^(.*)::([^:]+)$/) {
lib/App/Trace.pm view on Meta::CPAN
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 =~ /^(.*)::([^:]+)$/) {
lib/App/Trace.pm view on Meta::CPAN
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
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/Validation/Automation/Logging.pm view on Meta::CPAN
my $self = shift;
my $msg = shift;
local $OUTPUT_AUTOFLUSH = 1;
print { $self->log_file_handle }
scalar(localtime(time)).caller()." $msg"."\n" if( $msg );
return 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;
}
sub _read {
view release on metacpan or search on metacpan
bin/wrt-feed view on Meta::CPAN
use Carp;
use Getopt::Long qw(GetOptionsFromArray);
use Pod::Usage;
# If invoked directly from the command-line, caller() will return undef.
# Execute main() with a callback to print output directly, and a copy of
# our real @ARGV:
if (not caller()) {
my $output = sub { say @_; };
my $retval = main($output, @ARGV);
exit($retval);
}
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/Yabsm/Tools.pm view on Meta::CPAN
my $lower_ok = $lower <= $num_args;
my $upper_ok = $upper eq '_' ? 1 : $upper >= $num_args;
unless ($lower_ok && $upper_ok) {
my $caller = ( caller(1) )[3];
my $error_msg = "yabsm: internal error: called '$caller' with $num_args args but it expects";
my $range_msg;
if ($upper eq '_') { $range_msg = "at least $lower args" }
elsif ($lower == $upper) { $range_msg = "$lower args" }
else { $range_msg = "$lower-$upper args" }
view release on metacpan or search on metacpan
lib/App/Yath/Script.pm view on Meta::CPAN
$cli_version = int($1);
shift @ARGV;
}
my $argv = [@ARGV];
my @caller = caller();
my $exec = 0;
$SCRIPT = clean_path($caller[1]);
$ENV{YATH_SCRIPT} = $SCRIPT;
view release on metacpan or search on metacpan
script/_chinese-zodiac-of 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/_chinese-zodiac-of 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/_chinese-zodiac-of 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/_chinese-zodiac-of 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/_chinese-zodiac-of 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/_chinese-zodiac-of 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/_chinese-zodiac-of view on Meta::CPAN
# if ($args{base_name}) {
# my ($pkg, $leaf);
# if ($args{base_name} =~ /(.+)::(.+)/) {
# ($pkg, $leaf) = ($1, $2);
# } else {
# $pkg = CORE::caller();
# $leaf = $args{base_name};
# }
# no strict 'refs';
# $base_code = \&{"$pkg\::$leaf"};
# $base_meta = ${"$pkg\::SPEC"}{$leaf};
script/_chinese-zodiac-of view on Meta::CPAN
# if ($args{output_name}) {
# my ($pkg, $leaf);
# if ($args{output_name} =~ /(.+)::(.+)/) {
# ($pkg, $leaf) = ($1, $2);
# } else {
# $pkg = CORE::caller();
# $leaf = $args{output_name};
# }
# no strict 'refs';
# no warnings 'redefine';
# *{"$pkg\::$leaf"} = $output_code if $args{install_sub} // 1;
script/_chinese-zodiac-of 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/_chinese-zodiac-of view on Meta::CPAN
#
#This document describes version 0.46 of Perinci::Sub::Util (from Perl distribution Perinci-Sub-Util), released on 2017-01-31.
#
#=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/_chinese-zodiac-of view on Meta::CPAN
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#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/_chinese-zodiac-of 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/_chinese-zodiac-of 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
# sub _manager { return $manager }
#}
#
#sub import {
# my $class = shift;
# my $caller = caller();
#
# my @export_params = ( $caller, @_ );
# $class->_export_to_caller(@export_params);
#}
#
#sub _export_to_caller {
# my $class = shift;
# my $caller = shift;
#
#
#sub make_method {
# my ( $method, $code, $pkg ) = @_;
#
# $pkg ||= caller();
# no strict 'refs';
# *{ $pkg . "::$method" } = $code;
#}
#
#
#}
#
#sub import {
# my $self = shift;
#
# my $caller = caller();
# if (__log_enabled()) {
# require Log::Any;
# Log::Any->_export_to_caller($caller, @_);
# } else {
# my $saw_log_param = grep { $_ eq '$log' } @_;
# if ($saw_log_param) {
# __log_singleton();
# *{"$caller\::log"} = \$log_singleton;
#our @_c;
#our $_i;
#sub err {
# require Scalar::Util;
#
# my @caller = CORE::caller(1);
# if (!@caller) {
# @caller = ("main", "-e", 1, "program");
# }
#
# my ($status, $msg, $meta, $prev);
# $stack_trace = [];
# $_i = 1;
# while (1) {
# {
# package DB;
# @_c = CORE::caller($_i);
# if (@_c) {
# $_c[4] = [@DB::args];
# }
# }
# last unless @_c;
# my @r;
# my $i = 0;
# my $j = -1;
# while ($i <= $n+1) {
# $j++;
# @r = CORE::caller($j);
# last unless @r;
# if ($r[0] eq $pkg && $r[1] =~ /^\(eval /) {
# next;
# }
# $i++;
# if ($args{base_name}) {
# my ($pkg, $leaf);
# if ($args{base_name} =~ /(.+)::(.+)/) {
# ($pkg, $leaf) = ($1, $2);
# } else {
# $pkg = CORE::caller();
# $leaf = $args{base_name};
# }
# no strict 'refs';
# $base_code = \&{"$pkg\::$leaf"};
# $base_meta = ${"$pkg\::SPEC"}{$leaf};
# if ($args{output_name}) {
# my ($pkg, $leaf);
# if ($args{output_name} =~ /(.+)::(.+)/) {
# ($pkg, $leaf) = ($1, $2);
# } else {
# $pkg = CORE::caller();
# $leaf = $args{output_name};
# }
# no strict 'refs';
# no warnings 'redefine';
# *{"$pkg\::$leaf"} = $output_code if $args{install_sub} // 1;
# 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 {
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