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

=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.

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<$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.11
Committed:	Tue Apr 24 18:11:10 2007 UTC (19 years, 6 months ago) by elmex
Branch:	MAIN
Changes since 1.10:	+0 -1 lines
Log Message:	removed extension mechanisms which don't seem neccessary to me anymore. noone wants XMPP without the XEPs (at least not me).
#	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			=over 4
212
213			=item session_ready
214
215	elmex	1.2	This event is generated when the session has been fully established and
216			can be used to send around messages and other stuff.
217
218	elmex	1.9	=item session_error => $error
219	elmex	1.2
220			If an error happened during establishment of the session this
221	elmex	1.9	event will be generated. C<$error> will be an L<Net::XMPP2::Error::IQ>
222			error object.
223	elmex	1.1
224	elmex	1.8	=item roster_update => $roster, $contacts
225
226			This event is emitted when a roster update has been received.
227			C<$roster> is the L<Net::XMPP2::IM::Roster> object you get by
228			calling C<get_roster>.
229			C<$contacts> is an array reference of L<Net::XMPP2::IM::Contact> objects
230	elmex	1.9	which have changed. If a contact was removed it will return 'remove'
231			when you call the C<subscription> method on it.
232
233	elmex	1.10	The first time this event is sent is when the roster was received
234			for the first time.
235
236	elmex	1.9	=item roster_error => $error
237
238			If an error happened during retrival of the roster this event will
239			be generated.
240			C<$error> will be an L<Net::XMPP2::Error::IQ> error object.
241	elmex	1.8
242			=item presence_update => $roster, $contact, $old_presence, $new_presence
243
244			This event is emitted when the presence of a contact has changed.
245			C<$roster> is the L<Net::XMPP2::IM::Roster> object you get by
246			calling C<get_roster>.
247			C<$contact> is the L<Net::XMPP2::IM::Contact> object which presence status
248			has changed.
249			C<$old_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
250			presence prior to the change.
251			C<$new_presence> is a L<Net::XMPP2::IM::Presence> object which represents the
252			presence after to the change.
253
254			=item message => $msg
255
256			This event is emitted when a message was received.
257			C<$msg> is a L<Net::XMPP2::IM::Message> object.
258
259	elmex	1.1	=back
260
261			=head1 AUTHOR
262
263			Robin Redeker, C<< <elmex at ta-sa.org> >>
264
265			=head1 COPYRIGHT & LICENSE
266
267			Copyright 2007 Robin Redeker, all rights reserved.
268
269			This program is free software; you can redistribute it and/or modify it
270			under the same terms as Perl itself.
271
272			=cut
273
274			1; # End of Net::XMPP2