Changeset 1dfc7df


Ignore:
Timestamp:
Jan 11, 2007, 5:29:25 PM (17 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
fd5054a
Parents:
31cf416
git-author:
Nelson Elhage <nelhage@mit.edu> (01/11/07 17:28:56)
git-committer:
Nelson Elhage <nelhage@mit.edu> (01/11/07 17:29:25)
Message:
A first pass at jmuc_presence. 
File:
1 edited

Legend:

Unmodified
Added
Removed
  • perl/modules/jabber.pl

    r30c735c r1dfc7df  
    66use Authen::SASL qw(Perl);
    77use Net::Jabber;
     8use Net::Jabber::MUC;
    89use Net::DNS;
    910use Getopt::Long;
     
    4142    }
    4243    my $self = $class->SUPER::new(%args);
    43     return $self
     44    $self->{_BARNOWL_MUCS} = [];
     45    return $self;
     46}
     47
     48=head2 MUCJoin
     49
     50Extends MUCJoin to keep track of the MUCs we're joined to as
     51Net::Jabber::MUC objects. Takes the same arguments as
     52L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
     53
     54=cut
     55
     56sub MUCJoin {
     57    my $self = shift;
     58    my $muc = Net::Jabber::MUC->new(connection => $self, @_);
     59    $muc->Join(@_);
     60    push @{$self->MUCs}, $muc;
     61}
     62
     63=head2 MUCLeave ARGS
     64
     65Leave a MUC. The MUC is specified in the same form as L</FindMUC>
     66
     67=cut
     68
     69sub MUCLeave {
     70    my $self = shift;
     71    my $muc = $self->FindMUC(@_);
     72    return unless $muc;
     73
     74    $muc->Leave();
     75   
     76    $self->{_BARNOWL_MUCS} = grep {$_ != $muc} $self->MUCs;
     77}
     78
     79=head2 FindMUC ARGS
     80
     81Return the Net::Jabber::MUC object representing a specific MUC we're
     82joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
     83or Room => $room, Server => $server.
     84
     85=cut
     86
     87sub FindMUC {
     88    my $self = shift;
     89
     90    my %args;
     91    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
     92
     93    my $jid;
     94    if($args{jid}) {
     95        $jid = $args{jid};
     96    } elsif($args{room} && $args{server}) {
     97        $jid = Net::Jabber::JID->new(userid => $args{room},
     98                                     server => $args{server});
     99    }
     100    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
     101
     102    foreach my $muc ($self->MUCs) {
     103        return $muc if $muc->BaseJID eq $jid;
     104    }
     105    return undef;
     106}
     107
     108=head2 MUCs
     109
     110Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
     111objects we believe ourself to be connected to.
     112
     113=cut
     114
     115sub MUCs {
     116    my $self = shift;
     117    my $mucs = $self->{_BARNOWL_MUCS};
     118    return wantarray ? @$mucs : $mucs;
    44119}
    45120
     
    518593        part      => \&jmuc_part,
    519594        invite    => \&jmuc_invite,
    520         configure => \&jmuc_configure
     595        configure => \&jmuc_configure,
     596        presence  => \&jmuc_presence
    521597    );
    522598    my $func = $jmuc_commands{$cmd};
     
    560636      or die("Usage: jmuc join MUC [-p password] [-a account]");
    561637
    562     my $presence = new Net::Jabber::Presence;
    563     $presence->SetPresence( to => $muc );
    564     my $x = $presence->NewChild('http://jabber.org/protocol/muc');
    565     $x->AddHistory()->SetMaxChars(0);
    566     if ($password) {
    567         $x->SetPassword($password);
    568     }
    569 
    570     $conn->getConnectionFromJidStr($jid)->Send($presence);
     638    $conn->getConnectionFromJidStr($jid)->MUCJoin(Jid      => $muc,
     639                                                  Password => $password,
     640                                                  History  => {
     641                                                      MaxChars => 0
     642                                                     });
     643    return;
    571644}
    572645
     
    577650    die("Usage: jmuc part MUC [-a account]") unless $muc;
    578651
    579     $conn->getConnectionFromJidStr($jid)->PresenceSend( to => $muc, type => 'unavailable' );
     652    $conn->getConnectionFromJidStr($jid)->MUCLeave(JID => $muc);
    580653    queue_admin_msg("$jid has left $muc.");
    581654}
     
    612685    $conn->getConnectionFromJidStr($jid)->Send($iq);
    613686    queue_admin_msg("Accepted default instant configuration for $muc");
     687}
     688
     689sub jmuc_presence {
     690    my ( $jid, $muc, @args ) = @_;
     691
     692    my $m = $conn->getConnectionFromJidStr($jid)->FindMUC(jid => $muc);
     693    die("No such muc: $muc") unless $m;
     694
     695    my @jids = $m->Presence();
     696    BarnOwl::popless_ztext("JIDs present in " . $m->BaseJID . "\n\t" .
     697                           join("\n\t", map {$_->GetResource}@jids));
    614698}
    615699
Note: See TracChangeset for help on using the changeset viewer.