view release on metacpan or  search on metacpan

lib/AnyEvent/STOMP/Client.pm  view on Meta::CPAN

package AnyEvent::STOMP::Client;

use strict;
use warnings;

use parent 'Object::Event';

use Carp;
use AnyEvent;
use AnyEvent::Handle;
use List::Util 'max';


our $VERSION = '0.42';


my $EOL = chr(10);
my $NULL = chr(0);
my %ENCODE_MAP = (
    "\r" => "\\r",
    "\n" => "\\n",
    ":"  => "\\c",
    "\\" => "\\\\",
);
my %DECODE_MAP = reverse %ENCODE_MAP;


sub new {
    my $class = shift;
    my $self = $class->SUPER::new;

    $self->{connection_timeout_margin} = 250;
    $self->{connected} = 0;
    $self->{counter} = 0;

    $self->{host} = shift || 'localhost';
    $self->{port} = shift || 61613;

    my $connect_headers = shift || {};

    $self->{connect_headers} = {
        'accept-version' => '1.2',
        'host' => $self->{host},
        'heart-beat' => '0,0'
    };

    if (defined $connect_headers->{'virtual-host'}) {
        $self->{connect_headers}{host} = $connect_headers->{'virtual-host'};
    }

    if (defined $connect_headers->{'heart-beat'}) {
        $self->{connect_headers}{'heart-beat'} = $connect_headers->{'heart-beat'};
    }

    if (defined $connect_headers->{'login'}
        and defined $connect_headers->{'passcode'}
    ) {
        $self->{connect_headers}{'login'} = $connect_headers->{'login'};
        $self->{connect_headers}{'passcode'} = $connect_headers->{'passcode'};
    }

    my $tls_ctx = shift;
    if (defined $tls_ctx) {
        $self->{tls_hash}{tls} = 'connect';
        $self->{tls_hash}{tls_ctx} = $tls_ctx;

        if ($tls_ctx->{verify}) {
            foreach my $key (keys %$tls_ctx) {
                if ($key =~ m/_file$/ && not -r $tls_ctx->{$key}) {
                    die "ERROR: Cannot access $key at $tls_ctx->{$key}.\n";
                }
            }
        }
    }

    $self->set_exception_cb(
        sub {
            my ($exception, $eventname) = @_;
            $self->event('ERROR', $self->{host}, $self->{port}, "$eventname: $exception");
        }
    );

    return bless $self, $class;
}

sub connect {
    my $self = shift;

    if ($self->is_connected) {
        undef $self->{handle};