XMPP2/IM/Connection.pm

package Net::XMPP2::IM::Connection;
use strict;
use Net::XMPP2::Connection;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::XMPP2::IM::Roster;
use Net::XMPP2::IM::Message;
our @ISA = qw/Net::XMPP2::Connection/;

=head1 NAME

Net::XMPP2::IM::Connection - "XML" stream that implements the XMPP RFC 3921.

=head1 SYNOPSIS

   use Net::XMPP2::Connection;

   my $con = Net::XMPP2::Connection->new;

=head1 DESCRIPTION

This module represents a XMPP instant messaging connection and implements
RFC 3921.

This module is a subclass of C<Net::XMPP2::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<Net::XMPP2::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.

=back

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = $class->SUPER::new (@_);

   $self->{roster} = Net::XMPP2::IM::Roster->new (connection => $self);

   $self->reg_cb (message_xml =>
      sub { shift @_; $self->handle_message (@_);    1 });
   $self->reg_cb (presence_xml =>
      sub { shift @_; $self->handle_presence (@_);   1 });
   $self->reg_cb (iq_set_request_xml =>
      sub { shift @_; $self->handle_iq_set (@_);     1 });
   $self->reg_cb (disconnect =>
      sub { shift @_; $self->handle_disconnect (@_); 1 });

   $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);
      1
   };

   $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) = @_;
   $self->{session_active} = 1;
   if ($self->{dont_retrieve_roster}) {
      $self->send_presence;
   } else {
      $self->retrieve_roster (sub { $self->send_presence });
   }
   $self->event ('session_ready');
}

=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<Net::XMPP2::Error::IQ> object when
an error occured 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<Net::XMPP2::IM::Roster>.

=cut

sub get_roster {
   my ($self) = @_;
   $self->{roster}
}

sub handle_iq_set {
   my ($self, $node, $rhandled) = @_;

   if ($node->find_all ([qw/roster query/])) {
      $self->store_roster ($node);
      $self->reply_iq_result ($node);
      $$rhandled = 1
   }
}

sub handle_presence {
   my ($self, $node) = @_;
   if ($node->attr ('type') eq 'error') {
      my $error = Net::XMPP2::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 = Net::XMPP2::Error::Message->new (node => $node);
      $self->event (message_error => $error);
      return if $error->type ne 'continue';
   }

   my $from     = $node->attr ('from');
   my $to       = $node->attr ('to');
   my $type     = $node->attr ('type');
   my ($thread) = $node->find_all ([qw/client thread/]);

   my %bodies;
   my %subjects;

   $bodies{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client body/]);
   $subjects{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client subject/]);

   my $msg =
      Net::XMPP2::IM::Message->new (
         connection => $self,
         from       => $from,
         to         => $to,
         type       => $type,
         bodies     => \%bodies,
         subjects   => \%subjects,
         thread     => $thread
      );

   $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<Net::XMPP2::IM::Roster>
object you get by calling C<get_roster>.

=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<Net::XMPP2::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<Net::XMPP2::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 retrival of the roster this event will
be generated.
C<$error> will be an L<Net::XMPP2::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<Net::XMPP2::IM::Contact> object which presence status
has changed.
C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
presence prior to the change.
C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
presence after to the change.

=item presence_error => $error

This event is emitted when a presence stanza error was received.
C<$error> will be an L<Net::XMPP2::Error::Presence> error object.

=item message => $msg

This event is emitted when a message was received.
C<$msg> is a L<Net::XMPP2::IM::Message> object.

=item message_error => $error

This event is emitted when a message stanza error was received.
C<$error> will be an L<Net::XMPP2::Error::Message> error object.

=item contact_request_subscribe => $roster, $contact, $rdoit

This event is generated when the C<$contact> wants to subscribe
to your presence. C<$rdoit> is a reference to a scalar. Setting
the referenced scalar to 1 will accept the subscription request and send
a subscribed presence.

If you want to accept or decline the request later, call
C<send_subscribed> method of L<Net::XMPP2::IM::Contact> or
C<send_unsubscribed> method of L<Net::XMPP2::IM::Contact> on C<$contact>.

=item contact_subscribed => $roster, $contact

This event is generated when C<$contact> subscribed to your presence successfully.

=item contact_did_unsubscribe => $roster, $contact, $rdoit

This event is generated when C<$contact> unsubscribes from your presence.
Setting the in C<$rdoit> referenced scalar to 1 will also let you unsubscribe
from his presence.

If you want to unsubscribe later from him call the C<send_unsubscribed> method
of L<Net::XMPP2::IM::Contact> on C<$contact>.

=item contact_unsubscribed => $roster, $contact

This event is generated when C<$contact> unsubscribed you from his presence.

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 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 Net::XMPP2
Revision:	1.18
Committed:	Sat Jul 7 12:39:45 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.17:	+14 -0 lines
Log Message:	fixed some bugs, redesigned disco mechanism, probably added some bugs, added samples/disco_test example.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::IM::Connection;
2			use strict;
3			use Net::XMPP2::Connection;
4			use Net::XMPP2::Namespaces qw/xmpp_ns/;
5	elmex	1.5	use Net::XMPP2::IM::Roster;
6	elmex	1.6	use Net::XMPP2::IM::Message;
7	elmex	1.1	our @ISA = qw/Net::XMPP2::Connection/;
8
9			=head1 NAME
10
11	elmex	1.16	Net::XMPP2::IM::Connection - "XML" stream that implements the XMPP RFC 3921.
12	elmex	1.1
13			=head1 SYNOPSIS
14
15			use Net::XMPP2::Connection;
16
17			my $con = Net::XMPP2::Connection->new;
18
19			=head1 DESCRIPTION
20
21			This module represents a XMPP instant messaging connection and implements
22			RFC 3921.
23
24			This module is a subclass of C<Net::XMPP2::Connection> and inherits all methods.
25			For example C<reg_cb> and the stanza sending routines.
26
27			For additional events that can be registered to look below in the EVENTS section.
28
29			=head1 METHODS
30
31	elmex	1.14	=over 4
32	elmex	1.1
33	elmex	1.14	=item B<new (%args)>
34	elmex	1.7
35			This is the constructor. It takes the same arguments as
36			the constructor of L<Net::XMPP2::Connection> along with a
37			few others:
38
39			=over 4
40
41			=item dont_retrieve_roster => $bool
42
43			Set this to a true value if no roster should be requested on connection
44			establishment. You can retrieve the roster later if you want to
45			with the C<retrieve_roster> method.
46
47			The internal roster will be set even if this option is active, and
48			even presences will be stored in there, except that the C<get_contacts>
49			method on the roster object won't return anything as there are
50			no roster items.
51
52			=back
53
54			=cut
55
56	elmex	1.1	sub new {
57			my $this = shift;
58			my $class = ref($this) \|\| $this;
59			my $self = $class->SUPER::new (@_);
60	elmex	1.2
61	elmex	1.5	$self->{roster} = Net::XMPP2::IM::Roster->new (connection => $self);
62	elmex	1.2
63	elmex	1.5	$self->reg_cb (message_xml =>
64			sub { shift @_; $self->handle_message (@_); 1 });
65			$self->reg_cb (presence_xml =>
66			sub { shift @_; $self->handle_presence (@_); 1 });
67			$self->reg_cb (iq_set_request_xml =>
68			sub { shift @_; $self->handle_iq_set (@_); 1 });
69			$self->reg_cb (disconnect =>
70			sub { shift @_; $self->handle_disconnect (@_); 1 });
71	elmex	1.2
72	elmex	1.1	$self->reg_cb (stream_ready => sub {
73			my ($jid) = @_;
74	elmex	1.2	if ($self->features ()->find_all ([qw/session session/])) {
75			$self->send_session_iq;
76			} else {
77	elmex	1.7	$self->init_connection;
78	elmex	1.2	}
79	elmex	1.1	});
80	elmex	1.18
81			my $proxy_cb = sub {
82			my ($self, $er) = @_;
83			$self->event (error => $er);
84			1
85			};
86
87			$self->reg_cb (
88			session_error => $proxy_cb,
89			roster_error => $proxy_cb,
90			presence_error => $proxy_cb,
91			message_error => $proxy_cb,
92			);
93
94	elmex	1.1	$self
95			}
96
97	elmex	1.2	sub send_session_iq {
98			my ($self) = @_;
99
100			$self->send_iq (set => sub {
101			my ($w) = @_;
102			$w->addPrefix (xmpp_ns ('session'), '');
103			$w->emptyTag ([xmpp_ns ('session'), 'session']);
104
105			}, sub {
106	elmex	1.9	my ($node, $error) = @_;
107	elmex	1.2	if ($node) {
108	elmex	1.7	$self->init_connection;
109	elmex	1.2	} else {
110	elmex	1.14	$self->event (session_error => $error);
111	elmex	1.2	}
112			});
113			}
114
115	elmex	1.7	sub init_connection {
116			my ($self) = @_;
117			$self->{session_active} = 1;
118			if ($self->{dont_retrieve_roster}) {
119			$self->send_presence;
120			} else {
121	elmex	1.9	$self->retrieve_roster (sub { $self->send_presence });
122	elmex	1.7	}
123			$self->event ('session_ready');
124			}
125
126	elmex	1.14	=item B<retrieve_roster ($cb)>
127	elmex	1.9
128			This method initiates a roster request. If you set C<dont_retrieve_roster>
129			when creating this connection no roster was retrieved.
130			You can do that with this method. The coderef in C<$cb> will be
131			called after the roster was retrieved.
132
133			The first argument of the callback in C<$cb> will be the roster
134			and the second will be a L<Net::XMPP2::Error::IQ> object when
135			an error occured while retrieving the roster.
136
137			=cut
138
139	elmex	1.3	sub retrieve_roster {
140	elmex	1.9	my ($self, $cb) = @_;
141	elmex	1.4
142	elmex	1.3	$self->send_iq (get => sub {
143			my ($w) = @_;
144			$w->addPrefix (xmpp_ns ('roster'), '');
145			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
146	elmex	1.4
147	elmex	1.3	}, sub {
148	elmex	1.9	my ($node, $error) = @_;
149	elmex	1.3	if ($node) {
150	elmex	1.14	$self->{roster}->set_retrieved;
151	elmex	1.3	$self->store_roster ($node);
152			} else {
153	elmex	1.9	$self->event (roster_error => $error);
154	elmex	1.3	}
155	elmex	1.7
156	elmex	1.9	$cb->($self, $self->{roster}, $error) if $cb
157	elmex	1.3	});
158			}
159
160			sub store_roster {
161			my ($self, $node) = @_;
162	elmex	1.9	my @upd = $self->{roster}->update ($node);
163	elmex	1.8	$self->event (roster_update => $self->{roster}, \@upd);
164	elmex	1.5	}
165
166	elmex	1.14	=item B<get_roster>
167
168			Returns the roster object of type L<Net::XMPP2::IM::Roster>.
169
170			=cut
171
172	elmex	1.5	sub get_roster {
173			my ($self) = @_;
174			$self->{roster}
175			}
176
177			sub handle_iq_set {
178			my ($self, $node, $rhandled) = @_;
179
180			if ($node->find_all ([qw/roster query/])) {
181			$self->store_roster ($node);
182	elmex	1.9	$self->reply_iq_result ($node);
183			$$rhandled = 1
184	elmex	1.5	}
185	elmex	1.3	}
186
187	elmex	1.2	sub handle_presence {
188	elmex	1.5	my ($self, $node) = @_;
189	elmex	1.13	if ($node->attr ('type') eq 'error') {
190			my $error = Net::XMPP2::Error::Presence->new (node => $node);
191			$self->event (presence_error => $error);
192			return if $error->type ne 'continue';
193			}
194
195	elmex	1.9	my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
196			$self->event (presence_update => $self->{roster}, $contact, $old, $new)
197	elmex	1.2	}
198
199			sub handle_message {
200	elmex	1.6	my ($self, $node) = @_;
201
202	elmex	1.13	if ($node->attr ('type') eq 'error') {
203			my $error = Net::XMPP2::Error::Message->new (node => $node);
204			$self->event (message_error => $error);
205			return if $error->type ne 'continue';
206			}
207
208	elmex	1.6	my $from = $node->attr ('from');
209			my $to = $node->attr ('to');
210			my $type = $node->attr ('type');
211			my ($thread) = $node->find_all ([qw/client thread/]);
212
213			my %bodies;
214			my %subjects;
215
216			$bodies{$_->attr ('lang') \|\| ''} = $_->text
217			for $node->find_all ([qw/client body/]);
218			$subjects{$_->attr ('lang') \|\| ''} = $_->text
219			for $node->find_all ([qw/client subject/]);
220
221			my $msg =
222			Net::XMPP2::IM::Message->new (
223			connection => $self,
224			from => $from,
225			to => $to,
226			type => $type,
227			bodies => \%bodies,
228			subjects => \%subjects,
229			thread => $thread
230			);
231
232			$self->event (message => $msg);
233	elmex	1.2	}
234
235	elmex	1.5	sub handle_disconnect {
236			my ($self) = @_;
237			delete $self->{roster};
238			}
239
240	elmex	1.14	=back
241
242	elmex	1.1	=head1 EVENTS
243
244			These additional events can be registered on with C<reg_cb>:
245
246	elmex	1.12	In the following events C<$roster> is the L<Net::XMPP2::IM::Roster>
247			object you get by calling C<get_roster>.
248
249	elmex	1.1	=over 4
250
251			=item session_ready
252
253	elmex	1.2	This event is generated when the session has been fully established and
254			can be used to send around messages and other stuff.
255
256	elmex	1.9	=item session_error => $error
257	elmex	1.2
258			If an error happened during establishment of the session this
259	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
260			error object.
261	elmex	1.1
262	elmex	1.8	=item roster_update => $roster, $contacts
263
264			This event is emitted when a roster update has been received.
265			C<$contacts> is an array reference of L<Net::XMPP2::IM::Contact> objects
266	elmex	1.9	which have changed. If a contact was removed it will return 'remove'
267			when you call the C<subscription> method on it.
268
269	elmex	1.10	The first time this event is sent is when the roster was received
270			for the first time.
271
272	elmex	1.9	=item roster_error => $error
273
274			If an error happened during retrival of the roster this event will
275			be generated.
276			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
277	elmex	1.8
278			=item presence_update => $roster, $contact, $old_presence, $new_presence
279
280			This event is emitted when the presence of a contact has changed.
281			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
282			has changed.
283			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
284			presence prior to the change.
285			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
286			presence after to the change.
287
288	elmex	1.13	=item presence_error => $error
289
290			This event is emitted when a presence stanza error was received.
291			C<$error> will be an L<Net::XMPP2::Error::Presence> error object.
292
293	elmex	1.8	=item message => $msg
294
295			This event is emitted when a message was received.
296			C<$msg> is a L<Net::XMPP2::IM::Message> object.
297
298	elmex	1.13	=item message_error => $error
299
300			This event is emitted when a message stanza error was received.
301			C<$error> will be an L<Net::XMPP2::Error::Message> error object.
302
303	elmex	1.12	=item contact_request_subscribe => $roster, $contact, $rdoit
304
305			This event is generated when the C<$contact> wants to subscribe
306			to your presence. C<$rdoit> is a reference to a scalar. Setting
307			the referenced scalar to 1 will accept the subscription request and send
308			a subscribed presence.
309
310	elmex	1.15	If you want to accept or decline the request later, call
311			C<send_subscribed> method of L<Net::XMPP2::IM::Contact> or
312			C<send_unsubscribed> method of L<Net::XMPP2::IM::Contact> on C<$contact>.
313	elmex	1.12
314			=item contact_subscribed => $roster, $contact
315
316			This event is generated when C<$contact> subscribed to your presence successfully.
317
318			=item contact_did_unsubscribe => $roster, $contact, $rdoit
319
320			This event is generated when C<$contact> unsubscribes from your presence.
321			Setting the in C<$rdoit> referenced scalar to 1 will also let you unsubscribe
322			from his presence.
323
324	elmex	1.17	If you want to unsubscribe later from him call the C<send_unsubscribed> method
325			of L<Net::XMPP2::IM::Contact> on C<$contact>.
326	elmex	1.12
327			=item contact_unsubscribed => $roster, $contact
328
329			This event is generated when C<$contact> unsubscribed you from his presence.
330
331	elmex	1.1	=back
332
333			=head1 AUTHOR
334
335	elmex	1.14	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
336	elmex	1.1
337			=head1 COPYRIGHT & LICENSE
338
339			Copyright 2007 Robin Redeker, all rights reserved.
340
341			This program is free software; you can redistribute it and/or modify it
342			under the same terms as Perl itself.
343
344			=cut
345
346			1; # End of Net::XMPP2