source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber/Connection.pm @ 367fbf3

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