view release on metacpan or search on metacpan
lib/App/PassManager/Role/Git.pm view on Meta::CPAN
}
}
# this logging routine is useful in combo with something like:
# $self->c(scalar [caller(0)]->[3]);
# $self->dump;
#sub c {
# my $self = shift;
# return unless $ENV{PASSMANAGER_TRACE};
view release on metacpan or search on metacpan
script/perlall view on Meta::CPAN
}
sub _fail {
my $c = shift;
if ($c->options->{verbose}) {
warn $c->{output}," at perlall line @{[(caller(0))[2]]}\n";
}
die "@_\n";
}
sub _glob_git {
view release on metacpan or search on metacpan
lib/App/perlminlint/Plugin.pm view on Meta::CPAN
use Carp;
use App::perlminlint::Object [as_base => qw/^app/];
sub NIMPL {
my ($pkg, $file, $line, $subname) = caller($_[0] // 1);
$subname =~ s/^.*?::(\w+)$/$1/;
croak "Plugin method $subname is not implemented in $pkg";
}
sub priority { 10 }
view release on metacpan or search on metacpan
lib/App/Pimpd/Collection/Search.pm view on Meta::CPAN
if(!@tracks) {
return;
}
# check if called from the interactive shell
my $caller_sub = (caller(1))[3];
if($caller_sub =~ m/App::Pimpd::Shell/) {
print "$_\n" for map {
sprintf("%s [%s] %s", $_->artist, $_->album, $_->title);
} @tracks;
lib/App/Pimpd/Collection/Search.pm view on Meta::CPAN
if(!@titles) {
return;
}
# check if called from the interactive shell
my $caller_sub = (caller(1))[3];
if($caller_sub =~ m/App::Pimpd::Shell/) {
print "$_\n" for map {
sprintf("%s [%s] %s", $_->artist, $_->album, $_->title);
} @titles;
lib/App/Pimpd/Collection/Search.pm view on Meta::CPAN
if(!@albums) {
return;
}
# check if called from the interactive shell
my $caller_sub = (caller(1))[3];
if($caller_sub =~ m/App::Pimpd::Shell/) {
print "$_\n" for map {
sprintf("%s [%s] %s", $_->artist, $_->album, $_->title);
} @albums;
view release on metacpan or search on metacpan
lib/Debug/LTrace/plstrace.pm view on Meta::CPAN
$self->{wrappers}{$sub} = Hook::LexWrap::wrap(
$sub,
pre => sub {
pop();
#my ( $pkg, $file, $line ) = caller(0);
#my ($caller_sub) = ( caller(1) )[3];
my $args = join(", ", map {$self->_esc($_)} @_);
my $entry_time = time();
my $msg = "> $sub($args)";
$msg = $self->_fmttime($entry_time) . " $msg" if $self->{-show_time};
lib/Debug/LTrace/plstrace.pm view on Meta::CPAN
}
unshift @messages, [ "$sub($args)", $entry_time ];
},
post => sub {
my $exit_time = time();
my $wantarray = ( caller(0) )[5];
my $call_data = shift(@messages);
my $res = defined($wantarray) ? " = ".$self->_esc($wantarray ? pop : [pop]) : '';
my $msg = "< $call_data->[0]$res";
$msg = $self->_fmttime($exit_time) . " $msg" if $self->{-show_time};
view release on metacpan or search on metacpan
lib/App/plx.pm view on Meta::CPAN
my $fs = 'File::Spec';
my $self = do {
package Perl::Layout::Executor::_self;
sub self { package DB; () = caller(2); $DB::args[0] }
use overload '%{}' => sub { self }, fallback => 1;
sub AUTOLOAD {
my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
self->$meth(@_[1..$#_]);
}
lib/App/plx.pm view on Meta::CPAN
}
$self->ensure_layout_config_dir;
return $self->run_action_cmd($cmd, @args);
}
caller() ? 1 : __PACKAGE__->new->run(@ARGV);
=head1 NAME
App::plx - Perl Layout Executor
view release on metacpan or search on metacpan
script/_ppgrep view on Meta::CPAN
#}
#
#sub get_logger {
# my ($package, %args) = @_;
#
# my $caller = caller(0);
# $args{category} = $caller if !defined($args{category});
# my $obj = []; $obj =~ $re_addr;
# my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
# add_target(object => $obj, \%args);
# if (keys %Global_Hooks) {
script/_ppgrep view on Meta::CPAN
#}
#
#sub import {
# my ($package, %args) = @_;
#
# my $caller = caller(0);
# $args{category} = $caller if !defined($args{category});
# add_target(package => $caller, \%args);
# if (keys %Global_Hooks) {
# require Log::ger::Heavy;
# init_target(package => $caller, \%args);
script/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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/_ppgrep 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
script/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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/_reposdb-inline 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
lib/App/revealup/base.pm view on Meta::CPAN
package App::revealup::base;
use strict;
use warnings;
sub import {
my $caller = caller(0);
no strict 'refs';
*{"${caller}::has"} = sub { attr($caller, @_) };
*{"${caller}::new"} = sub {
my ($klass, %opt) = @_;
for my $key (keys %opt) {
view release on metacpan or search on metacpan
$CONFIG{$k} = $v;
}
}
sub sbozyp_getopts {
my $err_prefix = (caller(1))[3] =~ /main_([a-z]+)$/ ? "$1: " : '';
my $getopt_err;
local $SIG{__WARN__} = sub { chomp($getopt_err = lcfirst $_[0]) };
GetOptionsFromArray(@_) or sbozyp_die($err_prefix.$getopt_err);
}
view release on metacpan or search on metacpan
our $VERSION = '0.01';
my $HISTSIZE_MAX = $ENV{HISTSIZE} // 1000;
exit main() unless caller();
sub main {
my ($help);
my $serial_fn = '/dev/ttyUSB0';
my $baudrate = 19200;
view release on metacpan or search on metacpan
bin/sh2p.pl view on Meta::CPAN
###########################################################
# main
# done this way to aid testing
# see "Perl Testing, A Developer's Notebook" by Ian Langworth & chromatic (O'Reilly)
main(@ARGV) unless caller();
sub main
{
my %args;
view release on metacpan or search on metacpan
script/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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/_wordlist-blossom 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
script/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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/_wordlist-wordle 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
script/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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/_wordlist 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';
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
lib/App/yajg.pm view on Meta::CPAN
our $VERSION = '0.20';
sub MAX_RECURSION () {300}
{
my $inc = caller() ? $INC{ __PACKAGE__ =~ s/::/\//r . '.pm' } : undef;
my $at = join '|' => "\Q$0\E", '\(eval [0-9]++\)', '-[eE]', $inc ? "\Q$inc\E" : ();
my $re = qr/at (?:$at) line [0-9]++(?:\.|, <> (?:chunk|line) [0-9]++\.)/;
sub remove_at_line ($) { (shift // '') =~ s/$re//r }
}
view release on metacpan or search on metacpan
bin/zipdetails view on Meta::CPAN
$entry->encapsulated(1) ;
$match->increment_childrenCount();
if ($NESTING_DEBUG)
{
say "#### nesting " . (caller(1))[3] . " index #" . $entry->index . ' "' .
$entry->outputFilename . '" [' . $entry->offsetStart . "->" . $entry->offsetEnd . "]" .
" in #" . $match->index . ' "' .
$match->outputFilename . '" [' . $match->offsetStart . "->" . $match->offsetEnd . "]" ;
}
}
view release on metacpan or search on metacpan
lib/AppConfig/Exporter.pm view on Meta::CPAN
push @EXPORT_OK, "\%$section";
*{"$section"} = { $appconfig->varlist("^${section}_", 1) };
__PACKAGE__->export_to_level( 1, $class, "\%$section" );
}
}
my $callpkg = caller(0);
eval "package $callpkg; use AppConfig qw(:argcount);";
die $@ if $@;
}
=item AppConfig
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/Gtk2/Ex/FileLocator/FileChooser.pm view on Meta::CPAN
printf "# %s %s\n", &caller_subroutine, @values
? join " ", map { defined $_ ? $_ : "" } @values
: "";
}
sub caller_subroutine { ( caller(2) )[3] || "" }
1;
__END__
view release on metacpan or search on metacpan
0.06 2014-04-23T14:25:16Z
- Fix "use constant FOO => 123;"
0.0501 2012-09-06T15:53:07Z
- Fix major bug: Should be caller(0) and not caller(1) in import(). This
made the perl debugger complain: syntax error at my-script.pl line 28,
near "documentation __FILE__" Contributor: Ole Bjørn Hessen
0.05 2012-07-20T12:13:24Z
- Applify works with Moo
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/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
lib/Earabic.pm view on Meta::CPAN
#
# instead of Carp::carp
#
sub carp {
my($package,$filename,$line) = caller(1);
print STDERR "@_ at $filename line $line.\n";
}
#
# instead of Carp::croak
#
sub croak {
my($package,$filename,$line) = caller(1);
print STDERR "@_ at $filename line $line.\n";
die "\n";
}
#
# instead of Carp::cluck
#
sub cluck {
my $i = 0;
my @cluck = ();
while (my($package,$filename,$line,$subroutine) = caller($i)) {
push @cluck, "[$i] $filename($line) $package::$subroutine\n";
$i++;
}
print STDERR CORE::reverse @cluck;
print STDERR "\n";
lib/Earabic.pm view on Meta::CPAN
# instead of Carp::confess
#
sub confess {
my $i = 0;
my @confess = ();
while (my($package,$filename,$line,$subroutine) = caller($i)) {
push @confess, "[$i] $filename($line) $package::$subroutine\n";
$i++;
}
print STDERR CORE::reverse @confess;
print STDERR "\n";
view release on metacpan or search on metacpan
perllib/Arch/Storage.pm view on Meta::CPAN
sub _name_operand ($$;$) {
my $self = shift;
my $arg = shift;
my $elem = shift;
my $func = (caller(1))[3];
my $name = $arg? Arch::Name->new($arg): $self->{name};
die "$func: no working name and no argument given\n" unless $name;
if ($elem) {
my $enclosing = $name->cast($elem);
view release on metacpan or search on metacpan
lib/Archer.pm view on Meta::CPAN
# hack to get the original caller as Plugin or Rule
# from plagger.
my $caller = $opt{ caller };
unless ( $caller ) {
my $i = 0;
while ( my $c = caller( $i++ ) ) {
last if $c !~ /Plugin|Rule/;
$caller = $c;
}
$caller ||= caller( 0 );
}
warn "$caller [$level] $msg\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';
return (@Existing, @Missing);
}
sub _running_under {
view release on metacpan or search on metacpan
xs/ppport.h view on Meta::CPAN
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;
xs/ppport.h view on Meta::CPAN
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/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