File Coverage

blib/lib/Acme/Spork.pm

Criterion	Covered	Total	%
statement	21	66	31.8
branch	1	18	5.5
condition	0	7	0.0
subroutine	7	11	63.6
pod	0	3	0.0
total	29	105	27.6

package Acme::Spork;

use strict;
use warnings;
use Carp;
use IO::Handle;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT    = qw(spork);
our @EXPORT_OK = qw(daemonize daemonize_without_close_on);

use version;our $VERSION = qv('0.0.8');

our %reopen_stdfhs_to;

sub import {
    shift->export_to_level(1, grep(!/^-/, @_));
    if(grep /^-reopen_stdfhs$/, @_) {
        %reopen_stdfhs_to = (
             STDIN  => [qw(< /dev/null)],
             STDOUT => [qw(> /dev/null)],
             STDERR => [qw(>&STDOUT)],
        );
    }
    return;
}

sub spork {
    my $spork = shift;
    croak "spork() needs a code ref!" if ref $spork ne 'CODE';

    my $PARENT_WTR = IO::Handle->new;
    my $CHILD_RDR  = IO::Handle->new;

    pipe($CHILD_RDR,  $PARENT_WTR); # or return/croak ?
    $PARENT_WTR->autoflush(1);

    defined (my $kid = fork) or die "Cannot fork: $!\n";

    if ($kid) {
        close $PARENT_WTR;
        chomp(my $grandkid_pid = <$CHILD_RDR>);
        close $CHILD_RDR;
        waitpid($kid,0);
        return $grandkid_pid;
    }
    else {
        ## local $SIG{CHLD} = 'IGNORE';
        if (!defined &setsid) {
            require POSIX;
            *setsid = *POSIX::setsid;
        }
        setsid();
        ##

        defined ( my $grandkid = fork) or die "Kid cannot fork: $!\n";
        if ($grandkid) {
            close $CHILD_RDR;
            print $PARENT_WTR "$grandkid\n";
            close $PARENT_WTR;
            CORE::exit(0);
        }
        else {
            close $CHILD_RDR;
            close $PARENT_WTR;

            for my $stdfh (qw(STDIN STDOUT STDERR)) {
                close $stdfh;
                if(exists $reopen_stdfhs_to{ $stdfh } && ref $reopen_stdfhs_to{ $stdfh } eq 'ARRAY') {
                    eval  "open( $stdfh, " . join(', ', map { qq{"$_"} } @{ $reopen_stdfhs_to{ $stdfh } }) . ' );';
                    carp "Could not reopen $stdfh : $@" if $@;
                    # no strict 'refs';
                    # open( $stdfh , @{ $reopen_stdfhs_to{ $stdfh } }) or carp "Could not reopen $stdfh : $!";
                }
            }

            ## if (!defined &setsid) {
            ##     require POSIX;
            ##     *setsid = *POSIX::setsid;
            ## }
            ##
            ## setsid();
            ## $SIG{CHLD} = 'DEFAULT';
            $spork->(@_);
            CORE::exit(0);
        }
    }
}

sub daemonize {
    require Proc::Daemon;
    {
        local $SIG{'HUP'} = $SIG{'HUP'} || ''; # workaround until http://rt.cpan.org/Public/Bug/Display.html?id=21453
        goto &Proc::Daemon::Init;
    }
}

sub daemonize_without_close_on {
    require Proc::Daemon;
    {
        no warnings 'redefine';
        local *POSIX::close = sub { return 1; }; # the "without_close_on" part

        local $SIG{'HUP'} = $SIG{'HUP'} || ''; # workaround until http://rt.cpan.org/Public/Bug/Display.html?id=21453
        Proc::Daemon::Init(@_);
    }
}

1;

__END__