view release on metacpan or  search on metacpan

lib/AnyEvent/XMPP/IM/Roster.pm  view on Meta::CPAN

package AnyEvent::XMPP::IM::Roster;
use AnyEvent::XMPP::IM::Contact;
use AnyEvent::XMPP::IM::Presence;
use AnyEvent::XMPP::Util qw/prep_bare_jid bare_jid cmp_bare_jid/;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use strict;
no warnings;

=head1 NAME

AnyEvent::XMPP::IM::Roster - Instant messaging roster for XMPP

=head1 SYNOPSIS

   my $con = AnyEvent::XMPP::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<AnyEvent::XMPP::IM::Connection>.
It manages also the presence information that is received.

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

=cut

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

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

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

   my @upd;

   for my $item ($query->find_all ([qw/roster item/])) {
      my $jid = $item->attr ('jid');

      my $sub = $item->attr ('subscription'),
      $self->touch_jid ($jid);

      if ($sub eq 'remove') {
         my $c = $self->remove_contact ($jid);
         $c->update ($item);
      } else {
         push @upd, $self->get_contact ($jid)->update ($item);
      }
   }

   @upd
}

sub update_presence {
   my ($self, $node) = @_;
   my $jid  = $node->attr ('from');
   # XXX: should check whether C<$jid> is nice JID.

   my $type = $node->attr ('type');
   my $contact = $self->touch_jid ($jid);

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

   if ($type eq 'subscribe') {
      $self->{connection}->event (
         contact_request_subscribe => $self, $contact, $stati{''});

   } elsif ($type eq 'subscribed') {
      $self->{connection}->event (
         contact_subscribed => $self, $contact, $stati{''});

   } elsif ($type eq 'unsubscribe') {
      $self->{connection}->event (
         contact_did_unsubscribe => $self, $contact, $stati{''});

   } elsif ($type eq 'unsubscribed') {
      $self->{connection}->event (
         contact_unsubscribed => $self, $contact, $stati{''});

   } else {
      return $contact->update_presence ($node)
   }
   return ($contact)
}

sub touch_jid {
   my ($self, $jid, $contact) = @_;
   my $bjid = prep_bare_jid ($jid);

   if (cmp_bare_jid ($jid, $self->{connection}->jid)) {
      $self->{myself} =
         $contact
         || AnyEvent::XMPP::IM::Contact->new (
               connection => $self->{connection},
               jid        => AnyEvent::XMPP::Util::bare_jid ($jid),
               is_me      => 1,
            );
      return $self->{myself}
   }

   unless ($self->{contacts}->{$bjid}) {
      $self->{contacts}->{$bjid} =
         $contact
         || AnyEvent::XMPP::IM::Contact->new (
               connection => $self->{connection},
               jid        => AnyEvent::XMPP::Util::bare_jid ($jid),
            )
   }

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