source: perl/modules/Jabber/lib/Net/Jabber/MUC.pm @ 86840c5

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 86840c5 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 4.6 KB
RevLine 
[004caa5]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;
[31cf416]57    } elsif($args{room} && $args{server} && $args{nick}) {
[004caa5]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
67    bless($self, $class);
68
69    $self->_init;
70
71    return $self;
72}
73
74=head2 JID
75
76Returns the Net::Jabber::JID object representing this MUC's JID
77(room@host/nick)
78
79=cut
80
81sub JID {
82    my $self = shift;
83    return $self->{JID};
84}
85
86=head2 BaseJID
87
88Returns the base JID of this MUC as a string
89
90=cut
91
92sub BaseJID {
93    my $self = shift;
94    return $self->JID->GetJID('base');
95}
96
97
98=head2 _init
99
100Add callbacks to our connection to receive the appropriate packets.
101
102=cut
103
104sub _init {
105    my $self = shift;
106
107    $self->{CONNECTION}->SetXPathCallBacks('/presence' => sub { $self->_handler(@_) });
108}
109
110=head2 Join
111
112Sends the appropriate presence packet to join us to the MUC.
113
114=cut
115
116sub Join {
117    my $self = shift;
118    my %args;
119    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
120
121    my $presence = Net::Jabber::Presence->new;
122    $presence->SetTo($self->JID);
123    my $x = $presence->NewChild('http://jabber.org/protocol/muc');
124    if($args{password}) {
125        $x->SetPassword($args{password});
126    }
127    if($args{history}) {
128        my $h = $x->AddHistory();
129        if($args{history}{MaxChars}) {
130            $h->SetMaxChars($args{history}{MaxChars});
131        } elsif($args{history}{MaxStanzas}) {
132            $h->SetMaxStanzas($args{history}{MaxStanzas});
133        } elsif($args{history}{Seconds}) {
134            $h->SetSeconds($args{history}{Seconds});
135        } elsif($args{history}{Since}) {
136            $h->SetSince($args{history}{Since});
137        }
138    }
139    $self->{CONNECTION}->Send($presence);
140}
141
142=head2 Leave
143
144Leaves the MUC
145
146=cut
147
148sub Leave {
149    my $self = shift;
150    my %args;
151    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
152
153    $self->{CONNECTION}->PresenceSend(to => $self->JID, type => 'unavailable');
154    $self->{PRESENCE} = {};
155}
156
157
158=head2 _handler
159
160Central dispatch point for handling incoming packets.
161
162=cut
163
164sub _handler {
165    my $self = shift;
166    my $sid = shift;
167    my $packet = shift;
[31cf416]168
[004caa5]169    $self->_handlePresence($packet) if $packet->GetTag() eq "presence";
170}
171
172=head2 handlePresence
173
174Handle an incoming presence packet.
175
176=cut
177
178sub _handlePresence {
179    my $self = shift;
180    my $presence = shift;
181
182    my $type = $presence->GetType() || "available";
[31cf416]183    my $from = Net::Jabber::JID->new($presence->GetFrom());
184
185    return unless $from->GetJID('base') eq $self->BaseJID;
[004caa5]186
[31cf416]187    if($type eq 'unavailable') {
[004caa5]188        delete $self->{PRESENCE}->{$from->GetJID('full')};
[31cf416]189    } elsif($type eq 'available') {
[004caa5]190        $self->{PRESENCE}->{$from->GetJID('full')} = $from;
191    }
192}
193
194=head2 Contains JID
195
196Returns true iff the MUC contains the specified full JID
197
198=cut
199
200sub Contains {
201    my $self = shift;
202    my $jid = shift;
203
204    $jid = $jid->GetJID('full') if UNIVERSAL::isa($jid, 'Net::Jabber::JID');
205
206    return exists $self->{PRESENCE}->{$jid};
207}
208
209=head2 Presence
210
211Returns a list of JIDS in the MUC, as Net::Jabber::JID objects
212
213=cut
214
215sub Presence {
216    my $self = shift;
[31cf416]217    return values %{$self->{PRESENCE}};
[004caa5]218}
[31cf416]219
2201;
Note: See TracBrowser for help on using the repository browser.