view release on metacpan or  search on metacpan

lib/AnyEvent/XMPP/Ext/VCard.pm  view on Meta::CPAN

up after the C<session_ready> event was received. You can prevent the automatic
retrieval by giving a true value in C<$dont_retrieve_vcard>.  However, just
make sure to hook up on any connection before it is connected if you want to
offer avatar support on it.

Best is probably to do it like this:

   my $vcard = AnyEvent::XMPP::Ext::VCard->new;
   $con->reg_cb (
      stream_ready => sub { $vcard->hook_on ($con) }
   );

=cut

sub hook_on {
   my ($self, $con, $dont_retrieve_vcard) = @_;

   Scalar::Util::weaken $self;

   my $rid =
      $con->reg_cb (
         ext_before_send_presence_hook => sub {
            my ($con, $id, $type, $attrs, $create_cb) = @_;

            my $chlds;

            my $vc = $self->my_vcard ($con);

            if ($vc && !$vc->{_avatar}) {
               push @$chlds, { ns => xmpp_ns ('vcard_upd'), name => 'photo' }

            } elsif ($vc && $vc->{_avatar}) {
               push @$chlds, { 
                  ns => xmpp_ns ('vcard_upd'),
                  name => 'photo',
                  childs => [ $vc->{_avatar_hash} ]
               }
            }

            push @$create_cb, {
               defns => xmpp_ns ('vcard_upd'),
               node => {
                  ns => xmpp_ns ('vcard_upd'),
                  name => 'x',
                  ($chlds ? (childs => [ @$chlds ]) : ()),
              }
            };
         },
         ext_after_session_ready => sub {
            my ($con) = @_;

            if (not $dont_retrieve_vcard) {
               $self->retrieve ($con, undef, sub {
                  my ($jid, $vc, $error) = @_;

                  if ($error) {
                     $self->event (retrieve_vcard_error => $error);
                  }

                  # the own vcard was already set by retrieve
                  # this will push out an updated presence
                  $self->_publish_avatar;
               });
            }
         }
      );

   my $ar = [$con, $rid];
   Scalar::Util::weaken $ar->[0];
   push @{$self->{hooked}}, $ar;
}

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

   for (@{$self->{hooked}}) {
      if ($_->[0]) { $_->[0]->send_presence () }
   }
}

=item B<my_vcard ($con)>

This method returns the vcard for the account connected by C<$con>.
This only works if vcard was (successfully) retrieved. If the connection was
hoooked up the vcard was automatically retrieved.

Alternatively C<$con> can also be a string reprensenting the JID of an
account.

=cut

sub my_vcard {
   my ($self, $con) = @_;
   $self->{own_vcards}->{prep_bare_jid (ref ($con) ? $con->jid : $con)}
}

=item B<cache ([$newcache])>

See also C<new> about the meaning of cache hashes.
If no argument is given the current cache is returned.

=cut

sub cache {
   my ($self, $cache_hash) = @_;
   $self->{cache} = $cache_hash if defined $cache_hash;
   $self->{cache}
}

sub _store {
   my ($self, $con, $vcard_cb, $cb) = @_;

   $con->send_iq (
      set => sub {
         my ($w) = @_;
         $w->addPrefix (xmpp_ns ('vcard'), '');
         $w->startTag ([xmpp_ns ('vcard'), 'vCard']);
         $vcard_cb->($w);
         $w->endTag;

      }, sub {