package AnyEvent::XMPP::SimpleConnection; use strict; no warnings; use AnyEvent; use IO::Handle; use Encode; use AnyEvent::Socket; use AnyEvent::Handle; =head1 NAME AnyEvent::XMPP::SimpleConnection - Low level TCP/TLS connection =head1 SYNOPSIS package foo; use AnyEvent::XMPP::SimpleConnection; our @ISA = qw/AnyEvent::XMPP::SimpleConnection/; =head1 DESCRIPTION This module only implements the basic low level socket and SSL handling stuff. It is used by L and you shouldn't mess with it :-) (NOTE: This is the part of AnyEvent::XMPP which I feel least confident about :-) =cut sub new { my $this = shift; my $class = ref($this) || $this; my $self = { disconnect_cb => sub {}, @_ }; bless $self, $class; return $self; } sub connect { my ($self, $host, $service, $timeout) = @_; $self->{handle} and return 1; $self->{handle} = tcp_connect $host, $service, sub { my ($fh, $peerhost, $peerport) = @_; unless ($fh) { $self->disconnect ("Couldn't create socket to $host:$service: $!"); return; } $self->{peer_host} = $peerhost; $self->{peer_port} = $peerport; binmode $fh, ":raw"; $self->{handle} = AnyEvent::Handle->new ( fh => $fh, on_eof => sub { $self->disconnect ("EOF on connection to $self->{peer_host}:$self->{peer_port}: $!"); }, autocork => 1, on_error => sub { $self->disconnect ("Error on connection to $self->{peer_host}:$self->{peer_port}: $!"); }, on_read => sub { my ($hdl) = @_; my $data = $hdl->rbuf; $hdl->rbuf = ''; $data = decode_utf8 $data; $self->handle_data (\$data); }, ); $self->connected }, sub { $timeout }; return 1; } sub connected { # subclass responsibility } sub send_buffer_empty { # subclass responsibility } sub block_until_send_buffer_empty { # subclass responsibility } sub debug_wrote_data { # subclass responsibility } sub end_sockets { my ($self) = @_; delete $self->{handle}; } sub write_data { my ($self, $data) = @_; $self->{handle}->push_write (encode_utf8 ($data)); $self->debug_wrote_data (encode_utf8 ($data)); $self->{handle}->on_drain (sub { $self->send_buffer_empty; }); } sub enable_ssl { my ($self) = @_; $self->{handle}->starttls ('connect'); $self->{ssl_enabled} = 1; } sub disconnect { my ($self, $msg) = @_; $self->end_sockets; $self->{disconnect_cb}->($self->{peer_host}, $self->{peer_port}, $msg); $self->remove_all_callbacks; } 1;