Coro/Coro/RWLock.pm

=head1 NAME

Coro::RWLock - reader/write locks

=head1 SYNOPSIS

 use Coro;

 $lck = new Coro::RWLock;

 $lck->rdlock; # acquire read lock
 $lck->unlock; # unlock lock again

 # or:
 $lck->wrlock; # acquire write lock
 $lck->tryrdlock; # try a readlock
 $lck->trywrlock; # try a write lock


=head1 DESCRIPTION

This module implements reader/write locks. A read can be acquired for
read by many coroutines in parallel as long as no writer has locked it
(shared access). A single write lock can be acquired when no readers
exist. RWLocks basically allow many concurrent readers (without writers)
OR a single writer (but no readers).

You don't have to load C<Coro::RWLock> manually, it will be loaded 
automatically when you C<use Coro> and call the C<new> constructor. 

=over 4

=cut

package Coro::RWLock;

use common::sense;

use Coro ();

our $VERSION = 6.04;

=item $l = new Coro::RWLock;

Create a new reader/writer lock.

=cut

sub new {
   # [rdcount, [readqueue], wrcount, [writequeue]]
   bless [0, [], 0, []], $_[0];
}

=item $l->rdlock

Acquire a read lock.

=item $l->tryrdlock

Try to acquire a read lock.

=cut

sub rdlock {
   while ($_[0][0]) {
      push @{$_[0][3]}, $Coro::current;
      &Coro::schedule;
   }
   ++$_[0][2];
}

sub tryrdlock {
   return if $_[0][0];
   ++$_[0][2];
}

=item $l->wrlock

Acquire a write lock.

=item $l->trywrlock

Try to acquire a write lock.

=cut

sub wrlock {
   while ($_[0][0] || $_[0][2]) {
      push @{$_[0][1]}, $Coro::current;
      &Coro::schedule;
   }
   ++$_[0][0];
}

sub trywrlock {
   return if $_[0][0] || $_[0][2];
   ++$_[0][0];
}

=item $l->unlock

Give up a previous C<rdlock> or C<wrlock>.

=cut

sub unlock {
   # either we are a reader or a writer. decrement accordingly.
   if ($_[0][2]) {
      return if --$_[0][2];
   } else {
      $_[0][0]--;
   }
   # now we have the choice between waking up a reader or a writer. we choose the writer.
   if (@{$_[0][1]}) {
      (shift @{$_[0][1]})->ready;
   } elsif (@{$_[0][3]}) {
      (shift @{$_[0][3]})->ready;
   }
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.88
Committed:	Wed Aug 3 14:52:19 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_04
Changes since 1.87:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::RWLock - reader/write locks
4
5			=head1 SYNOPSIS
6
7	root	1.79	use Coro;
8	root	1.1
9			$lck = new Coro::RWLock;
10
11			$lck->rdlock; # acquire read lock
12	root	1.78	$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	root	1.1
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	root	1.78	You don't have to load C<Coro::RWLock> manually, it will be loaded
29			automatically when you C<use Coro> and call the C<new> constructor.
30
31	root	1.1	=over 4
32
33			=cut
34
35			package Coro::RWLock;
36
37	root	1.71	use common::sense;
38	root	1.7
39	root	1.1	use Coro ();
40
41	root	1.88	our $VERSION = 6.04;
42	root	1.1
43			=item $l = new Coro::RWLock;
44
45			Create a new reader/writer lock.
46
47			=cut
48
49			sub new {
50	root	1.2	# [rdcount, [readqueue], wrcount, [writequeue]]
51			bless [0, [], 0, []], $_[0];
52	root	1.1	}
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	root	1.2	while ($_[0][0]) {
66			push @{$_[0][3]}, $Coro::current;
67	root	1.37	&Coro::schedule;
68	root	1.2	}
69			++$_[0][2];
70			}
71
72			sub tryrdlock {
73			return if $_[0][0];
74			++$_[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			while ($_[0][0] \|\| $_[0][2]) {
89			push @{$_[0][1]}, $Coro::current;
90	root	1.37	&Coro::schedule;
91	root	1.2	}
92			++$_[0][0];
93			}
94
95			sub trywrlock {
96			return if $_[0][0] \|\| $_[0][2];
97			++$_[0][0];
98			}
99
100			=item $l->unlock
101
102	root	1.78	Give up a previous C<rdlock> or C<wrlock>.
103	root	1.2
104			=cut
105
106			sub unlock {
107			# either we are a reader or a writer. decrement accordingly.
108			if ($_[0][2]) {
109			return if --$_[0][2];
110			} else {
111			$_[0][0]--;
112			}
113			# now we have the choice between waking up a reader or a writer. we choose the writer.
114			if (@{$_[0][1]}) {
115			(shift @{$_[0][1]})->ready;
116			} elsif (@{$_[0][3]}) {
117			(shift @{$_[0][3]})->ready;
118			}
119	root	1.1	}
120
121			1;
122
123			=back
124
125			=head1 AUTHOR
126
127	root	1.28	Marc Lehmann <schmorp@schmorp.de>
128	root	1.26	http://home.schmorp.de/
129	root	1.1
130			=cut
131