XMPP2/IM/Connection.pm

package Net::XMPP2::IM::Connection;
use warnings;
use strict;
use Net::XMPP2::Connection;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
our @ISA = qw/Net::XMPP2::Connection/;

=head1 NAME

Net::XMPP2::Connection - A XML stream that implements the XMPP RFC 3920.

=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->reg_cb (message  => sub { $self->handle_message (@_); 1 });
   $self->reg_cb (presence => sub { $self->handle_presence (@_); 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);
      }
   });
}

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

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/]);

      my $ro = $self->{roster}->{$jid} = {
         jid          => $jid,
         name         => $name,
         subscription => $subscription,
         groups       => [ @groups ]
      };
   }

   $self->event ('roster_update');
}

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

}

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

=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.3
Committed:	Fri Feb 2 23:24:39 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.2:	+40 -0 lines
Log Message:	lots of changes. added roster retrival
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::IM::Connection;
2			use warnings;
3			use strict;
4			use Net::XMPP2::Connection;
5			use Net::XMPP2::Namespaces qw/xmpp_ns/;
6			our @ISA = qw/Net::XMPP2::Connection/;
7
8			=head1 NAME
9
10			Net::XMPP2::Connection - A XML stream that implements the XMPP RFC 3920.
11
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
39			$self->reg_cb (message => sub { $self->handle_message (@_); 1 });
40			$self->reg_cb (presence => sub { $self->handle_presence (@_); 1 });
41
42	elmex	1.1	$self->reg_cb (stream_ready => sub {
43			my ($jid) = @_;
44	elmex	1.2	if ($self->features ()->find_all ([qw/session session/])) {
45			$self->send_session_iq;
46			} else {
47			$self->{session_active} = 1;
48			$self->send_presence ();
49	elmex	1.1	$self->event ('session_ready');
50	elmex	1.2	}
51	elmex	1.1	});
52			$self
53			}
54
55	elmex	1.2	sub send_session_iq {
56			my ($self) = @_;
57
58			$self->send_iq (set => sub {
59			my ($w) = @_;
60			$w->addPrefix (xmpp_ns ('session'), '');
61			$w->emptyTag ([xmpp_ns ('session'), 'session']);
62
63			}, sub {
64			my ($node, $errnode, $errar) = @_;
65			if ($node) {
66			$self->{session_active} = 1;
67			$self->send_presence;
68	elmex	1.3	$self->retrieve_roster;
69	elmex	1.2	$self->event ('session_ready');
70			} else {
71			$self->event (session_error => $errnode, $errar);
72			}
73			});
74			}
75
76	elmex	1.3	sub retrieve_roster {
77			my ($self) = @_;
78			$self->send_iq (get => sub {
79			my ($w) = @_;
80			$w->addPrefix (xmpp_ns ('roster'), '');
81			$w->emptyTag ([xmpp_ns ('roster'), 'query']);
82			}, sub {
83			my ($node, $errnode, $errar) = @_;
84			if ($node) {
85			$self->store_roster ($node);
86			} else {
87			$self->event (roster_error => $errnode, $errar);
88			}
89			});
90			}
91
92			sub store_roster {
93			my ($self, $node) = @_;
94
95			my ($query) = $node->find_all ([qw/roster query/]);
96			return unless $query;
97
98			for my $item ($query->find_all ([qw/roster item/])) {
99			my ($jid, $name, $subscription) =
100			($item->attr ('jid'), $item->attr ('name'), $item->attr ('subscription'));
101			my @groups;
102			push @groups, $_->text for $item->find_all ([qw/roster group/]);
103
104			my $ro = $self->{roster}->{$jid} = {
105			jid => $jid,
106			name => $name,
107			subscription => $subscription,
108			groups => [ @groups ]
109			};
110			}
111
112			$self->event ('roster_update');
113			}
114
115	elmex	1.2	sub handle_presence {
116			my ($self) = @_;
117
118			}
119
120			sub handle_message {
121			my ($self) = @_;
122			}
123
124	elmex	1.1	=head1 EVENTS
125
126			These additional events can be registered on with C<reg_cb>:
127
128			=over 4
129
130			=item session_ready
131
132	elmex	1.2	This event is generated when the session has been fully established and
133			can be used to send around messages and other stuff.
134
135			=item session_error => $erriq, $errarr
136
137			If an error happened during establishment of the session this
138			event will be generated. C<$erriq> is the L<Net::XMPP2::Node> object
139			of the error iq tag and C<$errar> is an error array as described in
140			L<Net::XMPP2::Connection::send_iq> for error responses for iq requests.
141	elmex	1.1
142			=back
143
144			=head1 AUTHOR
145
146			Robin Redeker, C<< <elmex at ta-sa.org> >>
147
148			=head1 BUGS
149
150			Please report any bugs or feature requests to
151			C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
152			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
153			I will be notified, and then you'll automatically be notified of progress on
154			your bug as I make changes.
155
156			=head1 SUPPORT
157
158			You can find documentation for this module with the perldoc command.
159
160			perldoc Net::XMPP2
161
162			You can also look for information at:
163
164			=over 4
165
166			=item * AnnoCPAN: Annotated CPAN documentation
167
168			L<http://annocpan.org/dist/Net-XMPP2>
169
170			=item * CPAN Ratings
171
172			L<http://cpanratings.perl.org/d/Net-XMPP2>
173
174			=item * RT: CPAN's request tracker
175
176			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>
177
178			=item * Search CPAN
179
180			L<http://search.cpan.org/dist/Net-XMPP2>
181
182			=back
183
184			=head1 ACKNOWLEDGEMENTS
185
186			=head1 COPYRIGHT & LICENSE
187
188			Copyright 2007 Robin Redeker, all rights reserved.
189
190			This program is free software; you can redistribute it and/or modify it
191			under the same terms as Perl itself.
192
193			=cut
194
195
196
197			1; # End of Net::XMPP2