source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber/Connection.pm @ 892568b

barnowl_perlaimdebianrelease-1.10release-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>, 17 years ago
Show full JIDs for users in non-anonymous JIDs in :jmuc presence. closes #24
  • Property mode set to 100644
File size: 2.4 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
54Returns true if successful, false if this connection was not in the
55named MUC.
56
57=cut
58
59sub MUCLeave {
60    my $self = shift;
61    my $muc = $self->FindMUC(@_);
62    return unless $muc;
63
64    $muc->Leave();
65    $self->{_BARNOWL_MUCS} = [grep {$_->BaseJID ne $muc->BaseJID} $self->MUCs];
66    return 1;
67}
68
69=head2 FindMUC ARGS
70
71Return the Net::Jabber::MUC object representing a specific MUC we're
72joined to, undef if it doesn't exists. ARGS can be either JID => $JID,
73or Room => $room, Server => $server.
74
75=cut
76
77sub FindMUC {
78    my $self = shift;
79
80    my %args;
81    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
82
83    my $jid;
84    if($args{jid}) {
85        $jid = $args{jid};
86    } elsif($args{room} && $args{server}) {
87        $jid = Net::Jabber::JID->new(userid => $args{room},
88                                     server => $args{server});
89    }
90    $jid = $jid->GetJID('base') if UNIVERSAL::isa($jid, 'Net::XMPP::JID');
91
92    foreach my $muc ($self->MUCs) {
93        return $muc if $muc->BaseJID eq $jid;
94    }
95    return undef;
96}
97
98=head2 MUCs
99
100Returns a list (or arrayref in scalar context) of Net::Jabber::MUC
101objects we believe ourself to be connected to.
102
103=cut
104
105sub MUCs {
106    my $self = shift;
107    my $mucs = $self->{_BARNOWL_MUCS};
108    return wantarray ? @$mucs : $mucs;
109}
110
111
112=head1 SEE ALSO
113
114L<Net::Jabber::Client>, L<BarnOwl::Module::Jabber>
115
116=cut
117
1181;
Note: See TracBrowser for help on using the repository browser.