File Coverage

blib/lib/true.pm

Criterion	Covered	Total	%
statement	36	37	97.3
branch	9	12	75.0
condition	5	6	83.3
subroutine	9	9	100.0
pod	0	1	0.0
total	59	65	90.7

package true;

use strict;
use warnings;

use B::Hooks::OP::Annotation;
use B::Hooks::OP::Check;
use Devel::StackTrace;
use XSLoader;

our $VERSION = '0.18';
our %TRUE;

XSLoader::load(__PACKAGE__, $VERSION);

# XXX CopFILE(&PL_compiling) gives the wrong result here (it works in the OP checker in the XS).
# return the full path of the file that's currently being compiled
sub ccfile() {
    my ($file, $source, $line);
    my $trace = Devel::StackTrace->new;

    # find the innermost require frame
    #
    # for "use Foo::Bar" or "require Foo::Bar", the evaltext contains "Foo/Bar.pm", and
    # the filename/line refer to the file where the use/require statement appeared.

    # work from the innermost frame out
    while (my $frame = $trace->next_frame) {
        next unless ($frame->is_require);
        my $required = $frame->evaltext;

        if (defined($file = $INC{$required})) {
            $source = $frame->filename;
            $line = $frame->line;
        } else { # shouldn't happen
            warn "true: can't find required file ($required) in \%INC";
        }

        last;
    }

    return wantarray ? ($file, $source, $line) : $file;
}

# XXX should add a debug option
sub import {
    my ($file, $source, $line) = ccfile();

    if (defined($file) && not($TRUE{$file})) {
        $TRUE{$file} = 1;
        # warn "true: enabling true for $file at $source line $line", $/;
        xs_enter();
    }
}

sub unimport {
    my ($file, $source, $line) = ccfile();

    if (defined($file) && $TRUE{$file}) {
        # warn "true: disabling true for $file at $source line $line", $/;
        delete $TRUE{$file};
        xs_leave() unless (%TRUE);
    }
}

1;

__END__