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) = @_;
   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>:

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 message => $msg

This event is emitted when a message was received.
C<$msg> is a L<Net::XMPP2::IM::Message> 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.12
Committed:	Sun Jun 24 10:41:58 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.11:	+32 -4 lines
Log Message:	finished subscription implementation and also added the possibility of forwarding all events of an object to some other object and forwarded all events from a IM::Connection to the Client.
#	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.9	my ($contact, $old, $new) = $self->{roster}->update_presence ($node);
169			$self->event (presence_update => $self->{roster}, $contact, $old, $new)
170	elmex	1.2	}
171
172			sub handle_message {
173	elmex	1.6	my ($self, $node) = @_;
174
175			my $from = $node->attr ('from');
176			my $to = $node->attr ('to');
177			my $type = $node->attr ('type');
178			my ($thread) = $node->find_all ([qw/client thread/]);
179
180			my %bodies;
181			my %subjects;
182
183			$bodies{$_->attr ('lang') \|\| ''} = $_->text
184			for $node->find_all ([qw/client body/]);
185			$subjects{$_->attr ('lang') \|\| ''} = $_->text
186			for $node->find_all ([qw/client subject/]);
187
188			my $msg =
189			Net::XMPP2::IM::Message->new (
190			connection => $self,
191			from => $from,
192			to => $to,
193			type => $type,
194			bodies => \%bodies,
195			subjects => \%subjects,
196			thread => $thread
197			);
198
199			$self->event (message => $msg);
200	elmex	1.2	}
201
202	elmex	1.5	sub handle_disconnect {
203			my ($self) = @_;
204			delete $self->{roster};
205			}
206
207	elmex	1.1	=head1 EVENTS
208
209			These additional events can be registered on with C<reg_cb>:
210
211	elmex	1.12	In the following events C<$roster> is the L<Net::XMPP2::IM::Roster>
212			object you get by calling C<get_roster>.
213
214	elmex	1.1	=over 4
215
216			=item session_ready
217
218	elmex	1.2	This event is generated when the session has been fully established and
219			can be used to send around messages and other stuff.
220
221	elmex	1.9	=item session_error => $error
222	elmex	1.2
223			If an error happened during establishment of the session this
224	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
225			error object.
226	elmex	1.1
227	elmex	1.8	=item roster_update => $roster, $contacts
228
229			This event is emitted when a roster update has been received.
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	elmex	1.10	The first time this event is sent is when the roster was received
235			for the first time.
236
237	elmex	1.9	=item roster_error => $error
238
239			If an error happened during retrival of the roster this event will
240			be generated.
241			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
242	elmex	1.8
243			=item presence_update => $roster, $contact, $old_presence, $new_presence
244
245			This event is emitted when the presence of a contact has changed.
246			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
247			has changed.
248			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
249			presence prior to the change.
250			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
251			presence after to the change.
252
253			=item message => $msg
254
255			This event is emitted when a message was received.
256			C<$msg> is a L<Net::XMPP2::IM::Message> object.
257
258	elmex	1.12	=item contact_request_subscribe => $roster, $contact, $rdoit
259
260			This event is generated when the C<$contact> wants to subscribe
261			to your presence. C<$rdoit> is a reference to a scalar. Setting
262			the referenced scalar to 1 will accept the subscription request and send
263			a subscribed presence.
264
265			If you want to accept or decline the request laster call
266			L<Net::XMPP2::IM::Contact::send_subscribed> or
267			L<Net::XMPP2::IM::Contact::send_unsubscribed> on C<$contact>.
268
269			=item contact_subscribed => $roster, $contact
270
271			This event is generated when C<$contact> subscribed to your presence successfully.
272
273			=item contact_did_unsubscribe => $roster, $contact, $rdoit
274
275			This event is generated when C<$contact> unsubscribes from your presence.
276			Setting the in C<$rdoit> referenced scalar to 1 will also let you unsubscribe
277			from his presence.
278
279			If you want to unsubscribe later from him call L<Net::XMPP2::IM::Contact::send_unsubscribed> on C<$contact>.
280
281			=item contact_unsubscribed => $roster, $contact
282
283			This event is generated when C<$contact> unsubscribed you from his presence.
284
285			=item
286
287	elmex	1.1	=back
288
289			=head1 AUTHOR
290
291			Robin Redeker, C<< <elmex at ta-sa.org> >>
292
293			=head1 COPYRIGHT & LICENSE
294
295			Copyright 2007 Robin Redeker, all rights reserved.
296
297			This program is free software; you can redistribute it and/or modify it
298			under the same terms as Perl itself.
299
300			=cut
301
302			1; # End of Net::XMPP2