The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use warnings;
use strict;

use Test::More;

{
    package App::Test;
    use Moose;
    extends 'Reflex::Base';
    use Reflex::Trait::Watched qw/ watches /;
    use Reflexive::ZmqSocket::ReplySocket;
    use Reflexive::ZmqSocket::RequestSocket;
    use ZeroMQ::Constants(':all');

    watches request => (
        isa => 'Reflexive::ZmqSocket::RequestSocket',
        clearer => 'clear_request',
        predicate => 'has_request',
    );

    watches reply => (
        isa => 'Reflexive::ZmqSocket::ReplySocket',
        clearer => 'clear_reply',
        predicate => 'has_reply',
    );
    
    for(qw/ping pong pang pung/)
    {
        has "$_"  => (
            is => 'ro',
            isa => 'Bool',
            traits => ['Bool'],
            default => 0,
            handles => { "toggle_$_" => 'toggle' },
        );
    }

    sub init {
        my ($self) = @_;

        my $rep = Reflexive::ZmqSocket::ReplySocket->new(
            endpoints => [ 'tcp://127.0.0.1:54321' ],
            endpoint_action => 'connect',
            socket_options => {
                +ZMQ_LINGER ,=> 1,
            },
        );

        my $req = Reflexive::ZmqSocket::RequestSocket->new(
            endpoints => [ 'tcp://127.0.0.1:54321' ],
            endpoint_action => 'bind',
            socket_options => {
                +ZMQ_LINGER ,=> 1,
            },
        );

        $self->request($req);
        $self->reply($rep);
    }

    sub clear {
        my ($self) = @_;
        $self->ignore($self->request) if $self->has_request;
        $self->ignore($self->reply) if $self->has_reply;
        $self->clear_request;
        $self->clear_reply;
    }

    sub BUILD {
        my ($self) = @_;
        
        $self->clear();
        $self->init();
    }

    sub on_reply_message {
        my ($self, $msg) = @_;
        return if $self->ping;
        $self->toggle_ping;
        $self->reply->send($msg->data + 1);
    }

    sub on_reply_multipart_message {
        my ($self, $msg) = @_;
        if($msg->count_parts == 3)
        {
            my @parts = map { $_->data } $msg->all_parts;
            Test::More::is_deeply(\@parts, [1,2,3], 'Multipart request is in order');
            $self->toggle_pang;
            $self->reply->send([3,2,1]);
        }
    }

    sub on_request_message {
        my ($self, $msg) = @_;
        $self->toggle_pong;
        $self->request->send([1, 2, 3]);
    }

    sub on_request_multipart_message {
        my ($self, $msg) = @_;
        if($msg->count_parts == 3)
        {
            my @parts = map { $_->data } $msg->all_parts;
            Test::More::is_deeply(\@parts, [3,2,1], 'Multipart response is in order');
            $self->toggle_pung;
            $self->request->send(2);
        }
    }

    sub on_request_socket_flushed {
        my ($self) = @_;
        if($self->pung)
        {
            $self->clear();
        }
    }
    
    sub on_reply_socket_flushed {
        my ($self) = @_;
        if($self->pung)
        {
            $self->clear();
        }
    }

    sub on_reply_socket_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a reply socket error: \n" . $msg->dump);
    }

    sub on_request_socket_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a request socket error: \n" . $msg->dump);
    }

    sub on_reply_bind_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a reply bind socket error: \n" . $msg->dump);
    }

    sub on_reply_connect_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a reply connect socket error: \n" . $msg->dump);
    }

    sub on_request_connect_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a request connect socket error: \n" . $msg->dump);
    }

    sub on_request_bind_error {
        my ($self, $msg) = @_;
        Test::More::BAIL_OUT("There should never be a request bind socket error: \n" . $msg->dump);
    }

    __PACKAGE__->meta->make_immutable();
}

my $app = App::Test->new();
$app->request->send(1);
$app->run_all();

ok($app->ping, 'Successfully set ping');
ok($app->pong, 'Successfully set pong');
ok($app->pang, 'Successfully set pang');
ok($app->pung, 'Successfully set pung');

done_testing();