AnyEvent::XMPP::Ext::MUC::Room - Room class

AnyEvent-XMPP documentation Contained in the AnyEvent-XMPP distribution.

Index

Code Index:

NAME

Top

AnyEvent::XMPP::Ext::MUC::Room - Room class

SYNOPSIS

Top

DESCRIPTION

Top

This module represents a room handle for a MUC.

METHODS

Top

new (%args)
get_user ($nick)

This method returns the user with the $nick in the room.

get_me

This method returns the AnyEvent::XMPP::Ext::MUC::User object of yourself in the room. If will return undef if we are not in the room anymore.

get_user_jid ($jid)

This method looks whether a user with the JID $jid exists in the room. That means whether the node and domain part of the JID match the rooms node and domain part, and the resource part of the JID matches a joined nick.

get_users

This method returns the list of occupants as AnyEvent::XMPP::Ext::MUC::User objects.

make_instant ($cb)

If you just created a room you can create an instant room with this method instead of going through room configuration for a reserved room.

If you want to create a reserved room instead don't forget to unset the create_instant argument of the join_room method of AnyEvent::XMPP::Ext::MUC!

See also the request_configuration method below for the reserved room config.

$cb is the callback that will be called when the instant room creation is finished. If successful the first argument will be this room object ($self), if unsuccessful the first argument will be undef and the second will be a AnyEvent::XMPP::Error::IQ object.

request_configuration ($cb)

This method requests the room configuration. When the configuration form or an error arrives $cb will be called. The first argument to the callback will be a AnyEvent::XMPP::Ext::DataForm with the room configuration form or undef in case of an error. The second argument will be a AnyEvent::XMPP::Error::MUC error object if an error occurred or undef if no error occurred.

If you made an answer form you can send it via the send_configuration method below.

Here is an example:

   $room->request_configuration (sub {
      my ($form, $err) = @_;
      $form or return;

      my $af = AnyEvent::XMPP::Ext::DataForm->new;
      $af->make_answer_form ($form);
      $af->set_field_value ('muc#roomconfig_maxusers', 20);
      $af->clear_empty_fields;

      $roomhdl->send_configuration ($af, sub {
         # ...
      });
   });
send_configuration ($answer_form, $cb)

This method sends the answer form to a configuration request to the room. $answer_form should be a AnyEvent::XMPP::Ext::DataForm object containig the answer form with the changed configuration.

The first argument of $cb will be a true value if the configuration change was successful. The second argument of $cb will be a AnyEvent::XMPP::Error::IQ object if the configuration change was not successful.

make_message (%args)

This method constructs a AnyEvent::XMPP::Ext::MUC::Message with a connection to this room.

%args are further arguments for the constructor of AnyEvent::XMPP::Ext::MUC::Message. The default to argument for the message is the room and the type will be 'groupchat'.

send_part ($msg, $cb, $timeout)

This lets you part the room, $msg is an optional part message and can be undef if no custom message should be generated.

$cb is called when we successfully left the room or after $timeout seconds. The default for $timeout is 60.

The first argument to the call of $cb will be undef if we successfully parted, or a true value when the timeout hit. Even if we timeout we consider ourself parted (and a 'leave' event is generated).

users

Returns a list of AnyEvent::XMPP::Ext::MUC::User objects which are in this room.

jid

Returns the bare JID of this room.

nick_jid

Returns the full JID of yourself in the room.

is_connected

Returns true if this room is still connected (but maybe not joined (yet)).

connection

If the room is still joined this method will return the connection on which the room is connected.

is_joined

Returns true if this room is still joined (and connected).

change_nick ($newnick)

This method lets you change your nickname in this room.

change_subject ($newsubject)

This methods changes the subject of the room.

AUTHOR

Top

Robin Redeker, <elmex at ta-sa.org>, JID: <elmex at jabber.org>

COPYRIGHT & LICENSE

Top

Copyright 2007, 2008 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.

AnyEvent-XMPP documentation Contained in the AnyEvent-XMPP distribution. 
package AnyEvent::XMPP::Ext::MUC::Room;
use strict;
no warnings;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::Util qw/
   bare_jid prep_bare_jid cmp_jid split_jid join_jid is_bare_jid
   prep_res_jid prep_join_jid resourceprep
/;
use AnyEvent::XMPP::Ext::MUC::User;
use AnyEvent::XMPP::Ext::DataForm;
use AnyEvent::XMPP::Error::MUC;

use constant {
   JOIN_SENT => 1,
   JOINED    => 2,
   LEFT      => 3,
};


sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = bless { status => LEFT, @_ }, $class;
   $self->init;
   $self
}

sub init {
   my ($self) = @_;
   $self->{jid} = bare_jid ($self->{jid});
}

sub event {
   my ($self, $ev, @args) = @_;
   $self->{muc}->event ($ev, $self, @args);
}

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

   my $msg = AnyEvent::XMPP::Ext::MUC::Message->new (room => $self);

   if ($node->attr ('type') eq 'error') {
      my $error =
         AnyEvent::XMPP::Error::MUC->new (
            message_node => $node,
            message      => $msg
         );

      if ($error->type eq 'subject_change_forbidden') {
         $self->event (subject_change_error => $error);
      } else {
         $self->event (message_error => $error);
      }

   } else {
      $msg->from_node ($node);
      my $is_echo = cmp_jid ($msg->from, $self->nick_jid)
                    && $msg->type eq 'groupchat';

      if (not (defined $msg->any_body)
          && defined $msg->any_subject) { # subject change
         $self->event (subject_change => $msg, $is_echo);
         return;
      }

      $self->event (message => $msg, $is_echo);
   }
}

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

   my $s = $self->{status};

   my $from = $node->attr ('from');
   my $type = $node->attr ('type');

   my $error;
   if ($type eq 'error') {
      $error = AnyEvent::XMPP::Error::Presence->new (node => $node);
   }

   my $stati = {};
   my $new_nick;

   if (my ($x) = $node->find_all ([qw/muc_user x/])) {
      for ($x->find_all ([qw/muc_user status/])) {
         $stati->{$_->attr ('code')}++;
      }

      if (my ($i) = $x->find_all ([qw/muc_user item/])) {
         $new_nick = $i->attr ('nick');
      }
   }

   my $nick_change = $stati->{'303'};

   if ($s == JOIN_SENT) {
      if ($error) {
         my $muce = AnyEvent::XMPP::Error::MUC->new (
            presence_error => $error,
            type           => 'presence_error'
         );
         $self->event (join_error => $muce);

      } else {
         if (cmp_jid ($from, $self->nick_jid)) {
            my $user = $self->add_user_xml ($node);
            $self->{status} = JOINED;
            $self->{me} = $user;

            if ($user->did_create_room) {
               if ($self->{locked_cb}) {
                  (delete $self->{locked_cb})->($self);

               } else {
                  $self->event ('locked');
               }
            } else {
               $self->event (enter => $user);
            }

         } else {
            $self->add_user_xml ($node);
         }
      }

   } elsif ($s == JOINED) { # nick changes?
      if ($error) {
         my $muce = AnyEvent::XMPP::Error::MUC->new (
            presence_error => $error,
            type           => 'presence_error'
         );
         $self->event (error => $muce);

      } elsif (!$nick_change && $type eq 'unavailable') {
         if (cmp_jid ($from, $self->nick_jid)) {
            $self->event ('leave', $self->get_me);
            $self->we_left_room ();

         } else {
            my $nick = prep_res_jid ($from);

            my $user = delete $self->{users}->{$nick};
            if ($user) {
               $user->update ($node);
               $self->event (part => $user);
            } else {
               warn "User with '$nick' not found in room $self->{jid}!\n";
            }
         }

      } elsif ($nick_change && $type eq 'unavailable') {
         my $nick = prep_res_jid ($from);
         my $nnick = resourceprep ($new_nick);

         my $user = $self->{users}->{$nnick} = delete $self->{users}->{$nick};
         if ($user) {
            $user->update ($node);
            $self->event (nick_change_leave => $user, $nick, $new_nick);
         } else {
            warn "User with '$nick' not found in room $self->{jid} for nickchange!\n";
         }

      } else {
         my $nick = prep_res_jid $from;
         my $pre  = $self->{users}->{$nick};
         my $in_nick_change = $pre ? $pre->is_in_nick_change : undef;
         my $user = $self->add_user_xml ($node);

         if ($pre) {
            if ($in_nick_change) {
               $self->event (nick_change => $user, $user->{old_nick}, $user->nick);
            } else {
               $self->event (presence => $user);
            }
         } else {
            $self->event (join => $user);
         }
      }
   }
}

sub we_left_room {
   my ($self) = @_;
   $self->{users}  = {};
   $self->{status} = LEFT;
   delete $self->{me};
}


sub get_user {
   my ($self, $nick) = @_;
   $self->{users}->{$nick}
}


sub get_me {
   my ($self) = @_;
   $self->{me}
}


sub get_user_jid {
   my ($self, $jid) = @_;
   my ($room, $srv, $nick) = split_jid ($jid);
   return unless prep_join_jid ($room, $srv) eq prep_bare_jid $self->jid;
   $self->{users}->{$nick}
}


sub get_users {
   my ($self) = @_;
   values %{$self->{users}};
}

sub add_user_xml {
   my ($self, $node) = @_;
   my $from = $node->attr ('from');
   my $nick = prep_res_jid ($from);

   my $user = $self->{users}->{$nick};
   unless ($user) {
      $user = $self->{users}->{$nick} =
         AnyEvent::XMPP::Ext::MUC::User->new (room => $self);
   }

   $user->update ($node);

   $user
}

sub _join_jid_nick {
   my ($jid, $nick) = @_;
   my ($node, $host) = split_jid $jid;
   join_jid ($node, $host, $nick);
}

sub check_online {
   my ($self) = @_;
   unless ($self->is_connected) {
      warn "room $self not connected anymore!";
      return 0;
   }
   1
}

sub send_join {
   my ($self, $nick, $password, $history) = @_;
   $self->check_online or return;

   $self->{nick_jid} = _join_jid_nick ($self->{jid}, $nick);
   $self->{status}   = JOIN_SENT;

   my @chlds;
   if (defined $password) {
      push @chlds, { name => 'password', childs => [ $password ] };
   }

   if (defined $history) {
      my $h;
      push @{$h->{attrs}}, ('maxchars', $history->{chars})
         if defined $history->{chars};
      push @{$h->{attrs}}, ('maxstanzas', $history->{stanzas})
         if defined $history->{stanzas};
      push @{$h->{attrs}}, ('seconds', $history->{seconds})
         if defined $history->{seconds};

      if (defined $h->{attrs}) {
         $h->{name} = 'history';
         push @chlds, $h;
      }
   }

   my $con = $self->{connection};
   $con->send_presence (undef, {
      defns => 'muc', node => { ns => 'muc', name => 'x', childs => [ @chlds ] }
   }, to => $self->{nick_jid});
}


sub make_instant {
   my ($self, $cb) = @_;
   $self->check_online or return;

   my $df = AnyEvent::XMPP::Ext::DataForm->new;
   $df->set_form_type ('submit');
   my $sxl = $df->to_simxml;

   $self->{connection}->send_iq (
      set => {
         defns => 'muc_owner', node => {
            name => 'query', childs => [ $sxl ]
         }
      }, sub {
         my ($n, $e) = @_;

         if ($e) {
            $cb->(undef, $e);
         } else {
            $cb->($self, undef);
         }
      },
      to => $self->jid
   );
}


sub request_configuration {
   my ($self, $cb) = @_;
   $self->check_online or return;

   $self->{connection}->send_iq (
      get => {
         defns => 'muc_owner', node => { name => 'query' }
      }, sub {
         my ($n, $e) = @_;
         if ($n) {
            if (my ($x) = $n->find_all ([qw/muc_owner query/], [qw/data_form x/])) {
               my $form = AnyEvent::XMPP::Ext::DataForm->new;
               $form->from_node ($x);
               $cb->($form, undef);
            } else {
               $e = AnyEvent::XMPP::Error::MUC->new (
                  type => 'no_config_form',
                  text => "The room didn't provide a configuration form"
               );
               $cb->(undef, $e);
            }
         } else {
            $cb->(undef, $e);
         }
      },
      to => $self->jid
   );
}


sub send_configuration {
   my ($self, $form, $cb) = @_;
   $self->check_online or return;

   $self->{connection}->send_iq (
      set => {
         defns => 'muc_owner', node => { name => 'query', childs => [
            $form->to_simxml
         ]}
      }, sub {
         my ($n, $e) = @_;
         if ($e) {
            $cb->(undef, $e);
         } else {
            $cb->(1, undef);
         }
      },
      to => $self->jid
   );
}

sub message_class { 'AnyEvent::XMPP::Ext::MUC::Message' }


sub make_message {
   my ($self, %args) = @_;

   $self->message_class ()->new (
      room       => $self,
      to         => $self->jid,
      type       => 'groupchat',
      %args
   )
}


sub send_part {
   my ($self, $msg, $cb, $timeout) = @_;
   $self->check_online or return;
   $timeout ||= 60;

   my $con = $self->{connection};
   my $timeouted = 0;

   if ($cb) {
      $self->{_part_timeout} =
         AnyEvent->timer (after => $timeout, cb => sub {
            delete $self->{_part_timeout};
            $timeouted = 1;
            $self->event ('leave', $self->get_me);
         });

      $self->{muc}->reg_cb (ext_after_leave => sub {
         my ($muc, $room) = @_;
         return unless cmp_jid ($room->nick_jid, $self->nick_jid);

         delete $self->{_part_timeout};
         $cb->($timeouted) if $cb;
         $muc->unreg_me;
      });
   }

   $con->send_presence (
      'unavailable', undef,
      (defined $msg ? (status => $msg) : ()),
      to => $self->{nick_jid}
   );
}


sub users {
   my ($self) = @_;
   values %{$self->{users}}
}


sub jid      { $_[0]->{jid} }


sub nick_jid { $_[0]->{nick_jid} }


sub is_connected {
   my ($self) = @_;
   $self->{muc} && $self->{connection} && $self->{connection}->is_connected
}


sub connection {
   my ($self) = @_;
   $self->{connection}
}


sub is_joined {
   my ($self) = @_;
   $self->is_connected
   && $self->{status} == JOINED
}


sub change_nick {
   my ($self, $newnick) = @_;
   my ($room, $srv) = split_jid $self->jid;
   $self->{connection}->send_presence (
      undef, undef, to => join_jid ($room, $srv, $newnick)
   );
}


sub change_subject {
   my ($self, $newsubject) = @_;
   my $msg = $self->make_message (subject => $newsubject);
   $msg->send;
}


1;