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->{ext} = {}; # reserved for extensions
   $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) = @_;
   my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
   $self->event (presence_update => $self->{roster}, $contact, $old, $new)
}

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

   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>:

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

=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<$roster> is the L<Net::XMPP2::IM::Roster> object you get by
calling C<get_roster>.
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 message => $msg

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

=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.9
Committed:	Sun Apr 22 14:36:52 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.8:	+36 -55 lines
Log Message:	implemented addition/removal/update of roster items and first functionality for subscription.
#	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			$self->{ext} = {}; # reserved for extensions
62	elmex	1.5	$self->{roster} = Net::XMPP2::IM::Roster->new (connection => $self);
63	elmex	1.2
64	elmex	1.5	$self->reg_cb (message_xml =>
65			sub { shift @_; $self->handle_message (@_); 1 });
66			$self->reg_cb (presence_xml =>
67			sub { shift @_; $self->handle_presence (@_); 1 });
68			$self->reg_cb (iq_set_request_xml =>
69			sub { shift @_; $self->handle_iq_set (@_); 1 });
70			$self->reg_cb (disconnect =>
71			sub { shift @_; $self->handle_disconnect (@_); 1 });
72	elmex	1.2
73	elmex	1.1	$self->reg_cb (stream_ready => sub {
74			my ($jid) = @_;
75	elmex	1.2	if ($self->features ()->find_all ([qw/session session/])) {
76			$self->send_session_iq;
77			} else {
78	elmex	1.7	$self->init_connection;
79	elmex	1.2	}
80	elmex	1.1	});
81			$self
82			}
83
84	elmex	1.2	sub send_session_iq {
85			my ($self) = @_;
86
87			$self->send_iq (set => sub {
88			my ($w) = @_;
89			$w->addPrefix (xmpp_ns ('session'), '');
90			$w->emptyTag ([xmpp_ns ('session'), 'session']);
91
92			}, sub {
93	elmex	1.9	my ($node, $error) = @_;
94	elmex	1.2	if ($node) {
95	elmex	1.7	$self->init_connection;
96	elmex	1.2	} else {
97	elmex	1.9	$self->event (session_error => $error); # TODO: make error obj
98	elmex	1.2	}
99			});
100			}
101
102	elmex	1.7	sub init_connection {
103			my ($self) = @_;
104			$self->{session_active} = 1;
105			if ($self->{dont_retrieve_roster}) {
106			$self->send_presence;
107			} else {
108	elmex	1.9	$self->retrieve_roster (sub { $self->send_presence });
109	elmex	1.7	}
110			$self->event ('session_ready');
111			}
112
113	elmex	1.9	=head2 retrieve_roster ($cb)
114
115			This method initiates a roster request. If you set C<dont_retrieve_roster>
116			when creating this connection no roster was retrieved.
117			You can do that with this method. The coderef in C<$cb> will be
118			called after the roster was retrieved.
119
120			The first argument of the callback in C<$cb> will be the roster
121			and the second will be a L<Net::XMPP2::Error::IQ> object when
122			an error occured while retrieving the roster.
123
124			=cut
125
126	elmex	1.3	sub retrieve_roster {
127	elmex	1.9	my ($self, $cb) = @_;
128	elmex	1.4
129	elmex	1.3	$self->send_iq (get => sub {
130			my ($w) = @_;
131			$w->addPrefix (xmpp_ns ('roster'), '');
132			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
133	elmex	1.4
134	elmex	1.3	}, sub {
135	elmex	1.9	my ($node, $error) = @_;
136	elmex	1.3	if ($node) {
137			$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			sub get_roster {
153			my ($self) = @_;
154			$self->{roster}
155			}
156
157			sub handle_iq_set {
158			my ($self, $node, $rhandled) = @_;
159
160			if ($node->find_all ([qw/roster query/])) {
161			$self->store_roster ($node);
162	elmex	1.9	$self->reply_iq_result ($node);
163			$$rhandled = 1
164	elmex	1.5	}
165	elmex	1.3	}
166
167	elmex	1.2	sub handle_presence {
168	elmex	1.5	my ($self, $node) = @_;
169	elmex	1.9	my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
170			$self->event (presence_update => $self->{roster}, $contact, $old, $new)
171	elmex	1.2	}
172
173			sub handle_message {
174	elmex	1.6	my ($self, $node) = @_;
175
176			my $from = $node->attr ('from');
177			my $to = $node->attr ('to');
178			my $type = $node->attr ('type');
179			my ($thread) = $node->find_all ([qw/client thread/]);
180
181			my %bodies;
182			my %subjects;
183
184			$bodies{$_->attr ('lang') \|\| ''} = $_->text
185			for $node->find_all ([qw/client body/]);
186			$subjects{$_->attr ('lang') \|\| ''} = $_->text
187			for $node->find_all ([qw/client subject/]);
188
189			my $msg =
190			Net::XMPP2::IM::Message->new (
191			connection => $self,
192			from => $from,
193			to => $to,
194			type => $type,
195			bodies => \%bodies,
196			subjects => \%subjects,
197			thread => $thread
198			);
199
200			$self->event (message => $msg);
201	elmex	1.2	}
202
203	elmex	1.5	sub handle_disconnect {
204			my ($self) = @_;
205			delete $self->{roster};
206			}
207
208	elmex	1.1	=head1 EVENTS
209
210			These additional events can be registered on with C<reg_cb>:
211
212			=over 4
213
214			=item session_ready
215
216	elmex	1.2	This event is generated when the session has been fully established and
217			can be used to send around messages and other stuff.
218
219	elmex	1.9	=item session_error => $error
220	elmex	1.2
221			If an error happened during establishment of the session this
222	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
223			error object.
224	elmex	1.1
225	elmex	1.8	=item roster_update => $roster, $contacts
226
227			This event is emitted when a roster update has been received.
228			C<$roster> is the L<Net::XMPP2::IM::Roster> object you get by
229			calling C<get_roster>.
230			C<$contacts> is an array reference of L<Net::XMPP2::IM::Contact> objects
231	elmex	1.9	which have changed. If a contact was removed it will return 'remove'
232			when you call the C<subscription> method on it.
233
234			=item roster_error => $error
235
236			If an error happened during retrival of the roster this event will
237			be generated.
238			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
239	elmex	1.8
240			=item presence_update => $roster, $contact, $old_presence, $new_presence
241
242			This event is emitted when the presence of a contact has changed.
243			C<$roster> is the L<Net::XMPP2::IM::Roster> object you get by
244			calling C<get_roster>.
245			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
246			has changed.
247			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
248			presence prior to the change.
249			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
250			presence after to the change.
251
252			=item message => $msg
253
254			This event is emitted when a message was received.
255			C<$msg> is a L<Net::XMPP2::IM::Message> object.
256
257	elmex	1.1	=back
258
259			=head1 AUTHOR
260
261			Robin Redeker, C<< <elmex at ta-sa.org> >>
262
263			=head1 COPYRIGHT & LICENSE
264
265			Copyright 2007 Robin Redeker, all rights reserved.
266
267			This program is free software; you can redistribute it and/or modify it
268			under the same terms as Perl itself.
269
270			=cut
271
272			1; # End of Net::XMPP2