Permalink
Browse files

Create a compositional verson of eg-04-inheritance.pl, and debug Stag…

…e destruct-time cleanup.
  • Loading branch information...
rcaputo committed Aug 11, 2009
1 parent 6a1900e commit 0d9b0c15edb61bb45099b3cc113821804cc29f66
Showing with 62 additions and 20 deletions.
  1. +1 −18 Stage.pm
  2. +2 −2 eg-04-inheritance.pl
  3. +59 −0 eg-05-composition.pl
View
@@ -344,24 +344,7 @@ sub _check_args {
sub DEMOLISH {
my $self = shift;
-
- # Find ever observed object, and the list of events observed.
- # Clean them all out.
- # Automortify would rock.
- while (my ($observed, $observations) = each %{$observers{$self}}) {
- foreach my $event ( map { $_->{event} } @$observations ) {
- delete $observations{$observed}{$event}{$self};
- unless (scalar keys %{$observations{$observed}{$event}}) {
- delete $observations{$observed}{$event};
- unless (scalar keys %{$observations{$observed}}) {
- delete $observations{$observed};
- }
- }
- }
- }
-
- delete $observers{$self};
- undef;
+ $self->ignore(observed => $_) foreach keys %{$observers{$self}};
}
sub ignore {
View
@@ -1,8 +1,8 @@
#!/usr/bin/env perl
# An object's emitted events can also trigger methods in the subclass.
-# This example creates a UDP rot13 server using inheritance rather
-# than the composition archtectures in past examples.
+# This example creates a UDP echo server using inheritance rather than
+# the composition archtectures in past examples.
{
package UdpEchoPeer;
View
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+# An object's emitted events can also trigger methods in the subclass.
+# This example is a direct port of eg-04-inheritance.pl, but it uses a
+# UdpPeer object rather than inheriting from the UdpPeer class.
+
+{
+ package UdpEchoPeer;
+ use Moose;
+ extends 'Stage';
+ use UdpPeer;
+
+ has peer => (
+ isa => 'UdpPeer|Undef',
+ is => 'rw',
+ );
+
+ sub BUILD {
+ my ($self, $args) = @_;
+ $self->peer(
+ UdpPeer->new(
+ port => $args->{port},
+ observers => [
+ {
+ observer => $self,
+ role => 'peer',
+ }
+ ]
+ )
+ );
+ }
+
+ sub on_peer_datagram {
+ my ($self, $args) = @_;
+ my $data = $args->{datagram};
+
+ if ($data =~ /^\s*shutdown\s*$/) {
+ $self->ignore(observed => $self->peer());
+ $self->peer(undef);
+ return;
+ }
+
+ $self->peer()->send(
+ datagram => $data,
+ remote_addr => $args->{remote_addr},
+ );
+ }
+
+ sub on_peer_error {
+ my ($self, $args) = @_;
+ warn "$args->{op} error $args->{errnum}: $args->{errstr}";
+ $self->ignore(observed => $self->peer());
+ $self->peer(undef);
+ }
+}
+
+my $peer = UdpEchoPeer->new( port => 12345 );
+POE::Kernel->run();
+exit;

0 comments on commit 0d9b0c1

Please sign in to comment.