XMPP2/IM/Roster.pm

package Net::XMPP2::IM::Roster;
use Net::XMPP2::IM::Contact;
use Net::XMPP2::IM::Presence;
use strict;

=head1 NAME

Net::XMPP2::IM::Roster - A instant messaging roster for XMPP

=head1 SYNOPSIS

   my $con = Net::XMPP2::IM::Connection->new (...);
   ...
   my $ro  = $con->roster;
   if (my $c = $ro->get_contact ('test@example.com')) {
      $c->make_message ()->add_body ("Hello there!")->send;
   }

=head1 DESCRIPTION

This module represents a class for roster objects which contain
contact information.

It manages the roster of a JID connected by an L<Net::XMPP2::IM::Connection>.
It manages also the presence information that is received.

You get the roster by calling the C<roster> method on an L<Net::XMPP2::IM::Connection>
object. There is no other way.

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   bless { @_ }, $class;
}

sub touch_jid {
   my ($self, $jid) = @_;
   my $bjid = Net::XMPP2::Util::prep_bare_jid ($jid);

   unless ($self->{contacts}->{$bjid}) {
      $self->{contacts}->{$bjid} =
         Net::XMPP2::IM::Contact->new (
            connection => $self->{connection},
            jid        => Net::XMPP2::Util::bare_jid ($jid)
         )
   }

   $self->{contacts}->{$bjid}
}

sub set_presence {
   my ($self, $jid, %data) = @_;
   $self->touch_jid ($jid);
   $self->get_contact ($jid)->set_presence ($jid, %data);
}

sub set_contact {
   my ($self, $jid, %data) = @_;
   $self->touch_jid ($jid);
   $self->get_contact ($jid)->_set (%data);
}

=head2 get_contact ($jid)

Returns the contact on the roster with the JID C<$jid>.
(If C<$jid> is not bare the resource part will be stripped
before searching)

The return value is an instance of L<Net::XMPP2::IM::Contact>.

=cut

sub get_contact {
   my ($self, $jid) = @_;
   my $bjid = Net::XMPP2::Util::prep_bare_jid ($jid);
   $self->{contacts}->{$bjid}
}

=head2 get_contacts

Returns the contacts that are on this roster as
L<Net::XMPP2::IM::Contact> objects.

NOTE: This method only returns the contacts that have
a roster item. If you haven't retrieved the roster yet
the presence information is still stored but you have
to get the contacts without a roster item with the
C<get_contacts_off_roster> method. See below.

=cut

sub get_contacts {
   my ($self) = @_;
   grep {
      $_->subscription && $_->subscription ne ''
   } values %{$self->{contacts}}
}

=head2 get_contacts_off_roster

Returns the contacts that are not on the roster
but for which we have received presence.
Return value is a list of L<Net::XMPP2::IM::Contact> objects.

See also documentation of L<Net::XMPP2::IM::Roster::get_contacts>
above.

=cut

sub get_contacts_off_roster {
   my ($self) = @_;
   grep {
      not ($_->subscription) || $_->subscription eq ''
   } values %{$self->{contacts}}
}

=head2 debug_dump

This prints the roster and all it's contacts
and their presences.

=cut

sub debug_dump {
   my ($self) = @_;
   print "### ROSTER BEGIN ###\n";
   my %groups;
   for my $contact ($self->get_contacts) {
      push @{$groups{$_}}, $contact for $contact->groups;
      push @{$groups{''}}, $contact unless $contact->groups;
   }

   for my $grp (sort keys %groups) {
      print "=== $grp ====\n";
      $_->debug_dump for @{$groups{$grp}};
   }
   if ($self->get_contacts_off_roster) {
      print "### OFF ROSTER ###\n";
      %groups;
      for my $contact ($self->get_contacts_off_roster) {
         push @{$groups{$_}}, $contact for $contact->groups;
         push @{$groups{''}}, $contact unless $contact->groups;
      }

      for my $grp (sort keys %groups) {
         print "=== $grp ====\n";
         $_->debug_dump for @{$groups{$grp}};
      }
   }

   print "### ROSTER END ###\n";
}

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>

=head1 SEE ALSO

L<Net::XMPP2::IM::Connection>, L<Net::XMPP2::IM::Contact>, L<Net::XMPP2::IM::Presence>

=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 9 20:23:06 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.2:	+89 -179 lines
Log Message:	removed unneccessary documentation and added neglected documentation.
#	User	Rev	Content
1	elmex	1.3	package Net::XMPP2::IM::Roster;
2			use Net::XMPP2::IM::Contact;
3			use Net::XMPP2::IM::Presence;
4	elmex	1.1	use strict;
5
6			=head1 NAME
7
8			Net::XMPP2::IM::Roster - A instant messaging roster for XMPP
9
10			=head1 SYNOPSIS
11
12			my $con = Net::XMPP2::IM::Connection->new (...);
13			...
14	elmex	1.3	my $ro = $con->roster;
15			if (my $c = $ro->get_contact ('test@example.com')) {
16			$c->make_message ()->add_body ("Hello there!")->send;
17			}
18	elmex	1.1
19			=head1 DESCRIPTION
20
21			This module represents a class for roster objects which contain
22			contact information.
23
24	elmex	1.3	It manages the roster of a JID connected by an L<Net::XMPP2::IM::Connection>.
25			It manages also the presence information that is received.
26
27			You get the roster by calling the C<roster> method on an L<Net::XMPP2::IM::Connection>
28			object. There is no other way.
29
30	elmex	1.1	=cut
31
32			sub new {
33			my $this = shift;
34			my $class = ref($this) \|\| $this;
35			bless { @_ }, $class;
36			}
37
38			sub touch_jid {
39			my ($self, $jid) = @_;
40			my $bjid = Net::XMPP2::Util::prep_bare_jid ($jid);
41
42			unless ($self->{contacts}->{$bjid}) {
43			$self->{contacts}->{$bjid} =
44			Net::XMPP2::IM::Contact->new (
45			connection => $self->{connection},
46			jid => Net::XMPP2::Util::bare_jid ($jid)
47			)
48			}
49
50			$self->{contacts}->{$bjid}
51			}
52
53			sub set_presence {
54			my ($self, $jid, %data) = @_;
55	elmex	1.3	$self->touch_jid ($jid);
56	elmex	1.1	$self->get_contact ($jid)->set_presence ($jid, %data);
57			}
58
59			sub set_contact {
60			my ($self, $jid, %data) = @_;
61	elmex	1.3	$self->touch_jid ($jid);
62	elmex	1.1	$self->get_contact ($jid)->_set (%data);
63			}
64
65	elmex	1.3	=head2 get_contact ($jid)
66
67			Returns the contact on the roster with the JID C<$jid>.
68			(If C<$jid> is not bare the resource part will be stripped
69			before searching)
70
71			The return value is an instance of L<Net::XMPP2::IM::Contact>.
72
73			=cut
74
75	elmex	1.1	sub get_contact {
76			my ($self, $jid) = @_;
77	elmex	1.3	my $bjid = Net::XMPP2::Util::prep_bare_jid ($jid);
78			$self->{contacts}->{$bjid}
79			}
80
81			=head2 get_contacts
82
83			Returns the contacts that are on this roster as
84			L<Net::XMPP2::IM::Contact> objects.
85
86			NOTE: This method only returns the contacts that have
87			a roster item. If you haven't retrieved the roster yet
88			the presence information is still stored but you have
89			to get the contacts without a roster item with the
90			C<get_contacts_off_roster> method. See below.
91
92			=cut
93
94			sub get_contacts {
95			my ($self) = @_;
96			grep {
97			$_->subscription && $_->subscription ne ''
98			} values %{$self->{contacts}}
99			}
100
101			=head2 get_contacts_off_roster
102
103			Returns the contacts that are not on the roster
104			but for which we have received presence.
105			Return value is a list of L<Net::XMPP2::IM::Contact> objects.
106
107			See also documentation of L<Net::XMPP2::IM::Roster::get_contacts>
108			above.
109
110			=cut
111
112			sub get_contacts_off_roster {
113			my ($self) = @_;
114			grep {
115			not ($_->subscription) \|\| $_->subscription eq ''
116			} values %{$self->{contacts}}
117	elmex	1.1	}
118
119	elmex	1.3	=head2 debug_dump
120
121			This prints the roster and all it's contacts
122			and their presences.
123
124			=cut
125
126	elmex	1.1	sub debug_dump {
127			my ($self) = @_;
128			print "### ROSTER BEGIN ###\n";
129			my %groups;
130	elmex	1.3	for my $contact ($self->get_contacts) {
131	elmex	1.1	push @{$groups{$_}}, $contact for $contact->groups;
132			push @{$groups{''}}, $contact unless $contact->groups;
133			}
134
135			for my $grp (sort keys %groups) {
136			print "=== $grp ====\n";
137			$_->debug_dump for @{$groups{$grp}};
138			}
139	elmex	1.3	if ($self->get_contacts_off_roster) {
140			print "### OFF ROSTER ###\n";
141			%groups;
142			for my $contact ($self->get_contacts_off_roster) {
143			push @{$groups{$_}}, $contact for $contact->groups;
144			push @{$groups{''}}, $contact unless $contact->groups;
145			}
146
147			for my $grp (sort keys %groups) {
148			print "=== $grp ====\n";
149			$_->debug_dump for @{$groups{$grp}};
150			}
151			}
152
153	elmex	1.1	print "### ROSTER END ###\n";
154			}
155
156			=head1 AUTHOR
157
158			Robin Redeker, C<< <elmex at ta-sa.org> >>
159
160	elmex	1.3	=head1 SEE ALSO
161	elmex	1.1
162	elmex	1.3	L<Net::XMPP2::IM::Connection>, L<Net::XMPP2::IM::Contact>, L<Net::XMPP2::IM::Presence>
163	elmex	1.1
164			=head1 COPYRIGHT & LICENSE
165
166			Copyright 2007 Robin Redeker, all rights reserved.
167
168			This program is free software; you can redistribute it and/or modify it
169			under the same terms as Perl itself.
170
171			=cut
172
173
174
175			1; # End of Net::XMPP2