view release on metacpan or  search on metacpan

lib/MCE/Mutex/Channel.pm  view on Meta::CPAN

###############################################################################
## ----------------------------------------------------------------------------
## MCE::Mutex::Channel - Mutex locking via a pipe or socket.
##
###############################################################################

package MCE::Mutex::Channel;

use strict;
use warnings;

no warnings qw( threads recursion uninitialized once );

our $VERSION = '1.904';

use if $^O eq 'MSWin32', 'threads';
use if $^O eq 'MSWin32', 'threads::shared';

use base 'MCE::Mutex';
use MCE::Util ();
use Scalar::Util qw(looks_like_number weaken);
use Time::HiRes 'alarm';

my $is_MSWin32 = ($^O eq 'MSWin32') ? 1 : 0;
my $use_pipe = ($^O !~ /mswin|mingw|msys|cygwin/i && $] gt '5.010000');
my $tid = $INC{'threads.pm'} ? threads->tid : 0;

sub CLONE {
    $tid = threads->tid if $INC{'threads.pm'};
}

sub MCE::Mutex::Channel::_guard::DESTROY {
    my ($pid, $obj) = @{ $_[0] };
    CORE::syswrite($obj->{_w_sock}, '0'), $obj->{ $pid } = 0 if $obj->{ $pid };

    return;
}

sub DESTROY {
    my ($pid, $obj) = ($tid ? $$ .'.'. $tid : $$, @_);
    CORE::syswrite($obj->{_w_sock}, '0'), $obj->{$pid    } = 0 if $obj->{$pid    };
    CORE::syswrite($obj->{_r_sock}, '0'), $obj->{$pid.'b'} = 0 if $obj->{$pid.'b'};

    if ( $obj->{_init_pid} eq $pid ) {
        (!$use_pipe || $obj->{impl} eq 'Channel2')
            ? MCE::Util::_destroy_socks($obj, qw(_w_sock _r_sock))
            : MCE::Util::_destroy_pipes($obj, qw(_w_sock _r_sock));
    }

    return;
}

my @mutex;

sub _destroy {
    my $pid = $tid ? $$ .'.'. $tid : $$;

    # Called by { MCE, MCE::Child, and MCE::Hobo }::_exit
    for my $i ( 0 .. @mutex - 1 ) {
        CORE::syswrite($mutex[$i]->{_w_sock}, '0'), $mutex[$i]->{$pid} = 0
            if ( $mutex[$i]->{$pid} );
        CORE::syswrite($mutex[$i]->{_r_sock}, '0'), $mutex[$i]->{$pid.'b'} = 0
            if ( $mutex[$i]->{$pid.'b'} );
    }
}

sub _save_for_global_cleanup {
    push(@mutex, $_[0]), weaken($mutex[-1]);
}

###############################################################################
## ----------------------------------------------------------------------------
## Public methods.
##
###############################################################################

sub new {
    my ($class, %obj) = (@_, impl => 'Channel');
    $obj{_init_pid} = $tid ? $$ .'.'. $tid : $$;
    $obj{_t_lock} = threads::shared::share( my $t_lock ) if $is_MSWin32;

    $use_pipe
        ? MCE::Util::_pipe_pair(\%obj, qw(_r_sock _w_sock))
        : MCE::Util::_sock_pair(\%obj, qw(_r_sock _w_sock));