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 { $_->is_on_roster } 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 $_->is_on_roster } 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.4
Committed:	Fri Apr 20 14:56:45 2007 UTC (19 years, 6 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+4 -8 lines
Log Message:	implemented Client.pm. Implemented error objects which simplyfied the error reporting.
#	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.4	$self->get_contact ($jid)->set_presence ($jid, %data)
57	elmex	1.1	}
58
59			sub set_contact {
60			my ($self, $jid, %data) = @_;
61	elmex	1.3	$self->touch_jid ($jid);
62	elmex	1.4	$self->get_contact ($jid)->_set (%data)
63	elmex	1.1	}
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	elmex	1.4	grep { $_->is_on_roster } values %{$self->{contacts}}
97	elmex	1.3	}
98
99			=head2 get_contacts_off_roster
100
101			Returns the contacts that are not on the roster
102			but for which we have received presence.
103			Return value is a list of L<Net::XMPP2::IM::Contact> objects.
104
105			See also documentation of L<Net::XMPP2::IM::Roster::get_contacts>
106			above.
107
108			=cut
109
110			sub get_contacts_off_roster {
111			my ($self) = @_;
112	elmex	1.4	grep { not $_->is_on_roster } values %{$self->{contacts}}
113	elmex	1.1	}
114
115	elmex	1.3	=head2 debug_dump
116
117			This prints the roster and all it's contacts
118			and their presences.
119
120			=cut
121
122	elmex	1.1	sub debug_dump {
123			my ($self) = @_;
124			print "### ROSTER BEGIN ###\n";
125			my %groups;
126	elmex	1.3	for my $contact ($self->get_contacts) {
127	elmex	1.1	push @{$groups{$_}}, $contact for $contact->groups;
128			push @{$groups{''}}, $contact unless $contact->groups;
129			}
130
131			for my $grp (sort keys %groups) {
132			print "=== $grp ====\n";
133			$_->debug_dump for @{$groups{$grp}};
134			}
135	elmex	1.3	if ($self->get_contacts_off_roster) {
136			print "### OFF ROSTER ###\n";
137			%groups;
138			for my $contact ($self->get_contacts_off_roster) {
139			push @{$groups{$_}}, $contact for $contact->groups;
140			push @{$groups{''}}, $contact unless $contact->groups;
141			}
142
143			for my $grp (sort keys %groups) {
144			print "=== $grp ====\n";
145			$_->debug_dump for @{$groups{$grp}};
146			}
147			}
148
149	elmex	1.1	print "### ROSTER END ###\n";
150			}
151
152			=head1 AUTHOR
153
154			Robin Redeker, C<< <elmex at ta-sa.org> >>
155
156	elmex	1.3	=head1 SEE ALSO
157	elmex	1.1
158	elmex	1.3	L<Net::XMPP2::IM::Connection>, L<Net::XMPP2::IM::Contact>, L<Net::XMPP2::IM::Presence>
159	elmex	1.1
160			=head1 COPYRIGHT & LICENSE
161
162			Copyright 2007 Robin Redeker, all rights reserved.
163
164			This program is free software; you can redistribute it and/or modify it
165			under the same terms as Perl itself.
166
167			=cut
168
169
170
171			1; # End of Net::XMPP2