Coro で Balking パターン

Perl Design Pattern Coro

増補改訂版 Java言語で学ぶデザインパターン入門 マルチスレッド編 を参考に Coro で Balking パターンを実装。Balking パターン途中で止めること(Balkする=途中で止める)。この例だと「保存しようとしたけど、既に保存されていたらやめちゃおう。」


use strict;
use warnings;

package Changer;
use Coro;
use Coro::Timer;

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

sub run {
    my $self = shift;
    my $coro = async {
        do {
            my $data = $self->{data};

            my $text;
            $text = "data1";
            print "Changer: change $text\n";
            $data->change($text);

            print "Changer: save\n";
            $data->save();

            $text = "data2";
            print "Changer: change $text\n";
            $data->change($text);

            print "Changer: save\n";
            $data->save();

            $text = "data3";
            print "Changer: change $text\n";
            $data->change($text);

            print "Changer: sleep...\n";
            Coro::Timer::sleep(2);

            print "Changer: save\n";
            $data->save();
        };
    };
}

package Saver;
use Coro;
use Coro::Timer;

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

sub run {
    my $self = shift;
    my $coro = async {
        do {
            my $period = $self->{period};
            my $data   = $self->{data};
            while (1) {
                print "Saver  : save\n";
                $data->save();
                Coro::Timer::sleep($period);
            }
        };
    };

    return $coro;
}

package Data;
use Coro;
use Coro::Semaphore;

sub new {
    my ( $class, %args ) = @_;
    $args{sem}     = Coro::Semaphore->new;
    $args{changed} = 0;

    bless \%args, $class;
}

sub change {
    my $self = shift;
    $self->{content} = shift;
    $self->{changed} = 1;
}

sub save {
    my $self  = shift;
    my $guard = $self->{sem}->guard();

    if ( $self->{changed} == 1 ) {
        print "Data   : do_save\n";
        $self->do_save();
        $self->{changed} = 0;
    }
    else {
        print "Data   : don't do_save and balk\n";
    }
}

sub do_save {
    my $self = shift;
    my $file = $self->{file};
    open my $fh, '>', $file or die "$!:$file";
    print {$fh} $self->{content};
    close $fh or die "$!:$file";
}

package main;
use Coro;

my $data = Data->new( file => 'data.txt' );
my $saver = Saver->new( data => $data, period => 1 );
my $changer = Changer->new( data => $data );

my $changer_coro = $changer->run();
my $saver_coro   = $saver->run();

$changer_coro->join();
$saver_coro->cancel();

出力

$ perl -w Balking.pl
Changer: change data1
Changer: save
Data   : do_save
Changer: change data2
Changer: save
Data   : do_save
Changer: change data3
Changer: sleep...
Saver  : save
Data   : do_save
Saver  : save
Data   : don't do_save and balk
Changer: save
Data   : don't do_save and balk
Saver  : save
Data   : don't do_save and balk

pic ファイル

.PS

copy "sequence.pic";

boxwid = 1.3;

# Define the objects
object(C,":changer");
object(D,":data");
object(S,":saver");
step();

# Message sequences
active(C);
active(S);
comment(S,T2,down 0.25 right 0.25,wid 1.25 ht 0.25 "save periodically");

message(C,D,"change");
active(D);
rmessage(D,C,"");
inactive(D);

message(C,D,"save");
active(D);
message(D,D,"do_save");
active(D);
step();
inactive(D);
rmessage(D,C,"");
inactive(D);

message(C,D,"change");
active(D);
rmessage(D,C,"");
inactive(D);

message(S,D,"save");
active(D);
message(D,D,"do_save");
active(D);
step();
inactive(D);
rmessage(D,S,"");
inactive(D);

message(C,D,"save");
active(D);
comment(D,T2,up 0.5 left 0.5,wid 1 ht 0.5 "don't do_save," "and balk");
rmessage(D,C,"");
inactive(D);

complete(C);
complete(D);
complete(S);

.PE

参考

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

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

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