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

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

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

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

bench/attr_bench.pl  view on Meta::CPAN

7
8
9
10
11
12
13
14
15
16
17
 
use Cache::MemoryCache;
my %caches;
 
sub getCache {
    my (undef, undef, undef, $method) = caller(2);
    return $caches{$method} ||= do {
         warn "Getting cache $method";
         Cache::MemoryCache->new({namespace=>$method});
        };
}

 view release on metacpan or  search on metacpan

lib/Attribute/Default.pm  view on Meta::CPAN

36
37
38
39
40
41
42
43
44
45
46
## once 'exsub' is exported for compile-time speed.
##
sub import {
  my $class = shift;
  my ($subname) = @_;
  my $callpkg = (caller())[0];
 
  if (defined($subname) && $subname eq 'exsub') {
    no strict 'refs';
    *{ "${callpkg}::exsub" } = \&exsub;
  }

 view release on metacpan or  search on metacpan

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

316
317
318
319
320
321
322
323
324
325
326
327
328
329
#####################################################################
# 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/Attribute/GlobalEnable.pm  view on Meta::CPAN

42
43
44
45
46
47
48
49
50
51
my $class = shift();
croak "Must specify some arguments." if not @_;
my $args  = {@_};
 
## set the package to the caller
$PACKAGE = caller();
croak "Must sub-package ".$PACKAGE if not $PACKAGE or $PACKAGE eq __PACKAGE__;
 
## make sure our sub-packaged module is using the exporter
_export_the_exporter_to( $PACKAGE ) or die "Bad exporting exporter";

lib/Attribute/GlobalEnable.pm  view on Meta::CPAN

339
340
341
342
343
344
345
346
347
348
349
my $debug_level = _is_flag_on($attribute, $flag);
if( not defined $debug_level ) {
  unshift( @_, $flag ) if not defined $debug_level;
}
 
my $full_package = (caller(2))[3];
 
my $caller_sub_name     = '';
GET_PROPER_PACKAGE_NAME: {
  my @packages     = split /::/, $full_package;
  pop @packages;

 view release on metacpan or  search on metacpan

demo/Demo.pm  view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22
23
                     "with data ($data)\nin phase $phase\n";
};
 
sub This : ATTR(SCALAR) {
        print STDERR "This at ",
                     join(":", map { defined() ? $_ : "" } caller(1)),
                     "\n";
}
 
sub Demo : ATTR(HASH) {
        my ($package, $symbol, $referent, $attr, $data) = @_;

 view release on metacpan or  search on metacpan

demo/Demo.pm  view on Meta::CPAN

11
12
13
14
15
16
17
18
19
20
21
                     "with data (@$data)\nin phase $phase\n";
};
 
sub This : ATTR(SCALAR) {
        print STDERR "This at ",
                     join(":", map { defined() ? $_ : "" } caller(1)),
                     "\n";
}
 
sub Multi : ATTR(RAWDATA) {
        my ($package, $symbol, $referent, $attr, $data) = @_;

 view release on metacpan or  search on metacpan

demo/Demo.pm  view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22
23
                     "with data ($data)\nin phase $phase\n";
};
 
sub This : ATTR(SCALAR) {
        print STDERR "This at ",
                     join(":", map { defined() ? $_ : "" } caller(1)),
                     "\n";
}
 
sub Demo : ATTR(HASH) {
        my ($package, $symbol, $referent, $attr, $data) = @_;

 view release on metacpan or  search on metacpan

lib/Attribute/Lexical.pm  view on Meta::CPAN

5
6
7
8
9
10
11
12
13
14
15
=head1 SYNOPSIS
 
    use Attribute::Lexical "CODE:Funky" => \&funky_attr_handler;
    sub thingy :Funky { ... }
 
    $handler = Attribute::Lexical->handler_for_caller([caller(0)],
                "CODE:Funky");
 
=head1 DESCRIPTION
 
This module manages attributes that can be attached to subroutine and

lib/Attribute/Lexical.pm  view on Meta::CPAN

144
145
146
147
148
149
150
151
152
153
154
use if !_KLUDGE_FAKE_MRO, "mro";
 
our $VERSION = "0.005";
 
# Hints stored in %^H only maintain referenceful structure during the
# compilation phase.  Copies of %^H that are accessible via caller(),
# which we need in order to support runtime use of the lexical state,
# flatten all values to plain strings.  So %interned_handler permanently
# holds references to all handler functions seen, keyed by the string
# form of the reference.
my %interned_handler;

lib/Attribute/Lexical.pm  view on Meta::CPAN

168
169
170
171
172
173
174
175
176
177
178
my $invocant = shift(@_);
my $target = shift(@_);
my @unhandled;
my @caller;
for(my $i = 0; ; $i++) {
        @caller = caller($i);
        if(!@caller || $caller[3] =~ /::BEGIN\z/) {
                # Strangely not called via attributes::import.
                # No idea of the relevant lexical environment,
                # so don't handle any attributes.
                ALL_UNHANDLED:

lib/Attribute/Lexical.pm  view on Meta::CPAN

181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
}
if($caller[3] eq "attributes::import") {
        if(Attribute::Lexical::_KLUDGE_RUNTIME_HINTS) {
                # On earlier perls we can only get lexical
                # hints during compilation, because %^H
                # isn't shown by caller().  In that case,
                # we check here that the attributes are
                # being applied as part of compilation,
                # indicated by attributes::import being
                # called directly from a BEGIN block.
                # If it's called elsewhere, including
                # indirectly from within a BEGIN
                # block, then it's a runtime attribute
                # application, which we can't handle.
                my @nextcall = caller($i+1);
                unless(@nextcall &&
                                $nextcall[3] =~ /::BEGIN\z/) {
                        goto ALL_UNHANDLED;
                }
        }

lib/Attribute/Lexical.pm  view on Meta::CPAN

206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
        ([A-Za-z_][0-9A-Za-z_]*)
        (?:\((.*)\))?
\z/sx);
if(defined($ident) && defined(my $handler = (
        Attribute::Lexical::_KLUDGE_RUNTIME_HINTS ? 
                # %^H is not available through caller() on
                # earlier perls.  In that case, if called
                # during compilation, we can kludge by
                # looking at the current compilation %^H.
                Attribute::Lexical->handler_for_compilation(
                        "$type:$ident")
        :
                Attribute::Lexical->handler_for_caller(
                        \@caller, "$type:$ident")
))) {
        $handler->($target, $ident, $arg, \@caller);
} else {
        push @unhandled, $attr;

lib/Attribute/Lexical.pm  view on Meta::CPAN

271
272
273
274
275
276
277
278
279
280
281
All these methods are meant to be invoked on the C<Attribute::Lexical>
package.
 
=over
 
=item Attribute::Lexical->handler_for_caller(CALLER, NAME)
 
Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>")
according to the lexical declarations prevailing in a specified place.
I<CALLER> must be a reference to an array of the form returned by
the L<caller|perlfunc/caller> function, describing the lexical site

lib/Attribute/Lexical.pm  view on Meta::CPAN

306
307
308
309
310
311
312
313
314
315
316
don't make lexical state available at runtime.
 
=cut
 
BEGIN { unless(_KLUDGE_RUNTIME_HINTS) { eval q{
        sub handler { shift->handler_for_caller([caller(0)], @_) }
1; } or die $@; } }
 
=item Attribute::Lexical->handler_for_compilation(NAME)
 
Looks up the attribute named I<NAME> (e.g., "B<CODE:Funky>") according to

 view release on metacpan or  search on metacpan

t/lib/Test/Builder.pm  view on Meta::CPAN

1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
=cut
 
sub todo {
    my($self, $pack) = @_;
 
    $pack = $pack || $self->exported_to || $self->caller(1);
 
    no strict 'refs';
    return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
                                     : 0;
}
 
=item B<caller>
 
    my $package = $Test->caller;
    my($pack, $file, $line) = $Test->caller;
    my($pack, $file, $line) = $Test->caller($height);
 
Like the normal caller(), except it reports according to your level().
 
=cut
 
sub caller {
    my($self, $height) = @_;
    $height ||= 0;
 
    my @caller = CORE::caller($self->level + $height + 1);
    return wantarray ? @caller : $caller[0];
}
 
=back

t/lib/Test/Builder.pm  view on Meta::CPAN

1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
    # We don't want to muck with death in an eval, but $^S isn't
    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
    # with it.  Instead, we use caller.  This also means it runs under
    # 5.004!
    my $in_eval = 0;
    for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
        $in_eval = 1 if $sub =~ /^\(eval\)/;
    }
    $Test_Died = 1 unless $in_eval;
};

 view release on metacpan or  search on metacpan

lib/Attribute/Tie.pm  view on Meta::CPAN

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
    # Anything else
    eval qq{ require Tie::$mod2tie };
    return $MOD2TIE{$mod2tie} = 'Tie::'.$mod2tie unless $@;
 
    # Report Failure and die
    my ( $pkg, $file, $line ) = caller(4);
    die "Neither $mod2tie nor Tie::$mod2tie is available",
      " at $file line $line\n";
}
 
sub error {
    my ( $ref, $mod2tie, @tiearg ) = @_;
    my ( $pkg, $file,    $line )   = caller(4);
    my $s = $SIGIL{ ref $ref };
    die "tie(", join( ", ", $s . ref $ref, qq('$mod2tie'), @tiearg ),
      ") failed : $! at $file line $line\n";
}

 view release on metacpan or  search on metacpan

lib/Attribute/Method.pm  view on Meta::CPAN

15
16
17
18
19
20
21
22
23
24
25
    '%' => {},
);
 
sub import {
    my ( $class, @vars ) = @_;
    my $pkg = caller();
    push @vars, '$self';
    for my $var (@vars) {
        my $sigil = substr( $var, 0, 1, '' );
        no strict 'refs';
        *{ $pkg . '::' . $var } = $sigil2ref{$sigil};

 view release on metacpan or  search on metacpan

MPG123.pm  view on Meta::CPAN

23
24
25
26
27
28
29
30
31
32
33
sub crit { my $self = shift; return $self->log('crit', @_); }
sub warn { my $self = shift; return $self->log('warn', @_); }
 
sub log {
  my $self = shift;
  my @caller = caller(2);
  # print "caller line is ".$caller[2]."\n";
  # ($package, $filename, $line, $subroutine, $hasargs,
  #  $wantarray, $evaltext, $is_require, $hints, $bitmask)
  if (defined $self->{Log}) {
    &{$self->{Log}}(@_, @caller);

 view release on metacpan or  search on metacpan

Daemon.pm  view on Meta::CPAN

28
29
30
31
32
33
34
35
36
37
38
sub crit { my $self = shift; return $self->log('crit', @_); }
sub warn { my $self = shift; return $self->log('warn', @_); }
 
sub log {
  my $self = shift;
  my @caller = caller(2);
  # print "caller line is ".$caller[2]."\n";
  # ($package, $filename, $line, $subroutine, $hasargs,
  #  $wantarray, $evaltext, $is_require, $hints, $bitmask)
  if (defined $self->{Log}) {
    &{$self->{Log}}(@_, @caller);

 view release on metacpan or  search on metacpan

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

229
230
231
232
233
234
235
236
237
238
239
 
    chdir $cwd;
 
    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
 
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {

 view release on metacpan or  search on metacpan

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

316
317
318
319
320
321
322
323
324
325
326
327
328
329
#####################################################################
# Utility Functions
 
sub _caller {
        my $depth = 0;
        my $call  = caller($depth);
        while ( $call eq __PACKAGE__ ) {
                $depth++;
                $call = caller($depth);
        }
        return $call;
}
 
sub _read {

 view release on metacpan or  search on metacpan

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

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

ppport.h  view on Meta::CPAN

6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
    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))
    count++;
if (!count--)
    break;

ppport.h  view on Meta::CPAN

6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
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

268
269
270
271
272
273
274
275
276
277
278
279
280
281
    @found;
}
 
sub _caller {
    my $depth = 0;
    my $call  = caller($depth);
    while ( $call eq __PACKAGE__ ) {
        $depth++;
        $call = caller($depth);
    }
    return $call;
}
 
1;

 view release on metacpan or  search on metacpan

inc/Module/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/Audio/Nama.pm  view on Meta::CPAN

185
186
187
188
189
190
191
192
193
194
195
                 waitpid $pid, 1;
        } @pids;
}
         
sub cleanup_exit {
        logsub((caller(0))[3]);
        remove_riff_header_stubs();
        trigger_rec_cleanup_hooks();
        # for each process: 
        # - SIGINT (1st time)
        # - allow time to close down

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
    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))
    count++;
if (!count--)
    break;

ppport.h  view on Meta::CPAN

6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
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

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/AutoInstall.pm  view on Meta::CPAN

229
230
231
232
233
234
235
236
237
238
239
 
    chdir $cwd;
 
    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
 
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {