181:	hit eof while in pod documentation (no =cut seen)
	this can cause trouble with some pod utilities
#PODNAME: Net::Object::Peer::Cookbook
#ABSTRACT: Recipes for Net::Object::Peer

# COPYRIGHT

#pod =head1 RECIPES
#pod
#pod =head2 Loop Detection
#pod
#pod In a situation where an event handler may itself emit an event it's
#pod possible to generate event loops.
#pod
#pod Here's a node class which accepts a single class of event. When a node
#pod receives an event, it also emits the same event.
#pod
#pod The event handler has a loop detector which will bail if the handler
#pod processes an event from an emitter more than once while the handler is
#pod itself emitting the event.
#pod
#pod  # examples/Loop.pm
#pod # EXAMPLE: examples/Loop.pm
#pod
#pod
#pod Now, let's set up a loop:
#pod
#pod  # examples/loop.pl
#pod # EXAMPLE: examples/loop.pl
#pod
#pod And the result:
#pod
#pod  % perl examples/loop.pl Loop
#pod # COMMAND: perl -Ilib examples/loop.pl Loop
#pod
#pod To protect all event handlers, we can modify
#pod L<build_sub|Net::Object::Peer/build_sub> so that it adds loop
#pod detection to every handler.  Here's a first attempt, which wraps
#pod the standard event handler in a subroutine:
#pod
#pod  # examples/LoopWrap.pm
#pod # EXAMPLE: examples/LoopWrap.pm
#pod
#pod And the result:
#pod
#pod  % perl examples/loop.pl LoopWrap
#pod # COMMAND: perl -Ilib examples/loop.pl LoopWrap
#pod
#pod Here's an alternative, taking advantage of the fact that
#pod L<build_sub|Net::Object::Peer/build_sub> returns a coderef generated
#pod by L<Sub::Quote/quote_sub>, so our loop detection code can be inlined
#pod directly into the event handler. Note that L<Sub::Quote> keeps
#pod I<copies> of the values referenced in C<%capture>, so handling of
#pod references to objects are slightly complicated.  C<$self> is weakened
#pod to avoid memory leaks, but copies of references turn into strong
#pod references, so instead a I<reference> to the weakened reference is
#pod passed.
#pod
#pod  # examples/LoopQuote.pm
#pod # EXAMPLE: examples/LoopQuote.pm
#pod
#pod And the result:
#pod
#pod  % perl examples/loop.pl LoopQuote
#pod # COMMAND: perl -Ilib examples/loop.pl LoopQuote
#pod
#pod =head2 Translation/Proxy Nodes
#pod
#pod Nodes in a network communicate via a common vocabulary of named
#pod events.  The problem at hand is how to subscribe to a node which uses
#pod a different naming scheme (but assumedly similar meanings).
#pod
#pod Let's start with a base C<Node> class:
#pod
#pod  # examples/translate/Node.pm
#pod # EXAMPLE: examples/translate/Node.pm
#pod
#pod and two subclasses, in one of which the C<doit> method emits an C<A> event
#pod
#pod  # examples/translate/NodeA.pm
#pod # EXAMPLE: examples/translate/NodeA.pm
#pod
#pod and in the other the C<doit> method emits a C<B> event
#pod
#pod  # examples/translate/NodeB.pm
#pod # EXAMPLE: examples/translate/NodeB.pm
#pod
#pod C<NodeA> expects an C<A> event from a C<doit()> action, but C<NodeB>
#pod emits a C<B> event: obviously a failure to communicate.
#pod
#pod =head3 Override the event Handler
#pod
#pod One approach to translating the C<B> event to an C<A> one is to
#pod override C<NodeA>'s default event handler for a C<B> event:
#pod
#pod  #examples/translate_override.pl
#pod # EXAMPLE: examples/translate_override.pl
#pod
#pod  % perl examples/translate_override.pl
#pod # COMMAND: perl examples/translate_override.pl
#pod
#pod However, this complicates instrospection of C<$nA>'s subscriptions of
#pod C<A> events, as an C<A> event might actually be a C<B> event.
#pod
#pod =head3 Proxy Node
#pod
#pod Another approach is to create a proxy node which translates events.
#pod
#pod  # examples/translate/TranslateBtoA.pm
#pod # EXAMPLE: examples/translate/TranslateBtoA.pm
#pod
#pod Things to note:
#pod
#pod =over
#pod
#pod =item *
#pod
#pod The object stores a weak reference to the node it's a proxy
#pod for.  Technically a reference is only needed for the subscription.
#pod
#pod =item *
#pod
#pod When resending the event, the proxy object
#pod
#pod =over
#pod
#pod =item *
#pod
#pod masquerades as the upstream emitter via the C<emitter> option; and
#pod
#pod =item *
#pod
#pod sets the C<addr> attribute to its own, so that the outgoing event
#pod will correctly identify the proxy object.
#pod
#pod =back
#pod
#pod =item *
#pod
#pod The proxy subscribes to the emitter's C<detach> event in addition to
#pod the one it will translate so that it can, in turn, send a C<detach>
#pod event to it's listeners.
#pod
#pod =back
#pod
#pod Here's code to use it:
#pod
#pod  # examples/translate_in_scope.pl
#pod # EXAMPLE: examples/translate_in_scope.pl
#pod
#pod with the result:
#pod
#pod  % perl examples/translate_in_scope.pl
#pod # COMMAND: perl examples/translate_in_scope.pl
#pod
#pod In this approach, there's an extra object (C<$xlate>) to keep track of.  Since
#pod B<Net::Object::Peer> uses only weak references, when C<$xlate> goes out of
#pod scope, the subscription will cease to do anything.  For example,
#pod
#pod  # examples/translate_out_of_scope.pl
#pod # EXAMPLE: examples/translate_out_of_scope.pl
#pod
#pod with the result:
#pod
#pod  % perl examples/translate_out_of_scope.pl
#pod # COMMAND: perl examples/translate_out_of_scope.pl
#pod
#pod I.e, nothing.
#pod
#pod
#pod One solution is to add the C<Net::Object::Peer::Ephemeral> role to the
#pod proxy class.
#pod
#pod  # examples/translate/TranslateBtoAEphemeral.pm
#pod # EXAMPLE: examples/translate/TranslateBtoAEphemeral.pm
#pod
#pod This instructs C<Net::Object::Peer> to store a strong reference, so the following
#pod code
#pod
#pod  # examples/translate_ephemeral.pl
#pod # EXAMPLE: examples/translate_ephemeral.pl
#pod
#pod works:
#pod
#pod  % perl examples/translate_ephemeral.pl
#pod # COMMAND: perl examples/translate_ephemeral.pl

__END__

=pod

=head1 NAME

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

=head1 VERSION

version 0.04

=head1 RECIPES

=head2 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
L<build_sub|Net::Object::Peer/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
L<build_sub|Net::Object::Peer/build_sub> returns a coderef generated
by L<Sub::Quote/quote_sub>, so our loop detection code can be inlined
directly into the event handler. Note that L<Sub::Quote> keeps
I<copies> of the values referenced in C<%capture>, so handling of
references to objects are slightly complicated.  C<$self> is weakened
to avoid memory leaks, but copies of references turn into strong
references, so instead a I<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.


=head2 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 C<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 C<doit> method emits an C<A> event

 # examples/translate/NodeA.pm
 package NodeA;
 
 use Moo;
 extends 'Node';
 
 sub doit { $_[0]->emit( 'A' ) }
 
 1;

and in the other the C<doit> method emits a C<B> event

 # examples/translate/NodeB.pm
 package NodeB;
 
 use Moo;
 extends 'Node';
 
 sub doit { $_[0]->emit( 'B' ) }
 
 1;

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

=head3 Override the event Handler

One approach to translating the C<B> event to an C<A> one is to
override C<NodeA>'s default event handler for a C<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 C<$nA>'s subscriptions of
C<A> events, as an C<A> event might actually be a C<B> event.

=head3 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:

=over

=item *

The object stores a weak reference to the node it's a proxy
for.  Technically a reference is only needed for the subscription.

=item *

When resending the event, the proxy object

=over

=item *

masquerades as the upstream emitter via the C<emitter> option; and

=item *

sets the C<addr> attribute to its own, so that the outgoing event
will correctly identify the proxy object.

=back

=item *

The proxy subscribes to the emitter's C<detach> event in addition to
the one it will translate so that it can, in turn, send a C<detach>
event to it's listeners.

=back

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 (C<$xlate>) to keep track of.  Since
B<Net::Object::Peer> uses only weak references, when C<$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 C<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 C<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


=head1 AUTHOR

Diab Jerius <djerius@cpan.org>

=head1 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

=cut
