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.

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

   } else {
      $self->retrieve_roster (sub {
         $self->initial_presence;
         $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<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.19
Committed:	Thu Jul 19 11:36:33 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.18:	+34 -5 lines
Log Message:	added initial_presence argument to the IM::Connection and the Client. added and upgraded some examples. further work on the registration forms.
#	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	elmex	1.19	=item initial_presence => $priority
53
54			This sets whether the initial presence should be sent. C<$priority>
55			should be the priority of the initial presence. The default value
56			for the initial presence C<$priority> is 10.
57
58			If you pass a undefined value as C<$priority> no initial presence will
59			be sent!
60
61	elmex	1.7	=back
62
63			=cut
64
65	elmex	1.1	sub new {
66			my $this = shift;
67			my $class = ref($this) \|\| $this;
68	elmex	1.19
69			my %args = @_;
70
71			unless (exists $args{initial_presence}) {
72			$args{initial_presence} = 10;
73			}
74
75			my $self = $class->SUPER::new (%args);
76	elmex	1.2
77	elmex	1.5	$self->{roster} = Net::XMPP2::IM::Roster->new (connection => $self);
78	elmex	1.2
79	elmex	1.5	$self->reg_cb (message_xml =>
80			sub { shift @_; $self->handle_message (@_); 1 });
81			$self->reg_cb (presence_xml =>
82			sub { shift @_; $self->handle_presence (@_); 1 });
83			$self->reg_cb (iq_set_request_xml =>
84			sub { shift @_; $self->handle_iq_set (@_); 1 });
85			$self->reg_cb (disconnect =>
86			sub { shift @_; $self->handle_disconnect (@_); 1 });
87	elmex	1.2
88	elmex	1.1	$self->reg_cb (stream_ready => sub {
89			my ($jid) = @_;
90	elmex	1.2	if ($self->features ()->find_all ([qw/session session/])) {
91			$self->send_session_iq;
92			} else {
93	elmex	1.7	$self->init_connection;
94	elmex	1.2	}
95	elmex	1.1	});
96	elmex	1.18
97			my $proxy_cb = sub {
98			my ($self, $er) = @_;
99			$self->event (error => $er);
100			1
101			};
102
103			$self->reg_cb (
104			session_error => $proxy_cb,
105			roster_error => $proxy_cb,
106			presence_error => $proxy_cb,
107			message_error => $proxy_cb,
108			);
109
110	elmex	1.1	$self
111			}
112
113	elmex	1.2	sub send_session_iq {
114			my ($self) = @_;
115
116			$self->send_iq (set => sub {
117			my ($w) = @_;
118			$w->addPrefix (xmpp_ns ('session'), '');
119			$w->emptyTag ([xmpp_ns ('session'), 'session']);
120
121			}, sub {
122	elmex	1.9	my ($node, $error) = @_;
123	elmex	1.2	if ($node) {
124	elmex	1.7	$self->init_connection;
125	elmex	1.2	} else {
126	elmex	1.14	$self->event (session_error => $error);
127	elmex	1.2	}
128			});
129			}
130
131	elmex	1.7	sub init_connection {
132			my ($self) = @_;
133			if ($self->{dont_retrieve_roster}) {
134	elmex	1.19	$self->initial_presence;
135			$self->{session_active} = 1;
136			$self->event ('session_ready');
137
138	elmex	1.7	} else {
139	elmex	1.19	$self->retrieve_roster (sub {
140			$self->initial_presence;
141			$self->{session_active} = 1;
142			$self->event ('session_ready');
143			});
144			}
145			}
146
147			sub initial_presence {
148			my ($self) = @_;
149			if (defined $self->{initial_presence}) {
150			$self->send_presence (undef, undef, priority => $self->{initial_presence});
151	elmex	1.7	}
152	elmex	1.19	# else do nothing
153	elmex	1.7	}
154
155	elmex	1.14	=item B<retrieve_roster ($cb)>
156	elmex	1.9
157			This method initiates a roster request. If you set C<dont_retrieve_roster>
158			when creating this connection no roster was retrieved.
159			You can do that with this method. The coderef in C<$cb> will be
160			called after the roster was retrieved.
161
162			The first argument of the callback in C<$cb> will be the roster
163			and the second will be a L<Net::XMPP2::Error::IQ> object when
164			an error occured while retrieving the roster.
165
166			=cut
167
168	elmex	1.3	sub retrieve_roster {
169	elmex	1.9	my ($self, $cb) = @_;
170	elmex	1.4
171	elmex	1.3	$self->send_iq (get => sub {
172			my ($w) = @_;
173			$w->addPrefix (xmpp_ns ('roster'), '');
174			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
175	elmex	1.4
176	elmex	1.3	}, sub {
177	elmex	1.9	my ($node, $error) = @_;
178	elmex	1.3	if ($node) {
179	elmex	1.14	$self->{roster}->set_retrieved;
180	elmex	1.3	$self->store_roster ($node);
181			} else {
182	elmex	1.9	$self->event (roster_error => $error);
183	elmex	1.3	}
184	elmex	1.7
185	elmex	1.9	$cb->($self, $self->{roster}, $error) if $cb
186	elmex	1.3	});
187			}
188
189			sub store_roster {
190			my ($self, $node) = @_;
191	elmex	1.9	my @upd = $self->{roster}->update ($node);
192	elmex	1.8	$self->event (roster_update => $self->{roster}, \@upd);
193	elmex	1.5	}
194
195	elmex	1.14	=item B<get_roster>
196
197			Returns the roster object of type L<Net::XMPP2::IM::Roster>.
198
199			=cut
200
201	elmex	1.5	sub get_roster {
202			my ($self) = @_;
203			$self->{roster}
204			}
205
206			sub handle_iq_set {
207			my ($self, $node, $rhandled) = @_;
208
209			if ($node->find_all ([qw/roster query/])) {
210			$self->store_roster ($node);
211	elmex	1.9	$self->reply_iq_result ($node);
212			$$rhandled = 1
213	elmex	1.5	}
214	elmex	1.3	}
215
216	elmex	1.2	sub handle_presence {
217	elmex	1.5	my ($self, $node) = @_;
218	elmex	1.13	if ($node->attr ('type') eq 'error') {
219			my $error = Net::XMPP2::Error::Presence->new (node => $node);
220			$self->event (presence_error => $error);
221			return if $error->type ne 'continue';
222			}
223
224	elmex	1.9	my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
225			$self->event (presence_update => $self->{roster}, $contact, $old, $new)
226	elmex	1.2	}
227
228			sub handle_message {
229	elmex	1.6	my ($self, $node) = @_;
230
231	elmex	1.13	if ($node->attr ('type') eq 'error') {
232			my $error = Net::XMPP2::Error::Message->new (node => $node);
233			$self->event (message_error => $error);
234			return if $error->type ne 'continue';
235			}
236
237	elmex	1.6	my $from = $node->attr ('from');
238			my $to = $node->attr ('to');
239			my $type = $node->attr ('type');
240			my ($thread) = $node->find_all ([qw/client thread/]);
241
242			my %bodies;
243			my %subjects;
244
245			$bodies{$_->attr ('lang') \|\| ''} = $_->text
246			for $node->find_all ([qw/client body/]);
247			$subjects{$_->attr ('lang') \|\| ''} = $_->text
248			for $node->find_all ([qw/client subject/]);
249
250			my $msg =
251			Net::XMPP2::IM::Message->new (
252			connection => $self,
253			from => $from,
254			to => $to,
255			type => $type,
256			bodies => \%bodies,
257			subjects => \%subjects,
258			thread => $thread
259			);
260
261			$self->event (message => $msg);
262	elmex	1.2	}
263
264	elmex	1.5	sub handle_disconnect {
265			my ($self) = @_;
266			delete $self->{roster};
267			}
268
269	elmex	1.14	=back
270
271	elmex	1.1	=head1 EVENTS
272
273			These additional events can be registered on with C<reg_cb>:
274
275	elmex	1.12	In the following events C<$roster> is the L<Net::XMPP2::IM::Roster>
276			object you get by calling C<get_roster>.
277
278	elmex	1.1	=over 4
279
280			=item session_ready
281
282	elmex	1.2	This event is generated when the session has been fully established and
283			can be used to send around messages and other stuff.
284
285	elmex	1.9	=item session_error => $error
286	elmex	1.2
287			If an error happened during establishment of the session this
288	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
289			error object.
290	elmex	1.1
291	elmex	1.8	=item roster_update => $roster, $contacts
292
293			This event is emitted when a roster update has been received.
294			C<$contacts> is an array reference of L<Net::XMPP2::IM::Contact> objects
295	elmex	1.9	which have changed. If a contact was removed it will return 'remove'
296			when you call the C<subscription> method on it.
297
298	elmex	1.10	The first time this event is sent is when the roster was received
299			for the first time.
300
301	elmex	1.9	=item roster_error => $error
302
303			If an error happened during retrival of the roster this event will
304			be generated.
305			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
306	elmex	1.8
307			=item presence_update => $roster, $contact, $old_presence, $new_presence
308
309			This event is emitted when the presence of a contact has changed.
310			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
311			has changed.
312			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
313			presence prior to the change.
314			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
315			presence after to the change.
316
317	elmex	1.13	=item presence_error => $error
318
319			This event is emitted when a presence stanza error was received.
320			C<$error> will be an L<Net::XMPP2::Error::Presence> error object.
321
322	elmex	1.8	=item message => $msg
323
324			This event is emitted when a message was received.
325			C<$msg> is a L<Net::XMPP2::IM::Message> object.
326
327	elmex	1.13	=item message_error => $error
328
329			This event is emitted when a message stanza error was received.
330			C<$error> will be an L<Net::XMPP2::Error::Message> error object.
331
332	elmex	1.12	=item contact_request_subscribe => $roster, $contact, $rdoit
333
334			This event is generated when the C<$contact> wants to subscribe
335			to your presence. C<$rdoit> is a reference to a scalar. Setting
336			the referenced scalar to 1 will accept the subscription request and send
337			a subscribed presence.
338
339	elmex	1.15	If you want to accept or decline the request later, call
340			C<send_subscribed> method of L<Net::XMPP2::IM::Contact> or
341			C<send_unsubscribed> method of L<Net::XMPP2::IM::Contact> on C<$contact>.
342	elmex	1.12
343			=item contact_subscribed => $roster, $contact
344
345			This event is generated when C<$contact> subscribed to your presence successfully.
346
347			=item contact_did_unsubscribe => $roster, $contact, $rdoit
348
349			This event is generated when C<$contact> unsubscribes from your presence.
350			Setting the in C<$rdoit> referenced scalar to 1 will also let you unsubscribe
351			from his presence.
352
353	elmex	1.17	If you want to unsubscribe later from him call the C<send_unsubscribed> method
354			of L<Net::XMPP2::IM::Contact> on C<$contact>.
355	elmex	1.12
356			=item contact_unsubscribed => $roster, $contact
357
358			This event is generated when C<$contact> unsubscribed you from his presence.
359
360	elmex	1.1	=back
361
362			=head1 AUTHOR
363
364	elmex	1.14	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
365	elmex	1.1
366			=head1 COPYRIGHT & LICENSE
367
368			Copyright 2007 Robin Redeker, all rights reserved.
369
370			This program is free software; you can redistribute it and/or modify it
371			under the same terms as Perl itself.
372
373			=cut
374
375			1; # End of Net::XMPP2