File Coverage

blib/lib/MCE/Mutex/Channel2.pm
Criterion Covered Total %
statement 45 69 65.2
branch 10 48 20.8
condition 2 9 22.2
subroutine 12 16 75.0
pod 5 5 100.0
total 74 147 50.3


line stmt bran cond sub pod time code
1             ###############################################################################
2             ## ----------------------------------------------------------------------------
3             ## MCE::Mutex::Channel2 - Provides two mutexes using a single channel.
4             ##
5             ###############################################################################
6              
7             package MCE::Mutex::Channel2;
8              
9 17     17   117 use strict;
  17         34  
  17         558  
10 17     17   99 use warnings;
  17         32  
  17         530  
11              
12 17     17   86 no warnings qw( threads recursion uninitialized once );
  17         54  
  17         1297  
13              
14             our $VERSION = '1.888';
15              
16 17     17   717 use if $^O eq 'MSWin32', 'threads';
  17         77  
  17         267  
17 17     17   942 use if $^O eq 'MSWin32', 'threads::shared';
  17         181  
  17         102  
18              
19 17     17   594 use base 'MCE::Mutex::Channel';
  17         30  
  17         9443  
20 17     17   119 use MCE::Util ();
  17         34  
  17         293  
21 17     17   280 use Scalar::Util 'looks_like_number';
  17         34  
  17         716  
22 17     17   225 use Time::HiRes 'alarm';
  17         36  
  17         67  
23              
24             my $is_MSWin32 = ($^O eq 'MSWin32') ? 1 : 0;
25             my $tid = $INC{'threads.pm'} ? threads->tid() : 0;
26              
27             sub CLONE {
28 0 0   0   0 $tid = threads->tid() if $INC{'threads.pm'};
29             }
30              
31             ###############################################################################
32             ## ----------------------------------------------------------------------------
33             ## Public methods.
34             ##
35             ###############################################################################
36              
37             sub new {
38 30     30 1 132 my ($class, %obj) = (@_, impl => 'Channel2');
39 30 50       112 $obj{_init_pid} = $tid ? $$ .'.'. $tid : $$;
40 30 50       91 $obj{_t_lock} = threads::shared::share( my $t_lock ) if $is_MSWin32;
41 30 50       63 $obj{_t_lock2} = threads::shared::share( my $t_lock2 ) if $is_MSWin32;
42              
43 30         154 MCE::Util::_sock_pair(\%obj, qw(_r_sock _w_sock), undef, 1);
44              
45 30         734 CORE::syswrite($obj{_w_sock}, '0');
46 30         408 CORE::syswrite($obj{_r_sock}, '0');
47 30         173 bless \%obj, $class;
48              
49 30 100 66     389 if ( caller !~ /^MCE:?/ || caller(1) !~ /^MCE:?/ ) {
50 1         8 MCE::Mutex::Channel::_save_for_global_cleanup(\%obj);
51             }
52              
53 30         192 return \%obj;
54             }
55              
56             sub lock2 {
57 94 50   94 1 999 my ($pid, $obj) = ($tid ? $$ .'.'. $tid : $$, shift);
58              
59             CORE::lock($obj->{_t_lock2}), MCE::Util::_sock_ready($obj->{_w_sock})
60 94 50       370 if $is_MSWin32;
61             MCE::Util::_sysread($obj->{_w_sock}, my($b), 1), $obj->{ $pid.'b' } = 1
62 94 50       1153 unless $obj->{ $pid.'b' };
63              
64 94         389 return;
65             }
66              
67             *lock_exclusive2 = \&lock2;
68             *lock_shared2 = \&lock2;
69              
70             sub unlock2 {
71 94 50   94 1 427 my ($pid, $obj) = ($tid ? $$ .'.'. $tid : $$, shift);
72              
73             CORE::syswrite($obj->{_r_sock}, '0'), $obj->{ $pid.'b' } = 0
74 94 50       1392 if $obj->{ $pid.'b' };
75              
76 94         419 return;
77             }
78              
79             sub synchronize2 {
80 0 0   0 1   my ($pid, $obj, $code) = ($tid ? $$ .'.'. $tid : $$, shift, shift);
81 0           my (@ret, $b);
82              
83 0 0         return unless ref($code) eq 'CODE';
84              
85             # lock, run, unlock - inlined for performance
86             CORE::lock($obj->{_t_lock2}), MCE::Util::_sock_ready($obj->{_w_sock})
87 0 0         if $is_MSWin32;
88             MCE::Util::_sysread($obj->{_w_sock}, $b, 1), $obj->{ $pid.'b' } = 1
89 0 0         unless $obj->{ $pid.'b' };
90              
91             (defined wantarray)
92 0 0         ? @ret = wantarray ? $code->(@_) : scalar $code->(@_)
    0          
93             : $code->(@_);
94              
95 0           CORE::syswrite($obj->{_r_sock}, '0'), $obj->{ $pid.'b' } = 0;
96              
97 0 0         return wantarray ? @ret : $ret[-1];
98             }
99              
100             *enter2 = \&synchronize2;
101              
102             sub timedwait2 {
103 0     0 1   my ($obj, $timeout) = @_;
104              
105 0 0         $timeout = 1 unless defined $timeout;
106 0 0 0       Carp::croak('MCE::Mutex::Channel2: timedwait2 (timeout) is not valid')
107             if (!looks_like_number($timeout) || $timeout < 0);
108              
109 0 0         $timeout = 0.0003 if $timeout < 0.0003;
110 0           local $@; my $ret = '';
  0            
111              
112 0           eval {
113 0     0     local $SIG{ALRM} = sub { alarm 0; die "alarm clock restart\n" };
  0            
  0            
114 0 0         alarm $timeout unless $is_MSWin32;
115              
116             die "alarm clock restart\n"
117 0 0 0       if $is_MSWin32 && MCE::Util::_sock_ready($obj->{_w_sock}, $timeout);
118              
119 0 0         (!$is_MSWin32)
120             ? ($obj->lock_exclusive2, $ret = 1, alarm(0))
121             : ($obj->lock_exclusive2, $ret = 1);
122             };
123              
124 0 0         alarm 0 unless $is_MSWin32;
125              
126 0           $ret;
127             }
128              
129             1;
130              
131             __END__