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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
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 all matches for this distribution
view release on metacpan or search on metacpan
lib/App/cpangrep.pm view on Meta::CPAN
return 0;
}
sub debug {
return unless $DEBUG;
warn "DEBUG: ", @_, " [", join("/", (caller(1))[3,2]), "]\n";
}
1;
__END__
view all matches for this distribution
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 all matches for this distribution
view release on metacpan or search on metacpan
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
sub as_heavy {
require Exporter::Heavy;
# Unfortunately, this does not work if the caller is aliased as *name = \&foo
# Thus the need to create a lot of identical subroutines
my $c = (caller(1))[3];
$c =~ s/.*:://;
\&{"Exporter::Heavy::heavy_$c"};
}
sub export {
goto &{as_heavy()};
}
sub import {
my $pkg = shift;
my $callpkg = caller($ExportLevel);
if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
*{$callpkg."::import"} = \&import;
return;
}
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
sub export_fail {
my $self = shift;
@_;
}
# Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
# *name = \&foo. Thus the need to create a lot of identical subroutines
# Otherwise we could have aliased them to export().
sub export_to_level {
goto &{as_heavy()};
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
sub heavy_export_to_level
{
my $pkg = shift;
my $level = shift;
(undef) = shift; # XXX redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
}
# Utility functions
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
$VERSION = '0.228';
sub import {
my $class = shift;
my $inheritor = caller(0);
if ( @_ and $_[0] eq '-norequire' ) {
shift @_;
} else {
for ( my @filename = @_ ) {
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
qv => 1,
'UNIVERSAL::VERSION' => 1,
);
}
my $callpkg = caller();
if (exists($args{declare})) {
*{$callpkg.'::declare'} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
qv => 1,
'UNIVERSAL::VERSION' => 1,
);
}
my $callpkg = caller();
if (exists($args{declare})) {
*{$callpkg.'::declare'} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
view all matches for this distribution
view release on metacpan or search on metacpan
script/cpanmw view on Meta::CPAN
};
}
## GLOBAL hook
{
*App::cpanminus::script::_diag = sub {
my $caller = ( caller(1) )[3];
goto &{ $org_m->{_diag} }
unless $caller =~ s/^App::cpanminus::script:://;
### $caller
my @arg = @_;
if ( $caller eq 'diag_ok' ) {
view all matches for this distribution
view release on metacpan or search on metacpan
$VERSION = '0.225';
sub import {
my $class = shift;
my $inheritor = caller(0);
if ( @_ and $_[0] eq '-norequire' ) {
shift @_;
} else {
for ( my @filename = @_ ) {
qv => 1,
'UNIVERSAL::VERSION' => 1,
);
}
my $callpkg = caller();
if (exists($args{declare})) {
*{$callpkg.'::declare'} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
view all matches for this distribution
view release on metacpan or search on metacpan
t/t_Common.pm view on Meta::CPAN
# "By The Way" messages showing file:linenum of the call
sub btw(@) { unshift @_,0; goto &btwN }
sub btwN($@) {
my $N=shift;
my ($fn, $lno) = (caller($N))[1,2];
$fn =~ s/.*[\\\/]//;
$fn =~ s/(.)\.[a-z]+$/$1/a;
local $_ = join("",@_);
s/\n\z//s;
printf STDERR "%s:%d: %s\n", $fn, $lno, $_;
view all matches for this distribution
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 all matches for this distribution
view release on metacpan or search on metacpan
script/_finddo 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/_finddo 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/_finddo 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/_finddo view on Meta::CPAN
#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);
script/_finddo 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/_finddo view on Meta::CPAN
# 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++;
script/_finddo 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/_finddo 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/_finddo 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/_finddo 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/_finddo 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 all matches for this distribution