File Coverage

blib/lib/Coro/RWLock.pm
Criterion Covered Total %
statement 26 31 83.8
branch 11 12 91.6
condition 5 6 83.3
subroutine 8 8 100.0
pod 5 5 100.0
total 55 62 88.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Coro::RWLock - reader/write locks
4              
5             =head1 SYNOPSIS
6              
7             use Coro;
8              
9             $lck = new Coro::RWLock;
10              
11             $lck->rdlock; # acquire read lock
12             $lck->unlock; # unlock lock again
13              
14             # or:
15             $lck->wrlock; # acquire write lock
16             $lck->tryrdlock; # try a readlock
17             $lck->trywrlock; # try a write lock
18              
19              
20             =head1 DESCRIPTION
21              
22             This module implements reader/write locks. A read can be acquired for
23             read by many coroutines in parallel as long as no writer has locked it
24             (shared access). A single write lock can be acquired when no readers
25             exist. RWLocks basically allow many concurrent readers (without writers)
26             OR a single writer (but no readers).
27              
28             You don't have to load C manually, it will be loaded
29             automatically when you C and call the C constructor.
30              
31             =over 4
32              
33             =cut
34              
35             package Coro::RWLock;
36              
37 2     2   718 use common::sense;
  2         4  
  2         11  
38              
39 2     2   108 use Coro ();
  2         4  
  2         1038  
40              
41             our $VERSION = 6.514;
42              
43             =item $l = new Coro::RWLock;
44              
45             Create a new reader/writer lock.
46              
47             =cut
48              
49             sub new {
50             # [rdcount, [readqueue], wrcount, [writequeue]]
51 1     1   51 bless [0, [], 0, []], $_[0];
52             }
53              
54             =item $l->rdlock
55              
56             Acquire a read lock.
57              
58             =item $l->tryrdlock
59              
60             Try to acquire a read lock.
61              
62             =cut
63              
64             sub rdlock {
65 3     3 1 36 while ($_[0][0]) {
66 0         0 push @{$_[0][3]}, $Coro::current;
  0         0  
67 0         0 &Coro::schedule;
68             }
69 3         7 ++$_[0][2];
70             }
71              
72             sub tryrdlock {
73 2 100   2 1 11 return if $_[0][0];
74 1         2 ++$_[0][2];
75             }
76              
77             =item $l->wrlock
78              
79             Acquire a write lock.
80              
81             =item $l->trywrlock
82              
83             Try to acquire a write lock.
84              
85             =cut
86              
87             sub wrlock {
88 1   66 1 1 9 while ($_[0][0] || $_[0][2]) {
89 1         2 push @{$_[0][1]}, $Coro::current;
  1         3  
90 1         14 &Coro::schedule;
91             }
92 1         10 ++$_[0][0];
93             }
94              
95             sub trywrlock {
96 3 100 100 3 1 22 return if $_[0][0] || $_[0][2];
97 1         2 ++$_[0][0];
98             }
99              
100             =item $l->unlock
101              
102             Give up a previous C or C.
103              
104             =cut
105              
106             sub unlock {
107             # either we are a reader or a writer. decrement accordingly.
108 4 100   4 1 24 if ($_[0][2]) {
109 2 100       6 return if --$_[0][2];
110             } else {
111 2         4 $_[0][0]--;
112             }
113             # now we have the choice between waking up a reader or a writer. we choose the writer.
114 3 100       5 if (@{$_[0][1]}) {
  3 50       6  
115 1         1 (shift @{$_[0][1]})->ready;
  1         4  
116 2         5 } elsif (@{$_[0][3]}) {
117 0           (shift @{$_[0][3]})->ready;
  0            
118             }
119             }
120              
121             1;
122              
123             =back
124              
125             =head1 AUTHOR/SUPPORT/CONTACT
126              
127             Marc A. Lehmann
128             http://software.schmorp.de/pkg/Coro.html
129              
130             =cut
131