NAME

Net::Object::Peer::Cookbook - Recipes for Net::Object::Peer

VERSION

version 0.05

RECIPES

Loop Detection

In a situation where an event handler may itself emit an event it's possible to generate event loops.

Here's a node class which accepts a single class of event. When a node receives an event, it also emits the same event.

The event handler has a loop detector which will bail if the handler processes an event from an emitter more than once while the handler is itself emitting the event.

# examples/Loop.pm
package Loop;

use Carp;
our @CARP_NOT = qw( Beam::Emitter );

use Try::Tiny;
use Scalar::Util qw[ refaddr ];

use Moo;
use MooX::ClassAttribute;

with 'Net::Object::Peer';

has seen     => ( is => 'ro', default  => sub { {} } );
has name     => ( is => 'ro', required => 1          );

# Set high so can verify there is a loop
class_has
    max_seen => ( is => 'rw', default =>  5          );

sub label {
    my ( $self, $emitter, $name ) = @_;
    qq/@{[$self->name]} got '$name' from @{[$emitter->name]}/;
}

sub fail {
    my ( $self, $event ) = @_;
    croak( "loop detected: ",
	   $self->label( $event->emitter, $event->name ) );
}

sub tag {
    my ( $self, $emitter, $name ) = @_;
    join $;, $name, refaddr $self, refaddr $emitter;
}

sub _cb_signal {
    my ( $self, $event ) = @_;

    my $tag = $self->tag( $event->emitter, $event->name );

    $self->fail( $event )
      if $self->seen->{$tag}++ == $self->max_seen;

    print $self->label( $event->emitter, $event->name ), "\n";

    try    { $self->emit( $event->name ) }
    catch  { die $_                      }
    finally{ delete $self->seen->{$tag}  };
}

1;

Now, let's set up a loop:

# examples/loop.pl
use Try::Tiny;

use lib 'examples';
use Module::Load;

my ( $class ) = @ARGV;

load $class;

my $n1 = $class->new( name => 'n1' );
my $n2 = $class->new( name => 'n2' );
my $n3 = $class->new( name => 'n3' );

$n3->subscribe( $n1, "signal" );
$n3->subscribe( $n2, "signal" );
$n2->subscribe( $n3, "signal" );

# and start the ping-pong
try {
    $n1->emit( 'signal' );
}
catch {
    print $_;
};

And the result:

% perl examples/loop.pl Loop
n3 got 'signal' from n1
n2 got 'signal' from n3
n3 got 'signal' from n2
n2 got 'signal' from n3
n3 got 'signal' from n2
n2 got 'signal' from n3
n3 got 'signal' from n2
n2 got 'signal' from n3
n3 got 'signal' from n2
n2 got 'signal' from n3
n3 got 'signal' from n2
loop detected: n2 got 'signal' from n3 at (eval 121) line 21.

To protect all event handlers, we can modify build_sub so that it adds loop detection to every handler. Here's a first attempt, which wraps the standard event handler in a subroutine:

# examples/LoopWrap.pm
package LoopWrap;

use Try::Tiny;
use Scalar::Util qw[ weaken ];
use Moo;
extends 'Loop';

my %seen;

around build_sub => sub {

    my $orig = shift;
    my ( $self, $emitter, $name ) = @_;
    my @args = @_;

    my $tag = $self->tag( $emitter, $name );

    my $sub = &$orig( @args );

    weaken $self;

    return sub {
        my ( $event ) = @_;

        $self->fail( $event )
           if $seen{$tag}++;

        my @args = @_;

        try     { $sub->( @args )    }
        catch   { die $_             }
        finally { delete $seen{$tag} };
    };
};

1;

And the result:

% perl examples/loop.pl LoopWrap
n3 got 'signal' from n1
n2 got 'signal' from n3
n3 got 'signal' from n2
loop detected: n2 got 'signal' from n3 at examples/Loop.pm line 47.

Here's an alternative, taking advantage of the fact that build_sub returns a coderef generated by "quote_sub" in Sub::Quote, so our loop detection code can be inlined directly into the event handler. Note that Sub::Quote keeps copies of the values referenced in %capture, so handling of references to objects are slightly complicated. $self is weakened to avoid memory leaks, but copies of references turn into strong references, so instead a reference to the weakened reference is passed.

# examples/LoopQuote.pm
package LoopQuote;

use Scalar::Util qw[ weaken ];
use Sub::QuoteX::Utils qw[ quote_subs ];
use Moo;
extends 'Loop';

my %seen;

around build_sub => sub {

    my $orig = shift;
    my ( $self, $emitter, $name ) = @_;

    my $tag = $self->tag( $emitter, $name );

    my $sub = &$orig;

    weaken $self;

    my %captures = (
        '$seen'   => \\%seen,
        '$r_self' => \\$self,
        '$name'   => \$name,
        '$tag'    => \$tag,
    );

    return quote_subs(
        \q[
            use Try::Tiny;
            my $event = $_[0];
            $$r_self->fail( $event ) if $seen->{$tag}++;
            my @args = @_;
            try {
           ],
        [ $sub, local => 1, args => q[@args] ],
        \q[
            }
            catch { die $_ } finally { delete $seen->{$tag} };
          ],
        { capture => \%captures },
    );
};

1;

And the result:

% perl examples/loop.pl LoopQuote
n3 got 'signal' from n1
n2 got 'signal' from n3
n3 got 'signal' from n2
loop detected: n2 got 'signal' from n3 at examples/Loop.pm line 47.

Translation/Proxy Nodes

Nodes in a network communicate via a common vocabulary of named events. The problem at hand is how to subscribe to a node which uses a different naming scheme (but assumedly similar meanings).

Let's start with a base Node class:

# examples/translate/Node.pm
package Node;

use Moo;
use strictures 2;

with 'Net::Object::Peer';

sub _cb_A { print "recieved event A\n" }

sub _cb_B { print "recieved event B\n" }

sub _cb_detach {
    my ( $self, $event ) = @_;
    $self->unsubscribe( $event->emitter );
}
1;

and two subclasses, in one of which the doit method emits an A event

# examples/translate/NodeA.pm
package NodeA;

use Moo;
extends 'Node';

sub doit { $_[0]->emit( 'A' ) }

1;

and in the other the doit method emits a B event

# examples/translate/NodeB.pm
package NodeB;

use Moo;
extends 'Node';

sub doit { $_[0]->emit( 'B' ) }

1;

NodeA expects an A event from a doit() action, but NodeB emits a B event: obviously a failure to communicate.

Override the event Handler

One approach to translating the B event to an A one is to override NodeA's default event handler for a B event:

#examples/translate_override.pl
use lib 'lib';
use lib 'examples/translate';
use NodeA;
use NodeB;

my $nA = NodeA->new;
my $nB = NodeB->new;

$nA->subscribe( $nB, 'B' => { method => '_cb_A' } );

$nB->doit;

% perl examples/translate_override.pl
recieved event A

However, this complicates instrospection of $nA's subscriptions of A events, as an A event might actually be a B event.

Proxy Node

Another approach is to create a proxy node which translates events.

# examples/translate/TranslateBtoA.pm
package TranslateBtoA;
use Types::Standard ':all';
use Moo;
with 'Net::Object::Peer';

has proxy_for => (
    is       => 'ro',
    weak_ref => 1,    # very important!
    required => 1,
    isa      => ConsumerOf ['Net::Object::Peer'],
);

sub BUILD {
    $_[0]->subscribe( $_[0]->proxy_for, 'B', 'detach' );
}

sub _cb_B {
    my ( $self, $event ) = @_;

    # re-emit as A
    $self->emit( 'A', emitter => $event->emitter, addr => $self->addr );
}

sub _cb_detach {

    $_[0]->emit( 'detach' );
}

1;

Things to note:

The object stores a weak reference to the node it's a proxy for. Technically a reference is only needed for the subscription.
When resending the event, the proxy object
- masquerades as the upstream emitter via the emitter option; and
- sets the addr attribute to its own, so that the outgoing event will correctly identify the proxy object.
The proxy subscribes to the emitter's detach event in addition to the one it will translate so that it can, in turn, send a detach event to it's listeners.

Here's code to use it:

# examples/translate_in_scope.pl
use lib 'lib';
use lib 'examples/translate';
use NodeA;
use NodeB;

use TranslateBtoA;

my $nA = NodeA->new;
my $nB = NodeB->new;

my $xlate = TranslateBtoA->new( proxy_for => $nB );
$nA->subscribe( $xlate, 'A' );

$nB->doit;

with the result:

% perl examples/translate_in_scope.pl
recieved event A

In this approach, there's an extra object ($xlate) to keep track of. Since Net::Object::Peer uses only weak references, when $xlate goes out of scope, the subscription will cease to do anything. For example,

# examples/translate_out_of_scope.pl
use lib 'lib';
use lib 'examples/translate';
use NodeA;
use NodeB;

use TranslateBtoA;

my $nA = NodeA->new;
my $nB = NodeB->new;

$nA->subscribe( TranslateBtoA->new( proxy_for => $nB ), 'A' );

$nB->doit;

with the result:

% perl examples/translate_out_of_scope.pl

I.e, nothing.

One solution is to add the Net::Object::Peer::Ephemeral role to the proxy class.

# examples/translate/TranslateBtoAEphemeral.pm
package TranslateBtoAEphemeral;
use Moo;
extends 'TranslateBtoA';
with 'Net::Object::Peer::Ephemeral';

1;

This instructs Net::Object::Peer to store a strong reference, so the following code

# examples/translate_ephemeral.pl
use lib 'lib';
use lib 'examples/translate';

use NodeA;
use NodeB;

use TranslateBtoAEphemeral;

my $nA = NodeA->new;
my $nB = NodeB->new;

$nA->subscribe( TranslateBtoAEphemeral->new( proxy_for => $nB ), 'A', 'detach' );

$nB->doit;

works:

% perl examples/translate_ephemeral.pl
recieved event A

AUTHOR

Diab Jerius <djerius@cpan.org>

COPYRIGHT AND LICENSE

This is free software, licensed under:

The GNU General Public License, Version 3, June 2007

To install Net::Object::Peer, copy and paste the appropriate command in to your terminal.

cpanm

cpanm Net::Object::Peer

CPAN shell

perl -MCPAN -e shell
install Net::Object::Peer

For more information on module installation, please visit the detailed CPAN module installation guide.

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)

NAME

VERSION

RECIPES

Loop Detection

Translation/Proxy Nodes

Override the event Handler

Proxy Node

AUTHOR

COPYRIGHT AND LICENSE

Module Install Instructions