File Coverage

blib/lib/Data/Sync/Shared.pm
Criterion Covered Total %
statement 41 42 97.6
branch 15 20 75.0
condition 6 8 75.0
subroutine 10 10 100.0
pod 0 5 0.0
total 72 85 84.7


line stmt bran cond sub pod time code
1             package Data::Sync::Shared;
2 10     10   1408624 use strict;
  10         34  
  10         334  
3 10     10   41 use warnings;
  10         24  
  10         5652  
4             our $VERSION = '0.05';
5              
6             require XSLoader;
7             XSLoader::load('Data::Sync::Shared', $VERSION);
8              
9             # Guard objects — auto-release on scope exit
10              
11             package Data::Sync::Shared::RWLock::Guard {
12             sub DESTROY {
13 2     2   3436 my $self = shift;
14 2 50       16 $self->[0]->${\$self->[1]} if $self->[0];
  2         19  
15             }
16             }
17              
18             sub Data::Sync::Shared::RWLock::rdlock_guard {
19 1     1 0 218306 my $self = shift;
20 1         32 $self->rdlock(@_);
21 1         31 bless [$self, 'rdunlock'], 'Data::Sync::Shared::RWLock::Guard';
22             }
23              
24             sub Data::Sync::Shared::RWLock::wrlock_guard {
25 1     1 0 593 my $self = shift;
26 1         17 $self->wrlock(@_);
27 1         7 bless [$self, 'wrunlock'], 'Data::Sync::Shared::RWLock::Guard';
28             }
29              
30             package Data::Sync::Shared::Condvar::Guard {
31             sub DESTROY {
32 1     1   404 my $self = shift;
33 1 50       61 $self->[0]->unlock if $self->[0];
34             }
35             }
36              
37             sub Data::Sync::Shared::Condvar::lock_guard {
38 1     1 0 897 my $self = shift;
39 1         18 $self->lock;
40 1         13 bless [$self], 'Data::Sync::Shared::Condvar::Guard';
41             }
42              
43             # Condvar wait_while — loop until predicate returns false
44              
45             sub Data::Sync::Shared::Condvar::wait_while {
46 4     4 0 7866 my ($self, $pred, $timeout) = @_;
47 4   50     47 $timeout //= -1;
48 4 100       93 return $pred->() ? 0 : 1 if $timeout == 0;
    100          
49 2         51 my $deadline;
50 2 50       44 if ($timeout > 0) {
51 2         108 require Time::HiRes;
52 2         35 $deadline = Time::HiRes::time() + $timeout;
53             }
54 2         19 while ($pred->()) {
55 3 50       144 if (defined $deadline) {
56 3         26 my $remaining = $deadline - Time::HiRes::time();
57 3 100       100 return 0 if $remaining <= 0;
58 2         149820 $self->wait($remaining);
59             # Fall through to re-check predicate even on timeout — the
60             # condition may have cleared just before our deadline expired.
61             } else {
62 0         0 $self->wait;
63             }
64             }
65 1         36 return 1;
66             }
67              
68             # Semaphore guard
69              
70             sub Data::Sync::Shared::Semaphore::acquire_guard {
71 3     3 0 352767 my ($self, $n, $timeout) = @_;
72 3   100     17 $n //= 1;
73 3 100       9 if ($n == 1) {
74 2 100 100     25 $self->acquire($timeout // -1) or return undef;
75             } else {
76 1 50 50     14 $self->acquire_n($n, $timeout // -1) or return undef;
77             }
78 2         17 bless [$self, $n], 'Data::Sync::Shared::Semaphore::Guard';
79             }
80              
81             package Data::Sync::Shared::Semaphore::Guard {
82             sub DESTROY {
83 2     2   1576 my $self = shift;
84 2         20 $self->[0]->release($self->[1]);
85             }
86             }
87              
88             1;
89              
90             __END__