view release on metacpan or  search on metacpan

lib/Acme/Spork.pm  view on Meta::CPAN

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__

=head1 NAME

Acme::Spork - Perl extension for spork()ing in your script

=head1 SYNOPSIS

    use Acme::Spork;
    my $spork_pid = spork(\&long_running_code, @ARGV) 
        or die "Could not fork for spork: $!";
    print "Long running code has been started as PID $spork_pid, bye!\n";

=head1 DESCRIPTION

A spork in the plastic sense is a fork combined with a spoon. In programming I've come to call a spork() a fork() that does more than just a fork.

I use it to describe when you want to fork() to run some long running code but immediately return to the main program instead of waiting for it.

=head1 spork()