use Thread qw(cond_wait cond_broadcast);
To
use threads;
use threads::shared;
Both cond_wait() and cond_broadcast() are exported from threads::shared, and are specified to work the same way as their predecessors. If the module worked correctly under Thread, there is a good chance that it would work under thread/threads::shared.
It would of course be up to you to verify that.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] [d/l] [select] |
Actually, upon further review, it requires even more updating
than you suggest.
It relies on old threads locked attribute to control
access to the locking/unlocking methods, plus it needs to be
passed between threads, so I need to change its base hash to
a shared object which can be lock()'d
to support the same access control. And it needs
to implement Thread::Queue::Queueable so it gets automagically
reblessed when passed to another thread.
So, in its current form, its not really useable for ithreads,
tho the underlying locking algorithm is certainly useable.
| [reply] |
package threads::RWLock;
use threads;
use threads::shared;
BEGIN {
$VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d
+."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
}
=head1 FUNCTIONS AND METHODS
=over 8
=item new
C<new> creates a new rwlock. The new rwlock is unlocked.
=cut
sub new {
my $class = shift;
my %self : shared;
my $self = bless \%self, $class;
my %anon : shared;
$self->{locks} = 0;
$self->{locker} = \%anon;
$self->{writer} = 0;
return $self;
}
=item down_read
The C<down_read> method obtains a read lock. If the lock is currantly
held by a writer or writer are waiting for the lock, C<down_read> bloc
+ks
until the lock is available.
=cut
sub down_read {
my $self = shift;
lock $self;
if ($self->{locker}->{threads->self->tid}++) {
return;
}
cond_wait $self until $self->{locks} >= 0 && $self->{writer} == 0;
$self->{locker}->{threads->self->tid} = 1;
$self->{locks}++;
}
=item up_read
Releases a read lock previously obtained via C<down_read>.
=cut
sub up_read {
my $self = shift;
lock $self;
if (--$self->{locker}->{threads->self->tid} == 0) {
$self->{locks}--;
if ($self->{locks} == 0) {
cond_broadcast $self;
}
}
}
=item down_write
Obtains a write lock from the rwlock. Write locks are exclusive, so no
other reader or writer are allowed until the lock is released.
C<down_write> blocks until the lock is available.
=cut
sub down_write {
my $self = shift;
lock $self;
$self->{writer}++;
cond_wait $self until $self->{locks} == 0;
$self->{locks}--;
}
=item up_write
Release a write lock previously obtained via C<down_write>.
=cut
sub up_write {
my $self = shift;
lock $self;
$self->{writer}--;
$self->{locks} = 0;
cond_broadcast $self;
}
=back
=head1 SEE ALSO
the Thread::Semaphore manpage
=head1 AUTHOR
Andreas Ferber <aferber@cpan.org>
Tentatively modified for iThreads by BrowserUk@perlmonks
=cut
1;
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] [d/l] |