[380] in BarnOwl Developers
[D-O-H] r521 - in trunk: . owl/perl/lib/Net/Jabber
daemon@ATHENA.MIT.EDU (nelhage@MIT.EDU)
Thu Oct 29 18:05:31 2009
Resent-From: nelhage@mit.edu
Resent-To: barnowl-dev-mtg@charon.mit.edu
Date: Thu, 11 Jan 2007 16:13:37 -0500
To: dirty-owl-hackers@mit.edu
From: nelhage@MIT.EDU
Reply-To: dirty-owl-hackers@MIT.EDU
Author: nelhage
Date: 2007-01-11 16:13:37 -0500 (Thu, 11 Jan 2007)
New Revision: 521
Added:
trunk/owl/perl/lib/Net/Jabber/MUC.pm
Modified:
trunk/
Log:
r17945@phanatique: nelhage | 2007-01-11 16:12:55 -0500
Adding the beginning of a class abstracting MUC presence information.
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:17943
+ bb873fd7-8e23-0410-944a-99ec44c633eb:/branches/owl/filter-rewrite:15925
bb873fd7-8e23-0410-944a-99ec44c633eb:/local/d-o-h/trunk:17945
Added: trunk/owl/perl/lib/Net/Jabber/MUC.pm
===================================================================
--- trunk/owl/perl/lib/Net/Jabber/MUC.pm (rev 0)
+++ trunk/owl/perl/lib/Net/Jabber/MUC.pm 2007-01-11 21:13:37 UTC (rev 521)
@@ -0,0 +1,218 @@
+package Net::Jabber::MUC;
+
+=head1 NAME
+
+Net::Jabber::Roster - Jabber Multi-User Chat Object
+
+=head1 SYNOPSIS
+
+ my $Client = Net::XMPP:Client->new(...);
+
+ my $muc = Net::Jabber::MUC(connection => $Client,
+ room => "jabber",
+ server => "conference.jabber.org",
+ nick => "nick");
+ or
+ my $muc = Net::Jabber::MUC(connection => $Client,
+ jid => 'jabber@conference.jabber.org/nick');
+
+
+ $muc->Join(Password => "secret", History => {MaxChars => 0});
+
+ if( $muc->Contains($JID) ) { ... }
+ my @jids = $muc->Presence();
+
+ $muc->Leave();
+
+=head1 DESCRIPTION
+
+The MUC object seeks to provide a simple API for interfacing with
+Jabber multi-user chats (as defined in XEP 0045). It automatically
+registers callbacks with the connections to keep track of presence in
+the MUC.
+
+
+=cut
+
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ my $self = { };
+
+ my %args;
+ while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
+
+ if (!exists($args{connection}) ||
+ !$args{connection}->isa("Net::XMPP::Connection"))
+ {
+ croak("You must pass Net::Jabber::MUC a valid connection object.");
+ }
+
+ if($args{jid}) {
+ my $jid = $args{jid};
+ $jid = Net::Jabber::JID->new($jid) unless UNIVERSAL::isa($jid, 'Net::Jabber::JID');
+ $args{jid} = $jid;
+ } else if($args{room} && $args{server} && $args{nick}) {
+ $args{jid} = New::Jabber::JID->new($args{room}."@".$args{server}."/".$args{nick});
+ } else {
+ croak("You must specify either a jid or room,server,nick.");
+ }
+
+ $self->{CONNECTION} = $args{connection};
+ $self->{JID} = $args{jid};
+ $self->{PRESENCE} = { };
+
+ bless($self, $class);
+
+ $self->_init;
+
+ return $self;
+}
+
+=head2 JID
+
+Returns the Net::Jabber::JID object representing this MUC's JID
+(room@host/nick)
+
+=cut
+
+sub JID {
+ my $self = shift;
+ return $self->{JID};
+}
+
+=head2 BaseJID
+
+Returns the base JID of this MUC as a string
+
+=cut
+
+sub BaseJID {
+ my $self = shift;
+ return $self->JID->GetJID('base');
+}
+
+
+=head2 _init
+
+Add callbacks to our connection to receive the appropriate packets.
+
+=cut
+
+sub _init {
+ my $self = shift;
+
+ $self->{CONNECTION}->SetXPathCallBacks('/presence' => sub { $self->_handler(@_) });
+}
+
+=head2 Join
+
+Sends the appropriate presence packet to join us to the MUC.
+
+=cut
+
+sub Join {
+ my $self = shift;
+ my %args;
+ while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
+
+ my $presence = Net::Jabber::Presence->new;
+ $presence->SetTo($self->JID);
+ my $x = $presence->NewChild('http://jabber.org/protocol/muc');
+ if($args{password}) {
+ $x->SetPassword($args{password});
+ }
+ if($args{history}) {
+ my $h = $x->AddHistory();
+ if($args{history}{MaxChars}) {
+ $h->SetMaxChars($args{history}{MaxChars});
+ } elsif($args{history}{MaxStanzas}) {
+ $h->SetMaxStanzas($args{history}{MaxStanzas});
+ } elsif($args{history}{Seconds}) {
+ $h->SetSeconds($args{history}{Seconds});
+ } elsif($args{history}{Since}) {
+ $h->SetSince($args{history}{Since});
+ }
+ }
+ $self->{CONNECTION}->Send($presence);
+}
+
+=head2 Leave
+
+Leaves the MUC
+
+=cut
+
+sub Leave {
+ my $self = shift;
+ my %args;
+ while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
+
+ $self->{CONNECTION}->PresenceSend(to => $self->JID, type => 'unavailable');
+ $self->{PRESENCE} = {};
+}
+
+
+=head2 _handler
+
+Central dispatch point for handling incoming packets.
+
+=cut
+
+sub _handler {
+ my $self = shift;
+ my $sid = shift;
+ my $packet = shift;
+
+ $self->_handlePresence($packet) if $packet->GetTag() eq "presence";
+}
+
+=head2 handlePresence
+
+Handle an incoming presence packet.
+
+=cut
+
+sub _handlePresence {
+ my $self = shift;
+ my $presence = shift;
+
+ my $type = $presence->GetType() || "available";
+ my $from = $presence->GetFrom();
+
+ return unless $from->GetJid('base') eq $self->BaseJID;
+
+ if($type eq 'available') {
+ delete $self->{PRESENCE}->{$from->GetJID('full')};
+ } else {
+ $self->{PRESENCE}->{$from->GetJID('full')} = $from;
+ }
+}
+
+=head2 Contains JID
+
+Returns true iff the MUC contains the specified full JID
+
+=cut
+
+sub Contains {
+ my $self = shift;
+ my $jid = shift;
+
+ $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
+
+ return exists $self->{PRESENCE}->{$jid};
+}
+
+=head2 Presence
+
+Returns a list of JIDS in the MUC, as Net::Jabber::JID objects
+
+=cut
+
+sub Presence {
+ my $self = shift;
+ return keys %{$self->{PRESENCE}};
+}
