view release on metacpan or  search on metacpan

lib/IO/Multiplex/Intermediary.pm  view on Meta::CPAN

        }
    );
}

sub _input {
    my ($self)             = @_;
    my ($input, $wheel_id) = @_[ARG0, ARG1];
    $input =~ s/[\r\n]*$//;


    $self->send_to_client(
        {
            param => 'input',
            data => {
                id    => $wheel_id,
                value => $input,
            }
        }
    );
}

sub _process_input {
    my $self = shift;
    my $input = shift;

    my $json = eval { from_json($input) };

    {
        if ($@ || !$json) {
            warn "JSON error: $@";
        }
        elsif (!exists $json->{param}) {
            warn "Invalid JSON structure!";
        }
        else {
            last unless $json->{data}->{id};
            last unless reftype($self->rw_set);
            last unless $self->rw_set->{ $json->{data}->{id} };

            if ($json->{param} eq 'output') {
                $self->rw_set->{ $json->{data}->{id} }->put( $json->{data}->{value} );
                if ($json->{updates}) {
                    foreach my $key  (%{ $json->{updates} }) {
                        my $value = $json->{updates}->{$key};
                        $self->socket_info->{ $json->{data}->{id} }->{ $key } = $value
                    }
                }
            }
            elsif ($json->{param} eq 'disconnect') {
                my $id = $json->{data}->{id};
                $self->rw_set->{$id}->shutdown_output;
            }
        }
    }

}

sub client_input {
    my $self = shift;
    my $input = $_[ARG0];
    my @packets = split m{\e}, $input;
    s/[\r\n]*$// for @packets;
    $self->_process_input($_) for grep { $_} @packets;
}

sub _disconnect {
    my ($self)   = @_;
    my $wheel_id = $_[ARG3];
    delete $self->rw_set->{$wheel_id};
    $self->send_to_client(
        {
            param => 'disconnect',
            data => {
                id => $wheel_id,
            }
        }
    );
}

sub _error {
    my ($self) = @_;
    my ($operation, $errnum, $errstr) = @_[ARG0, ARG1, ARG2];
    warn "[SERVER] $operation error $errnum: $errstr";
}

sub client_disconnect {
    my $self = shift;
    #$_->put("Hold tight!\nThe MUD will be back up shortly.\n") for values %{$self->rw_set||{}};
}


sub send {
    my $self = shift;
    my $id = shift;
    my $data = shift;

    $self->rw_set->{$id}->put(to_json($data));
}

sub send_to_client {
    my $self   = shift;
    my $data   = shift;

    return unless defined $self->client_socket;
    $self->client_socket->put(to_json($data));
}


sub run {
    my $self = shift;
    POE::Kernel->run();
}

event START => \&_client_start;

event connect     => \&_connect;
event error       => \&_error;
event input       => \&_input;
event disconnect  => \&_disconnect;

__PACKAGE__->meta->make_immutable;