1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380
|
package AnyEvent::XMPP::IM::Connection;
use strict;
no warnings;
use AnyEvent::XMPP::Connection;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::IM::Roster;
use AnyEvent::XMPP::IM::Message;
use AnyEvent::XMPP::Util qw/cmp_bare_jid/;
our @ISA = qw/AnyEvent::XMPP::Connection/;
=head1 NAME
AnyEvent::XMPP::IM::Connection - "XML" stream that implements the XMPP RFC 3921.
=head1 SYNOPSIS
use AnyEvent::XMPP::Connection;
my $con = AnyEvent::XMPP::Connection->new;
=head1 DESCRIPTION
This module represents a XMPP instant messaging connection and implements
RFC 3921.
This module is a subclass of C<AnyEvent::XMPP::Connection> and inherits all methods.
For example C<reg_cb> and the stanza sending routines.
For additional events that can be registered to look below in the EVENTS section.
=head1 METHODS
=over 4
=item B<new (%args)>
This is the constructor. It takes the same arguments as
the constructor of L<AnyEvent::XMPP::Connection> along with a
few others:
=over 4
=item dont_retrieve_roster => $bool
Set this to a true value if no roster should be requested on connection
establishment. You can retrieve the roster later if you want to
with the C<retrieve_roster> method.
The internal roster will be set even if this option is active, and
even presences will be stored in there, except that the C<get_contacts>
method on the roster object won't return anything as there are
no roster items.
=item initial_presence => $priority
This sets whether the initial presence should be sent. C<$priority>
should be the priority of the initial presence. The default value
for the initial presence C<$priority> is 10.
If you pass a undefined value as C<$priority> no initial presence will
be sent!
=back
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my %args = @_;
unless (exists $args{initial_presence}) {
$args{initial_presence} = 10;
}
my $self = $class->SUPER::new (%args);
$self->{roster} = AnyEvent::XMPP::IM::Roster->new (connection => $self);
$self->reg_cb (message_xml =>
sub { shift @_; $self->handle_message (@_); });
$self->reg_cb (presence_xml =>
sub { shift @_; $self->handle_presence (@_); });
$self->reg_cb (iq_set_request_xml =>
sub { shift @_; $self->handle_iq_set (@_); });
$self->reg_cb (disconnect =>
sub { shift @_; $self->handle_disconnect (@_); });
$self->reg_cb (stream_ready => sub {
my ($jid) = @_;
if ($self->features ()->find_all ([qw/session session/])) {
$self->send_session_iq;
} else {
$self->init_connection;
}
});
my $proxy_cb = sub {
my ($self, $er) = @_;
$self->event (error => $er);
};
$self->reg_cb (
session_error => $proxy_cb,
roster_error => $proxy_cb,
presence_error => $proxy_cb,
message_error => $proxy_cb,
);
$self
}
sub send_session_iq {
my ($self) = @_;
$self->send_iq (set => sub {
my ($w) = @_;
$w->addPrefix (xmpp_ns ('session'), '');
$w->emptyTag ([xmpp_ns ('session'), 'session']);
}, sub {
my ($node, $error) = @_;
if ($node) {
$self->init_connection;
} else {
$self->event (session_error => $error);
}
});
}
sub init_connection {
my ($self) = @_;
if ($self->{dont_retrieve_roster}) {
$self->initial_presence;
$self->{session_active} = 1;
$self->event ('session_ready');
} else {
$self->retrieve_roster (sub {
$self->initial_presence; # XXX: is this the right order? after roster fetch?
$self->{session_active} = 1;
$self->event ('session_ready');
});
}
}
sub initial_presence {
my ($self) = @_;
if (defined $self->{initial_presence}) {
$self->send_presence (undef, undef, priority => $self->{initial_presence});
}
# else do nothing
}
=item B<retrieve_roster ($cb)>
This method initiates a roster request. If you set C<dont_retrieve_roster>
when creating this connection no roster was retrieved.
You can do that with this method. The coderef in C<$cb> will be
called after the roster was retrieved.
The first argument of the callback in C<$cb> will be the roster
and the second will be a L<AnyEvent::XMPP::Error::IQ> object when
an error occurred while retrieving the roster.
=cut
sub retrieve_roster {
my ($self, $cb) = @_;
$self->send_iq (get => sub {
my ($w) = @_;
$w->addPrefix (xmpp_ns ('roster'), '');
$w->emptyTag ([xmpp_ns ('roster'), 'query']);
}, sub {
my ($node, $error) = @_;
if ($node) {
$self->{roster}->set_retrieved;
$self->store_roster ($node);
} else {
$self->event (roster_error => $error);
}
$cb->($self, $self->{roster}, $error) if $cb
});
}
sub store_roster {
my ($self, $node) = @_;
my @upd = $self->{roster}->update ($node);
$self->event (roster_update => $self->{roster}, \@upd);
}
=item B<get_roster>
Returns the roster object of type L<AnyEvent::XMPP::IM::Roster>.
=cut
sub get_roster {
my ($self) = @_;
$self->{roster}
}
sub handle_iq_set {
my ($self, $node, $handled) = @_;
if ($node->find_all ([qw/roster query/])) {
$self->store_roster ($node);
$self->reply_iq_result ($node);
$$handled = 1;
}
}
sub handle_presence {
my ($self, $node) = @_;
if (defined ($node->attr ('to')) && !cmp_bare_jid ($node->attr ('to'), $self->jid)) {
return; # ignore presence that is not for us
}
if ($node->attr ('type') eq 'error') {
my $error = AnyEvent::XMPP::Error::Presence->new (node => $node);
$self->event (presence_error => $error);
return if $error->type ne 'continue';
}
my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
$self->event (presence_update => $self->{roster}, $contact, $old, $new)
}
sub handle_message {
my ($self, $node) = @_;
if ($node->attr ('type') eq 'error') {
my $error = AnyEvent::XMPP::Error::Message->new (node => $node);
$self->event (message_error => $error);
return if $error->type ne 'continue';
}
my $msg = AnyEvent::XMPP::IM::Message->new (connection => $self);
$msg->from_node ($node);
$self->event (message => $msg);
}
sub handle_disconnect {
my ($self) = @_;
delete $self->{roster};
}
=back
=head1 EVENTS
These additional events can be registered on with C<reg_cb>:
In the following events C<$roster> is the L<AnyEvent::XMPP::IM::Roster>
object you get by calling C<get_roster>.
NODE: The first argument to each callback is always the L<AnyEvent::XMPP::IM::Connection>
object itself. Also see L<Object::Event> for more information about registering
callbacks.
=over 4
=item session_ready
This event is generated when the session has been fully established and
can be used to send around messages and other stuff.
=item session_error => $error
If an error happened during establishment of the session this
event will be generated. C<$error> will be an L<AnyEvent::XMPP::Error::IQ>
error object.
=item roster_update => $roster, $contacts
This event is emitted when a roster update has been received.
C<$contacts> is an array reference of L<AnyEvent::XMPP::IM::Contact> objects
which have changed. If a contact was removed it will return 'remove'
when you call the C<subscription> method on it.
The first time this event is sent is when the roster was received
for the first time.
=item roster_error => $error
If an error happened during retrieval of the roster this event will
be generated.
C<$error> will be an L<AnyEvent::XMPP::Error::IQ> error object.
=item presence_update => $roster, $contact, $old_presence, $new_presence
This event is emitted when the presence of a contact has changed.
C<$contact> is the L<AnyEvent::XMPP::IM::Contact> object which presence status
has changed.
C<$old_presence> is a L<AnyEvent::XMPP::IM::Presence> object which represents the
presence prior to the change.
C<$new_presence> is a L<AnyEvent::XMPP::IM::Presence> object which represents the
presence after to the change. The new presence might be undef if the new presence
is 'unavailable'.
=item presence_error => $error
This event is emitted when a presence stanza error was received.
C<$error> will be an L<AnyEvent::XMPP::Error::Presence> error object.
=item message => $msg
This event is emitted when a message was received.
C<$msg> is a L<AnyEvent::XMPP::IM::Message> object.
=item message_error => $error
This event is emitted when a message stanza error was received.
C<$error> will be an L<AnyEvent::XMPP::Error::Message> error object.
=item contact_request_subscribe => $roster, $contact, $message
This event is generated when the C<$contact> wants to subscribe
to your presence.
If you want to accept or decline the request, call
C<send_subscribed> method of L<AnyEvent::XMPP::IM::Contact> or
C<send_unsubscribed> method of L<AnyEvent::XMPP::IM::Contact> on C<$contact>.
If you want to start a mutual subscription you have to call C<send_subscribe>
B<AFTER> you accepted or declined with C<send_subscribed>/C<send_unsubscribed>.
Calling it in the opposite order gets some servers confused!
If a C<status> element was transmitted with the subscription
it's contents will be in C<$message>. Which is usually a text written
from the one who requests subscription.
=item contact_subscribed => $roster, $contact, $message
This event is generated when C<$contact> subscribed you to his presence successfully.
If a C<status> element was transmitted with the subscribed presence
it's contents will be in C<$message>.
=item contact_did_unsubscribe => $roster, $contact, $message
This event is generated when C<$contact> unsubscribes from your presence.
If you want to unsubscribe from him call the C<send_unsubscribe> method
of L<AnyEvent::XMPP::IM::Contact> on C<$contact>.
If a C<status> element was transmitted with the unsubscription
it's contents will be in C<$message>. Which is usually a text written
from the one who unsubscribes.
=item contact_unsubscribed => $roster, $contact, $message
This event is generated when C<$contact> unsubscribed you from his presence.
If you want to unsubscribe him from your presence call the C<send_unsubscribed>
method of L<AnyEvent::XMPP::IM::Contact> on C<$contact>.
If a C<status> element was transmitted with the unsubscription
it's contents will be in C<$message>.
=back
=head1 AUTHOR
Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
=head1 COPYRIGHT & LICENSE
Copyright 2007, 2008 Robin Redeker, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of AnyEvent::XMPP
|