File Coverage

blib/lib/B/OPCheck.pm

Criterion	Covered	Total	%
statement	34	37	91.8
branch	1	4	25.0
condition	2	4	50.0
subroutine	11	11	100.0
pod			n/a
total	48	56	85.7

package B::OPCheck; # git description: v0.31-4-gd081d88
# ABSTRACT: PL_check hacks using Perl callbacks

use 5.008;

use strict;
use warnings;

use Carp;
use XSLoader;
use Scalar::Util;
use Scope::Guard;
use B::Utils 0.08 ();

our $VERSION = '0.32';

XSLoader::load 'B::OPCheck', $VERSION;

sub import {
    my ($class, $opname, $mode, $sub) = @_;

    $^H |= 0x120000; # set HINT_LOCALIZE_HH + an unused bit to work around a %^H bug

    my $by_opname = $^H{OPCHECK_leavescope} ||= {};
    my $guards = $by_opname->{$opname} ||= [];
    push @$guards, Scope::Guard->new(sub {
        leavescope($opname, $mode, $sub);
    });

    enterscope($opname, $mode, $sub);
}

sub unimport {
    my ($class, $opname) = @_;

    if ( defined $opname ) {
        my $by_opname = $^H{OPCHECK_leavescope};
        delete $by_opname->{$opname};
        return if scalar keys %$by_opname; # don't delete other things
    }

    delete $^H{OPCHECK_leavescope};
    $^H &= ~0x120000;
}

1;

__END__