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