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   1300797 use strict;
  10         15  
  10         450  
3 10     10   45 use warnings;
  10         25  
  10         6362  
4             our $VERSION = '0.04';
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   1246 my $self = shift;
14 2 50       16 $self->[0]->${\$self->[1]} if $self->[0];
  2         14  
15             }
16             }
17              
18             sub Data::Sync::Shared::RWLock::rdlock_guard {
19 1     1 0 213714 my $self = shift;
20 1         10 $self->rdlock(@_);
21 1         19 bless [$self, 'rdunlock'], 'Data::Sync::Shared::RWLock::Guard';
22             }
23              
24             sub Data::Sync::Shared::RWLock::wrlock_guard {
25 1     1 0 603 my $self = shift;
26 1         7 $self->wrlock(@_);
27 1         6 bless [$self, 'wrunlock'], 'Data::Sync::Shared::RWLock::Guard';
28             }
29              
30             package Data::Sync::Shared::Condvar::Guard {
31             sub DESTROY {
32 1     1   227 my $self = shift;
33 1 50       17 $self->[0]->unlock if $self->[0];
34             }
35             }
36              
37             sub Data::Sync::Shared::Condvar::lock_guard {
38 1     1 0 696 my $self = shift;
39 1         13 $self->lock;
40 1         9 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 5983 my ($self, $pred, $timeout) = @_;
47 4   50     63 $timeout //= -1;
48 4 100       42 return $pred->() ? 0 : 1 if $timeout == 0;
    100          
49 2         10 my $deadline;
50 2 50       38 if ($timeout > 0) {
51 2         84 require Time::HiRes;
52 2         25 $deadline = Time::HiRes::time() + $timeout;
53             }
54 2         55 while ($pred->()) {
55 3 50       68 if (defined $deadline) {
56 3         34 my $remaining = $deadline - Time::HiRes::time();
57 3 100       36 return 0 if $remaining <= 0;
58 2         151913 $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 305389 my ($self, $n, $timeout) = @_;
72 3   100     20 $n //= 1;
73 3 100       10 if ($n == 1) {
74 2 100 100     20 $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   1848 my $self = shift;
84 2         24 $self->[0]->release($self->[1]);
85             }
86             }
87              
88             1;
89              
90             __END__