[ホームへもどる] [Niftyの過去ログ集 へもどる]

Perlによるデザインパターン

Perlについて勉強していたころの習作です．

というわけで，今では完全に Perl から Ruby に移行しました．友人が Win32OLE や RubyUnit を実装してくれたおかげで Perl を使う理由がほとんどなくなってしまいました．

なお会議室でiWAさんに指摘されましたが，以下のプログラムで grep を使っているところは foreach で foreach my $i (@array) {...} の方がいいです．

00410/00410 BYI20012  まさーる         Perlでデザパタ(長文)
( 6)   97/10/04 12:45


皆さん、こんにちは。

DDJでデザパタ特集をやってるのでPerlerである方以外はいまさら興味ないかも
知れませんが、PerlでDecoratorパターンとObserverパターンを組合わせたサン
プルを作ってみました。標準出力にサインカーブを描いていく単純なプログラム
です（このプログラムはずーっと描き続けるので飽きたらKillしてください）。

以下ではGraphクラスがClockクラスのObserverであり、GraphDecoratorに
Decorateされるクラスになっています。GraphDecoraterは、親クラスのGraphク
ラスのインスタンス変数を継承する必要がないので、あえて継承しないという
Perlの特徴を利用しています。
--------------------------- 切り取り線 --------------------------------
package Graph;

sub new ($) {
    my $class = shift;
    my $self = {
        Y => 0,           #Y座標
        Line => ' ' x 41, #1行分描画用のバッファ
    };
    bless $self, $class;
    $self;
}

sub update($$) {          #1行分グラフを描画します。
    my $self = shift;
    print $self->{Line}, "\n";
    $self->{Line} = ' ' x 41;
    ++$self->{Y};
}

sub putX($$$) {           #バッファのX座標の位置に文字を書き込みます。
    my $self = shift;
    my ($x, $char) = @_;
    my $len = length($char);
    $self->{Line} =~ s/(^.{$x}).{$len}/\1$char/;
}

sub getY($) {             #現在のY座標の値を返します。
    my $self = shift;
    $self->{Y};
}

package GraphDecorator;

@ISA = qw(Graph);

sub new ($$) {
    my ($class, $component) = @_;
    $self = {
        Component => $component,
    };
    bless $self, $class;
    $self;
}

sub update($$) {
    my $self = shift;
    $self->{Component}->update(@_);
}

sub putX($$$) {
    my $self = shift;
    $self->{Component}->putX(@_);
}

sub getY($) {
    my $self = shift;
    $self->{Component}->getY(@_);
}

package SinDecorator;    #サインカーブを描くためのDecorator

@ISA = qw(GraphDecorator);

sub update($$) {
    my $self = shift;
    my $x  = int(sin($self->getY() * 0.25) * 20) + 20;
    $self->putX($x, 's');
    $self->SUPER::update(@_);
}

package CosDecorator;   #コサインカーブを描くためのDecorator

@ISA = qw(GraphDecorator);

sub update($$) {
    my $self = shift;
    my $x  = int(cos($self->getY() * 0.25) * 20) + 20;
    $self->putX($x, 'c');
    $self->SUPER::update(@_);
}

package AxisDecorator;  #XY軸を描くためのDecorator

@ISA = qw(GraphDecorator);

sub update($$) {
    my $self = shift;
    if ($self->getY() % 10 == 0) {
        grep { $self->putX($_, '-')} (0..40);
        $self->putX(20, '+');
    }
    else {
        $self->putX(20, '|');
    }
    $self->SUPER::update(@_);
}

package Observable;

sub addObserver($$) {
    my ($self, $observer) = @_;
    push(@{$self->{Observers}}, $observer);
}

sub notifyObservers($) {
    my $self = shift;
    grep { $_->update($self) } @{$self->{Observers}};
}

package Clock;

@ISA = qw(Observable);

sub new ($) {
    $class = shift;
    $self = {};
    bless $self, $class;
    $self;
}

sub start($) {
    $self = shift;
    while(1) {
        $self->notifyObservers();
        sleep 1;
    }
}

package main;

$aClock = new Clock;
$aClock->addObserver(new AxisDecorator(
                        new CosDecorator(
                            new SinDecorator(new Graph))));
$aClock->start();
-------------------------- 切り取り線 -----------------------------

                                     97/10/04(土) まさーる(BYI20012)

その後，Perlは静的型付け言語でないし C++ のようなインターフェイス継承がないから，GraphDecorator はいらないと思ってすぐ自己レスしました．

00411/00411 BYI20012  まさーる         RE:Perlでデザパタ(長文)
( 6)   97/10/04 13:11  00410へのコメント

自己レスです。

>GraphDecoraterは、親クラスのGraphク
>ラスのインスタンス変数を継承する必要がないので、あえて継承しないという
>Perlの特徴を利用しています。

よく考えたら、Perlは実装継承のみなのでそもそもGraphDecoratorをGraphから
継承する必要すらないということがわかりました^^;。メソッドをそっくり真似
ればいいだけです。だから、上でいったことは意味ないですね。というわけで

>package GraphDecorator;
>
>@ISA = qw(Graph);

のところは

package GraphDecorator;

#@ISA = qw(Graph);

とコメントアウトしてください。

                                     97/10/04(土) まさーる(BYI20012)

さらに Perl の Observer パターンはもっと改良できることもわかりました．

00456/00456 BYI20012  まさーる         RE^7:Perlでデザパタ(長文)
( 6)   97/10/12 21:26  00446へのコメント

小林　浩一 さん、こんにちは。

>  Smalltalkではインスタンスレベルの再利用というのが常套手段に
>なっているようです．「サクサクSmalltalk」の第10章，「プラガビリティと
>アダプタ」あたりにその事が書かれています．

そうですね。久しぶりにサクサク（の原書）を読み返しましたが、OOなPerlerを
目指すなら、Smalltalkがとても参考になりそうです。PlugableAdapterなどは
perlでも簡単に作れそうですし。

今日初めて知りましたが、Perlもメソッド名をパラメータとして渡たして後から
実行できるんですねえ。だからPerlのObservableは

package Observable;

sub addObserver($$$) {
    my ($self, $observer, $selector) = @_;
    push(@{$self->{Observers}}, [$observer, $selector]);
}

sub notifyObservers($) {
    my $self = shift;
    for (@{$self->{Observers}}) {
        my $selector = $_->[1];
        if ($selector) {
            $_->[0]->$selector($self);
        }
        else {
            $_->[0]->update($self);         
        }
    }
}

の方がいいかもしれない。そうすると

$anObservable->addObserver($anObserver, 'refresh')

と実行時に更新メソッドを登録できるし、これを見たらインターフェイス継承っ
てほんと意味がないなと実感します。Observerはupdateというメソッドを持つ必
要すらないんだもんなあ。

>この辺り，C++erとSmalltalkerで大きく感覚が違うところではないかと
>想像しています．Perlerまさーるさんとしては(^^;，Smalltalk風に
>インスタンスレベルの再利用を考慮されてはいかがでしょう？

はい、インスタンスレベルの再利用を優先させるのがいいのかもしれません。
C++でこういうのがうまく行かないのは、オブジェクト間の通信手段がSmalltalk
に比べてかなり不便だからなんでしょうね。だからインターフェイス継承を使う
必要があるし、Observerは使いにくいし..やっぱりGang of Fourのデザインパタ
ーンは、C++/Javaの本なんですかね。

>>＃Tucker!さんの修飾の出番か？ perlじゃ無理か^^;。
>
>  以前「COMもどき修飾」という，インスタンスレベルでの修飾の実装で
>発言したことがあります．同じような感じでPerlでもできそうな気がします．
>修飾をメカニズムから考えれば，結局はメッセージの送り先が可変と
>なるようなクラスを作ればいいだけです．そこにテンプレート&継承を
>使ったのがTucker!さんのオリジナル修飾で，委譲を使ったのがCOMもどき
>修飾でした．あと，メタクラスを使ったmackさんの実装もあったなぁ．(^^;

Tucker!さんの修飾って、実行時に修飾部品からクラスをその場でカスタマイズ
して自由に使えるというイメージがあるんですが、Perlのクラスがパッケージに
結びついているのでそういうのは無理かな、と思ったんです。ちょっと考えてみ
ます。

                                     97/10/12(日) まさーる(BYI20012)

ところで，今では考え方が少し変わりました．たとえ Perl のようにインターフェイス継承が意味がないとしてもなるべく明示的にインターフェイスを用意する方がいいと思っています．こちらの方がプログラマの意図を明確に表していると思うからです．

[ホームへもどる] [Niftyの過去ログ集 へもどる] [先頭へもどる]