File Coverage

blib/lib/Net/Async/WebSocket/JSON/Protocol.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	2	2	100.0
condition	1	3	33.3
subroutine	7	7	100.0
pod	3	3	100.0
total	40	42	95.2

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2017 -- [e-mail]

package Net::Async::WebSocket::JSON::Protocol;

use strict;
use warnings;
use base qw( Net::Async::WebSocket::Protocol );
Net::Async::WebSocket::Protocol->VERSION( '0.11' );  # on_text_frame

our $VERSION = '0.01';

=head1 NAME

C - send and receive JSON-encoded data over WebSockets

=head1 DESCRIPTION

This subclass of L provides some conveniences
for sending and receiving JSON-encoded data over WebSockets. Principly, it
provides one new method, L, for encoding Perl values into JSON and
sending them, and one new method, L, for decoding received JSON
content into Perl values when received.

=cut

=head1 EVENTS

The following events are invoked, either using subclass methods or CODE
references in parameters:

=head2 on_json

   $self->on_json( $data )
   $on_json->( $self, $data )

Invoked when a text frame is received and has been decoded from JSON. It is
passed the Perl data structure resulting from the decode operation.

=cut

sub _init
{
   my $self = shift;
   my ( $params ) = @_;
   $self->SUPER::_init( $params );

   $params->{json} //= do {
      require JSON::MaybeXS;
      JSON::MaybeXS->new;
   };
}

=head1 PARAMETERS

The following named parameters may be passed to C or C:

=over 8

=item json => OBJECT

Optional. The JSON codec instance. This must support C and C
methods compatible with those provided by L, L or similar.

   $text = $json->encode( $data )
   $data = $json->decode( $text )

Note in particular that the C<$text> strings are Unicode character strings,
not UTF-8 encoded byte strings, and therefore the C option must be
disabled.

If not provided, the L<< JSON::MaybeXS->new >> constructor is used to find a
suitable implementation.

=item on_json => CODE

CODE reference for event handler.

=back

=cut

sub configure
{
   my $self = shift;
   my %params = @_;

   foreach (qw( json on_json )) {
      $self->{$_} = delete $params{$_} if exists $params{$_};
   }

   # TODO: forbid on_text_frame

   $self->SUPER::configure( %params );
}

sub on_text_frame
{
   my $self = shift;
   my ( $text ) = @_;

   # TODO: try/catch
   my $data = $self->{json}->decode( $text );
   $self->invoke_event( on_json => $data );
}

=head1 METHODS

The following methods documented with a trailing call to C<< ->get >> return
L instances.

=cut

=head2 send_json

   $self->send_json( $data )->get

Sends a text frame containing a JSON encoding of the Perl data structure
provided.

=cut

sub send_json
{
   my $self = shift;
   my ( $data ) = @_;

   $self->send_text_frame( $self->{json}->encode( $data ) );
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;