Yes, it would need more than that one line changing, but something like this ought to be close:

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;
[download]