Coro で Future パターン

Perl Design Pattern Coro

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

Future パターンは別スレッドに仕事を投げて、戻りにID (引き換え券)を貰う。あとで引き換え券を渡して結果を確認する。


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

package Host;
use Coro;

sub new {
    my ( $class, %args ) = @_;
    bless bless \%args, $class;
}

sub request {
    my $self        = shift;
    my @args        = @_;
    my $future_data = FutureData->new();
    my $coro        = async {
        do {
            my $real_data = RealData->new(@args);
            $future_data->set_real_data($real_data);
        };
    };
    return $future_data;
}

package FutureData;
use Coro;
use Coro::Signal;

sub new {
    my ( $class, %args ) = @_;
    $args{real_data} = undef;
    $args{ready}     = 0;
    $args{signal}    = Coro::Signal->new();
    bless \%args, $class;
}

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

    if ( $self->{ready} ) {
        return;
    }

    $self->{real_data} = $real_data;
    $self->{ready}     = 1;
    $self->{signal}->broadcast();
}

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

    while ( $self->{ready} == 0 ) {
        $self->{signal}->wait();
    }
    return $self->{real_data}->get_content();
}

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 RealData;
use Coro;
use Coro::Select ();

sub new {
    my ( $class, %args ) = @_;
    my %defaults = ( count => '3', char => 'A' );
    %args = ( %defaults, %args );

    my $buffer = q{};
    for my $count ( 1 .. $args{count} ) {
        $buffer .= $args{char};

        # sleep 100 milli second
        Coro::Select::select( undef, undef, undef, 0.1 );
    }
    $args{content} = $buffer;
    bless \%args, $class;
}

sub get_content {
    my $self = shift;
    return $self->{content};
}

package main;
use Coro;
use Coro::Timer;

my $host  = Host->new();
my $data1 = $host->request( count => 10, char => 'A' );
my $data2 = $host->request( count => 20, char => 'B' );
my $data3 = $host->request( count => 30, char => 'C' );
Coro::Timer::sleep(2);
print "data1 = ", $data1->get_content(), $/;
print "data2 = ", $data2->get_content(), $/;
print "data3 = ", $data3->get_content(), $/;

出力

$ perl -w Future.pl
data1 = AAAAAAAAAA
data2 = BBBBBBBBBBBBBBBBBBBB
data3 = CCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

pic ファイル

.PS

copy "sequence.pic";

boxwid = 1.3;

# Define the objects
object(M,":main");
placeholder_object(H);
placeholder_object(T);
placeholder_object(F);
placeholder_object(R);
step();

# Message sequences
active(M);

create_message(M,H,":host");
message(M,H,"request");
active(H);
create_message(H,F,":future_data");
create_message(H,T,":coro");
rmessage(H,M,"");

active(T);
create_message(T,R,":real_data");
active(R);
rmessage(R,T);
inactive(R);

message(T,F,"set_real_data");
active(F);
rmessage(F,T);
inactive(F);

step();
inactive(T);
delete(T);

message(M,F,"get_content");
active(F);
message(F,R,"get_content");
active(R);
rmessage(R,F,"");
inactive(R);
rmessage(F,M,"");
inactive(F);


complete(M);
complete(H);
complete(T);
complete(F);
complete(R);

.PE

参考

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

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

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