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

=cut

=head2 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); # TODO: make error obj
      }
   });
}

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');
}

=head2 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->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);
}

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};
}

=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 laster call
L<Net::XMPP2::IM::Contact::send_subscribed> or
L<Net::XMPP2::IM::Contact::send_unsubscribed> 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.

=item

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.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.13
Committed:	Tue Jul 3 14:00:52 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.12:	+22 -0 lines
Log Message:	implemented stanza errors
#	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			=cut
32
33	elmex	1.7	=head2 new (%args)
34
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.9	$self->event (session_error => $error); # TODO: make error obj
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.9	=head2 retrieve_roster ($cb)
113
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			$self->store_roster ($node);
137			} else {
138	elmex	1.9	$self->event (roster_error => $error);
139	elmex	1.3	}
140	elmex	1.7
141	elmex	1.9	$cb->($self, $self->{roster}, $error) if $cb
142	elmex	1.3	});
143			}
144
145			sub store_roster {
146			my ($self, $node) = @_;
147	elmex	1.9	my @upd = $self->{roster}->update ($node);
148	elmex	1.8	$self->event (roster_update => $self->{roster}, \@upd);
149	elmex	1.5	}
150
151			sub get_roster {
152			my ($self) = @_;
153			$self->{roster}
154			}
155
156			sub handle_iq_set {
157			my ($self, $node, $rhandled) = @_;
158
159			if ($node->find_all ([qw/roster query/])) {
160			$self->store_roster ($node);
161	elmex	1.9	$self->reply_iq_result ($node);
162			$$rhandled = 1
163	elmex	1.5	}
164	elmex	1.3	}
165
166	elmex	1.2	sub handle_presence {
167	elmex	1.5	my ($self, $node) = @_;
168	elmex	1.13	if ($node->attr ('type') eq 'error') {
169			my $error = Net::XMPP2::Error::Presence->new (node => $node);
170			$self->event (presence_error => $error);
171			return if $error->type ne 'continue';
172			}
173
174	elmex	1.9	my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
175			$self->event (presence_update => $self->{roster}, $contact, $old, $new)
176	elmex	1.2	}
177
178			sub handle_message {
179	elmex	1.6	my ($self, $node) = @_;
180
181	elmex	1.13	if ($node->attr ('type') eq 'error') {
182			my $error = Net::XMPP2::Error::Message->new (node => $node);
183			$self->event (message_error => $error);
184			return if $error->type ne 'continue';
185			}
186
187	elmex	1.6	my $from = $node->attr ('from');
188			my $to = $node->attr ('to');
189			my $type = $node->attr ('type');
190			my ($thread) = $node->find_all ([qw/client thread/]);
191
192			my %bodies;
193			my %subjects;
194
195			$bodies{$_->attr ('lang') \|\| ''} = $_->text
196			for $node->find_all ([qw/client body/]);
197			$subjects{$_->attr ('lang') \|\| ''} = $_->text
198			for $node->find_all ([qw/client subject/]);
199
200			my $msg =
201			Net::XMPP2::IM::Message->new (
202			connection => $self,
203			from => $from,
204			to => $to,
205			type => $type,
206			bodies => \%bodies,
207			subjects => \%subjects,
208			thread => $thread
209			);
210
211			$self->event (message => $msg);
212	elmex	1.2	}
213
214	elmex	1.5	sub handle_disconnect {
215			my ($self) = @_;
216			delete $self->{roster};
217			}
218
219	elmex	1.1	=head1 EVENTS
220
221			These additional events can be registered on with C<reg_cb>:
222
223	elmex	1.12	In the following events C<$roster> is the L<Net::XMPP2::IM::Roster>
224			object you get by calling C<get_roster>.
225
226	elmex	1.1	=over 4
227
228			=item session_ready
229
230	elmex	1.2	This event is generated when the session has been fully established and
231			can be used to send around messages and other stuff.
232
233	elmex	1.9	=item session_error => $error
234	elmex	1.2
235			If an error happened during establishment of the session this
236	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
237			error object.
238	elmex	1.1
239	elmex	1.8	=item roster_update => $roster, $contacts
240
241			This event is emitted when a roster update has been received.
242			C<$contacts> is an array reference of L<Net::XMPP2::IM::Contact> objects
243	elmex	1.9	which have changed. If a contact was removed it will return 'remove'
244			when you call the C<subscription> method on it.
245
246	elmex	1.10	The first time this event is sent is when the roster was received
247			for the first time.
248
249	elmex	1.9	=item roster_error => $error
250
251			If an error happened during retrival of the roster this event will
252			be generated.
253			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
254	elmex	1.8
255			=item presence_update => $roster, $contact, $old_presence, $new_presence
256
257			This event is emitted when the presence of a contact has changed.
258			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
259			has changed.
260			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
261			presence prior to the change.
262			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
263			presence after to the change.
264
265	elmex	1.13	=item presence_error => $error
266
267			This event is emitted when a presence stanza error was received.
268			C<$error> will be an L<Net::XMPP2::Error::Presence> error object.
269
270	elmex	1.8	=item message => $msg
271
272			This event is emitted when a message was received.
273			C<$msg> is a L<Net::XMPP2::IM::Message> object.
274
275	elmex	1.13	=item message_error => $error
276
277			This event is emitted when a message stanza error was received.
278			C<$error> will be an L<Net::XMPP2::Error::Message> error object.
279
280	elmex	1.12	=item contact_request_subscribe => $roster, $contact, $rdoit
281
282			This event is generated when the C<$contact> wants to subscribe
283			to your presence. C<$rdoit> is a reference to a scalar. Setting
284			the referenced scalar to 1 will accept the subscription request and send
285			a subscribed presence.
286
287			If you want to accept or decline the request laster call
288			L<Net::XMPP2::IM::Contact::send_subscribed> or
289			L<Net::XMPP2::IM::Contact::send_unsubscribed> on C<$contact>.
290
291			=item contact_subscribed => $roster, $contact
292
293			This event is generated when C<$contact> subscribed to your presence successfully.
294
295			=item contact_did_unsubscribe => $roster, $contact, $rdoit
296
297			This event is generated when C<$contact> unsubscribes from your presence.
298			Setting the in C<$rdoit> referenced scalar to 1 will also let you unsubscribe
299			from his presence.
300
301			If you want to unsubscribe later from him call L<Net::XMPP2::IM::Contact::send_unsubscribed> on C<$contact>.
302
303			=item contact_unsubscribed => $roster, $contact
304
305			This event is generated when C<$contact> unsubscribed you from his presence.
306
307			=item
308
309	elmex	1.1	=back
310
311			=head1 AUTHOR
312
313			Robin Redeker, C<< <elmex at ta-sa.org> >>
314
315			=head1 COPYRIGHT & LICENSE
316
317			Copyright 2007 Robin Redeker, all rights reserved.
318
319			This program is free software; you can redistribute it and/or modify it
320			under the same terms as Perl itself.
321
322			=cut
323
324			1; # End of Net::XMPP2