source: perl/modules/Jabber/lib/Net/Jabber/MUC.pm @ 892568b

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 892568b was 892568b, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Show full JIDs for users in non-anonymous JIDs in :jmuc presence. closes #24
  • Property mode set to 100644
File size: 5.6 KB
Line 
1package Net::Jabber::MUC;
2
3=head1 NAME
4
5Net::Jabber::Roster - Jabber Multi-User Chat Object
6
7=head1 SYNOPSIS
8
9  my $Client = Net::XMPP:Client->new(...);
10
11  my $muc = Net::Jabber::MUC(connection => $Client,
12                             room   => "jabber",
13                             server => "conference.jabber.org",
14                             nick   => "nick");
15   or
16  my $muc = Net::Jabber::MUC(connection => $Client,
17                             jid    =>  'jabber@conference.jabber.org/nick');
18
19
20  $muc->Join(Password => "secret", History => {MaxChars => 0});
21
22  if( $muc->Contains($JID) ) { ... }
23  my @jids = $muc->Presence();
24
25  $muc->Leave();
26
27=head1 DESCRIPTION
28
29The MUC object seeks to provide a simple API for interfacing with
30Jabber multi-user chats (as defined in XEP 0045). It automatically
31registers callbacks with the connections to keep track of presence in
32the MUC.
33
34
35=cut
36
37use strict;
38use warnings;
39
40sub new {
41    my $class = shift;
42    my $self = { };
43
44    my %args;
45    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
46
47    if (!exists($args{connection}) ||
48        !$args{connection}->isa("Net::XMPP::Connection"))
49    {
50        croak("You must pass Net::Jabber::MUC a valid connection object.");
51    }
52
53    if($args{jid}) {
54        my $jid = $args{jid};
55        $jid = Net::Jabber::JID->new($jid) unless UNIVERSAL::isa($jid, 'Net::Jabber::JID');
56        $args{jid} = $jid;
57    } elsif($args{room} && $args{server} && $args{nick}) {
58        $args{jid} = New::Jabber::JID->new($args{room}."@".$args{server}."/".$args{nick});
59    } else {
60        croak("You must specify either a jid or room,server,nick.");
61    }
62
63    $self->{CONNECTION} = $args{connection};
64    $self->{JID} = $args{jid};
65    $self->{PRESENCE} = { };
66    $self->{ANONYMOUS} = 1;
67
68    bless($self, $class);
69
70    $self->_init;
71
72    return $self;
73}
74
75=head2 JID
76
77Returns the Net::Jabber::JID object representing this MUC's JID
78(room@host/nick)
79
80=cut
81
82sub JID {
83    my $self = shift;
84    return $self->{JID};
85}
86
87=head2 BaseJID
88
89Returns the base JID of this MUC as a string
90
91=cut
92
93sub BaseJID {
94    my $self = shift;
95    return $self->JID->GetJID('base');
96}
97
98
99=head2 _init
100
101Add callbacks to our connection to receive the appropriate packets.
102
103=cut
104
105sub _init {
106    my $self = shift;
107
108    $self->{CONNECTION}->SetXPathCallBacks('/presence' => sub { $self->_handler(@_) });
109}
110
111=head2 Join
112
113Sends the appropriate presence packet to join us to the MUC.
114
115=cut
116
117sub Join {
118    my $self = shift;
119    my %args;
120    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
121
122    my $presence = Net::Jabber::Presence->new;
123    $presence->SetTo($self->JID);
124    my $x = $presence->NewChild('http://jabber.org/protocol/muc');
125    if($args{password}) {
126        $x->SetPassword($args{password});
127    }
128    if($args{history}) {
129        my $h = $x->AddHistory();
130        if($args{history}{MaxChars}) {
131            $h->SetMaxChars($args{history}{MaxChars});
132        } elsif($args{history}{MaxStanzas}) {
133            $h->SetMaxStanzas($args{history}{MaxStanzas});
134        } elsif($args{history}{Seconds}) {
135            $h->SetSeconds($args{history}{Seconds});
136        } elsif($args{history}{Since}) {
137            $h->SetSince($args{history}{Since});
138        }
139    }
140    $self->{CONNECTION}->Send($presence);
141}
142
143=head2 Leave
144
145Leaves the MUC
146
147=cut
148
149sub Leave {
150    my $self = shift;
151    my %args;
152    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
153
154    $self->{CONNECTION}->PresenceSend(to => $self->JID, type => 'unavailable');
155    $self->{PRESENCE} = {};
156}
157
158
159=head2 _handler
160
161Central dispatch point for handling incoming packets.
162
163=cut
164
165sub _handler {
166    my $self = shift;
167    my $sid = shift;
168    my $packet = shift;
169
170    $self->_handlePresence($packet) if $packet->GetTag() eq "presence";
171}
172
173=head2 handlePresence
174
175Handle an incoming presence packet.
176
177=cut
178
179sub _handlePresence {
180    my $self = shift;
181    my $presence = shift;
182
183    my $type = $presence->GetType() || "available";
184    my $from = Net::Jabber::JID->new($presence->GetFrom());
185
186    return unless $from->GetJID('base') eq $self->BaseJID;
187
188    if($type eq 'unavailable') {
189        delete $self->{PRESENCE}->{$from->GetJID('full')};
190    } elsif($type eq 'available') {
191        $self->{PRESENCE}->{$from->GetJID('full')} = {ROOMNICK => $from};
192        my $x = $presence->GetX('http://jabber.org/protocol/muc#user');
193        if($x && $x->DefinedItem()) {
194            my $item = $x->GetItem();
195            if($item->DefinedJID()) {
196                $self->{PRESENCE}->{$from->GetJID('full')}->{FULLJID} = $item->GetJID();
197                $self->{ANONYMOUS} = 0;
198            }
199        }
200    }
201}
202
203=head2 Contains JID
204
205Returns true iff the MUC contains the specified full JID
206
207=cut
208
209sub Contains {
210    my $self = shift;
211    my $jid = shift;
212
213    $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
214
215    return exists $self->{PRESENCE}->{$jid};
216}
217
218=head2 GetFullJID roomjid
219
220Given the roomnick of a user in the MUC, return their full NIC if the
221MUC makes it available. If the MUC is anonymous or the user does not
222exist in the MUC, return undef.
223
224=cut
225
226sub GetFullJID {
227    my $self = shift;
228    my $jid = shift;
229
230    $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
231    my $pres = $self->{PRESENCE}->{$jid};
232    return unless $pres;
233    return $pres->{FULLJID};
234}
235
236=head2 Presence
237
238Returns a list of JIDS in the MUC, as Net::Jabber::JID objects
239
240=cut
241
242sub Presence {
243    my $self = shift;
244    return map {$_->{ROOMNICK}} values %{$self->{PRESENCE}};
245}
246
247=head2 Anonymous
248
249Returns true if the MUC is anonymous (hides participants real JIDs)
250
251=cut
252
253sub Anonymous {
254    my $self = shift;
255    return $self->{ANONYMOUS};
256}
257
2581;
Note: See TracBrowser for help on using the repository browser.