Coro で Read-Write Lock パターン

増補改訂版 Java言語で学ぶデザインパターン入門 マルチスレッド編 を参考に Coro で Read-Write Lock パターンを実装。

Read-Write Lockは、

• スレッドが読んている間は、別のスレッドも読める
• スレッドが書いている間は、別のスレッドは読めない
• スレッドが読んている間は、別のスレッドは書けない
• スレッドが書いている間は、別のスレッドは書けない

#!/usr/bin/perl
use strict;
use warnings;

package Reader;
use Coro;

sub new {
    my ( $class, %args ) = @_;
    my %defaults = ( name => 'Reader' );
    %args = ( %defaults, %args );
    bless \%args, $class;
}

sub run {
    my $self = shift;
    my $coro = async {
        do {
            my $name  = $self->{name};
            my $board = $self->{board};
            my $type  = $self->{type};
            print "$name : read $type data\n";
            my $content = $board->read( type => $type );
            print "$name : done $type data($content)\n";
        };
    };
    return $coro;
}

package Writer;
use Coro;

sub new {
    my ( $class, %args ) = @_;
    my %defaults = ( name => 'Writer' );
    %args = ( %defaults, %args );
    bless \%args, $class;
}

sub run {
    my $self    = shift;
    my $content = shift;
    my $coro    = async {
        do {
            my $name  = $self->{name};
            my $board = $self->{board};
            my $type  = $self->{type};
            print "$name : write $type data($content)\n";
            $board->write( type => $type, content => $content );
            print "$name : done $type data\n";
        };
    };
    return $coro;
}

package Locker;
use Coro;
use Coro::Semaphore;
use Coro::Timer;

sub new {
    my ( $class, %args ) = @_;
    $args{reading_readers} = 0;
    $args{waiting_writers} = 0;
    $args{writing_writers} = 0;
    $args{prefer_writer}   = 1;
    $args{signal}          = Coro::Signal->new;
    bless \%args, $class;
}

sub read_lock {
    my $self  = shift;
    my $guard = $self->_get_guard();

    while (( $self->{writing_writers} > 0 )
        || ( $self->{prefer_writer} && ( $self->{waiting_writers} > 0 ) ) )
    {
        $self->{signal}->wait();
    }
    $self->{reading_readers}++;
}

sub read_unlock {
    my $self  = shift;
    my $guard = $self->_get_guard();

    $self->{reading_readers}--;
    $self->{prefer_writer} = 1;
    $self->{signal}->broadcast();
}

sub write_lock {
    my $self  = shift;
    my $guard = $self->_get_guard();

    $self->{waiting_writers}++;
    while (( $self->{reading_readers} > 0 )
        || ( $self->{writing_writers} > 0 ) )
    {
        $self->{signal}->wait();
    }
    $self->{waiting_writers}--;
    $self->{writing_writers}++;
}

sub write_unlock {
    my $self  = shift;
    my $guard = $self->_get_guard();

    $self->{writing_writers}--;
    $self->{prefer_writer} = 0;
    $self->{signal}->broadcast();
}

sub _get_guard {
    my $self = shift;
    my $name = ( caller 1 )[3];
    $name =~ s/.*:://;
    $name .= '_sem';
    if ( !exists $self->{$name} ) {
        $self->{$name} = Coro::Semaphore->new;
    }
    else {
        my $class = ref $self->{$name};
        if ( $class ne 'Coro::Semaphore' ) {
            die "$name is not Coro::Semaphore";
        }
    }

    return $self->{$name}->guard();
}

package Board;
use Coro;
use Coro::Timer;

sub new {
    my ( $class, %args ) = @_;
    my %defaults = ( heavy => 'heavy data0', light => 'light data0' );
    %args = ( %defaults, %args );
    $args{locker} = Locker->new();
    bless \%args, $class;
}

sub read {
    my $self = shift;

    $self->{locker}->read_lock();
    my $content = $self->do_read(@_);
    $self->{locker}->read_unlock();
    return $content;
}

sub do_read {
    my $self = shift;
    my %args = @_;
    my $type = $args{type};

    if ( $type eq 'heavy' ) {
        Coro::Timer::sleep(1);
    }
    return $self->{$type};

}

sub write {
    my $self = shift;

    $self->{locker}->write_lock();
    $self->do_write(@_);
    $self->{locker}->write_unlock();
}

sub do_write {
    my $self    = shift;
    my %args    = @_;
    my $type    = $args{type};
    my $content = $args{content};

    if ( $type eq 'heavy' ) {
        Coro::Timer::sleep(1);
    }
    $self->{$type} = $content;
}

package main;
use Coro;

read_on_read();
read_on_write();
write_on_read();
write_on_write();

sub read_on_read {
    print "--- read_on_read\n";
    my $board = Board->new();
    my $reader1
        = Reader->new( name => 'reader1', type => 'heavy', board => $board );
    my $reader2
        = Reader->new( name => 'reader2', type => 'light', board => $board );

    my $reader1_coro = $reader1->run();
    my $reader2_coro = $reader2->run();

    $reader1_coro->join();
    $reader2_coro->join();
    print "\n";
}

sub read_on_write {
    print "--- read_on_write\n";
    my $board = Board->new();
    my $writer
        = Writer->new( name => 'writer', type => 'heavy', board => $board );
    my $reader
        = Reader->new( name => 'reader', type => 'light', board => $board );

    my $writer_coro = $writer->run('heavy data1');
    my $reader_coro = $reader->run();

    $writer_coro->join();
    $reader_coro->join();
    print "\n";
}

sub write_on_read {
    print "--- read_on_write\n";
    my $board = Board->new();
    my $reader
        = Reader->new( name => 'reader', type => 'heavy', board => $board );
    my $writer
        = Writer->new( name => 'writer', type => 'light', board => $board );

    my $reader_coro = $reader->run();
    my $writer_coro = $writer->run('light data1');

    $reader_coro->join();
    $writer_coro->join();
    print "\n";
}

sub write_on_write {
    print "--- write_on_write\n";
    my $board = Board->new();
    my $writer1
        = Writer->new( name => 'writer1', type => 'heavy', board => $board );
    my $writer2
        = Writer->new( name => 'writer2', type => 'light', board => $board );

    my $writer1_coro = $writer1->run('heavy data1');
    my $writer2_coro = $writer2->run('light data1');

    $writer1_coro->join();
    $writer2_coro->join();
    print "\n";
}

出力

--- read_on_read
reader1 : read heavy data
reader2 : read light data
reader2 : done light data(light data0)
reader1 : done heavy data(heavy data0)

--- read_on_write
writer : write heavy data(heavy data1)
reader : read light data
writer : done heavy data
reader : done light data(light data0)

--- read_on_write
reader : read heavy data
writer : write light data(light data1)
reader : done heavy data(heavy data0)
writer : done light data

--- write_on_write
writer1 : write heavy data(heavy data1)
writer2 : write light data(light data1)
writer1 : done heavy data
writer2 : done light data

参考

増補改訂版 Java言語で学ぶデザインパターン入門 マルチスレッド編

増補改訂版 Java言語で学ぶデザインパターン入門 マルチスレッド編