File Coverage

blib/lib/MCE/Mutex.pm
Criterion Covered Total %
statement 22 22 100.0
branch 5 6 83.3
condition 1 2 50.0
subroutine 7 7 100.0
pod 2 2 100.0
total 37 39 94.8


line stmt bran cond sub pod time code
1             ###############################################################################
2             ## ----------------------------------------------------------------------------
3             ## Locking for Many-Core Engine.
4             ##
5             ###############################################################################
6              
7             package MCE::Mutex;
8              
9 106     106   210160 use strict;
  106         248  
  106         3377  
10 106     106   523 use warnings;
  106         200  
  106         2979  
11              
12 106     106   614 no warnings qw( threads recursion uninitialized );
  106         197  
  106         5027  
13              
14             our $VERSION = '1.889';
15              
16             ## no critic (BuiltinFunctions::ProhibitStringyEval)
17             ## no critic (TestingAndDebugging::ProhibitNoStrict)
18              
19 106     106   620 use Carp ();
  106         323  
  106         22175  
20              
21             ## global Mutex used by MCE, MCE::Child, and MCE::Hobo inside threads
22             ## on UNIX platforms
23              
24             if ( $INC{'threads.pm'} && $^O !~ /mswin|mingw|msys|cygwin/i ) {
25             $MCE::_GMUTEX = MCE::Mutex->new( impl => 'Channel' );
26             MCE::Mutex::Channel::_save_for_global_cleanup($MCE::_GMUTEX);
27             }
28              
29             sub new {
30 463     463 1 2262 my ($class, %argv) = @_;
31             my $impl = defined($argv{impl})
32 463 100       1677 ? $argv{impl} : defined($argv{path}) ? 'Flock' : 'Channel';
    100          
33              
34 463         1573 $impl = ucfirst( lc $impl );
35              
36 463 50       27725 eval "require MCE::Mutex::$impl; 1;" ||
37             Carp::croak("Could not load Mutex implementation '$impl': $@");
38              
39 463         2088 my $pkg = 'MCE::Mutex::'.$impl;
40 106     106   804 no strict 'refs';
  106         197  
  106         13370  
41              
42 463         2420 return $pkg->new( %argv );
43             }
44              
45             ## base class method
46              
47             sub impl {
48 5   50 5 1 82 return $_[0]->{impl} || 'Not defined';
49             }
50              
51             1;
52              
53             __END__