source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber/Connection.pm @ 5ddb952

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 5ddb952 was 3c455b4, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 14 years ago
r675, take two. This was lost in the merging of the PAR branch. Fix the bug in which rejoining a MUC you're already in (nick change) results in the MUC appearing multiple times when you show presence info for all MUCs.
  • Property mode set to 100644
File size: 2.3 KB
Line 
1use warnings;
2use strict;
3
4=head1 NAME
5
6BarnOwl::Module::Jabber::Connection
7
8=head1 DESCRIPTION
9
10A subclass of L<Net::Jabber::Client> used in the BarnOwl jabber module
11
12=cut
13
14package BarnOwl::Module::Jabber::Connection;
15
16use base qw(Net::Jabber::Client);
17
18use Net::Jabber;
19
20sub new {
21    my $class = shift;
22
23    my %args = ();
24    if(BarnOwl::getvar('debug') eq 'on') {
25        $args{debuglevel} = 1;
26        $args{debugfile} = 'jabber.log';
27    }
28    my $self = $class->SUPER::new(%args);
29    $self->{_BARNOWL_MUCS} = [];
30    return $self;
31}
32
33=head2 MUCJoin
34
35Extends MUCJoin to keep track of the MUCs we're joined to as
36Net::Jabber::MUC objects. Takes the same arguments as
37L<Net::Jabber::MUC/new> and L<Net::Jabber::MUC/Connect>
38
39=cut
40
41sub MUCJoin {
42    my $self = shift;
43    my $muc = Net::Jabber::MUC->new(connection => $self, @_);
44    $muc->Join(@_);
45
46    # Add MUC to list of MUCs, unless we're just changing nicks.
47    push @{$self->MUCs}, $muc unless grep {$_->BaseJID eq $muc->BaseJID} $self->MUCs;
48}
49
50=head2 MUCLeave ARGS
51
52Leave a MUC. The MUC is specified in the same form as L</FindMUC>
53
54=cut
55
56sub MUCLeave {
57    my $self = shift;
58    my $muc = $self->FindMUC(@_);
59    return unless $muc;
60
61    $muc->Leave();
62    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
63}
64
65=head2 FindMUC ARGS
66
67Return the Net::Jabber::MUC object representing a specific MUC we're
68joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
69or Room => $room, Server => $server.
70
71=cut
72
73sub FindMUC {
74    my $self = shift;
75
76    my %args;
77    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
78
79    my $jid;
80    if($args{jid}) {
81        $jid = $args{jid};
82    } elsif($args{room} && $args{server}) {
83        $jid = Net::Jabber::JID->new(userid => $args{room},
84                                     server => $args{server});
85    }
86    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
87
88    foreach my $muc ($self->MUCs) {
89        return $muc if $muc->BaseJID eq $jid;
90    }
91    return undef;
92}
93
94=head2 MUCs
95
96Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
97objects we believe ourself to be connected to.
98
99=cut
100
101sub MUCs {
102    my $self = shift;
103    my $mucs = $self->{_BARNOWL_MUCS};
104    return wantarray ? @$mucs : $mucs;
105}
106
107
108=head1 SEE ALSO
109
110L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
111
112=cut
113
1141;
Note: See TracBrowser for help on using the repository browser.