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, $errnode, $errar) = @_;
      if ($node) {
         $self->init_connection;
      } else {
         $self->event (session_error => $errnode, $errar); # 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 (1);
   }
   $self->event ('session_ready');
}

sub retrieve_roster {
   my ($self, $init) = @_;

   $self->send_iq (get => sub {
      my ($w) = @_;
      $w->addPrefix (xmpp_ns ('roster'), '');
      $w->emptyTag ([xmpp_ns ('roster'), 'query']);

   }, sub {
      my ($node, $errnode, $errar) = @_;
      if ($node) {
         $self->store_roster ($node);
      } else {
         $self->event (roster_error => $errnode, $errar); # TODO: make error obj
      }

      $self->send_presence if $init;
   });
}

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

   my ($query) = $node->find_all ([qw/roster query/]);
   return unless $query;

   for my $item ($query->find_all ([qw/roster item/])) {
      my ($jid, $name, $subscription) =
         ($item->attr ('jid'), $item->attr ('name'), $item->attr ('subscription'));
      my @groups;
      push @groups, $_->text for $item->find_all ([qw/roster group/]);

      $self->{roster}->set_contact ($jid,
         name         => $name,
         subscription => $subscription,
         groups       => [ @groups ]
      );
   }

   $self->event (roster_update => $self->{roster});
}

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, sub {});
   }
}

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

   my $type       = $node->attr ('type');
   my ($show)     = $node->find_all ([qw/client show/]);
   my ($priority) = $node->find_all ([qw/client priority/]);

   my $jid = $node->attr ('from');

   my %stati;
   $stati{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client status/]);

   $self->{roster}->set_presence ($jid,
      show     => $show     ? $show->text     : undef,
      priority => $priority ? $priority->text : undef,
      type     => $type,
      status   => \%stati,
   );

   $self->event (presence_update => $self->{roster}, $self->{roster}->get_contact ($jid))
}

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 => $erriq, $errarr

If an error happened during establishment of the session this
event will be generated. C<$erriq> is the L<Net::XMPP2::Node> object
of the error iq tag and C<$errar> is an error array as described in
L<Net::XMPP2::Connection::send_iq> for error responses for iq requests.

=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.7
Committed:	Fri Feb 9 20:23:06 2007 UTC (19 years, 7 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+39 -48 lines
Log Message:	removed unneccessary documentation and added neglected documentation.
#	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			my ($node, $errnode, $errar) = @_;
94			if ($node) {
95	elmex	1.7	$self->init_connection;
96	elmex	1.2	} else {
97	elmex	1.4	$self->event (session_error => $errnode, $errar); # 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			$self->retrieve_roster (1);
109			}
110			$self->event ('session_ready');
111			}
112
113	elmex	1.3	sub retrieve_roster {
114	elmex	1.7	my ($self, $init) = @_;
115	elmex	1.4
116	elmex	1.3	$self->send_iq (get => sub {
117			my ($w) = @_;
118			$w->addPrefix (xmpp_ns ('roster'), '');
119			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
120	elmex	1.4
121	elmex	1.3	}, sub {
122			my ($node, $errnode, $errar) = @_;
123			if ($node) {
124			$self->store_roster ($node);
125			} else {
126	elmex	1.4	$self->event (roster_error => $errnode, $errar); # TODO: make error obj
127	elmex	1.3	}
128	elmex	1.7
129			$self->send_presence if $init;
130	elmex	1.3	});
131			}
132
133			sub store_roster {
134			my ($self, $node) = @_;
135
136			my ($query) = $node->find_all ([qw/roster query/]);
137			return unless $query;
138
139			for my $item ($query->find_all ([qw/roster item/])) {
140			my ($jid, $name, $subscription) =
141			($item->attr ('jid'), $item->attr ('name'), $item->attr ('subscription'));
142			my @groups;
143			push @groups, $_->text for $item->find_all ([qw/roster group/]);
144
145	elmex	1.5	$self->{roster}->set_contact ($jid,
146	elmex	1.3	name => $name,
147			subscription => $subscription,
148			groups => [ @groups ]
149	elmex	1.5	);
150	elmex	1.3	}
151
152	elmex	1.5	$self->event (roster_update => $self->{roster});
153			}
154
155			sub get_roster {
156			my ($self) = @_;
157			$self->{roster}
158			}
159
160			sub handle_iq_set {
161			my ($self, $node, $rhandled) = @_;
162
163			if ($node->find_all ([qw/roster query/])) {
164			$self->store_roster ($node);
165			$self->reply_iq_result ($node, sub {});
166			}
167	elmex	1.3	}
168
169	elmex	1.2	sub handle_presence {
170	elmex	1.5	my ($self, $node) = @_;
171
172			my $type = $node->attr ('type');
173			my ($show) = $node->find_all ([qw/client show/]);
174			my ($priority) = $node->find_all ([qw/client priority/]);
175
176			my $jid = $node->attr ('from');
177
178	elmex	1.6	my %stati;
179			$stati{$_->attr ('lang') \|\| ''} = $_->text
180	elmex	1.5	for $node->find_all ([qw/client status/]);
181
182			$self->{roster}->set_presence ($jid,
183			show => $show ? $show->text : undef,
184			priority => $priority ? $priority->text : undef,
185			type => $type,
186	elmex	1.6	status => \%stati,
187	elmex	1.5	);
188	elmex	1.2
189	elmex	1.5	$self->event (presence_update => $self->{roster}, $self->{roster}->get_contact ($jid))
190	elmex	1.2	}
191
192			sub handle_message {
193	elmex	1.6	my ($self, $node) = @_;
194
195			my $from = $node->attr ('from');
196			my $to = $node->attr ('to');
197			my $type = $node->attr ('type');
198			my ($thread) = $node->find_all ([qw/client thread/]);
199
200			my %bodies;
201			my %subjects;
202
203			$bodies{$_->attr ('lang') \|\| ''} = $_->text
204			for $node->find_all ([qw/client body/]);
205			$subjects{$_->attr ('lang') \|\| ''} = $_->text
206			for $node->find_all ([qw/client subject/]);
207
208			my $msg =
209			Net::XMPP2::IM::Message->new (
210			connection => $self,
211			from => $from,
212			to => $to,
213			type => $type,
214			bodies => \%bodies,
215			subjects => \%subjects,
216			thread => $thread
217			);
218
219			$self->event (message => $msg);
220	elmex	1.2	}
221
222	elmex	1.5	sub handle_disconnect {
223			my ($self) = @_;
224			delete $self->{roster};
225			}
226
227	elmex	1.1	=head1 EVENTS
228
229			These additional events can be registered on with C<reg_cb>:
230
231			=over 4
232
233			=item session_ready
234
235	elmex	1.2	This event is generated when the session has been fully established and
236			can be used to send around messages and other stuff.
237
238			=item session_error => $erriq, $errarr
239
240			If an error happened during establishment of the session this
241			event will be generated. C<$erriq> is the L<Net::XMPP2::Node> object
242			of the error iq tag and C<$errar> is an error array as described in
243			L<Net::XMPP2::Connection::send_iq> for error responses for iq requests.
244	elmex	1.1
245			=back
246
247			=head1 AUTHOR
248
249			Robin Redeker, C<< <elmex at ta-sa.org> >>
250
251			=head1 COPYRIGHT & LICENSE
252
253			Copyright 2007 Robin Redeker, all rights reserved.
254
255			This program is free software; you can redistribute it and/or modify it
256			under the same terms as Perl itself.
257
258			=cut
259
260			1; # End of Net::XMPP2