view release on metacpan or  search on metacpan

lib/App/TimeClock/Daily/PrinterInterface.pm  view on Meta::CPAN

94
95
96
97
98
99
100
101
102
103
104
105
 
=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

25
26
27
28
29
30
31
32
33
34
35
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

250
251
252
253
254
255
256
257
258
259
260
 
    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

419
420
421
422
423
424
425
426
427
428
429
 
 
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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

273
274
275
276
277
278
279
280
281
282
283
284
285
286
 
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

399
400
401
402
403
404
405
406
407
408
409
410
411
412
 
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

480
481
482
483
484
485
486
487
488
489
490
491
492
493
 
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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

363
364
365
366
367
368
369
370
371
372
373
374
375
376
#####################################################################
# 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

24
25
26
27
28
29
30
31
32
33
    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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

47
48
49
50
51
52
53
54
55
56
57
58
59
 
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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

365
366
367
368
369
370
371
372
373
374
375
376
377
378
#####################################################################
# 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

92
93
94
95
96
97
98
99
100
101
102
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

script/_chinese-zodiac-of  view on Meta::CPAN

13038
13039
13040
13041
13042
13043
13044
13045
13046
13047
13048
#}
#
#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

13076
13077
13078
13079
13080
13081
13082
13083
13084
13085
13086
#}
#
#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

14516
14517
14518
14519
14520
14521
14522
14523
14524
14525
14526
#        %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

19424
19425
19426
19427
19428
19429
19430
19431
19432
19433
19434
#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

19469
19470
19471
19472
19473
19474
19475
19476
19477
19478
19479
#            $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

19520
19521
19522
19523
19524
19525
19526
19527
19528
19529
19530
#    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

19669
19670
19671
19672
19673
19674
19675
19676
19677
19678
19679
#    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

19736
19737
19738
19739
19740
19741
19742
19743
19744
19745
19746
#    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

19797
19798
19799
19800
19801
19802
19803
19804
19805
19806
19807
#    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

19853
19854
19855
19856
19857
19858
19859
19860
19861
19862
19863
19864
19865
19866
19867
19868
19869
19870
19871
#
#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

20067
20068
20069
20070
20071
20072
20073
20074
20075
20076
20077
20078
20079
#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

20224
20225
20226
20227
20228
20229
20230
20231
20232
20233
20234
20235
20236
20237
20238
20239
20240
20241
#    }
#}
#
#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

20246
20247
20248
20249
20250
20251
20252
20253
20254
20255
20256
#        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

bin/_after  view on Meta::CPAN

3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
#    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;

bin/_after  view on Meta::CPAN

4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
#
#
#sub make_method {
#    my ( $method, $code, $pkg ) = @_;
#
#    $pkg ||= caller();
#    no strict 'refs';
#    *{ $pkg . "::$method" } = $code;
#}
#
#

bin/_after  view on Meta::CPAN

4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
#}
#
#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;

bin/_after  view on Meta::CPAN

7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
#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);

bin/_after  view on Meta::CPAN

7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;

bin/_after  view on Meta::CPAN

7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
#    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++;

bin/_after  view on Meta::CPAN

7439
7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
#    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};

bin/_after  view on Meta::CPAN

7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
#    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;

bin/_after  view on Meta::CPAN

7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
#    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

363
364
365
366
367
368
369
370
371
372
373
374
375
376
#####################################################################
# 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

363
364
365
366
367
368
369
370
371
372
373
374
375
376
#####################################################################
# 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/cpangrep.pm  view on Meta::CPAN

269
270
271
272
273
274
275
276
277
278
    return 0;
}
 
sub debug {
    return unless $DEBUG;
    warn "DEBUG: ", @_, " [", join("/", (caller(1))[3,2]), "]\n";
}
 
1;
__END__

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

363
364
365
366
367
368
369
370
371
372
373
374
375
376
#####################################################################
# 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/cpanminus/fatscript.pm  view on Meta::CPAN

12314
12315
12316
12317
12318
12319
12320
12321
12322
12323
12324
12325
12326
12327
12328
12329
12330
12331
12332
12333
12334
12335
 
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

12371
12372
12373
12374
12375
12376
12377
12378
12379
12380
12381
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

13107
13108
13109
13110
13111
13112
13113
13114
13115
13116
13117
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

23186
23187
23188
23189
23190
23191
23192
23193
23194
23195
23196
$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

23410
23411
23412
23413
23414
23415
23416
23417
23418
23419
23420
      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

23750
23751
23752
23753
23754
23755
23756
23757
23758
23759
23760
      qv => 1,
      'UNIVERSAL::VERSION' => 1,
  );
}
 
my $callpkg = caller();
 
if (exists($args{declare})) {
  *{$callpkg.'::declare'} =
      sub {return $class->declare(shift) }
    unless defined(&{$callpkg.'::declare'});

 view release on metacpan or  search on metacpan

script/cpanmw  view on Meta::CPAN

106
107
108
109
110
111
112
113
114
115
116
    };
}
## 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 release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

9776
9777
9778
9779
9780
9781
9782
9783
9784
9785
9786
$VERSION = '0.225';
 
sub import {
    my $class = shift;
 
    my $inheritor = caller(0);
 
    if ( @_ and $_[0] eq '-norequire' ) {
        shift @_;
    } else {
        for ( my @filename = @_ ) {

bin/cpant  view on Meta::CPAN

9978
9979
9980
9981
9982
9983
9984
9985
9986
9987
9988
      qv => 1,
      'UNIVERSAL::VERSION' => 1,
  );
}
 
my $callpkg = caller();
 
if (exists($args{declare})) {
  *{$callpkg.'::declare'} = 
      sub {return $class->declare(shift) }
    unless defined(&{$callpkg.'::declare'});

 view release on metacpan or  search on metacpan

t/t_Common.pm  view on Meta::CPAN

64
65
66
67
68
69
70
71
72
73
74
 
# "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 release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

363
364
365
366
367
368
369
370
371
372
373
374
375
376
#####################################################################
# 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

script/_finddo  view on Meta::CPAN

6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
#}
#
#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

6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
#}
#
#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

6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
#        %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

10365
10366
10367
10368
10369
10370
10371
10372
10373
10374
10375
#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

10405
10406
10407
10408
10409
10410
10411
10412
10413
10414
10415
#            $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

10455
10456
10457
10458
10459
10460
10461
10462
10463
10464
10465
#    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

10603
10604
10605
10606
10607
10608
10609
10610
10611
10612
10613
#    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

10668
10669
10670
10671
10672
10673
10674
10675
10676
10677
10678
#    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

10729
10730
10731
10732
10733
10734
10735
10736
10737
10738
10739
#    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

10843
10844
10845
10846
10847
10848
10849
10850
10851
10852
10853
10854
10855
10856
10857
10858
10859
10860
#    }
#}
#
#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

10865
10866
10867
10868
10869
10870
10871
10872
10873
10874
10875
#        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/_genpw-base56  view on Meta::CPAN

6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
#}
#
#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/_genpw-base56  view on Meta::CPAN

6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
#}
#
#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/_genpw-base56  view on Meta::CPAN

6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    my $caller = caller(0);
#    $args{target} = 'package';
#    $args{target_arg} = $caller;
#
#    set($pkg, \%args);
#}

script/_genpw-base56  view on Meta::CPAN

10386
10387
10388
10389
10390
10391
10392
10393
10394
10395
10396
#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/_genpw-base56  view on Meta::CPAN

10426
10427
10428
10429
10430
10431
10432
10433
10434
10435
10436
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;

script/_genpw-base56  view on Meta::CPAN

10476
10477
10478
10479
10480
10481
10482
10483
10484
10485
10486
#    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/_genpw-base56  view on Meta::CPAN

10624
10625
10626
10627
10628
10629
10630
10631
10632
10633
10634
#    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/_genpw-base56  view on Meta::CPAN

10689
10690
10691
10692
10693
10694
10695
10696
10697
10698
10699
#    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/_genpw-base56  view on Meta::CPAN

10750
10751
10752
10753
10754
10755
10756
10757
10758
10759
10760
#    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/_genpw-base56  view on Meta::CPAN

10864
10865
10866
10867
10868
10869
10870
10871
10872
10873
10874
10875
10876
10877
10878
10879
10880
10881
#    }
#}
#
#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/_genpw-base56  view on Meta::CPAN

10886
10887
10888
10889
10890
10891
10892
10893
10894
10895
10896
#        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/_genpw-base58  view on Meta::CPAN

6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
#}
#
#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/_genpw-base58  view on Meta::CPAN

6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
#}
#
#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/_genpw-base58  view on Meta::CPAN

6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    my $caller = caller(0);
#    $args{target} = 'package';
#    $args{target_arg} = $caller;
#
#    set($pkg, \%args);
#}

script/_genpw-base58  view on Meta::CPAN

10386
10387
10388
10389
10390
10391
10392
10393
10394
10395
10396
#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/_genpw-base58  view on Meta::CPAN

10426
10427
10428
10429
10430
10431
10432
10433
10434
10435
10436
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;

script/_genpw-base58  view on Meta::CPAN

10476
10477
10478
10479
10480
10481
10482
10483
10484
10485
10486
#    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/_genpw-base58  view on Meta::CPAN

10624
10625
10626
10627
10628
10629
10630
10631
10632
10633
10634
#    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/_genpw-base58  view on Meta::CPAN

10689
10690
10691
10692
10693
10694
10695
10696
10697
10698
10699
#    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/_genpw-base58  view on Meta::CPAN

10750
10751
10752
10753
10754
10755
10756
10757
10758
10759
10760
#    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/_genpw-base58  view on Meta::CPAN

10864
10865
10866
10867
10868
10869
10870
10871
10872
10873
10874
10875
10876
10877
10878
10879
10880
10881
#    }
#}
#
#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/_genpw-base58  view on Meta::CPAN

10886
10887
10888
10889
10890
10891
10892
10893
10894
10895
10896
#        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/_genpw-base64  view on Meta::CPAN

6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
#}
#
#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/_genpw-base64  view on Meta::CPAN

6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
#}
#
#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/_genpw-base64  view on Meta::CPAN

6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    my $caller = caller(0);
#    $args{target} = 'package';
#    $args{target_arg} = $caller;
#
#    set($pkg, \%args);
#}

script/_genpw-base64  view on Meta::CPAN

10419
10420
10421
10422
10423
10424
10425
10426
10427
10428
10429
#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/_genpw-base64  view on Meta::CPAN

10459
10460
10461
10462
10463
10464
10465
10466
10467
10468
10469
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;

script/_genpw-base64  view on Meta::CPAN

10509
10510
10511
10512
10513
10514
10515
10516
10517
10518
10519
#    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/_genpw-base64  view on Meta::CPAN

10657
10658
10659
10660
10661
10662
10663
10664
10665
10666
10667
#    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/_genpw-base64  view on Meta::CPAN

10722
10723
10724
10725
10726
10727
10728
10729
10730
10731
10732
#    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/_genpw-base64  view on Meta::CPAN

10783
10784
10785
10786
10787
10788
10789
10790
10791
10792
10793
#    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/_genpw-base64  view on Meta::CPAN

10897
10898
10899
10900
10901
10902
10903
10904
10905
10906
10907
10908
10909
10910
10911
10912
10913
10914
#    }
#}
#
#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/_genpw-base64  view on Meta::CPAN

10919
10920
10921
10922
10923
10924
10925
10926
10927
10928
10929
#        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};