# ABSTRACT: Peer-to-Peer Publish/Subscribe Network of Objects
package Net::Object::Peer;

use 5.10.0;
use strict;
use warnings;

our $VERSION = '0.01'; # TRIAL

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

use Scalar::Util qw[ refaddr weaken ];
use Data::OptList qw[ mkopt ];
use Safe::Isa;
use Ref::Util qw[ is_arrayref ];
use Types::Standard ':all';

use Moo::Role;
use MooX::ProtectedAttributes;

use Net::Object::Peer::Event;
use Net::Object::Peer::UnsubscribeEvent;
use Net::Object::Peer::Listener;
use Net::Object::Peer::Emitter;
use Net::Object::Peer::Subscriptions;
use Net::Object::Peer::Subscription;

use Sub::QuoteX::Utils qw[ quote_subs ];

#pod =begin pod_coverage
#pod
#pod =head3 UnsubscribeEvent
#pod
#pod =head3 Subscription
#pod
#pod =head3 Listener
#pod
#pod =head3 Emitter
#pod
#pod =end pod_coverage
#pod
#pod =cut

use constant UnsubscribeEvent => __PACKAGE__ . '::UnsubscribeEvent';
use constant Subscription     => __PACKAGE__ . '::Subscription';
use constant Emitter          => __PACKAGE__ . '::Emitter';


use namespace::clean;

has _subscriptions => (
    is        => 'ro',
    init_args => undef,
    isa       => InstanceOf ['Net::Object::Peer::Subscriptions'],
    default   => sub { Net::Object::Peer::Subscriptions->new },
    handles   => { subscriptions => 'list' },
);

protected_has _emitter => (
    is       => 'ro',
    init_arg => undef,
    default  => sub { Net::Object::Peer::Emitter->new },
    handles  => [qw< emit_args send_args >],
);



#pod =method build_sub
#pod
#pod   $coderef = $self->build_sub( $emitter, @tuple );
#pod
#pod C<build_sub> is the method responsible for creating and
#pod compiling the code for an event handler. It is invoked
#pod from the L</subscribe()> method, with the following parameters
#pod
#pod =over
#pod
#pod =item C<$emitter>
#pod
#pod The emitter object.
#pod
#pod =item C<@tuple>
#pod
#pod the tuple passed to L</subscribe> for this event.
#pod
#pod =back
#pod
#pod The default implementation will return a L<Sub::Quote::quote_sub|Sub::Quote/quote_sub>
#pod generated code reference for method calls and code specified as a
#pod string.  See L<Net::Object::Peer::Cookbook/Loop Detecton> for an
#pod example of using this attribute to inline additional code in the event
#pod handler.
#pod
#pod
#pod
#pod =cut

sub build_sub {

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

    return do {

        if ( !defined $arg ) {

            quote_subs( [ $self, "_cb_$name" ] );
        }

        elsif ( 'HASH' eq ref $arg ) {

            my %arg = %$arg;
            delete $arg{name};

            if ( defined $arg{method} ) {

                quote_subs( [ $self, delete $arg{method}, %arg ] );
            }

            elsif ( defined $arg->{code} ) {

                quote_subs( [ delete $arg{code}, %arg ] );
            }

	    else {

		croak( __PACKAGE__ . "::build_sub: can't figure out what to do with \%arg" );
	    }
        }

        elsif ( 'CODE' eq ref $arg ) {

            $arg;
        }

        else {

            croak( __PACKAGE__ . "::build_sub: illegal value for \$arg" );
        }
    };

}

#pod =method subscribe
#pod
#pod   $self->subscribe( $peer, @event_tuple [, @event_tuple, ...  ] );
#pod
#pod Subscribe to one or more events sent by C<$peer>, which must consume
#pod the L<Net::Object::Peer> role.
#pod
#pod The event name and the action to be performed when the event is
#pod emitted are specified by a tuple with the following forms:
#pod
#pod =over
#pod
#pod =item C<< $event_name >>
#pod
#pod the event handler will invoke the C<_cb_${event_name}> method on C<$self>.
#pod
#pod =item C<< $event_name => { method => $method_name } >>
#pod
#pod The event handler will invoke the C<$method_name> method on C<$self>.
#pod
#pod =item C<< $event_name => CODEREF >>
#pod
#pod The passed code reference is called.
#pod
#pod =item C<< $event_name => { code => $code, capture => \%capture } >>
#pod
#pod C<$code> is a string containing code to be run by the event handler.
#pod C<%capture> is a hash containing variable captures. See the
#pod documentation for "\%captures" in L<Sub::Quote/quote_sub> for more
#pod information.
#pod
#pod =back
#pod
#pod If C<$peer> provides a C<_notify_subscribed> method, that will be invoked as
#pod
#pod   $peer->_notify_subscribed( $self, $event_name, ... );
#pod
#pod for each subscription.
#pod
#pod =cut

sub subscribe {

    my $self = shift;
    my $peer = shift;

    my $subscriptions = $self->_subscriptions;

    weaken $self;
    weaken $peer;

    my $notify_subscribed = $peer->can( '_notify_subscribed' );

    my $args = Data::OptList::mkopt(
        \@_,
        {
            moniker        => 'events',
            require_unique => 1,
            must_be        => [ 'CODE', 'SCALAR', 'HASH' ],
        } );

    # don't register anything until we've parsed the input list of
    # event names and possible subs in order to make this as atomic as
    # possible.
    my @register;
    for my $opt ( @$args ) {

        my ( $name, $arg ) = @$opt;

        croak( "\$name must be a string\n" )
          if ref $name;
        push @register, [ $name, $self->build_sub( $peer, $name, $arg ) ];
    }

    for my $event ( @register ) {


        my ( $name, $sub ) = @$event;

        $_->unsubscribe foreach $self->_subscriptions->delete(
            name => $name,
            peer => $peer,
        );

        $self->_subscriptions->add(
            Subscription->new(
                name => $name,
                peer => $peer,
                unsubscribe =>
                  $peer->_emitter->subscribe( $name, $sub, peer => $self ),
            ) );

    }

    $peer->$notify_subscribed( $self, map { $_->[0] } @register )
      if $notify_subscribed;

}


#pod =method unsubscribe
#pod
#pod   # Unsubscribe from all events from all peers.
#pod   $self->unsubscribe;
#pod
#pod   # Unsubscribe from all events emitted by a peer
#pod   $self->unsubscribe( $peer );
#pod
#pod   # Unsubscribe from one or more events emitted by a peer
#pod   $self->unsubscribe( $peer, $event_name [, $event_name [, ... ]);
#pod
#pod   # Unsubscribe from one or more events emitted by all peers
#pod   $self->unsubscribe( $event_name [, $event_name [, ... ] ] )
#pod
#pod Unsubscribe from events/peers. After unsubscription, an I<unsubscribe>
#pod event with a L<Net::Object::Peer::UnsubscribeEvent> as a payload will
#pod be sent to affected peers who have subscribed to the unsubscribed event(s).
#pod
#pod =cut

sub unsubscribe {

    my $self = shift;

    return $self->_unsubscribe_all
      unless @_;

    if ( $_[0]->$_does( __PACKAGE__ ) ) {

        # $peer, $name, ...
        return $self->_unsubscribe_from_peer_events( @_ )
          if @_ > 1;

        # $peer
        return $self->_unsubscribe_from_peer( @_ );
    }

    # $name, ...
    return $self->_unsubscribe_from_events( @_ );

}

sub _unsubscribe_all {

    my $self = shift;

    # say $self->name, ":\tunsubscribing from all peers";

    $_->unsubscribe foreach $self->subscriptions;
    $self->_subscriptions->clear;

    # signal peers that unsubscribe has happened.

    # say $self->name, ":\tnotifying all subscribed peers of unsubscription";

    $self->emit( 'unsubscribe', class => UnsubscribeEvent );

    return;
}

sub _unsubscribe_from_peer_events {

    my ( $self, $peer ) = ( shift, shift );

    my @unsubscribed;

    for my $name ( @_ ) {

        for my $subscription (
            $self->_subscriptions->delete(
                peer => $peer,
                name => $name,
            ) )
        {
            # say $self->name, ":\tunsubscribing from ", $peer->name, ":$name";

            $subscription->unsubscribe;
            push @unsubscribed, $name;
        }
    }

    if ( @unsubscribed ) {

        # say $self->name, ":\tnotifying ", $peer->name,
        #   " of unsubscription from ", join( ', ', @unsubscribed );

        $self->send(
            $peer, 'unsubscribe',
            class       => UnsubscribeEvent,
            event_names => \@unsubscribed,
        );
    }

    return;
}


sub _unsubscribe_from_peer {

    my ( $self, $peer ) = @_;

    # say $self->name, ":\tunsubscribing from ", $peer->name;

    $_->unsubscribe foreach $self->_subscriptions->delete( peer => $peer );

    # say $self->name, ":\tnotifying ", $peer->name,
    #   " of unsubscription from all events";

    $self->send( $peer, 'unsubscribe', class => UnsubscribeEvent );

    return;
}

sub _unsubscribe_from_events {

    my ( $self, @names ) = @_;

    return unless @names;

    my %subs;
    my @subs = $self->_subscriptions->delete(
        sub {
            grep { $_[0]->name eq $_ } @names;
        } );

    for my $sub ( @subs ) {
        $sub->unsubscribe;

        my $list = $subs{ refaddr $sub->peer } ||= [ $sub->peer ];
        push @$list, $sub->name;
    }

    for my $sub ( values %subs ) {

        my ( $peer, @names ) = @_;
        $self->emit(
            'unsubscribe',
            class       => UnsubscribeEvent,
            event_names => \@names,
        );
    }


    return;
}

#pod =method subscriptions
#pod
#pod   my @subscriptions = $self->subscriptions;
#pod
#pod Returns the events to which C<$self> is subscribed as a list of
#pod L<Net::Object::Peer::Subscription> objects.
#pod
#pod =method emit
#pod
#pod   $self->emit( $event_name, %args );
#pod
#pod Broadcast the named event to all subscribed peers.  C<%args> contains
#pod arguments to be passed the the payload class constructor.  The default
#pod payload class is a L<Net::Object::Peer::Event> object; use the C<class> key to
#pod specify an alternate class, which must be erived from B<Net::Object::Peer::Event>.
#pod
#pod =cut

sub emit {

    my ( $self, $name ) = ( shift, shift );

    $self->_emitter->emit(
        $name,
        class   => 'Net::Object::Peer::Event',
        emitter => $self,
        @_
    );
}

#pod =method send
#pod
#pod   $self->send( $peer, $event_name, %args );
#pod
#pod This is similar to the L</emit> method, but only sends the event to the
#pod specified peer.
#pod
#pod =cut

sub send {

    my ( $self, $peer, $name ) = ( shift, shift, shift );

    $self->_emitter->send(
        $peer,
        $name,
        class   => 'Net::Object::Peer::Event',
        emitter => $self,
        @_
    );
}


#pod =method emit_args
#pod
#pod   $self->emit_args( $event_name, @args );
#pod
#pod Broadcast the named event to all subscribed peers. C<@args> will be
#pod passed directly to each subscriber's callback.
#pod
#pod =cut

#pod =method send_args
#pod
#pod   $self->send_args( $peer, $event_name, @args );
#pod
#pod This is similar to the L</emit_args> method, but only sends the event to the
#pod specified peer.
#pod
#pod =cut

# allow emit_args( unsubscribe => $event_name );
# or emit( unsubscribe ) which will unsubscribe all events from the emitter
sub __cb_unsubscribe {

    if ( $_[1]->$_isa( 'Beam::Event' ) ) {
        splice( @_, 1, 1, $_[1]->emitter );
    }
    goto &unsubscribe;
}

#pod =begin pod_coverage
#pod
#pod =head3 DEMOLISH
#pod
#pod =end pod_coverage
#pod
#pod =cut

sub DEMOLISH {

    my ( $self, $in_global_destruction ) = @_;

    return if $in_global_destruction;

    # unsubscribe from network
    $self->unsubscribe;
}


1;

#
# This file is part of Net-Object-Peer
#
# 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
#

=pod

=head1 NAME

Net::Object::Peer - Peer-to-Peer Publish/Subscribe Network of Objects

=head1 VERSION

version 0.01

=head1 SYNOPSIS

 use 5.10.0;
 
 package Node {
    use Moo;
    with 'Net::Object::Peer';
 
    has name => is => ( 'ro', required => 1 );
 
    sub _notify_subscribed {
 
      my ( $self, $peer, $name ) = @_;
 
      say $self->name, ":\tpeer (@{[ $peer->name ]}) subscribed to event $name";
 
    }
 
    sub _cb_changed {
 
        my ( $self, $event ) = @_;
 
        say $self->name, ":\tpeer (@{[ $event->emitter->name ]}) changed";
 
    }
 
    sub _cb_unsubscribe {
 
        my ( $self, $event ) = @_;
 
 	say $self->name, ":\tpeer (@{[ $event->emitter->name ]}) unsubscribed";
    }
 }
 
 
 my $n1 = Node->new( name => 'N1' );
 my $n2 = Node->new( name => 'N2' );
 
 # n1 will follow n2's changes
 $n1->subscribe( $n2, 'changed' );
 
 # n2 will notice if n1 is unsubscribed from it
 $n2->subscribe( $n1, 'unsubscribe' );
 
 $n2->emit( 'changed' );
 
 # destroy n1; n1 will unsubscribe and n2 will be notified 
 undef $n1;

Resulting in:

  N2:	peer (N2) subscribed to event changed
  N1:	peer (N1) subscribed to event unsubscribed
  N1:	peer (N2) changed
  N2:	unsubscribing from all peers
  N2:	notifying all subscribed peers of unsubscription
  N1:	unsubscribing from all peers
  N1:	notifying all subscribed peers of unsubscription

=head1 DESCRIPTION

B<Net::Object::Peer> is a L<Moo> L<< Role|Moo::Role >> which
implements a publish/subscribe peer-to-peer messaging system, based
upon L<Beam::Emitter>.  Objects in the network may broadcast events
to all subscribers or may send events to a particular subscriber.

Subscriptions and unsubscriptions are tracked and messages will be
sent to affected objects upon request.

While B<Net::Object::Peer> is designed around the concept of nodes
being objects with methods as event handlers, it retains
L<Beam::Emitter>'s ability to register code references as well.

L<Net::Object::Peer::Cookbook> provides some recipes.

=head2 Usage

As B<Net::Object::Peer> is purely peer based with no common message
bus, a network is built up by creating a set of network nodes and
linking them via subscriptions.

  my $n1 = Node->new( name => 'N1' );
  my $n2 = Node->new( name => 'N2' );

  $n1->subscribe( $n2, 'changed' );

Here C<$n1> I<subscribes to> C<$n2>'s C<changed> event. By default,
C<$n1>'s C<_cb_changed> method is invoked when C<$n2> emits a
C<changed> event.

=head2 Events

When a subscriber recieves an event, its registered handler for that
event type is invoked.  If the object creating the event used the
L</emit> or L</send> methods,

  $emitter->emit( $event_name );

 the event handler will be invoked as

  $subscriber->method( $event );

where C<$event> is an object derived from the L<Net::Object::Peer::Event> class.
(This assumes that the handler is a method; it may be a simple callback).

If the event was created with the L</emit_args> or L</send_args> methods,

  $emitter->emit_args( $event_name, @arguments );

the event handler will invoked as

  $subscriber->method( @arguments );

=head3 Subscription and Unsubscription Events

When a subscriber registers one or more event handlers with an emitter
via the subscriber's L</subscribe> method, the emitter's
C<_notify_subscribed> method will be invoked (if it exists) as

  $emitter->_notify_subscribed( $subscriber, @event_names );

After a subscriber de-registers a handler, either explicitly via
L</unsubscribe> or when the object is destroyed, it will L</emit> an
C<unsubscribe> event with a L<Net::Object::Peer::UnsubscribeEvent>
object as a payload.

While emitters are not automatically subscribed to C<"unsubscribe">
events, this is easily accomplished by adding code to the emitters'
C<_notify_subscribed> method.

=head1 METHODS

=head2 build_sub

  $coderef = $self->build_sub( $emitter, @tuple );

C<build_sub> is the method responsible for creating and
compiling the code for an event handler. It is invoked
from the L</subscribe()> method, with the following parameters

=over

=item C<$emitter>

The emitter object.

=item C<@tuple>

the tuple passed to L</subscribe> for this event.

=back

The default implementation will return a L<Sub::Quote::quote_sub|Sub::Quote/quote_sub>
generated code reference for method calls and code specified as a
string.  See L<Net::Object::Peer::Cookbook/Loop Detecton> for an
example of using this attribute to inline additional code in the event
handler.

=head2 subscribe

  $self->subscribe( $peer, @event_tuple [, @event_tuple, ...  ] );

Subscribe to one or more events sent by C<$peer>, which must consume
the L<Net::Object::Peer> role.

The event name and the action to be performed when the event is
emitted are specified by a tuple with the following forms:

=over

=item C<< $event_name >>

the event handler will invoke the C<_cb_${event_name}> method on C<$self>.

=item C<< $event_name => { method => $method_name } >>

The event handler will invoke the C<$method_name> method on C<$self>.

=item C<< $event_name => CODEREF >>

The passed code reference is called.

=item C<< $event_name => { code => $code, capture => \%capture } >>

C<$code> is a string containing code to be run by the event handler.
C<%capture> is a hash containing variable captures. See the
documentation for "\%captures" in L<Sub::Quote/quote_sub> for more
information.

=back

If C<$peer> provides a C<_notify_subscribed> method, that will be invoked as

  $peer->_notify_subscribed( $self, $event_name, ... );

for each subscription.

=head2 unsubscribe

  # Unsubscribe from all events from all peers.
  $self->unsubscribe;

  # Unsubscribe from all events emitted by a peer
  $self->unsubscribe( $peer );

  # Unsubscribe from one or more events emitted by a peer
  $self->unsubscribe( $peer, $event_name [, $event_name [, ... ]);

  # Unsubscribe from one or more events emitted by all peers
  $self->unsubscribe( $event_name [, $event_name [, ... ] ] )

Unsubscribe from events/peers. After unsubscription, an I<unsubscribe>
event with a L<Net::Object::Peer::UnsubscribeEvent> as a payload will
be sent to affected peers who have subscribed to the unsubscribed event(s).

=head2 subscriptions

  my @subscriptions = $self->subscriptions;

Returns the events to which C<$self> is subscribed as a list of
L<Net::Object::Peer::Subscription> objects.

=head2 emit

  $self->emit( $event_name, %args );

Broadcast the named event to all subscribed peers.  C<%args> contains
arguments to be passed the the payload class constructor.  The default
payload class is a L<Net::Object::Peer::Event> object; use the C<class> key to
specify an alternate class, which must be erived from B<Net::Object::Peer::Event>.

=head2 send

  $self->send( $peer, $event_name, %args );

This is similar to the L</emit> method, but only sends the event to the
specified peer.

=head2 emit_args

  $self->emit_args( $event_name, @args );

Broadcast the named event to all subscribed peers. C<@args> will be
passed directly to each subscriber's callback.

=head2 send_args

  $self->send_args( $peer, $event_name, @args );

This is similar to the L</emit_args> method, but only sends the event to the
specified peer.

=begin pod_coverage

=head3 UnsubscribeEvent

=head3 Subscription

=head3 Listener

=head3 Emitter

=end pod_coverage

=begin pod_coverage

=head3 DEMOLISH

=end pod_coverage

=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

__END__

#pod =head1 SYNOPSIS
#pod
#pod # EXAMPLE: examples/synopsis.pl
#pod
#pod Resulting in:
#pod
#pod   N2:	peer (N2) subscribed to event changed
#pod   N1:	peer (N1) subscribed to event unsubscribed
#pod   N1:	peer (N2) changed
#pod   N2:	unsubscribing from all peers
#pod   N2:	notifying all subscribed peers of unsubscription
#pod   N1:	unsubscribing from all peers
#pod   N1:	notifying all subscribed peers of unsubscription
#pod
#pod
#pod =head1 DESCRIPTION
#pod
#pod B<Net::Object::Peer> is a L<Moo> L<< Role|Moo::Role >> which
#pod implements a publish/subscribe peer-to-peer messaging system, based
#pod upon L<Beam::Emitter>.  Objects in the network may broadcast events
#pod to all subscribers or may send events to a particular subscriber.
#pod
#pod Subscriptions and unsubscriptions are tracked and messages will be
#pod sent to affected objects upon request.
#pod
#pod While B<Net::Object::Peer> is designed around the concept of nodes
#pod being objects with methods as event handlers, it retains
#pod L<Beam::Emitter>'s ability to register code references as well.
#pod
#pod L<Net::Object::Peer::Cookbook> provides some recipes.
#pod
#pod
#pod =head2 Usage
#pod
#pod As B<Net::Object::Peer> is purely peer based with no common message
#pod bus, a network is built up by creating a set of network nodes and
#pod linking them via subscriptions.
#pod
#pod   my $n1 = Node->new( name => 'N1' );
#pod   my $n2 = Node->new( name => 'N2' );
#pod
#pod   $n1->subscribe( $n2, 'changed' );
#pod
#pod Here C<$n1> I<subscribes to> C<$n2>'s C<changed> event. By default,
#pod C<$n1>'s C<_cb_changed> method is invoked when C<$n2> emits a
#pod C<changed> event.
#pod
#pod =head2 Events
#pod
#pod When a subscriber recieves an event, its registered handler for that
#pod event type is invoked.  If the object creating the event used the
#pod L</emit> or L</send> methods,
#pod
#pod   $emitter->emit( $event_name );
#pod
#pod  the event handler will be invoked as
#pod
#pod   $subscriber->method( $event );
#pod
#pod where C<$event> is an object derived from the L<Net::Object::Peer::Event> class.
#pod (This assumes that the handler is a method; it may be a simple callback).
#pod
#pod If the event was created with the L</emit_args> or L</send_args> methods,
#pod
#pod   $emitter->emit_args( $event_name, @arguments );
#pod
#pod the event handler will invoked as
#pod
#pod   $subscriber->method( @arguments );
#pod
#pod
#pod =head3 Subscription and Unsubscription Events
#pod
#pod When a subscriber registers one or more event handlers with an emitter
#pod via the subscriber's L</subscribe> method, the emitter's
#pod C<_notify_subscribed> method will be invoked (if it exists) as
#pod
#pod   $emitter->_notify_subscribed( $subscriber, @event_names );
#pod
#pod After a subscriber de-registers a handler, either explicitly via
#pod L</unsubscribe> or when the object is destroyed, it will L</emit> an
#pod C<unsubscribe> event with a L<Net::Object::Peer::UnsubscribeEvent>
#pod object as a payload.
#pod
#pod While emitters are not automatically subscribed to C<"unsubscribe">
#pod events, this is easily accomplished by adding code to the emitters'
#pod C<_notify_subscribed> method.
#pod
#pod
