PerlでObserverパターン
Subjectにremoveがないこと、ConcreteObserverのコンストラクタでSubjectオブジェクトを設定しているけど、まあいいんじゃないでしょうか。
use strict; my $subject = new ConcreteSubject(); my @observers = (); for(my $i = 0; $i < 5; $i++){ my $tmp_name = "name$i"; my $obj = new ConcreteObserver($tmp_name, $subject); $subject->register($obj); } $subject->state(2); ###################################### # subject class { package Subject; sub new{ my $this = shift; my @observer = (); my $obj = { "observer" => \@observer, @_ }; return bless $obj, $this; } sub register{ die "need override"; } sub notify_observer{ die "need override"; } } { package ConcreteSubject; use base qw(Subject); sub new{ my $this = shift; my $obj = new Subject(state => 0, @_); return bless $obj, $this; } sub state{ my $this = shift; if(@_){ $this->{state} = shift; $this->notify_observer(); } return $this->{state}; } sub register{ my $this = shift; my ($observer) = @_; push(@{$this->{observer}}, $observer); } sub notify_observer{ my $this = shift; foreach my $obj (@{$this->{observer}}){ $obj->update(); } } } ###################################### # observer class { package Observer; sub new{ my $this = shift; my $obj = {@_}; return bless $obj, $this; } sub update{ die "need override"; } } { package ConcreteObserver; use base qw(Observer); sub new{ my $this = shift; my $name = shift; my $subject = shift; my $obj = Observer->new("name" => $name, "subject" => $subject, @_); return bless $obj, $this; } sub name{ my $this = shift; if(@_){ $this->{name} = shift; } return $this->{name}; } sub update{ my $this = shift; my $subject = $this->{subject}; my $state = $subject->state(); my $name = $this->name(); print "$name : concrete observer updated! -> $state\n"; } }