File Coverage

blib/lib/Mutex/Util.pm

Criterion	Covered	Total	%
statement	35	90	38.8
branch	6	60	10.0
condition	0	6	0.0
subroutine	9	14	64.2
pod	4	4	100.0
total	54	174	31.0

###############################################################################
## ----------------------------------------------------------------------------
## Utility functions for Mutex.
##
###############################################################################

package Mutex::Util;

use strict;
use warnings;

no warnings qw( threads recursion uninitialized );

our $VERSION = '1.009';

## no critic (BuiltinFunctions::ProhibitStringyEval)

use IO::Handle ();
use Socket qw( AF_UNIX );
use Errno ();

my ($is_winenv, $zero_bytes, %sock_ready);

BEGIN {
    $is_winenv  = ( $^O =~ /mswin|mingw|msys|cygwin/i ) ? 1 : 0;
    $zero_bytes = pack('L', 0);
}

sub CLONE {
    %sock_ready = ();
}

###############################################################################
## ----------------------------------------------------------------------------
## Public functions.
##
###############################################################################

sub destroy_pipes {
    my ($obj, @params) = @_;
    local ($!,$?); local $SIG{__DIE__};

    for my $p (@params) {
        next unless (defined $obj->{$p});

        if (ref $obj->{$p} eq 'ARRAY') {
            for my $i (0 .. @{ $obj->{$p} } - 1) {
                next unless (defined $obj->{$p}[$i]);
                close $obj->{$p}[$i] if (fileno $obj->{$p}[$i]);
                undef $obj->{$p}[$i];
            }
        }
        else {
            close $obj->{$p} if (fileno $obj->{$p});
            undef $obj->{$p};
        }
    }

    return;
}

sub destroy_socks {
    my ($obj, @params) = @_;
    local ($!,$?,$@); local $SIG{__DIE__};

    for my $p (@params) {
        next unless (defined $obj->{$p});

        if (ref $obj->{$p} eq 'ARRAY') {
            for my $i (0 .. @{ $obj->{$p} } - 1) {
                next unless (defined $obj->{$p}[$i]);
                if (fileno $obj->{$p}[$i]) {
                    syswrite($obj->{$p}[$i], '0') if $is_winenv;
                    eval q{ CORE::shutdown($obj->{$p}[$i], 2) };
                    close $obj->{$p}[$i];
                }
                undef $obj->{$p}[$i];
            }
        }
        else {
            if (fileno $obj->{$p}) {
                syswrite($obj->{$p}, '0') if $is_winenv;
                eval q{ CORE::shutdown($obj->{$p}, 2) };
                close $obj->{$p};
            }
            undef $obj->{$p};
        }
    }

    return;
}

sub pipe_pair {
    my ($obj, $r_sock, $w_sock, $i) = @_;
    local $!;

    if (defined $i) {
        # remove tainted'ness
        ($i) = $i =~ /(.*)/;
        pipe($obj->{$r_sock}[$i], $obj->{$w_sock}[$i]) or die "pipe: $!\n";
        $obj->{$w_sock}[$i]->autoflush(1);
    }
    else {
        pipe($obj->{$r_sock}, $obj->{$w_sock}) or die "pipe: $!\n";
        $obj->{$w_sock}->autoflush(1);
    }

    return;
}

sub sock_pair {
    my ($obj, $r_sock, $w_sock, $i) = @_;
    local $!;

    if (defined $i) {
        # remove tainted'ness
        ($i) = $i =~ /(.*)/;
        socketpair( $obj->{$r_sock}[$i], $obj->{$w_sock}[$i],
            AF_UNIX, Socket::SOCK_STREAM(), 0 ) or die "socketpair: $!\n";
        $obj->{$r_sock}[$i]->autoflush(1);
        $obj->{$w_sock}[$i]->autoflush(1);
    }
    else {
        socketpair( $obj->{$r_sock}, $obj->{$w_sock},
            AF_UNIX, Socket::SOCK_STREAM(), 0 ) or die "socketpair: $!\n";
        $obj->{$r_sock}->autoflush(1);
        $obj->{$w_sock}->autoflush(1);
    }

    return;
}

sub _sock_ready {
   my ($socket, $timeout) = @_;
   return '' if !defined $timeout && $sock_ready{"$socket"} > 1;

   my ($val_bytes, $delay, $start) = (pack('L', 0), 0, time);

   if (!defined $timeout) {
      $sock_ready{"$socket"}++;
   }
   else {
      $timeout = undef   if $timeout < 0;
      $timeout += $start if $timeout;
   }

   while (1) {
      # MSWin32 FIONREAD - from winsock2.h macro
      ioctl($socket, 0x4004667f, $val_bytes);

      return '' if $val_bytes ne $zero_bytes;
      return  1 if $timeout && time > $timeout;

      # delay after a while to not consume a CPU core
      sleep(0.015), next if $delay;
      $delay = 1 if time - $start > 0.030;
   }
}

sub _sysread {
    ( @_ == 3
        ? CORE::sysread($_[0], $_[1], $_[2])
        : CORE::sysread($_[0], $_[1], $_[2], $_[3])
    )
    or do {
        goto \&_sysread if ($! == Errno::EINTR());
    };
}

1;

__END__