[383] in BarnOwl Developers
[D-O-H] r524 - in trunk: . owl/perl/modules
daemon@ATHENA.MIT.EDU (nelhage@MIT.EDU)
Thu Oct 29 18:05:34 2009
Resent-From: nelhage@mit.edu
Resent-To: barnowl-dev-mtg@charon.mit.edu
Date: Thu, 11 Jan 2007 17:29:25 -0500
To: dirty-owl-hackers@mit.edu
From: nelhage@MIT.EDU
Reply-To: dirty-owl-hackers@MIT.EDU
Author: nelhage
Date: 2007-01-11 17:29:25 -0500 (Thu, 11 Jan 2007)
New Revision: 524
Modified:
trunk/
trunk/owl/perl/modules/jabber.pl
Log:
r17949@phanatique: nelhage | 2007-01-11 17:28:56 -0500
A first pass at jmuc_presence.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- bb873fd7-8e23-0410-944a-99ec44c633eb:/branches/owl/filter-rewrite:15925
bb873fd7-8e23-0410-944a-99ec44c633eb:/local/d-o-h/trunk:17948
+ bb873fd7-8e23-0410-944a-99ec44c633eb:/branches/owl/filter-rewrite:15925
bb873fd7-8e23-0410-944a-99ec44c633eb:/local/d-o-h/trunk:17949
Modified: trunk/owl/perl/modules/jabber.pl
===================================================================
--- trunk/owl/perl/modules/jabber.pl 2007-01-11 22:29:21 UTC (rev 523)
+++ trunk/owl/perl/modules/jabber.pl 2007-01-11 22:29:25 UTC (rev 524)
@@ -5,6 +5,7 @@
use Authen::SASL qw(Perl);
use Net::Jabber;
+use Net::Jabber::MUC;
use Net::DNS;
use Getopt::Long;
@@ -40,9 +41,83 @@
$args{debugfile} = 'jabber.log';
}
my $self = $class->SUPER::new(%args);
- return $self
+ $self->{_BARNOWL_MUCS} = [];
+ return $self;
}
+=head2 MUCJoin
+
+Extends MUCJoin to keep track of the MUCs we're joined to as
+Net::Jabber::MUC objects. Takes the same arguments as
+L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
+
+=cut
+
+sub MUCJoin {
+ my $self = shift;
+ my $muc = Net::Jabber::MUC->new(connection => $self, @_);
+ $muc->Join(@_);
+ push @{$self->MUCs}, $muc;
+}
+
+=head2 MUCLeave ARGS
+
+Leave a MUC. The MUC is specified in the same form as L</FindMUC>
+
+=cut
+
+sub MUCLeave {
+ my $self = shift;
+ my $muc = $self->FindMUC(@_);
+ return unless $muc;
+
+ $muc->Leave();
+
+ $self->{_BARNOWL_MUCS} = grep {$_ != $muc} $self->MUCs;
+}
+
+=head2 FindMUC ARGS
+
+Return the Net::Jabber::MUC object representing a specific MUC we're
+joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
+or Room => $room, Server => $server.
+
+=cut
+
+sub FindMUC {
+ my $self = shift;
+
+ my %args;
+ while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
+
+ my $jid;
+ if($args{jid}) {
+ $jid = $args{jid};
+ } elsif($args{room} && $args{server}) {
+ $jid = Net::Jabber::JID->new(userid => $args{room},
+ server => $args{server});
+ }
+ $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
+
+ foreach my $muc ($self->MUCs) {
+ return $muc if $muc->BaseJID eq $jid;
+ }
+ return undef;
+}
+
+=head2 MUCs
+
+Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
+objects we believe ourself to be connected to.
+
+=cut
+
+sub MUCs {
+ my $self = shift;
+ my $mucs = $self->{_BARNOWL_MUCS};
+ return wantarray ? @$mucs : $mucs;
+}
+
################################################################################
################################################################################
package BarnOwl::Jabber::ConnectionManager;
@@ -517,7 +592,8 @@
join => \&jmuc_join,
part => \&jmuc_part,
invite => \&jmuc_invite,
- configure => \&jmuc_configure
+ configure => \&jmuc_configure,
+ presence => \&jmuc_presence
);
my $func = $jmuc_commands{$cmd};
if ( !$func ) {
@@ -559,15 +635,12 @@
$muc = shift @ARGV
or die("Usage: jmuc join MUC [-p password] [-a account]");
- my $presence = new Net::Jabber::Presence;
- $presence->SetPresence( to => $muc );
- my $x = $presence->NewChild('http://jabber.org/protocol/muc');
- $x->AddHistory()->SetMaxChars(0);
- if ($password) {
- $x->SetPassword($password);
- }
-
- $conn->getConnectionFromJidStr($jid)->Send($presence);
+ $conn->getConnectionFromJidStr($jid)->MUCJoin(Jid => $muc,
+ Password => $password,
+ History => {
+ MaxChars => 0
+ });
+ return;
}
sub jmuc_part {
@@ -576,7 +649,7 @@
$muc = shift @args if scalar @args;
die("Usage: jmuc part MUC [-a account]") unless $muc;
- $conn->getConnectionFromJidStr($jid)->PresenceSend( to => $muc, type => 'unavailable' );
+ $conn->getConnectionFromJidStr($jid)->MUCLeave(JID => $muc);
queue_admin_msg("$jid has left $muc.");
}
@@ -613,7 +686,18 @@
queue_admin_msg("Accepted default instant configuration for $muc");
}
+sub jmuc_presence {
+ my ( $jid, $muc, @args ) = @_;
+ my $m = $conn->getConnectionFromJidStr($jid)->FindMUC(jid => $muc);
+ die("No such muc: $muc") unless $m;
+
+ my @jids = $m->Presence();
+ BarnOwl::popless_ztext("JIDs present in " . $m->BaseJID . "\n\t" .
+ join("\n\t", map {$_->GetResource}@jids));
+}
+
+
#XXX TODO: Consider merging this with jmuc and selecting off the first two args.
sub cmd_jroster {
die "You are not logged in to Jabber" unless $conn->connected();
