view release on metacpan or  search on metacpan

pperl.h.header  view on Meta::CPAN

}


my $____self;
my $should_exit = 0;
my $exit_code = 0;

BEGIN {
    *CORE::GLOBAL::exit = sub {
        my $retval = shift || 0;
        my $package = (caller)[0];

        log_error("exit $package $retval $should_exit\n");
        if ($package eq 'PPerlServer' || $should_exit) {
            exit($retval);
        }
        $exit_code = $retval;
        goto __PPerl_exit;
    };

    *CORE::GLOBAL::fork = sub {
        my $package = (caller)[0];
        my $ret = fork();
        if (defined $ret && !$ret && $package ne 'PPerlServer') {
            # forked children should just exit
            $should_exit = 1;
        }
        return $ret;
    };

    *CORE::GLOBAL::exec = sub {
        # This is so horribly wrong, overloading exec() to be
        # system();exit() - but there's no other way to make this
        # work. See the documentation in t/19invoke_djbish.t for
        # further info on this issue.
        my $package = (caller)[0];
        log_error("exec $package $should_exit\n");
        if ($package eq 'PPerlServer' || $should_exit) {
            exec(@_);
        }
        my $code = system(@_);
        $exit_code = $code >> 8;
        goto __PPerl_exit;
    };
}