The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Protocol::SocketIO::Message;

use strict;
use warnings;

use Encode ();
use JSON   ();

use overload '""' => sub { $_[0]->to_string }, fallback => 1;

our %TYPES = (
    'disconnect'   => 0,
    'connect'      => 1,
    'heartbeat'    => 2,
    'message'      => 3,
    'json_message' => 4,
    'event'        => 5,
    'ack'          => 6,
    'error'        => 7,
    'noop'         => 8
);

sub new {
    my $class = shift;

    my $self = {@_};
    bless $self, $class;

    $self->{type} ||= ref $self->{data} ? 'json_message' : 'message';

    if ($self->{type} eq 'connect' || $self->{type} eq 'heartbeat') {
        $self->{endpoint} = '' unless defined $self->{endpoint};
    }

    return $self;
}

sub is_message {
    my $self = shift;

    return $self->type eq 'message' || $self->type eq 'json_message';
}

sub parse {
    my $self = shift;
    my ($string) = @_;

    return unless defined $string && $string ne '';

    return unless $string =~ m/:/;

    ($self->{type}, $self->{id}, $self->{endpoint}, $self->{data}) =
      split ':', $string, 4;

    return unless defined $self->{type};

    if ($self->{id} =~ s/\+$//) {

        # TODO ack
    }

    my %swapped = reverse %TYPES;
    return unless exists $swapped{$self->{type}};

    $self->{type} = $swapped{$self->{type}};

    for (qw(id endpoint data)) {
        $self->{$_} = '' unless defined $self->{$_};
    }

    if ($self->{type} eq 'json_message' || $self->{type} eq 'event') {
        eval {
            $self->{data} = JSON::decode_json($self->{data});
            1;
        } or do {
            delete $self->{data};
        };

        return unless defined $self->{data};
    }
    else {
        $self->{data} = Encode::decode('UTF-8', $self->{data});
    }

    return $self;
}

sub type     { $_[0]->{type} }
sub id       { $_[0]->{id} }
sub endpoint { $_[0]->{endpoint} }

sub data { $_[0]->{data} }

sub to_bytes {
    my $self = shift;

    my @message;

    my $type = $TYPES{$self->{type}};

    my $data;
    if ($self->{type} eq 'error') {
        $data = join '+', $self->{reason}, $self->{advice};
    }
    elsif ($self->{type} eq 'json_message' || $self->{type} eq 'event') {
        $data = JSON::encode_json($self->{data});
    }
    elsif ($self->{type} eq 'ack') {
        $data = $self->{message_id};
        if ($self->{args}) {
            $data .= '+' . JSON::encode_json($self->{args});
        }
    }
    else {
        $data = Encode::encode('UTF-8', $self->{data});
    }

    for ($data, $self->{endpoint}, $self->{id}, $type) {
        if (@message) {
            push @message, defined $_ ? $_ : '';
        }
        elsif (defined $_) {
            push @message, $_;
        }
    }

    return join ':', reverse @message;
}

sub to_string {
    my $self = shift;

    return Encode::decode('UTF-8', $self->to_bytes);
}

1;
__END__

=head1 NAME

Protocol::SocketIO::Message - Socket.IO message parsing and building

=head1 SYNOPSIS

    # Build messages
    $message = Protocol::SocketIO::Message->new(
        type     => 'disconnect',
        endpoint => '/test'
    );

    $message = Protocol::SocketIO::Message->new(
        type       => 'ack',
        message_id => 4,
        args       => ['A', 'B']
    );

    # Parse messages
    $message = Protocol::SocketIO::Message->new->parse('4:1::{"a":"b"}');

=head1 DESCRIPTION

L<Protocol::SocketIO::Message> parsers and builds Socket.IO messages.

=head1 METHODS

=head2 C<new>

=head2 C<parse>

=head2 C<type>

=head2 C<is_message>

=head2 C<id>

=head2 C<data>

=head2 C<endpoint>

=head2 C<to_bytes>

=head2 C<to_string>

=cut