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

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->{session_active} = 1;
         $self->send_presence ();
         $self->event ('session_ready');
      }
   });
   $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->{session_active} = 1;
         $self->send_presence;
         $self->retrieve_roster;
         $self->event ('session_ready');
      } else {
         $self->event (session_error => $errnode, $errar); # TODO: make error obj
      }
   });
}

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

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

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

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 BUGS

Please report any bugs or feature requests to
C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::XMPP2

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-XMPP2>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-XMPP2>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-XMPP2>

=back

=head1 ACKNOWLEDGEMENTS

=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.5
Committed:	Tue Feb 6 22:52:45 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+52 -9 lines
Log Message:	implemented firts parts of roster handling. added jid handling functions.
#	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.1	our @ISA = qw/Net::XMPP2::Connection/;
7
8			=head1 NAME
9
10	elmex	1.5	Net::XMPP2::IM::Connection - A XML stream that implements the XMPP RFC 3921.
11	elmex	1.1
12			=head1 SYNOPSIS
13
14			use Net::XMPP2::Connection;
15
16			my $con = Net::XMPP2::Connection->new;
17
18			=head1 DESCRIPTION
19
20			This module represents a XMPP instant messaging connection and implements
21			RFC 3921.
22
23			This module is a subclass of C<Net::XMPP2::Connection> and inherits all methods.
24			For example C<reg_cb> and the stanza sending routines.
25
26			For additional events that can be registered to look below in the EVENTS section.
27
28			=head1 METHODS
29
30			=cut
31
32			sub new {
33			my $this = shift;
34			my $class = ref($this) \|\| $this;
35			my $self = $class->SUPER::new (@_);
36	elmex	1.2
37			$self->{ext} = {}; # reserved for extensions
38	elmex	1.5	$self->{roster} = Net::XMPP2::IM::Roster->new (connection => $self);
39	elmex	1.2
40	elmex	1.5	$self->reg_cb (message_xml =>
41			sub { shift @_; $self->handle_message (@_); 1 });
42			$self->reg_cb (presence_xml =>
43			sub { shift @_; $self->handle_presence (@_); 1 });
44			$self->reg_cb (iq_set_request_xml =>
45			sub { shift @_; $self->handle_iq_set (@_); 1 });
46			$self->reg_cb (disconnect =>
47			sub { shift @_; $self->handle_disconnect (@_); 1 });
48	elmex	1.2
49	elmex	1.1	$self->reg_cb (stream_ready => sub {
50			my ($jid) = @_;
51	elmex	1.2	if ($self->features ()->find_all ([qw/session session/])) {
52			$self->send_session_iq;
53			} else {
54			$self->{session_active} = 1;
55			$self->send_presence ();
56	elmex	1.1	$self->event ('session_ready');
57	elmex	1.2	}
58	elmex	1.1	});
59			$self
60			}
61
62	elmex	1.2	sub send_session_iq {
63			my ($self) = @_;
64
65			$self->send_iq (set => sub {
66			my ($w) = @_;
67			$w->addPrefix (xmpp_ns ('session'), '');
68			$w->emptyTag ([xmpp_ns ('session'), 'session']);
69
70			}, sub {
71			my ($node, $errnode, $errar) = @_;
72			if ($node) {
73			$self->{session_active} = 1;
74			$self->send_presence;
75	elmex	1.3	$self->retrieve_roster;
76	elmex	1.2	$self->event ('session_ready');
77			} else {
78	elmex	1.4	$self->event (session_error => $errnode, $errar); # TODO: make error obj
79	elmex	1.2	}
80			});
81			}
82
83	elmex	1.3	sub retrieve_roster {
84			my ($self) = @_;
85	elmex	1.4
86	elmex	1.3	$self->send_iq (get => sub {
87			my ($w) = @_;
88			$w->addPrefix (xmpp_ns ('roster'), '');
89			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
90	elmex	1.4
91	elmex	1.3	}, sub {
92			my ($node, $errnode, $errar) = @_;
93			if ($node) {
94			$self->store_roster ($node);
95			} else {
96	elmex	1.4	$self->event (roster_error => $errnode, $errar); # TODO: make error obj
97	elmex	1.3	}
98			});
99			}
100
101			sub store_roster {
102			my ($self, $node) = @_;
103
104			my ($query) = $node->find_all ([qw/roster query/]);
105			return unless $query;
106
107			for my $item ($query->find_all ([qw/roster item/])) {
108			my ($jid, $name, $subscription) =
109			($item->attr ('jid'), $item->attr ('name'), $item->attr ('subscription'));
110			my @groups;
111			push @groups, $_->text for $item->find_all ([qw/roster group/]);
112
113	elmex	1.5	$self->{roster}->set_contact ($jid,
114	elmex	1.3	name => $name,
115			subscription => $subscription,
116			groups => [ @groups ]
117	elmex	1.5	);
118	elmex	1.3	}
119
120	elmex	1.5	$self->event (roster_update => $self->{roster});
121			}
122
123			sub get_roster {
124			my ($self) = @_;
125			$self->{roster}
126			}
127
128			sub handle_iq_set {
129			my ($self, $node, $rhandled) = @_;
130
131			if ($node->find_all ([qw/roster query/])) {
132			$self->store_roster ($node);
133			$self->reply_iq_result ($node, sub {});
134			}
135	elmex	1.3	}
136
137	elmex	1.2	sub handle_presence {
138	elmex	1.5	my ($self, $node) = @_;
139
140			my $type = $node->attr ('type');
141			my ($show) = $node->find_all ([qw/client show/]);
142			my ($priority) = $node->find_all ([qw/client priority/]);
143
144			my $jid = $node->attr ('from');
145
146			my @stati;
147			push @stati, [$_->attr ('lang'), $_->text]
148			for $node->find_all ([qw/client status/]);
149
150			$self->{roster}->set_presence ($jid,
151			show => $show ? $show->text : undef,
152			priority => $priority ? $priority->text : undef,
153			type => $type,
154			status => \@stati,
155			);
156	elmex	1.2
157	elmex	1.5	$self->event (presence_update => $self->{roster}, $self->{roster}->get_contact ($jid))
158	elmex	1.2	}
159
160			sub handle_message {
161			my ($self) = @_;
162			}
163
164	elmex	1.5	sub handle_disconnect {
165			my ($self) = @_;
166			delete $self->{roster};
167			}
168
169	elmex	1.1	=head1 EVENTS
170
171			These additional events can be registered on with C<reg_cb>:
172
173			=over 4
174
175			=item session_ready
176
177	elmex	1.2	This event is generated when the session has been fully established and
178			can be used to send around messages and other stuff.
179
180			=item session_error => $erriq, $errarr
181
182			If an error happened during establishment of the session this
183			event will be generated. C<$erriq> is the L<Net::XMPP2::Node> object
184			of the error iq tag and C<$errar> is an error array as described in
185			L<Net::XMPP2::Connection::send_iq> for error responses for iq requests.
186	elmex	1.1
187			=back
188
189			=head1 AUTHOR
190
191			Robin Redeker, C<< <elmex at ta-sa.org> >>
192
193			=head1 BUGS
194
195			Please report any bugs or feature requests to
196			C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
197			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
198			I will be notified, and then you'll automatically be notified of progress on
199			your bug as I make changes.
200
201			=head1 SUPPORT
202
203			You can find documentation for this module with the perldoc command.
204
205			perldoc Net::XMPP2
206
207			You can also look for information at:
208
209			=over 4
210
211			=item * AnnoCPAN: Annotated CPAN documentation
212
213			L<http://annocpan.org/dist/Net-XMPP2>
214
215			=item * CPAN Ratings
216
217			L<http://cpanratings.perl.org/d/Net-XMPP2>
218
219			=item * RT: CPAN's request tracker
220
221			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>
222
223			=item * Search CPAN
224
225			L<http://search.cpan.org/dist/Net-XMPP2>
226
227			=back
228
229			=head1 ACKNOWLEDGEMENTS
230
231			=head1 COPYRIGHT & LICENSE
232
233			Copyright 2007 Robin Redeker, all rights reserved.
234
235			This program is free software; you can redistribute it and/or modify it
236			under the same terms as Perl itself.
237
238			=cut
239
240
241
242			1; # End of Net::XMPP2