File Coverage

blib/lib/Devel/NYTProf/Core.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

# vim: ts=8 sw=4 expandtab:
##########################################################
# This script is part of the Devel::NYTProf distribution
#
# Copyright, contact and other information can be found
# at the bottom of this file, or by going to:
# http://metacpan.org/release/Devel-NYTProf/
#
###########################################################
package Devel::NYTProf::Core;


use XSLoader;

our $VERSION = '6.13';    # increment with XS changes too

XSLoader::load('Devel::NYTProf', $VERSION);

# Fudging for https://rt.cpan.org/Ticket/Display.html?id=82256
$Devel::NYTProf::StrEvalTestPad = ($] <= 5.017004) ? ";\n" : "";

if (my $NYTPROF = $ENV{NYTPROF}) {
    for my $optval ( $NYTPROF =~ /((?:[^\\:]+|\\.)+)/g) {
        my ($opt, $val) = $optval =~ /^((?:[^\\=]+|\\.)+)=((?:[^\\=]+|\\.)+)\z/;
        s/\\(.)/$1/g for $opt, $val;

        if ($opt eq 'sigexit') {
            # Intercept sudden process exit caused by signals
            my @sigs = ($val eq '1') ? qw(INT HUP PIPE BUS SEGV) : split(/,/, $val);
            $SIG{uc $_} = sub { DB::finish_profile(); exit 1; } for @sigs;
            next; # no need to tell the XS code about this
        }

        if ($opt eq 'posix_exit') {
            # Intercept sudden process exit caused by POSIX::_exit() call.
            # Should only be needed if subs=0.  We delay till after profiling
            # has probably started to minimize the effect on the profile.
            eval q{ INIT {
                require POSIX;
                my $orig = \&POSIX::_exit;
                local $^W = 0; # avoid sub redef warning
                *POSIX::_exit = sub { DB::finish_profile(); $orig->(@_) };
            } 1 } or die if $val;
            next; # no need to tell the XS code about this
        }

        DB::set_option($opt, $val);
    }
}

1;

__END__