File Coverage

blib/lib/MCE/Mutex/Channel2.pm
Criterion Covered Total %
statement 59 77 76.6
branch 17 52 32.6
condition 2 9 22.2
subroutine 14 18 77.7
pod 6 6 100.0
total 98 162 60.4


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   121 use strict;
  17         33  
  17         550  
10 17     17   90 use warnings;
  17         32  
  17         513  
11              
12 17     17   70 no warnings qw( threads recursion uninitialized once );
  17         39  
  17         1252  
13              
14             our $VERSION = '1.889';
15              
16 17     17   759 use if $^O eq 'MSWin32', 'threads';
  17         54  
  17         130  
17 17     17   993 use if $^O eq 'MSWin32', 'threads::shared';
  17         27  
  17         96  
18              
19 17     17   619 use base 'MCE::Mutex::Channel';
  17         34  
  17         9165  
20 17     17   118 use MCE::Util ();
  17         35  
  17         330  
21 17     17   75 use Scalar::Util 'looks_like_number';
  17         30  
  17         754  
22 17     17   99 use Time::HiRes 'alarm';
  17         21  
  17         115  
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             sub MCE::Mutex::Channel2::_guard::DESTROY {
32 52     52   173 my ($pid, $obj) = @{ $_[0] };
  52         476  
33 52 50       751 CORE::syswrite($obj->{_r_sock}, '0'), $obj->{$pid.'b'} = 0 if $obj->{$pid.'b'};
34              
35 52         324 return;
36             }
37              
38             ###############################################################################
39             ## ----------------------------------------------------------------------------
40             ## Public methods.
41             ##
42             ###############################################################################
43              
44             sub new {
45 30     30 1 133 my ($class, %obj) = (@_, impl => 'Channel2');
46 30 50       145 $obj{_init_pid} = $tid ? $$ .'.'. $tid : $$;
47 30 50       90 $obj{_t_lock} = threads::shared::share( my $t_lock ) if $is_MSWin32;
48 30 50       89 $obj{_t_lock2} = threads::shared::share( my $t_lock2 ) if $is_MSWin32;
49              
50 30         111 MCE::Util::_sock_pair(\%obj, qw(_r_sock _w_sock), undef, 1);
51              
52 30         726 CORE::syswrite($obj{_w_sock}, '0');
53 30         356 CORE::syswrite($obj{_r_sock}, '0');
54 30         162 bless \%obj, $class;
55              
56 30 100 66     356 if ( caller !~ /^MCE:?/ || caller(1) !~ /^MCE:?/ ) {
57 1         5 MCE::Mutex::Channel::_save_for_global_cleanup(\%obj);
58             }
59              
60 30         195 return \%obj;
61             }
62              
63             sub lock2 {
64 42 50   42 1 127 my ($pid, $obj) = ($tid ? $$ .'.'. $tid : $$, shift);
65              
66 42 50       121 unless ($obj->{ $pid.'b' }) {
67             CORE::lock($obj->{_t_lock2}), MCE::Util::_sock_ready($obj->{_w_sock})
68 42 50       87 if $is_MSWin32;
69 42         125 MCE::Util::_sysread($obj->{_w_sock}, my($b), 1), $obj->{ $pid.'b' } = 1;
70             }
71              
72 42         131 return;
73             }
74              
75             sub guard_lock2 {
76 0     0 1 0 &lock2(@_);
77 0 0       0 bless([ $tid ? $$ .'.'. $tid : $$, $_[0] ], MCE::Mutex::Channel2::_guard::);
78             }
79              
80             *lock_exclusive2 = \&lock2;
81             *lock_shared2 = \&lock2;
82              
83             sub unlock2 {
84 42 50   42 1 140 my ($pid, $obj) = ($tid ? $$ .'.'. $tid : $$, shift);
85              
86             CORE::syswrite($obj->{_r_sock}, '0'), $obj->{ $pid.'b' } = 0
87 42 50       434 if $obj->{ $pid.'b' };
88              
89 42         154 return;
90             }
91              
92             sub synchronize2 {
93 52 50   52 1 642 my ($pid, $obj, $code) = ($tid ? $$ .'.'. $tid : $$, shift, shift);
94 52         136 my (@ret, $b);
95              
96 52 50       341 return unless ref($code) eq 'CODE';
97              
98             # lock, run, unlock - inlined for performance
99 52         710 my $guard = bless([ $pid, $obj ], MCE::Mutex::Channel2::_guard::);
100 52 50       465 unless ($obj->{ $pid.'b' }) {
101             CORE::lock($obj->{_t_lock2}), MCE::Util::_sock_ready($obj->{_w_sock})
102 52 50       239 if $is_MSWin32;
103 52         507 MCE::Util::_sysread($obj->{_w_sock}, $b, 1), $obj->{ $pid.'b' } = 1;
104             }
105             (defined wantarray)
106 52 0       588 ? @ret = wantarray ? $code->(@_) : scalar $code->(@_)
    50          
107             : $code->(@_);
108              
109 52 50       734 return wantarray ? @ret : $ret[-1];
110             }
111              
112             *enter2 = \&synchronize2;
113              
114             sub timedwait2 {
115 0     0 1   my ($obj, $timeout) = @_;
116              
117 0 0         $timeout = 1 unless defined $timeout;
118 0 0 0       Carp::croak('MCE::Mutex::Channel2: timedwait2 (timeout) is not valid')
119             if (!looks_like_number($timeout) || $timeout < 0);
120              
121 0 0         $timeout = 0.0003 if $timeout < 0.0003;
122 0           local $@; my $ret = '';
  0            
123              
124 0           eval {
125 0     0     local $SIG{ALRM} = sub { alarm 0; die "alarm clock restart\n" };
  0            
  0            
126 0 0         alarm $timeout unless $is_MSWin32;
127              
128             die "alarm clock restart\n"
129 0 0 0       if $is_MSWin32 && MCE::Util::_sock_ready($obj->{_w_sock}, $timeout);
130              
131 0 0         (!$is_MSWin32)
132             ? ($obj->lock_exclusive2, $ret = 1, alarm(0))
133             : ($obj->lock_exclusive2, $ret = 1);
134             };
135              
136 0 0         alarm 0 unless $is_MSWin32;
137              
138 0           $ret;
139             }
140              
141             1;
142              
143             __END__