File Coverage

blib/lib/Devel/Callsite.pm

Criterion	Covered	Total	%
statement	14	15	93.3
branch	2	4	50.0
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	23	26	88.4

package Devel::Callsite;
use 5.005;
use vars qw($VERSION);
use XSLoader;
use base qw(Exporter);
$VERSION = '1.0.1';
if ($] >= 5.026) {
    @EXPORT = qw/callsite context addr_to_op caller_nextop/;
} else {
    @EXPORT = qw/callsite context/;
}

XSLoader::load __PACKAGE__;

BEGIN {
    if ($] >= 5.026) {
	sub caller_nextop {
	    my $level = ($#_ ? shift : 0) + 1;
	    return addr_to_op(callsite($level));
	}
    }
}

# Demo code
unless (caller) {
  my $site = sub { return callsite() };
  printf "OP location: 0x%x\n", $site->(); # prints caller OP location
  printf "OP location: 0x%x\n", $site->(); # prints a different OP location

  if ($] >= 5.026) {
      my $get_op = sub { return caller_nextop() };
      printf "OP is: %s\n", $get_op->();

      # prints the interpreter context, an unsigned number
      print "Expression context is: ", context(), "\n";
  }
}

1;
__END__