NAME

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

VERSION

version 0.01

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 128) line 18.

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.

AUTHOR

Diab Jerius <djerius@cpan.org>

COPYRIGHT AND LICENSE

This software is Copyright (c) 2016 by Smithsonian Astrophysical Observatory.

This is free software, licensed under:

The GNU General Public License, Version 3, June 2007