Devel-Caller

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

2.02 Friday 28th December, 2007
	Make use of INT2PTR macro for great justice! (or 64-bit stuff,
	it's hard to tell)

2.01 Thursday 27th December, 2007
	Translated the XS and C into perl using B.  Though the perl looks
	much like C this gives a chance to make it more perlish in the future.
  	There's a tiny bit of XS left to expose some internals to perl space.
	
	Dropped compatibilty for older perls (PadWalker doesn't work 
	there anyway)

0.11 Sunday 9th July, 2006
	Fudge around the segfaults in 5.8.x ithreaded builds by
	not looking up what the package variable is.

0.10 Wednesday 5th July, 2006
	Use strlen rather than playing with SvLEN/SvCUR to determine
	the length of identifiers in the pad.  It's a theoretical
	segfault waiting to happen, but one that isn't tickled by the

Changes  view on Meta::CPAN

0.05 2002-07-25
	Fix a segfault under ithreads.  
	Cleaned up some development cruft that leaked out while
	rushing.

0.04 2002-07-01
	Decode glob params too.

0.03 2002-04-02
	Refactored to share the upcontext code from PadWalker 0.08

META.json  view on Meta::CPAN

            "ExtUtils::MakeMaker" : "0"
         }
      },
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "runtime" : {
         "requires" : {
            "PadWalker" : "0.08",
            "Test::More" : "0"
         }
      }
   },
   "release_status" : "stable",
   "resources" : {
      "license" : [
         "http://dev.perl.org/licenses/"
      ],
      "repository" : {

META.yml  view on Meta::CPAN

license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: Devel-Caller
no_index:
  directory:
    - t
    - inc
requires:
  PadWalker: '0.08'
  Test::More: '0'
resources:
  license: http://dev.perl.org/licenses/
  repository: https://github.com/richardc/perl-devel-caller.git
version: '2.07'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

Makefile.PL  view on Meta::CPAN

use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
    NAME          => 'Devel::Caller',
    AUTHOR        => 'Richard Clamp <richardc@unixbeard.net>',
    LICENSE       => 'perl',
    VERSION_FROM  => 'lib/Devel/Caller.pm',
    ABSTRACT_FROM => 'lib/Devel/Caller.pm',
    PREREQ_PM     => {
        'Test::More' => 0,
        'PadWalker'  => '0.08'
    },
    META_MERGE => {
        'meta-spec' => { version => 2 },
        resources => {
            repository  => {
                type => 'git',
                url => 'https://github.com/richardc/perl-devel-caller.git',
                web => 'https://github.com/richardc/perl-devel-caller',
            },
            license     => 'http://dev.perl.org/licenses/',

lib/Devel/Caller.pm  view on Meta::CPAN

use strict;
package Devel::Caller;
use warnings;
use B qw( peekop );
use PadWalker ();
use XSLoader;
use base qw( Exporter  );
use 5.008;

our $VERSION = '2.07';
XSLoader::load __PACKAGE__, $VERSION;

our @EXPORT_OK = qw( caller_cv caller_args caller_vars called_with called_as_method );

sub caller_cv {
    my $level = shift;
    my $cx = PadWalker::_upcontext($level + 1);
    return unless $cx;
    return _context_cv($cx);
}

our $DEBUG = 0;

# scan forward through the ops noting the pushmark or a padrange ops.
# These indicate the start of a subroutine call.  We're looking for the most
# recent one before the subroutine invocation (the entersub).
sub scan_forward {

lib/Devel/Caller.pm  view on Meta::CPAN

        }
    }
    return pop @stack;
}

*caller_vars = \&called_with;
sub called_with {
    my $level = shift;
    my $want_names = shift;

    my $op  = _context_op( PadWalker::_upcontext( $level + 1 ));
    my $cv  = caller_cv( $level + 2 );
    my $pad = $cv ? B::svref_2object( $cv )->PADLIST : B::comppadlist;
    my $padn = $pad->ARRAYelt( 0 );
    my $padv = $pad->ARRAYelt( 1 );

    print "Context OP: ", peekop($op), "\n" if $DEBUG;
    $op = scan_forward( $op );
    print "Scanned forward to ", peekop($op), "\n" if $DEBUG;

    my @return;

lib/Devel/Caller.pm  view on Meta::CPAN

            push @return, $want_names ? undef : $op->sv;
            next;
        }
    }
    return @return;
}


sub called_as_method {
    my $level = shift || 0;
    my $op = _context_op( PadWalker::_upcontext( $level + 1 ));

    print "called_as_method: $op\n" if $DEBUG;
    die "was expecting a pushmark or pad, not a ". $op->name
      unless $op->name eq "pushmark";
    while (($op = $op->next) && ($op->name ne "entersub")) {
        print "method: ", $op->name, "\n" if $DEBUG;
        return 1 if $op->name =~ /^method(?:_named)?$/;
    }
    return;
}

lib/Devel/Caller.pm  view on Meta::CPAN

=item

As a version 2.0 of Devel::Caller we no longer maintain compatibility with
versions of perl earlier than 5.8.2.  Older versions continue to be available
from CPAN and backpan.

=back

=head1 SEE ALSO

L<perlfunc/caller>, L<PadWalker>, L<Devel::Peek>

=head1 AUTHOR

Richard Clamp <richardc@unixbeard.net> with close reference to
PadWalker by Robin Houston

=head1 COPYRIGHT

Copyright (c) 2002, 2003, 2006, 2007, 2008, 2010, 2013, 2023 Richard Clamp.
All Rights Reserved.

This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.

=cut