Coro で Thread-Specific Storage パターン

Perl Design Pattern Coro

増補改訂版 Java言語で学ぶデザインパターン入門 マルチスレッド編 を参考に Coro で Thread-Specific Storage パターンを実装。Thread-Specific Storage パターンは、スレッドごとのコインロッカー。

  • スレッドがコインロッカーを初めて使うときは、そのスレッド用のコインロッカーが作られる
  • 2回目から、既に作られたコインロッカーを使う
  • スレッドごとにコインロッカーが作られる

下の図だとスレッドが一個しかないけど、2つあればclien1-object1、client2-object2のような関係になる。


スレッドに名前を付けて、コインロッカーの門番である proxy に見せると専用のコインロッカーが割り当たるイメージ。Javaだとスレッドに名前を付ける標準の方法があるみたいだけど、Coroだとよくわからんな。

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

package Client;
use Coro;
use Coro::Select ();
use Scalar::Util qw(refaddr);

our %coro_name = ();

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

sub run {
    my $self = shift;
    my $coro = async {
        do {
            print $self->{name}, " BEGIN\n";
            my $id = refaddr($Coro::current);
            $Client::coro_name{$id} = $self->{name};
            for my $count ( 1 .. 10 ) {
                Log->println( "i = " . $count );

                # sleep 100 milli second
                Coro::Select::select( undef, undef, undef, 0.1 );
            }
            Log->close();
            print $self->{name}, " END\n";
        };
    };
    return $coro;
}

package TSLog;

sub new {
    my ( $class, %args ) = @_;
    my %defaults = ( filename => "no_name" );
    %args = ( %defaults, %args );

    my $file = $args{filename};
    open my $fh, '>', $file or die "$!:$file";
    %args = ( fh => $fh );
    bless \%args, $class;
}

sub println {
    my $self = shift;
    my $str  = shift;
    print { $self->{fh} } $str, $/;
}

sub close {
    my $self = shift;
    $self->println("==== End of log ====");
    close $self->{fh} or die "$!:" . $self->{filename};
}

package Log;
use Coro;
use Scalar::Util qw(refaddr);

our %_ts_log_list = ();

sub println {
    my $class = shift;
    my $str   = shift;
    $class->get_TSLog()->println($str);
}

sub close {
    my $class = shift;
    $class->get_TSLog()->close();
}

sub get_TSLog {
    my $class = shift;

    my $id   = refaddr($Coro::current);
    my $name = $Client::coro_name{$id};
    if ( !exists $_ts_log_list{$name} ) {
        $_ts_log_list{$name} = TSLog->new( filename => "${name}.txt" );
    }
    return $_ts_log_list{$name};
}

package main;

my $coro_alice = Client->new( name => "Alice" )->run();
my $coro_bobby = Client->new( name => "Bobby" )->run();
my $coro_chris = Client->new( name => "Chris" )->run();

$coro_alice->join();
$coro_bobby->join();
$coro_chris->join();

出力

$ perl -w ThreadSpecificStorage.pl
Alice BEGIN
Bobby BEGIN
Chris BEGIN
Alice END
Bobby END
Chris END
# Alice.txt, Bobby.txt. Chris.txtが作られる

pic ファイル

.PS

copy "sequence.pic";

boxwid = 1.3;

# Define the objects
object(CL,":client");
object(P,":proxy");
object(C,":collection");
placeholder_object(O);
step();

# Message sequences
active(CL);

message(CL,P,"request");
active(P);

message(P,C,"get_object");
active(C);
rmessage(C,P,"(null)");
inactive(C);

create_message(P,O,":Object");
rmessage(O,P,"(object)");

message(P,C,"set_object");
active(C);
rmessage(C,P,"");
inactive(C);

message(P,O,"request");
active(O);
rmessage(O,P,"");
inactive(O);

rmessage(P,CL,"");
inactive(P);

step();

message(CL,P,"request");
active(P);

message(P,C,"get_object");
active(C);
rmessage(C,P,"(object)");
inactive(C);

message(P,O,"request");
active(O);
rmessage(O,P,"");
inactive(O);

rmessage(P,CL,"");
inactive(P);

complete(CL);
complete(P);
complete(C);
complete(O);

.PE

参考

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

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

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