File Coverage

blib/lib/Hook/Fork.pm

Criterion	Covered	Total	%
statement	54	57	94.7
branch	13	14	92.8
condition	2	4	50.0
subroutine	15	16	93.7
pod	0	3	0.0
total	84	94	89.3

package Hook::Fork;
use strict;
use warnings;
use parent qw/DynaLoader/;

our $VERSION = '0.01_01';

__PACKAGE__->bootstrap($VERSION);

use Hook::Fork::Task;
use Guard;
use Scalar::Util qw(refaddr);

my %state;

BEGIN {
    %state = (
        parent => {
            head => undef,
            tail => undef,
        },
        child => {
            head => undef,
            tail => undef,
        },
        before => {
            head => undef,
            tail => undef,
        },
    );
}

sub make_registerer {
    my ($which) = @_;
    my $state = $state{$which} || die 'wtf';

    return sub(&) {
        my $code = shift;
        my $obj = Hook::Fork::Task->new($code);

        $state->{head} = $obj if !$state->{head};
        $state->{tail}->append($obj) if $state->{tail};
        $state->{tail} = $obj;

        if(defined wantarray){
            return guard {
                if(refaddr $obj == refaddr $state->{tail}){
                    $state->{tail} = $obj->{prev};
                }
                if(refaddr $obj == refaddr $state->{head}){
                    $state->{head} = $obj->{next};
                }
                $obj->remove;
            };
        }
    }
}

sub make_runner {
    my ($which) = @_;
    my $state = $state{$which} || die 'wtf';

    return sub {
        my $node = $state->{head};
        return if !$node;
        do {
            $node->run
        } while ($node = $node->{next});
        return;
    }
}

BEGIN {
    *register_parent_fork_hook = make_registerer('parent');
    *register_child_fork_hook  = make_registerer('child');
    *register_before_fork_hook = make_registerer('before');
    *run_parent_hooks = make_runner('parent');
    *run_child_hooks  = make_runner('child');
    *run_before_hooks = make_runner('before');
}

sub init {
    my $code = _init();
    if( $code != 0) {
        $! = $code;
        die "Problem hooking fork with pthread_atfork: $!";
    }
}

use Sub::Exporter -setup => {
    exports => [ map { "register_${_}_fork_hook" } keys %state ],
};

sub _get_state {
    return \%state;
}

init(); # setup the main handler

1;
__END__